gnu/services/nfs.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
   3 ;;; Copyright © 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
   4 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
   5 ;;;
   6 ;;; This file is part of GNU Guix.
   7 ;;;
   8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   9 ;;; under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 3 of the License, or (at
  11 ;;; your option) any later version.
  12 ;;;
  13 ;;; GNU Guix is distributed in the hope that it will be useful, but
  14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 (define-module (gnu services nfs)
  22   #:use-module (gnu)
  23   #:use-module (gnu services shepherd)
  24   #:use-module (gnu packages onc-rpc)
  25   #:use-module (gnu packages linux)
  26   #:use-module (gnu packages nfs)
  27   #:use-module (guix)
  28   #:use-module (guix records)
  29   #:use-module (srfi srfi-1)
  30   #:use-module (ice-9 match)
  31   #:use-module (gnu build file-systems)
  32   #:export (rpcbind-service-type
  33             rpcbind-configuration
  34             rpcbind-configuration?
  35
  36             pipefs-service-type
  37             pipefs-configuration
  38             pipefs-configuration?
  39
  40             idmap-service-type
  41             idmap-configuration
  42             idmap-configuration?
  43
  44             gss-service-type
  45             gss-configuration
  46             gss-configuration?
  47
  48             nfs-service-type
  49             nfs-configuration
  50             nfs-configuration?))
  51
  52
  53 (define default-pipefs-directory "/var/lib/nfs/rpc_pipefs")
  54
  55 \f
  56
  57 (define-record-type* <rpcbind-configuration>
  58   rpcbind-configuration make-rpcbind-configuration
  59   rpcbind-configuration?
  60   (rpcbind             rpcbind-configuration-rpcbind
  61                        (default rpcbind))
  62   (warm-start?         rpcbind-configuration-warm-start?
  63                        (default #t)))
  64
  65 (define rpcbind-service-type
  66   (let ((proc
  67          (lambda (config)
  68            (define rpcbind
  69              (rpcbind-configuration-rpcbind config))
  70
  71            (define rpcbind-command
  72              #~(list (string-append #$rpcbind "/sbin/rpcbind") "-f"
  73                      #$@(if (rpcbind-configuration-warm-start? config) '("-w") '())))
  74
  75            (shepherd-service
  76             (documentation "Start the RPC bind daemon.")
  77             (requirement '(networking))
  78             (provision '(rpcbind-daemon))
  79
  80             (start #~(make-forkexec-constructor #$rpcbind-command))
  81             (stop #~(make-kill-destructor))))))
  82     (service-type
  83      (name 'rpcbind)
  84      (extensions
  85       (list (service-extension shepherd-root-service-type
  86                                (compose list proc))))
  87      ;; We use the extensions feature to allow other services to automatically
  88      ;; configure and start this service.  Only one value can be provided.  We
  89      ;; override it with the value returned by the extending service.
  90      (compose identity)
  91      (extend (lambda (config values)
  92                (match values
  93                  ((first . rest) first)
  94                  (_ config))))
  95      (default-value (rpcbind-configuration))
  96      (description "Run the RPC Bind service, which provides a facility to map
  97 ONC RPC program numbers into universal addresses.  Many NFS related services
  98 use this facility."))))
  99
 100 \f
 101
 102 (define-record-type* <pipefs-configuration>
 103   pipefs-configuration make-pipefs-configuration
 104   pipefs-configuration?
 105   (mount-point           pipefs-configuration-mount-point
 106                          (default default-pipefs-directory)))
 107
 108 (define pipefs-service-type
 109   (let ((proc
 110          (lambda (config)
 111            (define pipefs-directory (pipefs-configuration-mount-point config))
 112
 113            (shepherd-service
 114             (documentation "Mount the pipefs pseudo file system.")
 115             (provision '(rpc-pipefs))
 116
 117             (start #~(lambda ()
 118                        (mkdir-p #$pipefs-directory)
 119                        (mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
 120                        (member #$pipefs-directory (mount-points))))
 121
 122             (stop #~(lambda (pid . args)
 123                       (umount #$pipefs-directory MNT_DETACH)
 124                       (not (member #$pipefs-directory (mount-points)))))))))
 125     (service-type
 126      (name 'pipefs)
 127      (extensions
 128       (list (service-extension shepherd-root-service-type
 129                                (compose list proc))))
 130      ;; We use the extensions feature to allow other services to automatically
 131      ;; configure and start this service.  Only one value can be provided.  We
 132      ;; override it with the value returned by the extending service.
 133      (compose identity)
 134      (extend (lambda (config values)
 135                (match values
 136                  ((first . rest) first)
 137                  (_ config))))
 138      (default-value (pipefs-configuration))
 139      (description "Mount the pipefs file system, which is used to transfer
 140 NFS-related data between the kernel and user-space programs."))))
 141
 142 \f
 143
 144 (define-record-type* <gss-configuration>
 145   gss-configuration make-gss-configuration
 146   gss-configuration?
 147   (pipefs-directory      gss-configuration-pipefs-directory
 148                          (default default-pipefs-directory))
 149   (nfs-utils             gss-configuration-gss
 150                          (default nfs-utils)))
 151
 152 (define gss-service-type
 153   (let ((proc
 154          (lambda (config)
 155            (define nfs-utils
 156              (gss-configuration-gss config))
 157
 158            (define pipefs-directory
 159              (gss-configuration-pipefs-directory config))
 160
 161            (define gss-command
 162              #~(list (string-append #$nfs-utils "/sbin/rpc.gssd") "-f"
 163                      "-p" #$pipefs-directory))
 164
 165            (shepherd-service
 166             (documentation "Start the RPC GSS daemon.")
 167             (requirement '(rpcbind-daemon rpc-pipefs))
 168             (provision '(gss-daemon))
 169
 170             (start #~(make-forkexec-constructor #$gss-command))
 171             (stop #~(make-kill-destructor))))))
 172     (service-type
 173      (name 'gss)
 174      (extensions
 175       (list (service-extension shepherd-root-service-type
 176                                (compose list proc))))
 177      ;; We use the extensions feature to allow other services to automatically
 178      ;; configure and start this service.  Only one value can be provided.  We
 179      ;; override it with the value returned by the extending service.
 180      (compose identity)
 181      (extend (lambda (config values)
 182                (match values
 183                  ((first . rest) first)
 184                  (_ config))))
 185      (default-value (gss-configuration))
 186      (description "Run the @dfn{global security system} (GSS) daemon, which
 187 provides strong security for protocols based on remote procedure calls (ONC
 188 RPC)."))))
 189
 190 \f
 191
 192 (define-record-type* <idmap-configuration>
 193   idmap-configuration make-idmap-configuration
 194   idmap-configuration?
 195   (pipefs-directory      idmap-configuration-pipefs-directory
 196                          (default default-pipefs-directory))
 197   (domain                idmap-configuration-domain
 198                          (default #f))
 199   (nfs-utils             idmap-configuration-nfs-utils
 200                          (default nfs-utils))
 201   (verbosity             idmap-configuration-verbosity
 202                          (default 0)))
 203
 204 (define idmap-service-type
 205   (let ((proc
 206          (lambda (config)
 207
 208            (define nfs-utils
 209              (idmap-configuration-nfs-utils config))
 210
 211            (define pipefs-directory
 212              (idmap-configuration-pipefs-directory config))
 213
 214            (define domain (idmap-configuration-domain config))
 215
 216            (define (idmap-config-file config)
 217              (plain-file "idmapd.conf"
 218                          (string-append
 219                           "\n[General]\n"
 220                           "Verbosity = "
 221                           (number->string
 222                            (idmap-configuration-verbosity config))
 223                           "\n"
 224                           (if domain
 225                               (format #f "Domain = ~a\n" domain)
 226                               "")
 227                           "\n[Mapping]\n"
 228                           "Nobody-User = nobody\n"
 229                           "Nobody-Group = nogroup\n")))
 230
 231            (define idmap-command
 232              #~(list (string-append #$nfs-utils "/sbin/rpc.idmapd") "-f"
 233                      "-p" #$pipefs-directory
 234                      ;; TODO: this is deprecated
 235                      "-c" #$(idmap-config-file config)))
 236
 237            (shepherd-service
 238             (documentation "Start the RPC IDMAP daemon.")
 239             (requirement '(rpcbind-daemon rpc-pipefs))
 240             (provision '(idmap-daemon))
 241             (start #~(make-forkexec-constructor #$idmap-command))
 242             (stop #~(make-kill-destructor))))))
 243     (service-type
 244      (name 'idmap)
 245      (extensions
 246       (list (service-extension shepherd-root-service-type
 247                                (compose list proc))))
 248      ;; We use the extensions feature to allow other services to automatically
 249      ;; configure and start this service.  Only one value can be provided.  We
 250      ;; override it with the value returned by the extending service.
 251      (compose identity)
 252      (extend (lambda (config values) (first values)))
 253      (default-value (idmap-configuration))
 254      (description "Run the idmap daemon, which provides a mapping between user
 255 IDs and user names.  It is typically required to access file systems mounted
 256 via NFSv4."))))
 257
 258 (define-record-type* <nfs-configuration>
 259   nfs-configuration make-nfs-configuration
 260   nfs-configuration?
 261   (nfs-utils           nfs-configuration-nfs-utils
 262                        (default nfs-utils))
 263   (nfs-versions        nfs-configuration-nfs-versions
 264                        (default '("4.2" "4.1" "4.0")))
 265   (exports             nfs-configuration-exports
 266                        (default '()))
 267   (rpcmountd-port      nfs-configuration-rpcmountd-port
 268                        (default #f))
 269   (rpcstatd-port       nfs-configuration-rpcstatd-port
 270                        (default #f))
 271   (rpcbind             nfs-configuration-rpcbind
 272                        (default rpcbind))
 273   (idmap-domain        nfs-configuration-idmap-domain
 274                        (default "localdomain"))
 275   (nfsd-port           nfs-configuration-nfsd-port
 276                        (default 2049))
 277   (nfsd-threads        nfs-configuration-nfsd-threads
 278                        (default 8))
 279   (nfsd-tcp?           nfs-configuration-nfsd-tcp?
 280                        (default #t))
 281   (nfsd-udp?           nfs-configuration-nfsd-udp?
 282                        (default #f))
 283   (pipefs-directory    nfs-configuration-pipefs-directory
 284                        (default default-pipefs-directory))
 285   ;; List of modules to debug; any of nfsd, nfs, rpc, idmap, statd, or mountd.
 286   (debug               nfs-configuration-debug
 287                        (default '())))
 288
 289 (define (nfs-shepherd-services config)
 290   "Return a list of <shepherd-service> for the NFS daemons with CONFIG."
 291   (match-record config <nfs-configuration>
 292     (nfs-utils nfs-versions exports
 293                rpcmountd-port rpcstatd-port nfsd-port nfsd-threads
 294                nfsd-tcp? nfsd-udp?
 295                pipefs-directory debug)
 296     (list (shepherd-service
 297            (documentation "Mount the nfsd pseudo file system.")
 298            (provision '(/proc/fs/nfsd))
 299            (start #~(lambda ()
 300                       (mount "nfsd" "/proc/fs/nfsd" "nfsd")
 301                       (member "/proc/fs/nfsd" (mount-points))))
 302
 303            (stop #~(lambda (pid . args)
 304                      (umount "/proc/fs/nfsd" MNT_DETACH)
 305                      (not (member "/proc/fs/nfsd" (mount-points))))))
 306           (shepherd-service
 307            (documentation "Run the NFS statd daemon.")
 308            (provision '(rpc.statd))
 309            (requirement '(/proc/fs/nfsd rpcbind-daemon))
 310            (start
 311             #~(make-forkexec-constructor
 312                (list #$(file-append nfs-utils "/sbin/rpc.statd")
 313                      ;; TODO: notification support may require a little more
 314                      ;; configuration work.
 315                      "--no-notify"
 316                      #$@(if (member 'statd debug)
 317                             '("--no-syslog") ; verbose logging to stderr
 318                             '())
 319                      "--foreground"
 320                      #$@(if rpcstatd-port
 321                             #~("--port" #$(number->string rpcstatd-port))
 322                             '()))
 323                #:pid-file "/var/run/rpc.statd.pid"))
 324            (stop #~(make-kill-destructor)))
 325           (shepherd-service
 326            (documentation "Run the NFS mountd daemon.")
 327            (provision '(rpc.mountd))
 328            (requirement '(/proc/fs/nfsd rpc.statd))
 329            (start
 330             #~(make-forkexec-constructor
 331                (list #$(file-append nfs-utils "/sbin/rpc.mountd")
 332                      "--foreground"
 333                      #$@(if (member 'mountd debug)
 334                             '("--debug" "all")
 335                             '())
 336                      #$@(if rpcmountd-port
 337                             #~("--port" #$(number->string rpcmountd-port))
 338                             '()))))
 339            (stop #~(make-kill-destructor)))
 340           (shepherd-service
 341            (documentation "Run the NFS daemon.")
 342            (provision '(rpc.nfsd))
 343            (requirement '(/proc/fs/nfsd rpc.statd networking))
 344            (start
 345             #~(lambda _
 346                 (zero? (apply system* #$(file-append nfs-utils "/sbin/rpc.nfsd")
 347                               (list
 348                                #$@(if (member 'nfsd debug)
 349                                       '("--debug")
 350                                       '())
 351                                "--port" #$(number->string nfsd-port)
 352                                #$@(map (lambda (version)
 353                                          (string-append "--nfs-version=" version))
 354                                        nfs-versions)
 355                                #$(number->string nfsd-threads)
 356                                #$(if nfsd-tcp?
 357                                      "--tcp"
 358                                      "--no-tcp")
 359                                #$(if nfsd-udp?
 360                                      "--udp"
 361                                      "--no-udp"))))))
 362            (stop
 363             #~(lambda _
 364                 (zero?
 365                  (system* #$(file-append nfs-utils "/sbin/rpc.nfsd") "0")))))
 366           (shepherd-service
 367            (documentation "Run the NFS mountd daemon and refresh exports.")
 368            (provision '(nfs))
 369            (requirement '(/proc/fs/nfsd rpc.nfsd rpc.mountd rpc.statd rpcbind-daemon))
 370            (start
 371             #~(lambda _
 372                 (let ((rpcdebug #$(file-append nfs-utils "/sbin/rpcdebug")))
 373                   (cond
 374                    ((member 'nfsd '#$debug)
 375                     (system* rpcdebug "-m" "nfsd" "-s" "all"))
 376                    ((member 'nfs '#$debug)
 377                     (system* rpcdebug "-m" "nfs" "-s" "all"))
 378                    ((member 'rpc '#$debug)
 379                     (system* rpcdebug "-m" "rpc" "-s" "all"))))
 380                 (zero? (system*
 381                         #$(file-append nfs-utils "/sbin/exportfs")
 382                         "-r"            ; re-export
 383                         "-a"            ; everthing
 384                         "-v"            ; be verbose
 385                         "-d" "all"      ; debug
 386                         ))))
 387            (stop
 388             #~(lambda _
 389                 (let ((rpcdebug #$(file-append nfs-utils "/sbin/rpcdebug")))
 390                   (cond
 391                    ((member 'nfsd '#$debug)
 392                     (system* rpcdebug "-m" "nfsd" "-c" "all"))
 393                    ((member 'nfs '#$debug)
 394                     (system* rpcdebug "-m" "nfs" "-c" "all"))
 395                    ((member 'rpc '#$debug)
 396                     (system* rpcdebug "-m" "rpc" "-c" "all"))))
 397                 #t))
 398            (respawn? #f)))))
 399
 400 (define %nfs-activation
 401   (with-imported-modules '((guix build utils))
 402     #~(begin
 403         (use-modules (guix build utils))
 404
 405         ;; directory containing monitor list
 406         (mkdir-p "/var/lib/nfs/sm")
 407         ;; Needed for client recovery tracking
 408         (mkdir-p "/var/lib/nfs/v4recovery")
 409         (let ((user (getpw "nobody")))
 410           (chown "/var/lib/nfs"
 411                  (passwd:uid user)
 412                  (passwd:gid user))
 413           (chown "/var/lib/nfs/v4recovery"
 414                  (passwd:uid user)
 415                  (passwd:gid user)))
 416         #t)))
 417
 418 (define nfs-service-type
 419   (service-type
 420    (name 'nfs)
 421    (extensions
 422     (list
 423      (service-extension shepherd-root-service-type nfs-shepherd-services)
 424      (service-extension activation-service-type (const %nfs-activation))
 425      (service-extension etc-service-type
 426                         (lambda (config)
 427                           `(("exports"
 428                              ,(plain-file "exports"
 429                                           (string-join
 430                                            (map string-join
 431                                                 (nfs-configuration-exports config))
 432                                            "\n"))))))
 433      ;; The NFS service depends on these other services.  They are extended so
 434      ;; that users don't need to configure them manually.
 435      (service-extension idmap-service-type
 436                         (lambda (config)
 437                           (idmap-configuration
 438                            (domain (nfs-configuration-idmap-domain config))
 439                            (verbosity
 440                             (if (member 'idmap (nfs-configuration-debug config))
 441                                 10 0))
 442                            (pipefs-directory (nfs-configuration-pipefs-directory config))
 443                            (nfs-utils (nfs-configuration-nfs-utils config)))))
 444      (service-extension pipefs-service-type
 445                         (lambda (config)
 446                           (pipefs-configuration
 447                            (mount-point (nfs-configuration-pipefs-directory config)))))
 448      (service-extension rpcbind-service-type
 449                         (lambda (config)
 450                           (rpcbind-configuration
 451                            (rpcbind (nfs-configuration-rpcbind config)))))))
 452    (description
 453     "Run all NFS daemons and refresh the list of exported file systems.")))