diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/base.scm | 8 | ||||
| -rw-r--r-- | gnu/services/cuirass.scm | 6 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 1 | ||||
| -rw-r--r-- | gnu/services/mcron.scm | 4 | ||||
| -rw-r--r-- | gnu/services/nfs.scm | 422 | ||||
| -rw-r--r-- | gnu/services/sound.scm | 101 |
6 files changed, 439 insertions, 103 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index b1eff89ecc..0c154d1c4e 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -10,6 +10,7 @@ ;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il> ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr> ;;; Copyright © 2019 John Soo <jsoo1@asu.edu> +;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -705,7 +706,7 @@ to add @var{device} to the kernel's entropy pool. The service will fail if (provision '(host-name)) (start #~(lambda _ (sethostname #$name))) - (respawn? #f))))) + (one-shot? #t))))) (define (host-name-service name) "Return a service that sets the host name to @var{name}." @@ -818,7 +819,10 @@ package or any valid argument to @command{setfont}, as in this example: '((\"tty1\" . \"LatGrkCyr-8x16\") (\"tty2\" . (file-append font-tamzen - \"/share/kbd/consolefonts/TamzenForPowerline10x20.psf\"))) + \"/share/kbd/consolefonts/TamzenForPowerline10x20.psf\")) + (\"tty3\" . (file-append + font-terminus + \"/share/consolefonts/ter-132n\"))) ; for HDPI @end example\n"))) (define* (console-font-service tty #:optional (font "LatGrkCyr-8x16")) diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm index d92421762a..7bfb021161 100644 --- a/gnu/services/cuirass.scm +++ b/gnu/services/cuirass.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org> -;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2018, 2019 Ricardo Wurmus <rekado@elephly.net> @@ -25,8 +25,8 @@ #:use-module (guix gexp) #:use-module (guix records) #:use-module (gnu packages admin) - #:autoload (gnu packages ci) (cuirass) - #:autoload (gnu packages version-control) (git) + #:use-module (gnu packages ci) + #:use-module (gnu packages version-control) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services shepherd) diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index b40622a637..1be05fda4e 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -1183,6 +1183,7 @@ or setting its password with passwd."))) x11-socket-directory-service + (service pulseaudio-service-type) (service alsa-service-type) %base-services)) diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm index 1327516b49..d9627c6bd0 100644 --- a/gnu/services/mcron.scm +++ b/gnu/services/mcron.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,7 +19,7 @@ (define-module (gnu services mcron) #:use-module (gnu services) #:use-module (gnu services shepherd) - #:autoload (gnu packages guile-xyz) (mcron) + #:use-module (gnu packages guile-xyz) #:use-module (guix deprecation) #:use-module (guix records) #:use-module (guix gexp) diff --git a/gnu/services/nfs.scm b/gnu/services/nfs.scm index 6ed4c0eabf..ddc9e2c47e 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. ;;; @@ -21,8 +22,10 @@ #: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 @@ -39,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") @@ -55,23 +62,36 @@ (default #t))) (define rpcbind-service-type - (shepherd-service-type - 'rpcbind - (lambda (config) - (define nfs-utils - (rpcbind-configuration-rpcbind config)) - - (define rpcbind-command - #~(list (string-append #$nfs-utils "/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))))) @@ -82,100 +102,314 @@ (default default-pipefs-directory))) (define pipefs-service-type - (shepherd-service-type - 'pipefs - (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))))))))) + (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))))) (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))) (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))))) (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 nfs-utils))) + (default #f)) + (nfs-utils idmap-configuration-nfs-utils + (default nfs-utils)) + (verbosity idmap-configuration-verbosity + (default 0))) (define idmap-service-type - (shepherd-service-type - 'idmap - (lambda (config) - - (define nfs-utils - (idmap-configuration-idmap 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" - (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 - "-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)))))) - + (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-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/services/sound.scm b/gnu/services/sound.scm index f2dd24402f..a1c928222a 100644 --- a/gnu/services/sound.scm +++ b/gnu/services/sound.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2018, 2020 Oleg Pykhalov <go.wigust@gmail.com> +;;; Copyright © 2020 Leo Prikler <leo.prikler@student.tugraz.at> ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,16 +22,24 @@ #:use-module (gnu services configuration) #:use-module (gnu services shepherd) #:use-module (gnu services) + #:use-module (gnu system pam) #:use-module (gnu system shadow) #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix store) + #:use-module (gnu packages audio) #:use-module (gnu packages linux) #:use-module (gnu packages pulseaudio) #:use-module (ice-9 match) #:export (alsa-configuration - alsa-service-type)) + alsa-service-type + + pulseaudio-configuration + pulseaudio-service-type + + ladspa-configuration + ladspa-service-type)) ;;; Commentary: ;;; @@ -97,4 +106,92 @@ ctl.!default { (default-value (alsa-configuration)) (description "Configure low-level Linux sound support, ALSA."))) + +;;; +;;; PulseAudio +;;; + +(define-record-type* <pulseaudio-configuration> + pulseaudio-configuration make-pulseaudio-configuration + pulseaudio-configuration? + (client-conf pulseaudio-client-conf + (default '())) + (daemon-conf pulseaudio-daemon-conf + ;; Flat volumes may cause unpleasant experiences to users + ;; when applications inadvertently max out the system volume + ;; (see e.g. <https://bugs.gnu.org/38172>). + (default '((flat-volumes . no)))) + (script-file pulseaudio-script-file + (default (file-append pulseaudio "/etc/pulse/default.pa"))) + (system-script-file pulseaudio-system-script-file + (default + (file-append pulseaudio "/etc/pulse/system.pa")))) + +(define (pulseaudio-environment config) + `(;; Define these variables, so that pulseaudio honors /etc. + ("PULSE_CONFIG" . "/etc/pulse/daemon.conf") + ("PULSE_CLIENTCONFIG" . "/etc/pulse/client.conf"))) + +(define (pulseaudio-conf-entry arg) + (match arg + ((key . value) + (format #f "~a = ~s~%" key value)) + ((? string? _) + (string-append arg "\n")))) + +(define pulseaudio-etc + (match-lambda + (($ <pulseaudio-configuration> client-conf daemon-conf + default-script-file system-script-file) + `(("pulse" + ,(file-union + "pulse" + `(("client.conf" + ,(apply mixed-text-file "client.conf" + (map pulseaudio-conf-entry client-conf))) + ("daemon.conf" + ,(apply mixed-text-file "daemon.conf" + "default-script-file = " default-script-file "\n" + (map pulseaudio-conf-entry daemon-conf))) + ("default.pa" ,default-script-file) + ("system.pa" ,system-script-file)))))))) + +(define pulseaudio-service-type + (service-type + (name 'pulseaudio) + (extensions + (list (service-extension session-environment-service-type + pulseaudio-environment) + (service-extension etc-service-type pulseaudio-etc))) + (default-value (pulseaudio-configuration)) + (description "Configure PulseAudio sound support."))) + + +;;; +;;; LADSPA +;;; + +(define-record-type* <ladspa-configuration> + ladspa-configuration make-ladspa-configuration + ladspa-configuration? + (plugins ladspa-plugins (default '()))) + +(define (ladspa-environment config) + ;; Define this variable in the global environment such that + ;; pulseaudio swh-plugins (and similar LADSPA plugins) work. + `(("LADSPA_PATH" . + (string-join + ',(map (lambda (package) (file-append package "/lib/ladspa")) + (ladspa-plugins config)) + ":")))) + +(define ladspa-service-type + (service-type + (name 'ladspa) + (extensions + (list (service-extension session-environment-service-type + ladspa-environment))) + (default-value (ladspa-configuration)) + (description "Configure LADSPA plugins."))) + ;;; sound.scm ends here |