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
  97 \f
  98
  99 (define-record-type* <pipefs-configuration>
 100   pipefs-configuration make-pipefs-configuration
 101   pipefs-configuration?
 102   (mount-point           pipefs-configuration-mount-point
 103                          (default default-pipefs-directory)))
 104
 105 (define pipefs-service-type
 106   (let ((proc
 107          (lambda (config)
 108            (define pipefs-directory (pipefs-configuration-mount-point config))
 109
 110            (shepherd-service
 111             (documentation "Mount the pipefs pseudo file system.")
 112             (provision '(rpc-pipefs))
 113
 114             (start #~(lambda ()
 115                        (mkdir-p #$pipefs-directory)
 116                        (mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
 117                        (member #$pipefs-directory (mount-points))))
 118
 119             (stop #~(lambda (pid . args)
 120                       (umount #$pipefs-directory MNT_DETACH)
 121                       (not (member #$pipefs-directory (mount-points)))))))))
 122     (service-type
 123      (name 'pipefs)
 124      (extensions
 125       (list (service-extension shepherd-root-service-type
 126                                (compose list proc))))
 127      ;; We use the extensions feature to allow other services to automatically
 128      ;; configure and start this service.  Only one value can be provided.  We
 129      ;; override it with the value returned by the extending service.
 130      (compose identity)
 131      (extend (lambda (config values) (first values)))
 132      (default-value (pipefs-configuration)))))
 133
 134 \f
 135
 136 (define-record-type* <gss-configuration>
 137   gss-configuration make-gss-configuration
 138   gss-configuration?
 139   (pipefs-directory      gss-configuration-pipefs-directory
 140                          (default default-pipefs-directory))
 141   (nfs-utils             gss-configuration-gss
 142                          (default nfs-utils)))
 143
 144 (define gss-service-type
 145   (let ((proc
 146          (lambda (config)
 147            (define nfs-utils
 148              (gss-configuration-gss config))
 149
 150            (define pipefs-directory
 151              (gss-configuration-pipefs-directory config))
 152
 153            (define gss-command
 154              #~(list (string-append #$nfs-utils "/sbin/rpc.gssd") "-f"
 155                      "-p" #$pipefs-directory))
 156
 157            (shepherd-service
 158             (documentation "Start the RPC GSS daemon.")
 159             (requirement '(rpcbind-daemon rpc-pipefs))
 160             (provision '(gss-daemon))
 161
 162             (start #~(make-forkexec-constructor #$gss-command))
 163             (stop #~(make-kill-destructor))))))
 164     (service-type
 165      (name 'gss)
 166      (extensions
 167       (list (service-extension shepherd-root-service-type
 168                                (compose list proc))))
 169      ;; We use the extensions feature to allow other services to automatically
 170      ;; configure and start this service.  Only one value can be provided.  We
 171      ;; override it with the value returned by the extending service.
 172      (compose identity)
 173      (extend (lambda (config values)
 174                (match values
 175                  ((first . rest) first)
 176                  (_ config))))
 177      (default-value (gss-configuration)))))
 178
 179 \f
 180
 181 (define-record-type* <idmap-configuration>
 182   idmap-configuration make-idmap-configuration
 183   idmap-configuration?
 184   (pipefs-directory      idmap-configuration-pipefs-directory
 185                          (default default-pipefs-directory))
 186   (domain                idmap-configuration-domain
 187                          (default #f))
 188   (nfs-utils             idmap-configuration-nfs-utils
 189                          (default nfs-utils))
 190   (verbosity             idmap-configuration-verbosity
 191                          (default 0)))
 192
 193 (define idmap-service-type
 194   (let ((proc
 195          (lambda (config)
 196
 197            (define nfs-utils
 198              (idmap-configuration-nfs-utils config))
 199
 200            (define pipefs-directory
 201              (idmap-configuration-pipefs-directory config))
 202
 203            (define domain (idmap-configuration-domain config))
 204
 205            (define (idmap-config-file config)
 206              (plain-file "idmapd.conf"
 207                          (string-append
 208                           "\n[General]\n"
 209                           "Verbosity = "
 210                           (number->string
 211                            (idmap-configuration-verbosity config))
 212                           "\n"
 213                           (if domain
 214                               (format #f "Domain = ~a\n" domain)
 215                               "")
 216                           "\n[Mapping]\n"
 217                           "Nobody-User = nobody\n"
 218                           "Nobody-Group = nogroup\n")))
 219
 220            (define idmap-command
 221              #~(list (string-append #$nfs-utils "/sbin/rpc.idmapd") "-f"
 222                      "-p" #$pipefs-directory
 223                      ;; TODO: this is deprecated
 224                      "-c" #$(idmap-config-file config)))
 225
 226            (shepherd-service
 227             (documentation "Start the RPC IDMAP daemon.")
 228             (requirement '(rpcbind-daemon rpc-pipefs))
 229             (provision '(idmap-daemon))
 230             (start #~(make-forkexec-constructor #$idmap-command))
 231             (stop #~(make-kill-destructor))))))
 232     (service-type
 233      (name 'idmap)
 234      (extensions
 235       (list (service-extension shepherd-root-service-type
 236                                (compose list proc))))
 237      ;; We use the extensions feature to allow other services to automatically
 238      ;; configure and start this service.  Only one value can be provided.  We
 239      ;; override it with the value returned by the extending service.
 240      (compose identity)
 241      (extend (lambda (config values) (first values)))
 242      (default-value (idmap-configuration)))))
 243
 244 (define-record-type* <nfs-configuration>
 245   nfs-configuration make-nfs-configuration
 246   nfs-configuration?
 247   (nfs-utils           nfs-configuration-nfs-utils
 248                        (default nfs-utils))
 249   (nfs-versions        nfs-configuration-nfs-versions
 250                        (default '("4.2" "4.1" "4.0")))
 251   (exports             nfs-configuration-exports
 252                        (default '()))
 253   (rpcmountd-port      nfs-configuration-rpcmountd-port
 254                        (default #f))
 255   (rpcstatd-port       nfs-configuration-rpcstatd-port
 256                        (default #f))
 257   (rpcbind             nfs-configuration-rpcbind
 258                        (default rpcbind))
 259   (idmap-domain        nfs-configuration-idmap-domain
 260                        (default "localdomain"))
 261   (nfsd-port           nfs-configuration-nfsd-port
 262                        (default 2049))
 263   (nfsd-threads        nfs-configuration-nfsd-threads
 264                        (default 8))
 265   (nfsd-tcp?           nfs-configuration-nfsd-tcp?
 266                        (default #t))
 267   (nfsd-udp?           nfs-configuration-nfsd-udp?
 268                        (default #f))
 269   (pipefs-directory    nfs-configuration-pipefs-directory
 270                        (default default-pipefs-directory))
 271   ;; List of modules to debug; any of nfsd, nfs, rpc, idmap, statd, or mountd.
 272   (debug               nfs-configuration-debug
 273                        (default '())))
 274
 275 (define (nfs-shepherd-services config)
 276   "Return a list of <shepherd-service> for the NFS daemons with CONFIG."
 277   (match-record config <nfs-configuration>
 278     (nfs-utils nfs-versions exports
 279                rpcmountd-port rpcstatd-port nfsd-port nfsd-threads
 280                nfsd-tcp? nfsd-udp?
 281                pipefs-directory debug)
 282     (list (shepherd-service
 283            (documentation "Mount the nfsd pseudo file system.")
 284            (provision '(/proc/fs/nfsd))
 285            (start #~(lambda ()
 286                       (mount "nfsd" "/proc/fs/nfsd" "nfsd")
 287                       (member "/proc/fs/nfsd" (mount-points))))
 288
 289            (stop #~(lambda (pid . args)
 290                      (umount "/proc/fs/nfsd" MNT_DETACH)
 291                      (not (member "/proc/fs/nfsd" (mount-points))))))
 292           (shepherd-service
 293            (documentation "Run the NFS statd daemon.")
 294            (provision '(rpc.statd))
 295            (requirement '(/proc/fs/nfsd rpcbind-daemon))
 296            (start
 297             #~(make-forkexec-constructor
 298                (list #$(file-append nfs-utils "/sbin/rpc.statd")
 299                      ;; TODO: notification support may require a little more
 300                      ;; configuration work.
 301                      "--no-notify"
 302                      #$@(if (member 'statd debug)
 303                             '("--no-syslog") ; verbose logging to stderr
 304                             '())
 305                      "--foreground"
 306                      #$@(if rpcstatd-port
 307                             '("--port" (number->string rpcstatd-port))
 308                             '()))
 309                #:pid-file "/var/run/rpc.statd.pid"))
 310            (stop #~(make-kill-destructor)))
 311           (shepherd-service
 312            (documentation "Run the NFS mountd daemon.")
 313            (provision '(rpc.mountd))
 314            (requirement '(/proc/fs/nfsd rpc.statd))
 315            (start
 316             #~(make-forkexec-constructor
 317                (list #$(file-append nfs-utils "/sbin/rpc.mountd")
 318                      "--foreground"
 319                      #$@(if (member 'mountd debug)
 320                             '("--debug" "all")
 321                             '())
 322                      #$@(if rpcmountd-port
 323                             '("--port" (number->string rpcmountd-port))
 324                             '()))))
 325            (stop #~(make-kill-destructor)))
 326           (shepherd-service
 327            (documentation "Run the NFS daemon.")
 328            (provision '(rpc.nfsd))
 329            (requirement '(/proc/fs/nfsd rpc.statd networking))
 330            (start
 331             #~(lambda _
 332                 (zero? (apply system* #$(file-append nfs-utils "/sbin/rpc.nfsd")
 333                               (list
 334                                #$@(if (member 'nfsd debug)
 335                                       '("--debug")
 336                                       '())
 337                                "--port" #$(number->string nfsd-port)
 338                                #$@(map (lambda (version)
 339                                          (string-append "--nfs-version=" version))
 340                                        nfs-versions)
 341                                #$(number->string nfsd-threads)
 342                                #$(if nfsd-tcp?
 343                                      "--tcp"
 344                                      "--no-tcp")
 345                                #$(if nfsd-udp?
 346                                      "--udp"
 347                                      "--no-udp"))))))
 348            (stop
 349             #~(lambda _
 350                 (zero?
 351                  (system* #$(file-append nfs-utils "/sbin/rpc.nfsd") "0")))))
 352           (shepherd-service
 353            (documentation "Run the NFS mountd daemon and refresh exports.")
 354            (provision '(nfs))
 355            (requirement '(/proc/fs/nfsd rpc.nfsd rpc.mountd rpc.statd rpcbind-daemon))
 356            (start
 357             #~(lambda _
 358                 (let ((rpcdebug #$(file-append nfs-utils "/sbin/rpcdebug")))
 359                   (cond
 360                    ((member 'nfsd '#$debug)
 361                     (system* rpcdebug "-m" "nfsd" "-s" "all"))
 362                    ((member 'nfs '#$debug)
 363                     (system* rpcdebug "-m" "nfs" "-s" "all"))
 364                    ((member 'rpc '#$debug)
 365                     (system* rpcdebug "-m" "rpc" "-s" "all"))))
 366                 (zero? (system*
 367                         #$(file-append nfs-utils "/sbin/exportfs")
 368                         "-r"            ; re-export
 369                         "-a"            ; everthing
 370                         "-v"            ; be verbose
 371                         "-d" "all"      ; debug
 372                         ))))
 373            (stop
 374             #~(lambda _
 375                 (let ((rpcdebug #$(file-append nfs-utils "/sbin/rpcdebug")))
 376                   (cond
 377                    ((member 'nfsd '#$debug)
 378                     (system* rpcdebug "-m" "nfsd" "-c" "all"))
 379                    ((member 'nfs '#$debug)
 380                     (system* rpcdebug "-m" "nfs" "-c" "all"))
 381                    ((member 'rpc '#$debug)
 382                     (system* rpcdebug "-m" "rpc" "-c" "all"))))
 383                 #t))
 384            (respawn? #f)))))
 385
 386 (define %nfs-activation
 387   (with-imported-modules '((guix build utils))
 388     #~(begin
 389         (use-modules (guix build utils))
 390
 391         ;; directory containing monitor list
 392         (mkdir-p "/var/lib/nfs/sm")
 393         ;; Needed for client recovery tracking
 394         (mkdir-p "/var/lib/nfs/v4recovery")
 395         (let ((user (getpw "nobody")))
 396           (chown "/var/lib/nfs"
 397                  (passwd:uid user)
 398                  (passwd:gid user))
 399           (chown "/var/lib/nfs/v4recovery"
 400                  (passwd:uid user)
 401                  (passwd:gid user)))
 402         #t)))
 403
 404 (define nfs-service-type
 405   (service-type
 406    (name 'nfs)
 407    (extensions
 408     (list
 409      (service-extension shepherd-root-service-type nfs-shepherd-services)
 410      (service-extension activation-service-type (const %nfs-activation))
 411      (service-extension etc-service-type
 412                         (lambda (config)
 413                           `(("exports"
 414                              ,(plain-file "exports"
 415                                           (string-join
 416                                            (map string-join
 417                                                 (nfs-configuration-exports config))
 418                                            "\n"))))))
 419      ;; The NFS service depends on these other services.  They are extended so
 420      ;; that users don't need to configure them manually.
 421      (service-extension idmap-service-type
 422                         (lambda (config)
 423                           (idmap-configuration
 424                            (domain (nfs-configuration-idmap-domain config))
 425                            (verbosity
 426                             (if (member 'idmap (nfs-configuration-debug config))
 427                                 10 0))
 428                            (pipefs-directory (nfs-configuration-pipefs-directory config))
 429                            (nfs-utils (nfs-configuration-nfs-utils config)))))
 430      (service-extension pipefs-service-type
 431                         (lambda (config)
 432                           (pipefs-configuration
 433                            (mount-point (nfs-configuration-pipefs-directory config)))))
 434      (service-extension rpcbind-service-type
 435                         (lambda (config)
 436                           (rpcbind-configuration
 437                            (rpcbind (nfs-configuration-rpcbind config)))))))
 438    (description
 439     "Run all NFS daemons and refresh the list of exported file systems.")))