From 76ef5ee8d5505bf82c3226398844224e22fa78e1 Mon Sep 17 00:00:00 2001 From: Stefan Date: Sun, 18 Apr 2021 19:32:55 +0200 Subject: [PATCH] NFS root for virtual machines. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 | 160 ++++++++++++++++++++-------------------------- 2 files changed, 92 insertions(+), 98 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..33c019da89 100644 --- a/gnu/tests/nfs.scm +++ b/gnu/tests/nfs.scm @@ -27,6 +27,7 @@ #: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) @@ -40,7 +41,7 @@ #:use-module (guix monads) #:export (%test-nfs %test-nfs-server - %test-nfs-root-fs)) + %test-nfs-root)) (define %base-os (operating-system @@ -265,7 +266,7 @@ 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 @@ -275,15 +276,8 @@ directories can be mounted.") (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)")))))))) + "*(rw,insecure,no_subtree_check,crossmnt,fsid=root,no_root_squash,async)")))))))) #:requirements '(nscd) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -292,13 +286,23 @@ directories can be mounted.") (marionette-operating-system (operating-system (inherit (simple-operating-system (service dhcp-client-service-type))) + (host-name "nfs-client") (kernel-arguments '("ip=dhcp")) + (initrd-modules + (cons "e1000" %base-initrd-modules)) + (initrd (lambda (file-systems . rest) + ;; Create a standard initrd but set up networking + ;; with the parameters QEMU expects by default. + (apply base-initrd + file-systems + #:qemu-networking? #t + rest))) (file-systems (cons (file-system (type "nfs") (mount-point "/") (device ":/export") - (options "addr=127.0.0.1,vers=4.2")) + (options "addr=127.0.0.1")) %base-file-systems))) #:requirements '(nscd) #:imported-modules '((gnu services herd) @@ -313,102 +317,80 @@ 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))) -)) + nfs-root-server-os)) #: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) + (symlink "/gnu" "/export/gnu") + (start-service 'nscd) + (start-service 'networking) + (start-service 'nfs) + #t) + 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)) - - (test-assert "NFS statd port is ready" - (wait-for-tcp-port 20002 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 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") + nfs-root-client-os)) + #:socket-directory "/tmp/client")) - ;;; Check whether NFS client host communicated with NFS server host. - - (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 "nfs-root client boots" + (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))) + (display content) + (newline) + (call-with-output-file "/mounts" + (lambda (port) + (display content port))) + content)) + client-marionette)) + + (test-assert "wait nfs-root client booted and deposited mounts file" + (and (wait-for-file "/export/mounts" server-marionette))) + (test-assert "nfs-root client booted and deposited mounts file" + (marionette-eval + '(begin + (current-output-port + (open-file "/dev/console" "w0")) + (call-with-input-file "/export/mounts" + get-string-all)) + server-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)))) -- 2.31.1