1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2016, 2017, 2020 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
4 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
5 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
6 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
7 ;;; Copyright © 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
9 ;;; This file is part of GNU Guix.
11 ;;; GNU Guix is free software; you can redistribute it and/or modify it
12 ;;; under the terms of the GNU General Public License as published by
13 ;;; the Free Software Foundation; either version 3 of the License, or (at
14 ;;; your option) any later version.
16 ;;; GNU Guix is distributed in the hope that it will be useful, but
17 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;;; GNU General Public License for more details.
21 ;;; You should have received a copy of the GNU General Public License
22 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
24 (define-module (gnu tests nfs)
25 #:use-module (gnu tests)
26 #:use-module (gnu bootloader)
27 #:use-module (gnu bootloader grub)
28 #:use-module (gnu system)
29 #:use-module (gnu system file-systems)
30 #:use-module (gnu system shadow)
31 #:use-module (gnu system vm)
32 #:use-module (gnu services)
33 #:use-module (gnu services base)
34 #:use-module (gnu services nfs)
35 #:use-module (gnu services networking)
36 #:use-module (gnu packages onc-rpc)
37 #:use-module (gnu packages nfs)
38 #:use-module (guix gexp)
39 #:use-module (guix store)
40 #:use-module (guix monads)
47 (host-name "olitupmok")
48 (timezone "Europe/Berlin")
49 (locale "en_US.UTF-8")
51 (bootloader (bootloader-configuration
52 (bootloader grub-bootloader)
54 (file-systems %base-file-systems)
55 (users %base-user-accounts)
60 (service rpcbind-service-type)
61 (service dhcp-client-service-type)
64 (define (run-nfs-test name socket)
65 "Run a test of an OS running RPC-SERVICE, which should create SOCKET."
67 (marionette-operating-system
69 #:imported-modules '((gnu services herd)
73 (with-imported-modules '((gnu build marionette))
75 (use-modules (gnu build marionette)
79 (make-marionette (list #$(virtual-machine os))))
81 (define (wait-for-socket file)
82 ;; Wait until SOCKET exists in the guest
85 (cond ((and (file-exists? ,file)
86 (eq? 'socket (stat:type (stat ,file))))
92 (error "Socket didn't show up: " ,file))))
98 (test-begin "rpc-daemon")
100 ;; Wait for the rpcbind daemon to be up and running.
101 (test-assert "RPC service running"
104 (use-modules (gnu services herd))
106 ;; Ensure 'rpcinfo' can be found below.
107 (setenv "PATH" "/run/current-system/profile/bin")
109 (start-service 'rpcbind-daemon))
112 ;; Check the socket file and that the service is still running.
113 (test-assert "RPC socket exists"
115 (wait-for-socket #$socket)
118 (use-modules (gnu services herd)
121 (live-service-running
123 (memq 'rpcbind-daemon
124 (live-service-provision live)))
125 (current-services))))
128 (test-assert "Probe RPC daemon"
130 '(zero? (system* "rpcinfo" "-p"))
134 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
136 (gexp->derivation name test))
141 (description "Test some things related to NFS.")
142 (value (run-nfs-test name "/var/run/rpcbind.sock"))))
146 (let ((os (simple-operating-system
147 (simple-service 'create-target-directory activation-service-type
150 (chmod "/remote" #o777)
152 (service dhcp-client-service-type)
153 (service nfs-service-type
155 (debug '(nfs nfsd mountd))
156 (exports '(("/export"
157 ;; crossmnt = This is the pseudo root.
158 ;; fsid=0 = root file system of the export
159 "*(ro,insecure,no_subtree_check,crossmnt,fsid=0)"))))))))
162 (host-name "nfs-server")
163 ;; We need to use a tmpfs here, because the test system's root file
164 ;; system cannot be re-exported via NFS.
168 (mount-point "/export")
170 (create-mount-point? #t))
173 ;; Enable debugging output.
174 (modify-services (operating-system-user-services os)
175 (syslog-service-type config
177 (syslog-configuration
182 "*.* /dev/console\n")))))))))
184 (define (run-nfs-server-test)
185 "Run a test of an OS running a service of NFS-SERVICE-TYPE."
187 (marionette-operating-system
189 #:requirements '(nscd)
190 #:imported-modules '((gnu services herd)
191 (guix combinators))))
193 (with-imported-modules '((gnu build marionette))
195 (use-modules (gnu build marionette)
199 (make-marionette (list #$(virtual-machine os))))
204 (test-begin "nfs-daemon")
208 (open-file "/dev/console" "w0"))
209 (chmod "/export" #o777)
210 (with-output-to-file "/export/hello"
211 (lambda () (display "hello world")))
212 (chmod "/export/hello" #o777))
215 (test-assert "nscd PID file is created"
218 (use-modules (gnu services herd))
219 (start-service 'nscd))
222 (test-assert "nscd is listening on its socket"
223 (wait-for-unix-socket "/var/run/nscd/socket"
226 (test-assert "network is up"
229 (use-modules (gnu services herd))
230 (start-service 'networking))
233 ;; Wait for the NFS services to be up and running.
234 (test-assert "nfs services are running"
235 (and (marionette-eval
237 (use-modules (gnu services herd))
238 (start-service 'nfs))
240 (wait-for-file "/var/run/rpc.statd.pid" marionette)))
242 (test-assert "nfs share is advertised"
244 '(zero? (system* (string-append #$nfs-utils "/sbin/showmount")
248 (test-assert "nfs share mounted"
251 (and (zero? (system* (string-append #$nfs-utils "/sbin/mount.nfs4")
252 "nfs-server:/" "/remote" "-v"))
253 (file-exists? "/remote/hello")))
256 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
258 (gexp->derivation "nfs-server-test" test))
260 (define %test-nfs-server
263 (description "Test that an NFS server can be started and exported
264 directories can be mounted.")
265 (value (run-nfs-server-test))))
268 (define (run-nfs-root-fs-test)
269 "Run a test of an OS mounting its root file system via NFS."
270 (define nfs-root-server-os
271 (marionette-operating-system
275 (modify-services (operating-system-user-services %nfs-os)
276 (nfs-service-type config =>
278 (debug '(nfs nfsd mountd))
279 ;;; Note: Adding the following line causes Guix to hang.
280 ;(rpcmountd-port 20001)
281 ;;; Note: Adding the following line causes Guix to hang.
282 ;(rpcstatd-port 20002) ; FIXME: Set broadcast port AND listening port.
284 (nfs-versions '("4.2"))
285 (exports '(("/export"
286 "*(rw,insecure,no_subtree_check,crossmnt,fsid=root,no_root_squash,insecure,async)"))))))))
287 #:requirements '(nscd)
288 #:imported-modules '((gnu services herd)
289 (guix combinators))))
291 (define nfs-root-client-os
292 (marionette-operating-system
294 (inherit (simple-operating-system (service dhcp-client-service-type)))
295 (kernel-arguments '("ip=dhcp"))
301 (options "addr=127.0.0.1,vers=4.2"))
302 %base-file-systems)))
303 #:requirements '(nscd)
304 #:imported-modules '((gnu services herd)
305 (guix combinators))))
308 (with-imported-modules '((gnu build marionette))
310 (use-modules (gnu build marionette)
316 (test-begin "start-nfs-boot-test")
318 ;;; Start up NFS server host.
320 (mkdir "/tmp/server")
321 (define server-marionette
322 (make-marionette (list #$(virtual-machine
324 ;(operating-system nfs-root-server-os)
325 ;(port-forwardings '( ; (111 . 111)
330 #:socket-directory "/tmp/server"))
334 (use-modules (gnu services herd))
336 (open-file "/dev/console" "w0"))
337 ;; FIXME: Instead statfs "/" and "/export" and wait until they
338 ;; are different file systems. But Guile doesn't seem to have
341 (chmod "/export" #o777)
342 (symlink "/gnu" "/export/gnu")
343 (start-service 'nscd)
344 (start-service 'networking)
345 (start-service 'nfs))
348 ;;; Wait for the NFS services to be up and running.
350 (test-assert "nfs services are running"
351 (wait-for-file "/var/run/rpc.statd.pid" server-marionette))
353 (test-assert "NFS port is ready"
354 (wait-for-tcp-port 2049 server-marionette))
356 (test-assert "NFS statd port is ready"
357 (wait-for-tcp-port 20002 server-marionette))
359 (test-assert "NFS mountd port is ready"
360 (wait-for-tcp-port 20001 server-marionette))
362 ;;; FIXME: (test-assert "NFS portmapper port is ready"
363 ;;; FIXME: (wait-for-tcp-port 111 server-marionette))
365 ;;; Start up NFS client host.
367 (define client-marionette
368 (make-marionette (list #$(virtual-machine
370 ;(port-forwardings '((111 . 111)
378 (use-modules (gnu services herd))
379 (use-modules (rnrs io ports))
382 (open-file "/dev/console" "w0"))
383 (let ((content (call-with-input-file "/proc/mounts" get-string-all)))
384 (call-with-output-file "/mounts.new"
386 (display content port))))
387 (chmod "/mounts.new" #o777)
388 (rename-file "/mounts.new" "/mounts"))
391 (test-assert "nfs-root-client booted")
393 ;;; Check whether NFS client host communicated with NFS server host.
395 (test-assert "nfs client deposited file"
396 (wait-for-file "/export/mounts" server-marionette))
400 (open-file "/dev/console" "w0"))
401 (call-with-input-file "/export/mounts" display))
405 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
407 (gexp->derivation "nfs-server-test" test))
409 (define %test-nfs-root-fs
412 (description "Test that an NFS server can be started and the exported
413 directory can be used as root filesystem.")
414 (value (run-nfs-root-fs-test))))