summary refs log tree commit diff
path: root/gnu/tests/nfs.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/tests/nfs.scm')
-rw-r--r--gnu/tests/nfs.scm152
1 files changed, 151 insertions, 1 deletions
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 5e4de2783b..da729ddcc9 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -39,7 +39,8 @@
   #:use-module (guix store)
   #:use-module (guix monads)
   #:export (%test-nfs
-            %test-nfs-server))
+            %test-nfs-server
+            %test-nfs-root-fs))
 
 (define %base-os
   (operating-system
@@ -262,3 +263,152 @@
    (description "Test that an NFS server can be started and exported
 directories can be mounted.")
    (value (run-nfs-server-test))))
+
+
+(define (run-nfs-root-fs-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)"))))))))
+     #: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))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+
+          (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.  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 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))
+              (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.
+
+          (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-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "nfs-server-test" test))
+
+(define %test-nfs-root-fs
+  (system-test
+   (name "nfs-root-fs")
+   (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))))