NFS root for virtual machines. From: Stefan gnu: system: Allow a root file-system over NFS for virtual machines. gnu: tests: Improve the test for a root file-system over NFS. However, the test is still failing. * gnu/system/vm.scm (virtualized-operating-system): Allow root file-systems over NFS. (system-qemu-image/shared-store-script): Respect the configured root file-system-device. * gnu/tests/nfs.scm (run-nfs-root-fs-test): Renamed to … (run-nfs-root-test): … this. Cleanup and improvements. (%test-nfs-root-fs): Renamed to … (%test-nfs-root): … this. Renamed the test from "nfs-root-fs" to "nfs-root". --- gnu/system/vm.scm | 30 ++++++-- gnu/tests/nfs.scm | 188 ++++++++++++++++++++++------------------------------- 2 files changed, 100 insertions(+), 118 deletions(-) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 97adfa12fa..be0a4695f2 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -608,7 +608,8 @@ environment with the store shared with the host. MAPPINGS is a list of (let ((target (file-system-mount-point fs)) (source (file-system-device fs))) (or (string=? target (%store-prefix)) - (string=? target "/") + (and (string=? target "/") + (not (string=? (file-system-type fs) "nfs"))) (and (string? source) (string-prefix? "/dev/" source)) @@ -618,14 +619,20 @@ environment with the store shared with the host. MAPPINGS is a list of (uuid? source)))))) (operating-system-file-systems os))) - (define virtual-file-systems - (cons (file-system - (mount-point "/") - (device "/dev/vda1") - (type "ext4")) + (define (add-missing-root-fs user-file-systems) + (if (null? (filter (lambda (fs) + (string=? (file-system-mount-point fs) "/")) + user-file-systems)) + (cons (file-system + (mount-point "/") + (device "/dev/vda1") + (type "ext4")) + user-file-systems) + user-file-systems)) - (append (map mapping->file-system mappings) - user-file-systems))) + (define virtual-file-systems + (append (map mapping->file-system mappings) + (add-missing-root-fs user-file-systems))) (operating-system (inherit os) @@ -754,7 +761,12 @@ it is mostly useful when FULL-BOOT? is true." #:disk-image-size disk-image-size))) (define kernel-arguments #~(list #$@(if graphic? #~() #~("console=ttyS0")) - #+@(operating-system-kernel-arguments os "/dev/vda1"))) + #+@(operating-system-kernel-arguments + os + (file-system-device + (first (filter (lambda (fs) + (string=? (file-system-mount-point fs) "/")) + (operating-system-file-systems os))))))) (define qemu-exec #~(list #+(file-append qemu "/bin/" diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm index 9b2b785176..2190e3a715 100644 --- a/gnu/tests/nfs.scm +++ b/gnu/tests/nfs.scm @@ -27,12 +27,14 @@ #:use-module (gnu bootloader grub) #:use-module (gnu system) #:use-module (gnu system file-systems) + #:use-module (gnu system linux-initrd) #:use-module (gnu system shadow) #:use-module (gnu system vm) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services nfs) #:use-module (gnu services networking) + #:use-module (gnu packages linux) #:use-module (gnu packages onc-rpc) #:use-module (gnu packages nfs) #:use-module (guix gexp) @@ -40,7 +42,7 @@ #:use-module (guix monads) #:export (%test-nfs %test-nfs-server - %test-nfs-root-fs)) + %test-nfs-root)) (define %base-os (operating-system @@ -265,44 +267,53 @@ directories can be mounted.") (value (run-nfs-server-test)))) -(define (run-nfs-root-fs-test) +(define (run-nfs-root-test) "Run a test of an OS mounting its root file system via NFS." (define nfs-root-server-os (marionette-operating-system (operating-system (inherit %nfs-os) (services - (modify-services (operating-system-user-services %nfs-os) - (nfs-service-type config => - (nfs-configuration - (debug '(nfs nfsd mountd)) - ;;; Note: Adding the following line causes Guix to hang. - ;(rpcmountd-port 20001) - ;;; Note: Adding the following line causes Guix to hang. - ;(rpcstatd-port 20002) ; FIXME: Set broadcast port AND listening port. - (nfsd-port 2049) - (nfs-versions '("4.2")) - (exports '(("/export" - "*(rw,insecure,no_subtree_check,crossmnt,fsid=root,no_root_squash,insecure,async)")))))))) + (cons* + (static-networking-service "ens3" "10.0.0.15" + #:netmask "255.255.255.0") + (modify-services (operating-system-user-services %nfs-os) + (delete dhcp-client-service-type) + (nfs-service-type config => + (nfs-configuration + (exports '(("/export" + "*(rw,fsid=0,async,no_wdelay,no_root_squash,insecure,no_subtree_check,crossmnt)"))))))))) #:requirements '(nscd) #:imported-modules '((gnu services herd) (guix combinators)))) (define nfs-root-client-os - (marionette-operating-system - (operating-system - (inherit (simple-operating-system (service dhcp-client-service-type))) - (kernel-arguments '("ip=dhcp")) - (file-systems (cons - (file-system - (type "nfs") - (mount-point "/") - (device ":/export") - (options "addr=127.0.0.1,vers=4.2")) - %base-file-systems))) - #:requirements '(nscd) - #:imported-modules '((gnu services herd) - (guix combinators)))) + (let ((base-os (simple-operating-system (service dhcp-client-service-type)))) + (marionette-operating-system + (operating-system + (inherit base-os) + (host-name "nfs-client") + (kernel (modify-linux #:linux (operating-system-kernel base-os) + #:configs '("CONFIG_E1000=y" + "CONFIG_ROOT_NFS=y" + "CONFIG_NFS_FS=y" + "CONFIG_NFS_V4=y"))) + (kernel-arguments '("ip=10.0.0.16:::255.255.255.0:::off")) + (file-systems (cons + (file-system + (type "nfs") + (mount-point "/") + (device ":/") + (options "addr=10.0.0.15,vers=4")) + %base-file-systems)) + (services (cons* + (static-networking-service "eth0" "10.0.0.16" + #:netmask "255.255.255.0" + #:requirement '()) + %base-services))) + #:requirements '(nscd) + #:imported-modules '((gnu services herd) + (guix combinators))))) (define test (with-imported-modules '((gnu build marionette)) @@ -313,102 +324,61 @@ directories can be mounted.") (mkdir #$output) (chdir #$output) - (test-begin "start-nfs-boot-test") - - ;;; Start up NFS server host. + (test-begin "start nfs-root server") (mkdir "/tmp/server") (define server-marionette - (make-marionette (list #$(virtual-machine - nfs-root-server-os - ;(operating-system nfs-root-server-os) - ;(port-forwardings '( ; (111 . 111) - ; (2049 . 2049) - ; (20001 . 20001) - ; (20002 . 20002))) -)) - #:socket-directory "/tmp/server")) + (make-marionette + (cons* #$(virtual-machine nfs-root-server-os) + '("-nic" "socket,listen=127.0.0.1:37915,model=e1000,mac=52:54:98:76:54:32")) + #:socket-directory "/tmp/server")) - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (current-output-port - (open-file "/dev/console" "w0")) - ;; FIXME: Instead statfs "/" and "/export" and wait until they - ;; are different file systems. But Guile doesn't seem to have - ;; statfs. - (sleep 5) - (chmod "/export" #o777) - (symlink "/gnu" "/export/gnu") - (start-service 'nscd) - (start-service 'networking) - (start-service 'nfs)) - server-marionette) - - ;;; Wait for the NFS services to be up and running. + (test-assert "nfs-root server boots" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (current-output-port + (open-file "/dev/console" "w0")) + (chmod "/export" #o777) + (mkdir-p "/export/var/run") + (mkdir-p "/export/run") + (call-with-output-file "/export/run/hello" + (lambda (port) + (display "Hello, World!" port))) + (and (start-service 'networking) + (start-service 'nscd) + (start-service 'nfs))) + server-marionette)) (test-assert "nfs services are running" - (wait-for-file "/var/run/rpc.statd.pid" server-marionette)) - - (test-assert "NFS port is ready" - (wait-for-tcp-port 2049 server-marionette)) + (and (wait-for-file "/var/run/rpc.statd.pid" server-marionette) + (marionette-eval + '(zero? (system* (string-append #$nfs-utils "/sbin/showmount") + "-e" "nfs-server")) + server-marionette))) - (test-assert "NFS statd port is ready" - (wait-for-tcp-port 20002 server-marionette)) - - (test-assert "NFS mountd port is ready" - (wait-for-tcp-port 20001 server-marionette)) - - ;;; FIXME: (test-assert "NFS portmapper port is ready" - ;;; FIXME: (wait-for-tcp-port 111 server-marionette)) + (test-end) - ;;; Start up NFS client host. + (test-begin "start nfs-root client") + (mkdir "/tmp/client") (define client-marionette - (make-marionette (list #$(virtual-machine - nfs-root-client-os - ;(port-forwardings '((111 . 111) - ; (2049 . 2049) - ; (20001 . 20001) - ; (20002 . 20002))) - )))) - - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (use-modules (rnrs io ports)) - - (current-output-port - (open-file "/dev/console" "w0")) - (let ((content (call-with-input-file "/proc/mounts" get-string-all))) - (call-with-output-file "/mounts.new" - (lambda (port) - (display content port)))) - (chmod "/mounts.new" #o777) - (rename-file "/mounts.new" "/mounts")) - client-marionette) - - (test-assert "nfs-root-client booted") - - ;;; Check whether NFS client host communicated with NFS server host. + (make-marionette + (cons* #$(virtual-machine nfs-root-client-os) + '("-nic" "socket,connect=127.0.0.1:37915,model=e1000,mac=52:54:98:76:54:33")) + #:socket-directory "/tmp/client")) - (test-assert "nfs client deposited file" - (wait-for-file "/export/mounts" server-marionette)) - (marionette-eval - '(begin - (current-output-port - (open-file "/dev/console" "w0")) - (call-with-input-file "/export/mounts" display)) - server-marionette) + (test-assert "wait nfs-root client booted and sees hello file" + (wait-for-file "/run/hello" client-marionette)) (test-end) (exit (= (test-runner-fail-count (test-runner-current)) 0))))) - (gexp->derivation "nfs-root-fs-test" test)) + (gexp->derivation "nfs-root-test" test)) -(define %test-nfs-root-fs +(define %test-nfs-root (system-test - (name "nfs-root-fs") + (name "nfs-root") (description "Test that an NFS server can be started and the exported -directory can be used as root file system.") - (value (run-nfs-root-fs-test)))) +directory can be used as root file system of an NFS client.") + (value (run-nfs-root-test))))