tests: nfs: Fix nfs-root-fs test.

This test has probably never been working. Rename it nfs-full, and test that
an NFS server can be started in a VM and mounted in another VM.

* gnu/tests/nfs.scm (run-nfs-root-fs-test): Rename it ...
(run-nfs-full-test): ... this way.
(%test-nfs-root-fs): Rename it ...
(%test-nfs-full): ... this way.
This commit is contained in:
Mathieu Othacehe 2021-12-22 18:30:34 +01:00
parent 207ee9d9cd
commit dbd3454c3b
No known key found for this signature in database
GPG key ID: 8354763531769CA6

View file

@ -33,6 +33,7 @@ (define-module (gnu tests nfs)
#:use-module (gnu services base)
#:use-module (gnu services nfs)
#:use-module (gnu services networking)
#:use-module (gnu packages admin)
#:use-module (gnu packages onc-rpc)
#:use-module (gnu packages nfs)
#:use-module (guix gexp)
@ -40,7 +41,7 @@ (define-module (gnu tests nfs)
#:use-module (guix monads)
#:export (%test-nfs
%test-nfs-server
%test-nfs-root-fs))
%test-nfs-full))
(define %base-os
(operating-system
@ -259,41 +260,63 @@ (define %test-nfs-server
(value (run-nfs-server-test))))
(define (run-nfs-root-fs-test)
(define (run-nfs-full-test)
"Run a test of an OS mounting its root file system via NFS."
(define nfs-root-server-os
(let ((os (simple-operating-system)))
(marionette-operating-system
(operating-system
(inherit %nfs-os)
(inherit os)
(services
(modify-services (operating-system-user-services %nfs-os)
(nfs-service-type config =>
(cons*
(service static-networking-service-type
(list
(static-networking
(addresses (list (network-address
(device "ens5")
(value "10.0.2.15/24")))))))
(simple-service 'export activation-service-type
#~(begin
(mkdir-p "/export")
(chmod "/export" #o777)))
(service nfs-service-type
(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,insecure,async)")))))
(modify-services (operating-system-user-services os)
(syslog-service-type config
=>
(syslog-configuration
(inherit config)
(config-file
(plain-file
"syslog.conf"
"*.* /dev/console\n"))))))))
#:requirements '(nscd)
#:imported-modules '((gnu services herd)
(guix combinators))))
(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)))
(simple-operating-system
(service static-networking-service-type
(list
(static-networking
(addresses
(list (network-address
(device "ens5")
(value "10.0.2.16/24")))))))
(service nfs-service-type
(nfs-configuration
(nfsd-port 2049)
(nfs-versions '("4.2"))))
(simple-service 'export activation-service-type
#~(begin
(mkdir-p "/export")
(chmod "/export" #o777))))
#:requirements '(nscd)
#:imported-modules '((gnu services herd)
(guix combinators))))
@ -308,84 +331,56 @@ (define test
(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)))
))
(make-marionette
(cons* #$(virtual-machine
(operating-system nfs-root-server-os)
(volatile? #f))
'("-device" "e1000,netdev=n1,mac=52:54:00:12:34:56"
"-netdev" "socket,id=n1,listen=:1234"))
#: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.
(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)))
))))
(make-marionette
(cons* #$(virtual-machine
(operating-system nfs-root-client-os)
(volatile? #f))
'("-device" "e1000,netdev=n2,mac=52:54:00:12:34:57"
"-netdev" "socket,id=n2,connect=127.0.0.1:1234"))
#:socket-directory "/tmp/client"))
(test-assert "NFS port is ready"
(wait-for-tcp-port 2049 client-marionette))
(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"
(and
(system* (string-append #$nfs-utils "/sbin/mount.nfs")
"10.0.2.15:/export" "/export" "-v")
(let ((content (call-with-input-file "/proc/mounts"
get-string-all)))
(call-with-output-file "/export/mounts"
(lambda (port)
(display content port))))
(chmod "/mounts.new" #o777)
(rename-file "/mounts.new" "/mounts"))
(display content port))))))
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
@ -395,11 +390,11 @@ (define client-marionette
(test-end))))
(gexp->derivation "nfs-root-fs-test" test))
(gexp->derivation "nfs-full-test" test))
(define %test-nfs-root-fs
(define %test-nfs-full
(system-test
(name "nfs-root-fs")
(name "nfs-full")
(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 by another machine.")
(value (run-nfs-full-test))))