mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
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:
parent
207ee9d9cd
commit
dbd3454c3b
1 changed files with 88 additions and 93 deletions
|
@ -33,6 +33,7 @@ (define-module (gnu tests nfs)
|
||||||
#: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 @@ (define-module (gnu tests nfs)
|
||||||
#: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 @@ (define %test-nfs-server
|
||||||
(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 @@ (define test
|
||||||
(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 @@ (define client-marionette
|
||||||
|
|
||||||
(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))))
|
||||||
|
|
Loading…
Reference in a new issue