bug#47744: nfs-root-fs test is failing

[Stefan <stefan-guix@vodafonemail.de>]

[-- Attachment #1: Type: text/plain, Size: 227 bytes --]

Hi!

Sorry, that was not quite correct. I sent a patch months back, which did not make it into this ticket, which solved this ticket but depends on <http://issues.guix.gnu.org/48314>.

Here it is again.


Bye

Stefan

[-- Attachment #2: nfs-root-for-virtual-machines.patch --]
[-- Type: application/octet-stream, Size: 14053 bytes --]

NFS root for virtual machines.

From: Stefan <stefan-guix@vodafonemail.de>

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))))
 
 \f
-(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))))