123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415 |
- (define-module (gnu tests nfs)
- #:use-module (gnu tests)
- #:use-module (gnu bootloader)
- #:use-module (gnu bootloader grub)
- #:use-module (gnu system)
- #:use-module (gnu system file-systems)
- #:use-module (gnu system shadow)
- #:use-module (gnu system vm)
- #:use-module (gnu services)
- #:use-module (gnu services base)
- #:use-module (gnu services nfs)
- #:use-module (gnu services networking)
- #:use-module (gnu packages onc-rpc)
- #:use-module (gnu packages nfs)
- #:use-module (guix gexp)
- #:use-module (guix store)
- #:use-module (guix monads)
- #:export (%test-nfs
- %test-nfs-server
- %test-nfs-root-fs))
- (define %base-os
- (operating-system
- (host-name "olitupmok")
- (timezone "Europe/Berlin")
- (locale "en_US.UTF-8")
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (target "/dev/sdX")))
- (file-systems %base-file-systems)
- (users %base-user-accounts)
- (packages (cons*
- rpcbind
- %base-packages))
- (services (cons*
- (service rpcbind-service-type)
- (service dhcp-client-service-type)
- %base-services))))
- (define (run-nfs-test name socket)
- "Run a test of an OS running RPC-SERVICE, which should create SOCKET."
- (define os
- (marionette-operating-system
- %base-os
- #:imported-modules '((gnu services herd)
- (guix combinators))))
- (define test
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (srfi srfi-64))
- (define marionette
- (make-marionette (list #$(virtual-machine os))))
- (define (wait-for-socket file)
-
- (marionette-eval
- `(let loop ((i 10))
- (cond ((and (file-exists? ,file)
- (eq? 'socket (stat:type (stat ,file))))
- #t)
- ((> i 0)
- (sleep 1)
- (loop (- i 1)))
- (else
- (error "Socket didn't show up: " ,file))))
- marionette))
- (mkdir #$output)
- (chdir #$output)
- (test-begin "rpc-daemon")
-
- (test-assert "RPC service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
-
- (setenv "PATH" "/run/current-system/profile/bin")
- (start-service 'rpcbind-daemon))
- marionette))
-
- (test-assert "RPC socket exists"
- (and
- (wait-for-socket #$socket)
- (marionette-eval
- '(begin
- (use-modules (gnu services herd)
- (srfi srfi-1))
- (live-service-running
- (find (lambda (live)
- (memq 'rpcbind-daemon
- (live-service-provision live)))
- (current-services))))
- marionette)))
- (test-assert "Probe RPC daemon"
- (marionette-eval
- '(zero? (system* "rpcinfo" "-p"))
- marionette))
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
- (gexp->derivation name test))
- (define %test-nfs
- (system-test
- (name "nfs")
- (description "Test some things related to NFS.")
- (value (run-nfs-test name "/var/run/rpcbind.sock"))))
- (define %nfs-os
- (let ((os (simple-operating-system
- (simple-service 'create-target-directory activation-service-type
- #~(begin
- (mkdir "/remote")
- (chmod "/remote" #o777)
- #t))
- (service dhcp-client-service-type)
- (service nfs-service-type
- (nfs-configuration
- (debug '(nfs nfsd mountd))
- (exports '(("/export"
-
-
- "*(ro,insecure,no_subtree_check,crossmnt,fsid=0)"))))))))
- (operating-system
- (inherit os)
- (host-name "nfs-server")
-
-
- (file-systems (cons
- (file-system
- (device "none")
- (mount-point "/export")
- (type "tmpfs")
- (create-mount-point? #t))
- %base-file-systems))
- (services
-
- (modify-services (operating-system-user-services os)
- (syslog-service-type config
- =>
- (syslog-configuration
- (inherit config)
- (config-file
- (plain-file
- "syslog.conf"
- "*.* /dev/console\n")))))))))
- (define (run-nfs-server-test)
- "Run a test of an OS running a service of NFS-SERVICE-TYPE."
- (define os
- (marionette-operating-system
- %nfs-os
- #: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))
- (define marionette
- (make-marionette (list #$(virtual-machine os))))
- (mkdir #$output)
- (chdir #$output)
- (test-begin "nfs-daemon")
- (marionette-eval
- '(begin
- (current-output-port
- (open-file "/dev/console" "w0"))
- (chmod "/export" #o777)
- (with-output-to-file "/export/hello"
- (lambda () (display "hello world")))
- (chmod "/export/hello" #o777))
- marionette)
- (test-assert "nscd PID file is created"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'nscd))
- marionette))
- (test-assert "nscd is listening on its socket"
- (wait-for-unix-socket "/var/run/nscd/socket"
- marionette))
- (test-assert "network is up"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'networking))
- marionette))
-
- (test-assert "nfs services are running"
- (and (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (start-service 'nfs))
- marionette)
- (wait-for-file "/var/run/rpc.statd.pid" marionette)))
- (test-assert "nfs share is advertised"
- (marionette-eval
- '(zero? (system* (string-append #$nfs-utils "/sbin/showmount")
- "-e" "nfs-server"))
- marionette))
- (test-assert "nfs share mounted"
- (marionette-eval
- '(begin
- (and (zero? (system* (string-append #$nfs-utils "/sbin/mount.nfs4")
- "nfs-server:/" "/remote" "-v"))
- (file-exists? "/remote/hello")))
- marionette))
- (test-end)
- (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
- (gexp->derivation "nfs-server-test" test))
- (define %test-nfs-server
- (system-test
- (name "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)
- (services
- (modify-services (operating-system-user-services %nfs-os)
- (nfs-service-type config =>
- (nfs-configuration
- (debug '(nfs nfsd mountd))
-
-
-
-
- (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")
-
- (mkdir "/tmp/server")
- (define server-marionette
- (make-marionette (list #$(virtual-machine
- nfs-root-server-os
-
-
-
-
-
- ))
- #:socket-directory "/tmp/server"))
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (current-output-port
- (open-file "/dev/console" "w0"))
-
-
-
- (sleep 5)
- (chmod "/export" #o777)
- (symlink "/gnu" "/export/gnu")
- (start-service 'nscd)
- (start-service 'networking)
- (start-service 'nfs))
- server-marionette)
-
- (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))
-
-
-
- (define client-marionette
- (make-marionette (list #$(virtual-machine
- nfs-root-client-os
-
-
-
-
- ))))
- (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")
-
- (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-root-fs-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 file system.")
- (value (run-nfs-root-fs-test))))
|