me
/
guix
Archived
1
0
Fork 0
Code

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.
master
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
1 changed files with 88 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

181
gnu/tests/nfs.scm
View File

@ -33,6 +33,7 @@
#:use-module (gnu services base) #:use-module (gnu services base)
#:use-module (gnu services nfs) #:use-module (gnu services nfs)
#:use-module (gnu services networking) #:use-module (gnu services networking)
#:use-module (gnu packages admin)
#:use-module (gnu packages onc-rpc) #:use-module (gnu packages onc-rpc)
#:use-module (gnu packages nfs) #:use-module (gnu packages nfs)
#:use-module (guix gexp) #:use-module (guix gexp)
@ -40,7 +41,7 @@
#:use-module (guix monads) #:use-module (guix monads)
#:export (%test-nfs #:export (%test-nfs
%test-nfs-server %test-nfs-server
%test-nfs-root-fs)) %test-nfs-full))
(define %base-os (define %base-os
(operating-system (operating-system
@ -259,41 +260,63 @@ directories can be mounted.")
(value (run-nfs-server-test)))) (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." "Run a test of an OS mounting its root file system via NFS."
(define nfs-root-server-os (define nfs-root-server-os
(marionette-operating-system (let ((os (simple-operating-system)))
(operating-system (marionette-operating-system
(inherit %nfs-os) (operating-system
(services (inherit os)
(modify-services (operating-system-user-services %nfs-os) (services
(nfs-service-type config => (cons*
(nfs-configuration (service static-networking-service-type
(debug '(nfs nfsd mountd)) (list
;;; Note: Adding the following line causes Guix to hang. (static-networking
;(rpcmountd-port 20001) (addresses (list (network-address
;;; Note: Adding the following line causes Guix to hang. (device "ens5")
;(rpcstatd-port 20002) ; FIXME: Set broadcast port AND listening port. (value "10.0.2.15/24")))))))
(nfsd-port 2049) (simple-service 'export activation-service-type
(nfs-versions '("4.2")) #~(begin
(exports '(("/export" (mkdir-p "/export")
"*(rw,insecure,no_subtree_check,crossmnt,fsid=root,no_root_squash,insecure,async)")))))))) (chmod "/export" #o777)))
#:requirements '(nscd) (service nfs-service-type
#:imported-modules '((gnu services herd) (nfs-configuration
(guix combinators)))) (nfsd-port 2049)
(nfs-versions '("4.2"))
(exports '(("/export"
"*(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)))))
(define nfs-root-client-os (define nfs-root-client-os
(marionette-operating-system (marionette-operating-system
(operating-system (simple-operating-system
(inherit (simple-operating-system (service dhcp-client-service-type))) (service static-networking-service-type
(kernel-arguments '("ip=dhcp")) (list
(file-systems (cons (static-networking
(file-system (addresses
(type "nfs") (list (network-address
(mount-point "/") (device "ens5")
(device ":/export") (value "10.0.2.16/24")))))))
(options "addr=127.0.0.1,vers=4.2")) (service nfs-service-type
%base-file-systems))) (nfs-configuration
(nfsd-port 2049)
(nfs-versions '("4.2"))))
(simple-service 'export activation-service-type
#~(begin
(mkdir-p "/export")
(chmod "/export" #o777))))
#:requirements '(nscd) #:requirements '(nscd)
#:imported-modules '((gnu services herd) #:imported-modules '((gnu services herd)
(guix combinators)))) (guix combinators))))
@ -308,84 +331,56 @@ directories can be mounted.")
(test-begin "start-nfs-boot-test") (test-begin "start-nfs-boot-test")
;;; Start up NFS server host. ;;; Start up NFS server host.
(mkdir "/tmp/server") (mkdir "/tmp/server")
(define server-marionette (define server-marionette
(make-marionette (list #$(virtual-machine (make-marionette
nfs-root-server-os (cons* #$(virtual-machine
;(operating-system nfs-root-server-os) (operating-system nfs-root-server-os)
;(port-forwardings '( ; (111 . 111) (volatile? #f))
; (2049 . 2049) '("-device" "e1000,netdev=n1,mac=52:54:00:12:34:56"
; (20001 . 20001) "-netdev" "socket,id=n1,listen=:1234"))
; (20002 . 20002))) #:socket-directory "/tmp/server"))
))
#: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. ;;; Wait for the NFS services to be up and running.
(test-assert "nfs services are running" (test-assert "nfs services are running"
(wait-for-file "/var/run/rpc.statd.pid" server-marionette)) (wait-for-file "/var/run/rpc.statd.pid" server-marionette))
(test-assert "NFS port is ready" (test-assert "NFS port is ready"
(wait-for-tcp-port 2049 server-marionette)) (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. ;;; Start up NFS client host.
(mkdir "/tmp/client")
(define client-marionette (define client-marionette
(make-marionette (list #$(virtual-machine (make-marionette
nfs-root-client-os (cons* #$(virtual-machine
;(port-forwardings '((111 . 111) (operating-system nfs-root-client-os)
; (2049 . 2049) (volatile? #f))
; (20001 . 20001) '("-device" "e1000,netdev=n2,mac=52:54:00:12:34:57"
; (20002 . 20002))) "-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 (marionette-eval
'(begin '(begin
(use-modules (gnu services herd))
(use-modules (rnrs io ports)) (use-modules (rnrs io ports))
(current-output-port (current-output-port
(open-file "/dev/console" "w0")) (open-file "/dev/console" "w0"))
(let ((content (call-with-input-file "/proc/mounts" get-string-all))) (and
(call-with-output-file "/mounts.new" (system* (string-append #$nfs-utils "/sbin/mount.nfs")
(lambda (port) "10.0.2.15:/export" "/export" "-v")
(display content port)))) (let ((content (call-with-input-file "/proc/mounts"
(chmod "/mounts.new" #o777) get-string-all)))
(rename-file "/mounts.new" "/mounts")) (call-with-output-file "/export/mounts"
(lambda (port)
(display content port))))))
client-marionette) client-marionette)
(test-assert "nfs-root-client booted")
;;; Check whether NFS client host communicated with NFS server host. ;;; Check whether NFS client host communicated with NFS server host.
(test-assert "nfs client deposited file" (test-assert "nfs client deposited file"
(wait-for-file "/export/mounts" server-marionette)) (wait-for-file "/export/mounts" server-marionette))
(marionette-eval (marionette-eval
'(begin '(begin
(current-output-port (current-output-port
@ -395,11 +390,11 @@ directories can be mounted.")
(test-end)))) (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 (system-test
(name "nfs-root-fs") (name "nfs-full")
(description "Test that an NFS server can be started and the exported (description "Test that an NFS server can be started and the exported
directory can be used as root file system.") directory can be used by another machine.")
(value (run-nfs-root-fs-test)))) (value (run-nfs-full-test))))