[bug#38902] [PATCH 0/9] Add NFS service

[bug#38902] [PATCH 0/9] Add NFS service

[Ricardo Wurmus]

Hi Guix,

this patch set adds a convenient nfs-service-type, a one-stop shop for setting
up an NFS server.  It takes care of starting and configuring all of the
component services that are needed for NFS to function properly.

I'm not sure the "Allow ... to be extended" changes are the best way to deal
with service extension, so I'd be especially happy to receive comments on
those patches.

Ricardo Wurmus (9):
  gnu: nfs-utils: Update to 2.4.2.
  services: nfs: Fix name of package variable.
  services: nfs: Allow rpcbind-service-type to be extended.
  services: nfs: Allow pipefs-service-type to be extended.
  services: nfs: Fix indentation and typo.
  services: nfs: Allow idmap-service-type to be extended.
  services: nfs: Add verbosity control to idmap-service-type.
  services: nfs: Allow gss-service-type to be extended.
  services: nfs: Add nfs-service-type.

 doc/guix.texi                                 |  77 +++-
 gnu/local.mk                                  |   1 -
 gnu/packages/nfs.scm                          |  45 +-
 .../patches/nfs-utils-missing-headers.patch   |  19 -
 gnu/services/nfs.scm                          | 422 ++++++++++++++----
 gnu/tests/nfs.scm                             | 157 ++++++-
 6 files changed, 583 insertions(+), 138 deletions(-)
 delete mode 100644 gnu/packages/patches/nfs-utils-missing-headers.patch

-- 
2.24.1

[bug#38902] [PATCH 1/9] gnu: nfs-utils: Update to 2.4.2.

[Ricardo Wurmus]

* gnu/packages/nfs.scm (nfs-utils): Update to 2.4.2.
[source]: Remove patch.
[arguments]: Update configure flags, remove fix-glibc-compatability phase,
update substitutions.
[inputs]: Add keyutils and rpcsvc-proto.
* gnu/packages/patches/nfs-utils-missing-headers.patch: Remove file.
* gnu/local.mk (dist_patch_DATA): Remove it.
---
 gnu/local.mk                                  |  1 -
 gnu/packages/nfs.scm                          | 45 ++++++++++---------
 .../patches/nfs-utils-missing-headers.patch   | 19 --------
 3 files changed, 25 insertions(+), 40 deletions(-)
 delete mode 100644 gnu/packages/patches/nfs-utils-missing-headers.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index c7dcc65082..bfdaba2761 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1198,7 +1198,6 @@ dist_patch_DATA =						\
   %D%/packages/patches/netsurf-system-utf8proc.patch		\
   %D%/packages/patches/netsurf-y2038-tests.patch		\
   %D%/packages/patches/netsurf-longer-test-timeout.patch	\
-  %D%/packages/patches/nfs-utils-missing-headers.patch		\
   %D%/packages/patches/ngircd-handle-zombies.patch		\
   %D%/packages/patches/nm-plugin-path.patch			\
   %D%/packages/patches/nsis-env-passthru.patch			\
diff --git a/gnu/packages/nfs.scm b/gnu/packages/nfs.scm
index 9d7acc3592..a3d5383c4d 100644
--- a/gnu/packages/nfs.scm
+++ b/gnu/packages/nfs.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
 ;;; Copyright © 2017, 2018 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2018 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
 
 (define-module (gnu packages nfs)
   #:use-module (gnu packages)
+  #:use-module (gnu packages crypto)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages libevent)
   #:use-module (gnu packages kerberos)
@@ -42,32 +44,27 @@
 (define-public nfs-utils
   (package
     (name "nfs-utils")
-    (version "2.1.1")
+    (version "2.4.2")
     (source (origin
              (method url-fetch)
              (uri (string-append
                    "mirror://kernel.org/linux/utils/nfs-utils/" version
                    "/nfs-utils-" version ".tar.xz"))
-             (patches (search-patches "nfs-utils-missing-headers.patch"))
              (sha256
               (base32
-               "1vqrqzhg9nh2wj1icp7k8v9dibgnn521b45np79nnkmqf16bbbhg"))))
+               "0f0hm8jq1p5gra55v621qpbb3mryakaikzpy5znkvxym0dx76r24"))))
     (build-system gnu-build-system)
     (arguments
      `(#:configure-flags
        `("--without-tcp-wrappers"
          ,(string-append "--with-start-statd="
                          (assoc-ref %outputs "out") "/sbin/start-statd")
-         ,(string-append "--with-krb5=" (assoc-ref %build-inputs "mit-krb5")))
+         ,(string-append "--with-krb5=" (assoc-ref %build-inputs "mit-krb5"))
+         ,(string-append "--with-pluginpath="
+                         (assoc-ref %outputs "out")
+                         "/lib/libnfsidmap"))
        #:phases
        (modify-phases %standard-phases
-         (add-after 'unpack 'fix-glibc-compatability
-           (lambda _
-             (substitute* '("utils/blkmapd/device-discovery.c"
-                            "utils/blkmapd/dm-device.c")
-               (("<sys/stat.h>")
-                "<sys/stat.h>\n#include <sys/sysmacros.h>"))
-             #t))
          (add-before 'configure 'adjust-command-file-names
            (lambda _
              ;; Remove assumptions of FHS from start-statd script
@@ -81,6 +78,11 @@
                 (string-append "exec "
                  (assoc-ref %outputs "out") "/sbin/rpc.statd")))
 
+             ;; find rpcgen
+             (substitute* "configure"
+               (("/usr/local/bin/rpcgen")
+                (which "rpcgen")))
+
              ;; This hook tries to write to /var
              ;; That needs to be done by a service too.
              (substitute* `("Makefile.in")
@@ -96,20 +98,23 @@
              (substitute* `("utils/statd/statd.c")
                (("/usr/sbin/")
                 (string-append (assoc-ref %outputs "out") "/sbin/")))
-             (substitute* `("utils/osd_login/Makefile.in"
-                            "utils/mount/Makefile.in"
+             (substitute* `("utils/mount/Makefile.in"
+                            "utils/nfsdcld/Makefile.in"
                             "utils/nfsdcltrack/Makefile.in")
                (("^sbindir = /sbin")
                 (string-append "sbindir = "
                                (assoc-ref %outputs "out") "/sbin")))
              #t)))))
-    (inputs `(("libevent" ,libevent)
-              ("libnfsidmap" ,libnfsidmap)
-              ("sqlite" ,sqlite)
-              ("lvm2" ,lvm2)
-              ("util-linux" ,util-linux)
-              ("mit-krb5" ,mit-krb5)
-              ("libtirpc" ,libtirpc)))
+    (inputs
+     `(("keyutils" ,keyutils)
+       ("libevent" ,libevent)
+       ("libnfsidmap" ,libnfsidmap)
+       ("rpcsvc-proto" ,rpcsvc-proto) ;for 'rpcgen'
+       ("sqlite" ,sqlite)
+       ("lvm2" ,lvm2)
+       ("util-linux" ,util-linux)
+       ("mit-krb5" ,mit-krb5)
+       ("libtirpc" ,libtirpc)))
     (native-inputs
      `(("pkg-config" ,pkg-config)))
     (home-page "http://www.kernel.org/pub/linux/utils/nfs-utils/")
diff --git a/gnu/packages/patches/nfs-utils-missing-headers.patch b/gnu/packages/patches/nfs-utils-missing-headers.patch
deleted file mode 100644
index 7f0542836e..0000000000
--- a/gnu/packages/patches/nfs-utils-missing-headers.patch
+++ /dev/null
@@ -1,19 +0,0 @@
-Fix compilation failure with glibc 2.26 caused by missing type
-declarations:
-
-------
-rpc.c: In function ‘nsm_recv_getport’:
-rpc.c:469:13: error: ‘UINT16_MAX’ undeclared (first use in this function)
-  if (port > UINT16_MAX) {
-------
-
---- a/support/nsm/rpc.c.orig	2016-08-03 20:25:15.000000000 +0200
-+++ b/support/nsm/rpc.c	2017-08-26 07:41:11.884000000 +0200
-@@ -40,6 +40,7 @@
- 
- #include <time.h>
- #include <stdbool.h>
-+#include <stdint.h>
- #include <string.h>
- #include <unistd.h>
- #include <fcntl.h>
-- 
2.24.1

[bug#38902] [PATCH 2/9] services: nfs: Fix name of package variable.

[Ricardo Wurmus]

* gnu/services/nfs.scm (rpcbind-service-type): Correct name from nfs-utils to
rpcbind.
---
 gnu/services/nfs.scm | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index 6ed4c0eabf..834e94a800 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
+;;; Copyright © 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -58,11 +59,11 @@
   (shepherd-service-type
    'rpcbind
    (lambda (config)
-     (define nfs-utils
+     (define rpcbind
        (rpcbind-configuration-rpcbind config))
 
      (define rpcbind-command
-       #~(list (string-append #$nfs-utils "/bin/rpcbind") "-f"
+       #~(list (string-append #$rpcbind "/bin/rpcbind") "-f"
                #$@(if (rpcbind-configuration-warm-start? config) '("-w") '())))
 
      (shepherd-service
-- 
2.24.1

[bug#38902] [PATCH 3/9] services: nfs: Allow rpcbind-service-type to be extended.

[Ricardo Wurmus]

* gnu/services/nfs.scm (rpcbind-service-type): Rewrite using SERVICE-TYPE to
add ability to extend the service.
---
 gnu/services/nfs.scm | 47 ++++++++++++++++++++++++++++----------------
 1 file changed, 30 insertions(+), 17 deletions(-)

diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index 834e94a800..0681e764ec 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -56,23 +56,36 @@
                        (default #t)))
 
 (define rpcbind-service-type
-  (shepherd-service-type
-   'rpcbind
-   (lambda (config)
-     (define rpcbind
-       (rpcbind-configuration-rpcbind config))
-
-     (define rpcbind-command
-       #~(list (string-append #$rpcbind "/bin/rpcbind") "-f"
-               #$@(if (rpcbind-configuration-warm-start? config) '("-w") '())))
-
-     (shepherd-service
-      (documentation "Start the RPC bind daemon.")
-      (requirement '(networking))
-      (provision '(rpcbind-daemon))
-
-      (start #~(make-forkexec-constructor #$rpcbind-command))
-      (stop #~(make-kill-destructor))))))
+  (let ((proc
+         (lambda (config)
+           (define rpcbind
+             (rpcbind-configuration-rpcbind config))
+
+           (define rpcbind-command
+             #~(list (string-append #$rpcbind "/bin/rpcbind") "-f"
+                     #$@(if (rpcbind-configuration-warm-start? config) '("-w") '())))
+
+           (shepherd-service
+            (documentation "Start the RPC bind daemon.")
+            (requirement '(networking))
+            (provision '(rpcbind-daemon))
+
+            (start #~(make-forkexec-constructor #$rpcbind-command))
+            (stop #~(make-kill-destructor))))))
+    (service-type
+     (name 'rpcbind)
+     (extensions
+      (list (service-extension shepherd-root-service-type
+                               (compose list proc))))
+     ;; We use the extensions feature to allow other services to automatically
+     ;; configure and start this service.  Only one value can be provided.  We
+     ;; override it with the value returned by the extending service.
+     (compose identity)
+     (extend (lambda (config values)
+               (match values
+                 ((first . rest) first)
+                 (_ config))))
+     (default-value (rpcbind-configuration)))))
 
 \f
 
-- 
2.24.1

[bug#38902] [PATCH 4/9] services: nfs: Allow pipefs-service-type to be extended.

[Ricardo Wurmus]

* gnu/services/nfs.scm (pipefs-service-type): Rewrite using SERVICE-TYPE to
add ability to extend the service.
---
 gnu/services/nfs.scm | 39 +++++++++++++++++++++++++--------------
 1 file changed, 25 insertions(+), 14 deletions(-)

diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index 0681e764ec..1b5dcb0e97 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -24,6 +24,7 @@
   #:use-module (gnu packages linux)
   #:use-module (guix)
   #:use-module (guix records)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (gnu build file-systems)
   #:export (rpcbind-service-type
@@ -96,23 +97,33 @@
                          (default default-pipefs-directory)))
 
 (define pipefs-service-type
-  (shepherd-service-type
-   'pipefs
-   (lambda (config)
-     (define pipefs-directory (pipefs-configuration-mount-point config))
+  (let ((proc
+         (lambda (config)
+           (define pipefs-directory (pipefs-configuration-mount-point config))
 
-     (shepherd-service
-      (documentation "Mount the pipefs pseudo file system.")
-      (provision '(rpc-pipefs))
+           (shepherd-service
+            (documentation "Mount the pipefs pseudo file system.")
+            (provision '(rpc-pipefs))
 
-      (start #~(lambda ()
-                 (mkdir-p #$pipefs-directory)
-                 (mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
-                 (member #$pipefs-directory (mount-points))))
+            (start #~(lambda ()
+                       (mkdir-p #$pipefs-directory)
+                       (mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
+                       (member #$pipefs-directory (mount-points))))
 
-      (stop #~(lambda (pid . args)
-                (umount #$pipefs-directory MNT_DETACH)
-                (not (member #$pipefs-directory (mount-points)))))))))
+            (stop #~(lambda (pid . args)
+                      (umount #$pipefs-directory MNT_DETACH)
+                      (not (member #$pipefs-directory (mount-points)))))))))
+    (service-type
+     (name 'pipefs)
+     (extensions
+      (list (service-extension shepherd-root-service-type
+                               (compose list proc))))
+     ;; We use the extensions feature to allow other services to automatically
+     ;; configure and start this service.  Only one value can be provided.  We
+     ;; override it with the value returned by the extending service.
+     (compose identity)
+     (extend (lambda (config values) (first values)))
+     (default-value (pipefs-configuration)))))
 
 \f
 
-- 
2.24.1

[bug#38902] [PATCH 5/9] services: nfs: Fix indentation and typo.

[Ricardo Wurmus]

* gnu/services/nfs.scm (<gss-configuration>, <idmap-configuration>): Fix
indentation.
(<idmap-configuration>): Rename accessor for NFS-UTILS field to
IDMAP-CONFIGURATION-NFS-UTILS.
(idmap-service-type): Use IDMAP-CONFIGURATION-NFS-UTILS.
---
 gnu/services/nfs.scm | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index 1b5dcb0e97..451020be31 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -130,7 +130,7 @@
 (define-record-type* <gss-configuration>
   gss-configuration make-gss-configuration
   gss-configuration?
-  (pipefs-directory            gss-configuration-pipefs-directory
+  (pipefs-directory      gss-configuration-pipefs-directory
                          (default default-pipefs-directory))
   (nfs-utils             gss-configuration-gss
                          (default nfs-utils)))
@@ -162,11 +162,11 @@
 (define-record-type* <idmap-configuration>
   idmap-configuration make-idmap-configuration
   idmap-configuration?
-  (pipefs-directory            idmap-configuration-pipefs-directory
+  (pipefs-directory      idmap-configuration-pipefs-directory
                          (default default-pipefs-directory))
   (domain                idmap-configuration-domain
-                           (default #f))
-  (nfs-utils             idmap-configuration-idmap
+                         (default #f))
+  (nfs-utils             idmap-configuration-nfs-utils
                          (default nfs-utils)))
 
 (define idmap-service-type
@@ -175,7 +175,7 @@
    (lambda (config)
 
      (define nfs-utils
-       (idmap-configuration-idmap config))
+       (idmap-configuration-nfs-utils config))
 
      (define pipefs-directory
        (idmap-configuration-pipefs-directory config))
-- 
2.24.1

[bug#38902] [PATCH 6/9] services: nfs: Allow idmap-service-type to be extended.

[Ricardo Wurmus]

* gnu/services/nfs.scm (idmap-service-type): Rewrite using SERVICE-TYPE to add
ability to extend the service.
---
 gnu/services/nfs.scm | 67 ++++++++++++++++++++++++++------------------
 1 file changed, 39 insertions(+), 28 deletions(-)

diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index 451020be31..9fb95bde7e 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -170,37 +170,48 @@
                          (default nfs-utils)))
 
 (define idmap-service-type
-  (shepherd-service-type
-   'idmap
-   (lambda (config)
-
-     (define nfs-utils
-       (idmap-configuration-nfs-utils config))
+  (let ((proc
+         (lambda (config)
 
-     (define pipefs-directory
-       (idmap-configuration-pipefs-directory config))
+           (define nfs-utils
+             (idmap-configuration-nfs-utils config))
 
-     (define domain (idmap-configuration-domain config))
+           (define pipefs-directory
+             (idmap-configuration-pipefs-directory config))
 
-     (define (idmap-config-file config)
-       (plain-file "idmapd.conf"
-                   (string-append
-                    "\n[General]\n"
-                    (if domain
-                        (format #f "Domain = ~a\n" domain))
-                    "\n[Mapping]\n"
-                    "Nobody-User = nobody\n"
-                    "Nobody-Group = nogroup\n")))
+           (define domain (idmap-configuration-domain config))
 
-     (define idmap-command
-       #~(list (string-append #$nfs-utils "/sbin/rpc.idmapd") "-f"
-               "-p" #$pipefs-directory
-               "-c" #$(idmap-config-file config)))
+           (define (idmap-config-file config)
+             (plain-file "idmapd.conf"
+                         (string-append
+                          "\n[General]\n"
+                          (if domain
+                              (format #f "Domain = ~a\n" domain)
+                              "")
+                          "\n[Mapping]\n"
+                          "Nobody-User = nobody\n"
+                          "Nobody-Group = nogroup\n")))
 
-     (shepherd-service
-       (documentation "Start the RPC IDMAP daemon.")
-       (requirement '(rpcbind-daemon rpc-pipefs))
-       (provision '(idmap-daemon))
-       (start #~(make-forkexec-constructor #$idmap-command))
-       (stop #~(make-kill-destructor))))))
+           (define idmap-command
+             #~(list (string-append #$nfs-utils "/sbin/rpc.idmapd") "-f"
+                     "-p" #$pipefs-directory
+                     ;; TODO: this is deprecated
+                     "-c" #$(idmap-config-file config)))
 
+           (shepherd-service
+            (documentation "Start the RPC IDMAP daemon.")
+            (requirement '(rpcbind-daemon rpc-pipefs))
+            (provision '(idmap-daemon))
+            (start #~(make-forkexec-constructor #$idmap-command))
+            (stop #~(make-kill-destructor))))))
+    (service-type
+     (name 'idmap)
+     (extensions
+      (list (service-extension shepherd-root-service-type
+                               (compose list proc))))
+     ;; We use the extensions feature to allow other services to automatically
+     ;; configure and start this service.  Only one value can be provided.  We
+     ;; override it with the value returned by the extending service.
+     (compose identity)
+     (extend (lambda (config values) (first values)))
+     (default-value (idmap-configuration)))))
-- 
2.24.1

[bug#38902] [PATCH 7/9] services: nfs: Add verbosity control to idmap-service-type.

[Ricardo Wurmus]

* gnu/services/nfs.scm (<idmap-configuration>)[verbosity]: New field.
(idmap-configuration-verbosity): New procedure.
(idmap-service-type): Use it.
* doc/guix.texi (Network File System): Document it.
---
 doc/guix.texi        | 3 +++
 gnu/services/nfs.scm | 8 +++++++-
 2 files changed, 10 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 70e3dfea6a..a26056899e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -22030,6 +22030,9 @@ The local NFSv4 domain name.
 This must be a string or @code{#f}.
 If it is @code{#f} then the daemon will use the host's fully qualified domain name.
 
+@item @code{verbosity} (default: @code{0})
+The verbosity level of the daemon.
+
 @end table
 @end deftp
 
diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index 9fb95bde7e..054dad08b6 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -167,7 +167,9 @@
   (domain                idmap-configuration-domain
                          (default #f))
   (nfs-utils             idmap-configuration-nfs-utils
-                         (default nfs-utils)))
+                         (default nfs-utils))
+  (verbosity             idmap-configuration-verbosity
+                         (default 0)))
 
 (define idmap-service-type
   (let ((proc
@@ -185,6 +187,10 @@
              (plain-file "idmapd.conf"
                          (string-append
                           "\n[General]\n"
+                          "Verbosity = "
+                          (number->string
+                           (idmap-configuration-verbosity config))
+                          "\n"
                           (if domain
                               (format #f "Domain = ~a\n" domain)
                               "")
-- 
2.24.1

[bug#38902] [PATCH 8/9] services: nfs: Allow gss-service-type to be extended.

[Ricardo Wurmus]

* gnu/services/nfs.scm (gss-service-type): Rewrite using SERVICE-TYPE to add
ability to extend the service.
---
 gnu/services/nfs.scm | 53 +++++++++++++++++++++++++++-----------------
 1 file changed, 33 insertions(+), 20 deletions(-)

diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm
index 054dad08b6..cd7e8fab01 100644
--- a/gnu/services/nfs.scm
+++ b/gnu/services/nfs.scm
@@ -136,26 +136,39 @@
                          (default nfs-utils)))
 
 (define gss-service-type
-  (shepherd-service-type
-   'gss
-   (lambda (config)
-     (define nfs-utils
-       (gss-configuration-gss config))
-
-     (define pipefs-directory
-       (gss-configuration-pipefs-directory config))
-
-     (define gss-command
-       #~(list (string-append #$nfs-utils "/sbin/rpc.gssd") "-f"
-               "-p" #$pipefs-directory))
-
-     (shepherd-service
-      (documentation "Start the RPC GSS daemon.")
-      (requirement '(rpcbind-daemon rpc-pipefs))
-      (provision '(gss-daemon))
-
-      (start #~(make-forkexec-constructor #$gss-command))
-      (stop #~(make-kill-destructor))))))
+  (let ((proc
+         (lambda (config)
+           (define nfs-utils
+             (gss-configuration-gss config))
+
+           (define pipefs-directory
+             (gss-configuration-pipefs-directory config))
+
+           (define gss-command
+             #~(list (string-append #$nfs-utils "/sbin/rpc.gssd") "-f"
+                     "-p" #$pipefs-directory))
+
+           (shepherd-service
+            (documentation "Start the RPC GSS daemon.")
+            (requirement '(rpcbind-daemon rpc-pipefs))
+            (provision '(gss-daemon))
+
+            (start #~(make-forkexec-constructor #$gss-command))
+            (stop #~(make-kill-destructor))))))
+    (service-type
+     (name 'gss)
+     (extensions
+      (list (service-extension shepherd-root-service-type
+                               (compose list proc))))
+     ;; We use the extensions feature to allow other services to automatically
+     ;; configure and start this service.  Only one value can be provided.  We
+     ;; override it with the value returned by the extending service.
+     (compose identity)
+     (extend (lambda (config values)
+               (match values
+                 ((first . rest) first)
+                 (_ config))))
+     (default-value (gss-configuration)))))
 
 \f
 
-- 
2.24.1

[bug#38902] [PATCH 9/9] services: nfs: Add nfs-service-type.

[Ricardo Wurmus]

* 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.
---
 doc/guix.texi        |  74 +++++++++++++++++-
 gnu/services/nfs.scm | 181 ++++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/nfs.scm    | 157 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 407 insertions(+), 5 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a26056899e..8eb31e54df 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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@*
@@ -21926,6 +21926,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
 
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"))))
+
+\f
+(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))))
-- 
2.24.1

bug#38902: [PATCH 9/9] services: nfs: Add nfs-service-type.

[Ricardo Wurmus]

I just pushed all of these patches to the master branch (907eeac2e7).

-- 
Ricardo