;;; 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")
(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))
(description "Run the RPC Bind service, which provides a facility to map
ONC RPC program numbers into universal addresses. Many NFS related services
use this facility."))))
(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)
(match values
((first . rest) first)
(_ config))))
(default-value (pipefs-configuration))
(description "Mount the pipefs file system, which is used to transfer
NFS-related data between the kernel and user-space programs."))))
(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))
(description "Run the @dfn{global security system} (GSS) daemon, which
provides strong security for protocols based on remote procedure calls (ONC
RPC)."))))
(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))
(description "Run the idmap daemon, which provides a mapping between user
IDs and user names. It is typically required to access file systems mounted
via NFSv4."))))
(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)
| 2022-08-28 | services: Add lightdm-service-type....* gnu/services/lightdm.scm: New service.
* tests/services/lightdm.scm: Test it.
* doc/guix.texi (X Window): Document it.
* gnu/local.mk (GNU_SYSTEM_MODULES): Register it.
Co-authored-by: L p R n d n <guix@lprndn.info>
Co-authored-by: Ricardo Wurmus <rekado@elephly.net>
| Maxim Cournoyer |
| 2022-08-28 | tests: Add test for menu-entry roundtrips as sexps....* tests/boot-parameters.scm (%uuid-menu-entry,
%file-system-label-menu-entry): New variables.
("menu-entry roundtrip, uuid", "menu-entry roundtrip,
file-system-label"): New tests.
Signed-off-by: Marius Bakke <marius@gnu.org>
| Josselin Poiret |
| 2022-08-25 | services: configuration: Change the value of the unset marker....The new value of %unset-value sticks out more when something goes wrong, and
is also more unique; i.e. easier to search for.
Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
| Attila Lendvai |
| 2022-08-25 | services: Use the new maybe/unset API....* gnu/home/services/ssh.scm (serialize-address-family): Use the public API of
the maybe infrastructure.
* gnu/services/file-sharing.scm (serialize-maybe-string): Use maybe-value.
(serialize-maybe-file-object): Use maybe-value-set?.
* gnu/services/getmail.scm (getmail-retriever-configuration): Don't use
internals in unset field declarations.
(getmail-destination-configuration): Ditto.
* gnu/services/messaging.scm (raw-content?): Use maybe-value-set?.
(prosody-configuration): Use %unset-value.
* gnu/services/telephony.scm (jami-shepherd-services): Use maybe-value- |
