From c41a8572efa69c5b29002245090db653f87e6da8 Mon Sep 17 00:00:00 2001
From: Danny Milosavljevic <dannym@scratchpost.org>
Date: Thu, 10 Sep 2020 18:08:48 +0200
Subject: tests: nfs: Improve "nfs-root-fs".

Follow-up to a1a39ed5a46044161a71cbe6931c7e3006a82ecb.

* gnu/tests/nfs.scm (run-nfs-root-fs-test): Improve tests.
(%test-nfs-root-fs)[description]: Modify.
---
 gnu/tests/nfs.scm | 72 ++++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 56 insertions(+), 16 deletions(-)

(limited to 'gnu/tests/nfs.scm')

diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index ee8e3ad000..da729ddcc9 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -273,11 +273,15 @@ directories can be mounted.")
        (inherit %nfs-os)
        (services
          (modify-services (operating-system-user-services %nfs-os)
-           (nfs-service-type
-            config
-            =>
+           (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)"))))))))
      #:requirements '(nscd)
@@ -287,14 +291,14 @@ directories can be mounted.")
   (define nfs-root-client-os
     (marionette-operating-system
      (operating-system
-       (inherit %nfs-os)
+       (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=0.0.0.0,vers=4.2"))
+                        (options "addr=127.0.0.1,vers=4.2"))
                      %base-file-systems)))
      #:requirements '(nscd)
      #:imported-modules '((gnu services herd)
@@ -306,24 +310,34 @@ directories can be mounted.")
           (use-modules (gnu build marionette)
                        (srfi srfi-64))
 
-          (mkdir "/tmp/server")
-          (define server-marionette
-            (make-marionette (list #$(virtual-machine nfs-root-server-os)) #:socket-directory "/tmp/server"))
-          (define client-marionette
-            (make-marionette (list #$(virtual-machine nfs-root-client-os))))
-
           (mkdir #$output)
           (chdir #$output)
 
           (test-begin "start-nfs-boot-test")
+
+          ;;; Start up NFS server host.
+
+          (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"))
+
           (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.
-              (sleep 10)
+              ;; are different file systems.  But Guile doesn't seem to have
+              ;; statfs.
+              (sleep 5)
               (chmod "/export" #o777)
               (symlink "/gnu" "/export/gnu")
               (start-service 'nscd)
@@ -331,10 +345,34 @@ directories can be mounted.")
               (start-service 'nfs))
            server-marionette)
 
-          ;; Wait for the NFS services to be up and running.
+          ;;; Wait for the NFS services to be up and running.
+
           (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))
+
+          (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))
+
+          ;;; Start up NFS client host.
+
+          (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))
@@ -352,6 +390,8 @@ directories can be mounted.")
 
           (test-assert "nfs-root-client booted")
 
+          ;;; 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
@@ -369,6 +409,6 @@ directories can be mounted.")
 (define %test-nfs-root-fs
   (system-test
    (name "nfs-root-fs")
-   (description "Test that an NFS server can be started and exported
-directories can be mounted.")
+   (description "Test that an NFS server can be started and the exported
+directory can be used as root filesystem.")
    (value (run-nfs-root-fs-test))))
-- 
cgit v1.2.3