aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/services/nfs.scm181
-rw-r--r--gnu/tests/nfs.scm157
2 files changed, 334 insertions, 4 deletions
diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index cd7e8fab01..ddc9e2c47e 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -22,6 +22,7 @@
#:use-module (gnu services shepherd)
#:use-module (gnu packages onc-rpc)
#:use-module (gnu packages linux)
+ #:use-module (gnu packages nfs)
#:use-module (guix)
#:use-module (guix records)
#:use-module (srfi srfi-1)
@@ -41,7 +42,11 @@
gss-service-type
gss-configuration
- gss-configuration?))
+ gss-configuration?
+
+ nfs-service-type
+ nfs-configuration
+ nfs-configuration?))
(define default-pipefs-directory "/var/lib/nfs/rpc_pipefs")
@@ -234,3 +239,177 @@
(compose identity)
(extend (lambda (config values) (first values)))
(default-value (idmap-configuration)))))
+
+(define-record-type* <nfs-configuration>
+ nfs-configuration make-nfs-configuration
+ nfs-configuration?
+ (nfs-utils nfs-configuration-nfs-utils
+ (default nfs-utils))
+ (nfs-version nfs-configuration-nfs-version
+ (default #f)) ; string
+ (exports nfs-configuration-exports
+ (default '()))
+ (rpcmountd-port nfs-configuration-rpcmountd-port
+ (default #f))
+ (rpcstatd-port nfs-configuration-rpcstatd-port
+ (default #f))
+ (rpcbind nfs-configuration-rpcbind
+ (default rpcbind))
+ (idmap-domain nfs-configuration-idmap-domain
+ (default "localdomain"))
+ (nfsd-port nfs-configuration-nfsd-port
+ (default 2049))
+ (nfsd-threads nfs-configuration-nfsd-threads
+ (default 8))
+ (pipefs-directory nfs-configuration-pipefs-directory
+ (default default-pipefs-directory))
+ ;; List of modules to debug; any of nfsd, nfs, rpc, idmap, statd, or mountd.
+ (debug nfs-configuration-debug
+ (default '())))
+
+(define (nfs-shepherd-services config)
+ "Return a list of <shepherd-service> for the NFS daemons with CONFIG."
+ (match-record config <nfs-configuration>
+ (nfs-utils nfs-version exports
+ rpcmountd-port rpcstatd-port nfsd-port nfsd-threads
+ pipefs-directory debug)
+ (list (shepherd-service
+ (documentation "Run the NFS statd daemon.")
+ (provision '(rpc.statd))
+ (requirement '(rpcbind-daemon))
+ (start
+ #~(make-forkexec-constructor
+ (list #$(file-append nfs-utils "/sbin/rpc.statd")
+ ;; TODO: notification support may require a little more
+ ;; configuration work.
+ "--no-notify"
+ #$@(if (member 'statd debug)
+ '("--no-syslog") ; verbose logging to stderr
+ '())
+ "--foreground"
+ #$@(if rpcstatd-port
+ '("--port" (number->string rpcstatd-port))
+ '()))
+ #:pid-file "/var/run/rpc.statd.pid"))
+ (stop #~(make-kill-destructor)))
+ (shepherd-service
+ (documentation "Run the NFS mountd daemon.")
+ (provision '(rpc.mountd))
+ (requirement '(rpc.statd))
+ (start
+ #~(make-forkexec-constructor
+ (list #$(file-append nfs-utils "/sbin/rpc.mountd")
+ #$@(if (member 'mountd debug)
+ '("--debug" "all")
+ '())
+ #$@(if rpcmountd-port
+ '("--port" (number->string rpcmountd-port))
+ '()))))
+ (stop #~(make-kill-destructor)))
+ (shepherd-service
+ (documentation "Run the NFS daemon.")
+ (provision '(rpc.nfsd))
+ (requirement '(rpc.statd networking))
+ (start
+ #~(lambda _
+ (zero? (system* #$(file-append nfs-utils "/sbin/rpc.nfsd")
+ #$@(if (member 'nfsd debug)
+ '("--debug")
+ '())
+ "--port" #$(number->string nfsd-port)
+ #$@(if nfs-version
+ '("--nfs-version" nfs-version)
+ '())
+ #$(number->string nfsd-threads)))))
+ (stop
+ #~(lambda _
+ (zero?
+ (system* #$(file-append nfs-utils "/sbin/rpc.nfsd") "0")))))
+ (shepherd-service
+ (documentation "Run the NFS mountd daemon and refresh exports.")
+ (provision '(nfs))
+ (requirement '(rpc.nfsd rpc.mountd rpc.statd rpcbind-daemon))
+ (start
+ #~(lambda _
+ (let ((rpcdebug #$(file-append nfs-utils "/sbin/rpcdebug")))
+ (cond
+ ((member 'nfsd '#$debug)
+ (system* rpcdebug "-m" "nfsd" "-s" "all"))
+ ((member 'nfs '#$debug)
+ (system* rpcdebug "-m" "nfs" "-s" "all"))
+ ((member 'rpc '#$debug)
+ (system* rpcdebug "-m" "rpc" "-s" "all"))))
+ (zero? (system*
+ #$(file-append nfs-utils "/sbin/exportfs")
+ "-r" ; re-export
+ "-a" ; everthing
+ "-v" ; be verbose
+ "-d" "all" ; debug
+ ))))
+ (stop
+ #~(lambda _
+ (let ((rpcdebug #$(file-append nfs-utils "/sbin/rpcdebug")))
+ (cond
+ ((member 'nfsd '#$debug)
+ (system* rpcdebug "-m" "nfsd" "-c" "all"))
+ ((member 'nfs '#$debug)
+ (system* rpcdebug "-m" "nfs" "-c" "all"))
+ ((member 'rpc '#$debug)
+ (system* rpcdebug "-m" "rpc" "-c" "all"))))
+ #t))
+ (respawn? #f)))))
+
+(define nfs-service-type
+ (service-type
+ (name 'nfs)
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type nfs-shepherd-services)
+ (service-extension activation-service-type
+ (const #~(begin
+ (use-modules (guix build utils))
+ (system* "mount" "-t" "nfsd"
+ "nfsd" "/proc/fs/nfsd")
+
+ (mkdir-p "/var/lib/nfs")
+ ;; directory containing monitor list
+ (mkdir-p "/var/lib/nfs/sm")
+ ;; Needed for client recovery tracking
+ (mkdir-p "/var/lib/nfs/v4recovery")
+ (let ((user (getpw "nobody")))
+ (chown "/var/lib/nfs"
+ (passwd:uid user)
+ (passwd:gid user))
+ (chown "/var/lib/nfs/v4recovery"
+ (passwd:uid user)
+ (passwd:gid user)))
+ #t)))
+ (service-extension etc-service-type
+ (lambda (config)
+ `(("exports"
+ ,(plain-file "exports"
+ (string-join
+ (map string-join
+ (nfs-configuration-exports config))
+ "\n"))))))
+ ;; The NFS service depends on these other services. They are extended so
+ ;; that users don't need to configure them manually.
+ (service-extension idmap-service-type
+ (lambda (config)
+ (idmap-configuration
+ (domain (nfs-configuration-idmap-domain config))
+ (verbosity
+ (if (member 'idmap (nfs-configuration-debug config))
+ 10 0))
+ (pipefs-directory (nfs-configuration-pipefs-directory config))
+ (nfs-utils (nfs-configuration-nfs-utils config)))))
+ (service-extension pipefs-service-type
+ (lambda (config)
+ (pipefs-configuration
+ (mount-point (nfs-configuration-pipefs-directory config)))))
+ (service-extension rpcbind-service-type
+ (lambda (config)
+ (rpcbind-configuration
+ (rpcbind (nfs-configuration-rpcbind config)))))))
+ (description
+ "Run all NFS daemons and refresh the list of exported file systems.")))
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 7ef9f1f7bf..014d049ab5 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -33,10 +34,12 @@
#: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))
+ #:export (%test-nfs
+ %test-nfs-server))
(define %base-os
(operating-system
@@ -53,8 +56,7 @@
rpcbind
%base-packages))
(services (cons*
- (service rpcbind-service-type
- (rpcbind-configuration))
+ (service rpcbind-service-type)
(service dhcp-client-service-type)
%base-services))))
@@ -133,3 +135,152 @@
(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"
+ ;; crossmnt = This is the pseudo root.
+ ;; fsid=0 = root file system of the export
+ "*(ro,insecure,no_subtree_check,crossmnt,fsid=0)"))))))))
+ (operating-system
+ (inherit os)
+ (host-name "nfs-server")
+ ;; We need to use a tmpfs here, because the test system's root file
+ ;; system cannot be re-exported via NFS.
+ (file-systems (cons
+ (file-system
+ (device "none")
+ (mount-point "/export")
+ (type "tmpfs")
+ (create-mount-point? #t))
+ %base-file-systems))
+ (services
+ ;; Enable debugging output.
+ (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))))
+ (define (wait-for-file file)
+ ;; Wait until FILE exists in the guest
+ (marionette-eval
+ `(let loop ((i 10))
+ (cond ((file-exists? ,file)
+ #t)
+ ((> i 0)
+ (sleep 1)
+ (loop (- i 1)))
+ (else
+ (error "File didn't show up: " ,file))))
+ marionette))
+
+ (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"
+ (marionette-eval
+ ;; XXX: Work around a race condition in nscd: nscd creates its
+ ;; PID file before it is listening on its socket.
+ '(let ((sock (socket PF_UNIX SOCK_STREAM 0)))
+ (let try ()
+ (catch 'system-error
+ (lambda ()
+ (connect sock AF_UNIX "/var/run/nscd/socket")
+ (close-port sock)
+ (format #t "nscd is ready~%")
+ #t)
+ (lambda args
+ (format #t "waiting for nscd...~%")
+ (usleep 500000)
+ (try)))))
+ marionette))
+
+ (test-assert "network is up"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'networking))
+ marionette))
+
+ ;; Wait for the NFS services to be up and running.
+ (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")))
+
+ (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))))
generated by cgit v1.2.3 (git 2.45.0) at 2024-12-11 13:35:14 +0000