tests: Add "nfs-root-fs" system test.

* gnu/tests/nfs.scm (run-nfs-root-fs-test): New procedure.
(%test-nfs-root-fs): New variable.  Export it.

Signed-off-by: Danny Milosavljevic <dannym@scratchpost.org>
This commit is contained in:
Stefan 2020-09-07 14:50:52 +02:00 committed by Danny Milosavljevic
parent b1c1d7efa6
commit a1a39ed5a4
No known key found for this signature in database
GPG key ID: E71A35542C30BAA5

View file

@ -39,7 +39,8 @@ (define-module (gnu tests nfs)
#: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,103 @@ (define %test-nfs-server
(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)
(file-systems %base-file-systems)
(services
(modify-services (operating-system-user-services %nfs-os)
(nfs-service-type
config
=>
(nfs-configuration
(debug '(nfs nfsd mountd))
(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 %nfs-os)
(kernel-arguments '("ip=dhcp"))
(file-systems (cons
(file-system
(type "nfs")
(mount-point "/")
(device ":/export")
(options "addr=0.0.0.0,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 "/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-root-server")
(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))
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-begin "boot-nfs-root-client")
(marionette-eval
'(begin
(use-modules (gnu services herd))
(current-output-port
(open-file "/dev/console" "w0"))
(with-output-to-file "/var/run/mounts"
(lambda () (system* "mount")))
(chmod "/var/run/mounts" #o777))
client-marionette)
(test-assert "nfs-root-client booted")
(marionette-eval
'(begin
(and (file-exists? "/export/var/run/mounts")
(system* "cat" "/export/var/run/mounts")))
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 exported
directories can be mounted.")
(value (run-nfs-root-fs-test))))