services: nfs: Add nfs-service-type.
* gnu/services/nfs.scm (<nfs-configuration>): New record. (nfs-configuration, nfs-configuration?, nfs-configuration-nfs-utils, nfs-configuration-nfs-version, nfs-configuration-exports, nfs-configuration-rpcmountd-port, nfs-configuration-rpcstatd-port, nfs-configuration-rpcbind, nfs-configuration-idmap-domain, nfs-configuration-nfsd-port, nfs-configuration-nfsd-threads, nfs-configuration-pipefs-directory, nfs-configuration-debug, nfs-shepherd-services): New procedures. (nfs-service-type): New variable. * doc/guix.texi (Network File System): Document it. * gnu/tests/nfs.scm (%test-nfs-server): New variable. (%base-os): Use default value of rpcbind-service-type.
This commit is contained in:
		
							parent
							
								
									a6bdca6b9b
								
							
						
					
					
						commit
						907eeac2e7
					
				
					 3 changed files with 407 additions and 5 deletions
				
			
		| 
						 | 
				
			
			@ -29,7 +29,7 @@ Copyright @copyright{} 2015, 2016 Mathieu Lirzin@*
 | 
			
		|||
Copyright @copyright{} 2014 Pierre-Antoine Rault@*
 | 
			
		||||
Copyright @copyright{} 2015 Taylan Ulrich Bayırlı/Kammer@*
 | 
			
		||||
Copyright @copyright{} 2015, 2016, 2017, 2019 Leo Famulari@*
 | 
			
		||||
Copyright @copyright{} 2015, 2016, 2017, 2018, 2019 Ricardo Wurmus@*
 | 
			
		||||
Copyright @copyright{} 2015, 2016, 2017, 2018, 2019, 2020 Ricardo Wurmus@*
 | 
			
		||||
Copyright @copyright{} 2016 Ben Woodcroft@*
 | 
			
		||||
Copyright @copyright{} 2016, 2017, 2018 Chris Marusich@*
 | 
			
		||||
Copyright @copyright{} 2016, 2017, 2018, 2019 Efraim Flashner@*
 | 
			
		||||
| 
						 | 
				
			
			@ -21940,6 +21940,78 @@ The @code{(gnu services nfs)} module provides the following services,
 | 
			
		|||
which are most commonly used in relation to mounting or exporting
 | 
			
		||||
directory trees as @dfn{network file systems} (NFS).
 | 
			
		||||
 | 
			
		||||
While it is possible to use the individual components that together make
 | 
			
		||||
up a Network File System service, we recommended to configure an NFS
 | 
			
		||||
server with the @code{nfs-service-type}.
 | 
			
		||||
 | 
			
		||||
@subsubheading NFS Service
 | 
			
		||||
@cindex NFS, server
 | 
			
		||||
 | 
			
		||||
The NFS service takes care of setting up all NFS component services,
 | 
			
		||||
kernel configuration file systems, and installs configuration files in
 | 
			
		||||
the locations that NFS expects.
 | 
			
		||||
 | 
			
		||||
@defvr {Scheme Variable} nfs-service-type
 | 
			
		||||
A service type for a complete NFS server.
 | 
			
		||||
@end defvr
 | 
			
		||||
 | 
			
		||||
@deftp {Data Type} nfs-configuration
 | 
			
		||||
This data type represents the configuration of the NFS service and all
 | 
			
		||||
of its subsystems.
 | 
			
		||||
 | 
			
		||||
It has the following parameters:
 | 
			
		||||
@table @asis
 | 
			
		||||
@item @code{nfs-utils} (default: @code{nfs-utils})
 | 
			
		||||
The nfs-utils package to use.
 | 
			
		||||
 | 
			
		||||
@item @code{nfs-version} (default: @code{#f})
 | 
			
		||||
If a string value is provided, the @command{rpc.nfsd} daemon will be
 | 
			
		||||
limited to supporting the given version of the NFS protocol.
 | 
			
		||||
 | 
			
		||||
@item @code{exports} (default: @code{'()})
 | 
			
		||||
This is a list of directories the NFS server should export.  Each entry
 | 
			
		||||
is a list consisting of two elements: a directory name and a string
 | 
			
		||||
containing all options.  This is an example in which the directory
 | 
			
		||||
@file{/export} is served to all NFS clients as a read-only share:
 | 
			
		||||
 | 
			
		||||
@lisp
 | 
			
		||||
(nfs-configuration
 | 
			
		||||
 (exports
 | 
			
		||||
  '(("/export"
 | 
			
		||||
     "*(ro,insecure,no_subtree_check,crossmnt,fsid=0)"))))
 | 
			
		||||
@end lisp
 | 
			
		||||
 | 
			
		||||
@item @code{rpcmountd-port} (default: @code{#f})
 | 
			
		||||
The network port that the @command{rpc.mountd} daemon should use.
 | 
			
		||||
 | 
			
		||||
@item @code{rpcstatd-port} (default: @code{#f})
 | 
			
		||||
The network port that the @command{rpc.statd} daemon should use.
 | 
			
		||||
 | 
			
		||||
@item @code{rpcbind} (default: @code{rpcbind})
 | 
			
		||||
The rpcbind package to use.
 | 
			
		||||
 | 
			
		||||
@item @code{idmap-domain} (default: @code{"localdomain"})
 | 
			
		||||
The local NFSv4 domain name.
 | 
			
		||||
 | 
			
		||||
@item @code{nfsd-port} (default: @code{2049})
 | 
			
		||||
The network port that the @command{nfsd} daemon should use.
 | 
			
		||||
 | 
			
		||||
@item @code{nfsd-threads} (default: @code{8})
 | 
			
		||||
The number of threads used by the @command{nfsd} daemon.
 | 
			
		||||
 | 
			
		||||
@item @code{pipefs-directory} (default: @code{"/var/lib/nfs/rpc_pipefs"})
 | 
			
		||||
The directory where the pipefs file system is mounted.
 | 
			
		||||
 | 
			
		||||
@item @code{debug} (default: @code{'()"})
 | 
			
		||||
A list of subsystems for which debugging output should be enabled.  This
 | 
			
		||||
is a list of symbols.  Any of these symbols are valid: @code{nfsd},
 | 
			
		||||
@code{nfs}, @code{rpc}, @code{idmap}, @code{statd}, or @code{mountd}.
 | 
			
		||||
@end table
 | 
			
		||||
@end deftp
 | 
			
		||||
 | 
			
		||||
If you don't need a complete NFS service or prefer to build it yourself
 | 
			
		||||
you can use the individual component services that are documented below.
 | 
			
		||||
 | 
			
		||||
@subsubheading RPC Bind Service
 | 
			
		||||
@cindex rpcbind
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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.")))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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))))
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue