[jackhill/guix/guix.git] / gnu / services / nfs.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 John Darrington <jmd@gnu.org>
;;; Copyright © 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services nfs)
  #:use-module (gnu)
  #: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)
  #:use-module (ice-9 match)
  #:use-module (gnu build file-systems)
  #:export (rpcbind-service-type
            rpcbind-configuration
            rpcbind-configuration?

            pipefs-service-type
            pipefs-configuration
            pipefs-configuration?

            idmap-service-type
            idmap-configuration
            idmap-configuration?

            gss-service-type
            gss-configuration
            gss-configuration?

            nfs-service-type
            nfs-configuration
            nfs-configuration?))


(define default-pipefs-directory "/var/lib/nfs/rpc_pipefs")

\f

(define-record-type* <rpcbind-configuration>
  rpcbind-configuration make-rpcbind-configuration
  rpcbind-configuration?
  (rpcbind             rpcbind-configuration-rpcbind
                       (default rpcbind))
  (warm-start?         rpcbind-configuration-warm-start?
                       (default #t)))

(define rpcbind-service-type
  (let ((proc
         (lambda (config)
           (define rpcbind
             (rpcbind-configuration-rpcbind config))

           (define rpcbind-command
             #~(list (string-append #$rpcbind "/sbin/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

(define-record-type* <pipefs-configuration>
  pipefs-configuration make-pipefs-configuration
  pipefs-configuration?
  (mount-point           pipefs-configuration-mount-point
                         (default default-pipefs-directory)))

(define pipefs-service-type
  (let ((proc
         (lambda (config)
           (define pipefs-directory (pipefs-configuration-mount-point config))

           (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))))

            (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

(define-record-type* <gss-configuration>
  gss-configuration make-gss-configuration
  gss-configuration?
  (pipefs-directory      gss-configuration-pipefs-directory
                         (default default-pipefs-directory))
  (nfs-utils             gss-configuration-gss
                         (default nfs-utils)))

(define gss-service-type
  (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

(define-record-type* <idmap-configuration>
  idmap-configuration make-idmap-configuration
  idmap-configuration?
  (pipefs-directory      idmap-configuration-pipefs-directory
                         (default default-pipefs-directory))
  (domain                idmap-configuration-domain
                         (default #f))
  (nfs-utils             idmap-configuration-nfs-utils
                         (default nfs-utils))
  (verbosity             idmap-configuration-verbosity
                         (default 0)))

(define idmap-service-type
  (let ((proc
         (lambda (config)

           (define nfs-utils
             (idmap-configuration-nfs-utils config))

           (define pipefs-directory
             (idmap-configuration-pipefs-directory config))

           (define domain (idmap-configuration-domain config))

           (define (idmap-config-file config)
             (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)
                              "")
                          "\n[Mapping]\n"
                          "Nobody-User = nobody\n"
                          "Nobody-Group = nogroup\n")))

           (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)))))

(define-record-type* <nfs-configuration>
  nfs-configuration make-nfs-configuration
  nfs-configuration?
  (nfs-utils           nfs-configuration-nfs-utils
                       (default nfs-utils))
  (nfs-versions        nfs-configuration-nfs-versions
                       (default '("4.2" "4.1" "4.0")))
  (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))
  (nfsd-tcp?           nfs-configuration-nfsd-tcp?
                       (default #t))
  (nfsd-udp?           nfs-configuration-nfsd-udp?
                       (default #f))
  (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-versions exports
               rpcmountd-port rpcstatd-port nfsd-port nfsd-threads
               nfsd-tcp? nfsd-udp?
               pipefs-directory debug)
    (list (shepherd-service
           (documentation "Mount the nfsd pseudo file system.")
           (provision '(/proc/fs/nfsd))
           (start #~(lambda ()
                      (mount "nfsd" "/proc/fs/nfsd" "nfsd")
                      (member "/proc/fs/nfsd" (mount-points))))

           (stop #~(lambda (pid . args)
                     (umount "/proc/fs/nfsd" MNT_DETACH)
                     (not (member "/proc/fs/nfsd" (mount-points))))))
          (shepherd-service
           (documentation "Run the NFS statd daemon.")
           (provision '(rpc.statd))
           (requirement '(/proc/fs/nfsd 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 '(/proc/fs/nfsd rpc.statd))
           (start
            #~(make-forkexec-constructor
               (list #$(file-append nfs-utils "/sbin/rpc.mountd")
                     "--foreground"
                     #$@(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 '(/proc/fs/nfsd rpc.statd networking))
           (start
            #~(lambda _
                (zero? (apply system* #$(file-append nfs-utils "/sbin/rpc.nfsd")
                              (list
                               #$@(if (member 'nfsd debug)
                                      '("--debug")
                                      '())
                               "--port" #$(number->string nfsd-port)
                               #$@(map (lambda (version)
                                         (string-append "--nfs-version=" version))
                                       nfs-versions)
                               #$(number->string nfsd-threads)
                               #$(if nfsd-tcp?
                                     "--tcp"
                                     "--no-tcp")
                               #$(if nfsd-udp?
                                     "--udp"
                                     "--no-udp"))))))
           (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 '(/proc/fs/nfsd 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-activation
  (with-imported-modules '((guix build utils))
    #~(begin
        (use-modules (guix build utils))

        ;; 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)))

(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 %nfs-activation))
     (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.")))
Commit	Line	Data
d6a07ee6 JD	1	;;; GNU Guix --- Functional package management for GNU
d6a07ee6 JD	2	;;; Copyright © 2016 John Darrington <jmd@gnu.org>
981ce389	3	;;; Copyright © 2018, 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
9e2d275b	4	;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
d6a07ee6 JD	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)
eb419bc9	25	#:use-module (gnu packages linux)
907eeac2	26	#:use-module (gnu packages nfs)
d6a07ee6 JD	27	#:use-module (guix)
d6a07ee6 JD	28	#:use-module (guix records)
25c8c8cd	29	#:use-module (srfi srfi-1)
eb419bc9 JD	30	#:use-module (ice-9 match)
eb419bc9 JD	31	#:use-module (gnu build file-systems)
d6a07ee6 JD	32	#:export (rpcbind-service-type
d6a07ee6 JD	33	rpcbind-configuration
eb419bc9 JD	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
907eeac2 RW	46	gss-configuration?
	47
	48	nfs-service-type
	49	nfs-configuration
	50	nfs-configuration?))
eb419bc9 JD	51
	52
	53	(define default-pipefs-directory "/var/lib/nfs/rpc_pipefs")
	54
	55	\f
d6a07ee6 JD	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
ba1808d5 RW	66	(let ((proc
	67	(lambda (config)
	68	(define rpcbind
	69	(rpcbind-configuration-rpcbind config))
d6a07ee6	70
ba1808d5	71	(define rpcbind-command
9e2d275b	72	#~(list (string-append #$rpcbind "/sbin/rpcbind") "-f"
ba1808d5	73	#$@(if (rpcbind-configuration-warm-start? config) '("-w") '())))
d6a07ee6	74
ba1808d5 RW	75	(shepherd-service
	76	(documentation "Start the RPC bind daemon.")
	77	(requirement '(networking))
	78	(provision '(rpcbind-daemon))
d6a07ee6	79
ba1808d5 RW	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)))))
eb419bc9 JD	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
25c8c8cd RW	106	(let ((proc
	107	(lambda (config)
	108	(define pipefs-directory (pipefs-configuration-mount-point config))
eb419bc9	109
25c8c8cd RW	110	(shepherd-service
	111	(documentation "Mount the pipefs pseudo file system.")
	112	(provision '(rpc-pipefs))
eb419bc9	113
25c8c8cd RW	114	(start #~(lambda ()
	115	(mkdir-p #$pipefs-directory)
	116	(mount "rpc_pipefs" #$pipefs-directory "rpc_pipefs")
	117	(member #$pipefs-directory (mount-points))))
eb419bc9	118
25c8c8cd RW	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)))))
eb419bc9 JD	133
	134	\f
	135
	136	(define-record-type* <gss-configuration>
	137	gss-configuration make-gss-configuration
	138	gss-configuration?
5d4ba498	139	(pipefs-directory gss-configuration-pipefs-directory
eb419bc9 JD	140	(default default-pipefs-directory))
	141	(nfs-utils gss-configuration-gss
	142	(default nfs-utils)))
	143
	144	(define gss-service-type
a6bdca6b RW	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)))))
eb419bc9 JD	178
	179	\f
	180
	181	(define-record-type* <idmap-configuration>
	182	idmap-configuration make-idmap-configuration
	183	idmap-configuration?
5d4ba498	184	(pipefs-directory idmap-configuration-pipefs-directory
eb419bc9 JD	185	(default default-pipefs-directory))
eb419bc9 JD	186	(domain idmap-configuration-domain
5d4ba498 RW	187	(default #f))
5d4ba498 RW	188	(nfs-utils idmap-configuration-nfs-utils
2a23942e RW	189	(default nfs-utils))
	190	(verbosity idmap-configuration-verbosity
	191	(default 0)))
eb419bc9 JD	192
eb419bc9 JD	193	(define idmap-service-type
af32ea35 RW	194	(let ((proc
af32ea35 RW	195	(lambda (config)
eb419bc9	196
af32ea35 RW	197	(define nfs-utils
af32ea35 RW	198	(idmap-configuration-nfs-utils config))
eb419bc9	199
af32ea35 RW	200	(define pipefs-directory
af32ea35 RW	201	(idmap-configuration-pipefs-directory config))
eb419bc9	202
af32ea35	203	(define domain (idmap-configuration-domain config))
eb419bc9	204
af32ea35 RW	205	(define (idmap-config-file config)
	206	(plain-file "idmapd.conf"
	207	(string-append
	208	"\n[General]\n"
2a23942e RW	209	"Verbosity = "
	210	(number->string
	211	(idmap-configuration-verbosity config))
	212	"\n"
af32ea35 RW	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")))
eb419bc9	219
af32ea35 RW	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)))
eb419bc9	225
af32ea35 RW	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)))))
907eeac2 RW	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))
bc3fda5d RW	249	(nfs-versions nfs-configuration-nfs-versions
bc3fda5d RW	250	(default '("4.2" "4.1" "4.0")))
907eeac2 RW	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))
c08fac0f MC	265	(nfsd-tcp? nfs-configuration-nfsd-tcp?
	266	(default #t))
	267	(nfsd-udp? nfs-configuration-nfsd-udp?
	268	(default #f))
907eeac2 RW	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>
bc3fda5d	278	(nfs-utils nfs-versions exports
907eeac2	279	rpcmountd-port rpcstatd-port nfsd-port nfsd-threads
c08fac0f	280	nfsd-tcp? nfsd-udp?
907eeac2 RW	281	pipefs-directory debug)
907eeac2 RW	282	(list (shepherd-service
b3c083b9 RW	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
907eeac2 RW	293	(documentation "Run the NFS statd daemon.")
907eeac2 RW	294	(provision '(rpc.statd))
b3c083b9	295	(requirement '(/proc/fs/nfsd rpcbind-daemon))
907eeac2 RW	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))
b3c083b9	314	(requirement '(/proc/fs/nfsd rpc.statd))
907eeac2 RW	315	(start
	316	#~(make-forkexec-constructor
	317	(list #$(file-append nfs-utils "/sbin/rpc.mountd")
5fdc5b2d	318	"--foreground"
907eeac2 RW	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))
b3c083b9	329	(requirement '(/proc/fs/nfsd rpc.statd networking))
907eeac2 RW	330	(start
907eeac2 RW	331	#~(lambda _
bc3fda5d RW	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)
c08fac0f MC	341	#$(number->string nfsd-threads)
	342	#$(if nfsd-tcp?
	343	"--tcp"
	344	"--no-tcp")
	345	#$(if nfsd-udp?
	346	"--udp"
	347	"--no-udp"))))))
907eeac2 RW	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))
b3c083b9	355	(requirement '(/proc/fs/nfsd rpc.nfsd rpc.mountd rpc.statd rpcbind-daemon))
907eeac2 RW	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
e28770df LC	386	(define %nfs-activation
	387	(with-imported-modules '((guix build utils))
	388	#~(begin
	389	(use-modules (guix build utils))
	390
e28770df LC	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
907eeac2 RW	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)
e28770df	410	(service-extension activation-service-type (const %nfs-activation))
907eeac2 RW	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.")))