From eba81e68acbb989bcd1c1c22d2fe2c808724bb21 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Wed, 25 Jan 2023 16:38:51 +0000 Subject: services: configuration: simplify alist? procedure. * gnu/services/configuration.scm (alist?): simplify procedure. Signed-off-by: Maxim Cournoyer --- gnu/services/configuration.scm | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 02d1aa1796..174c2f20d2 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -440,10 +440,7 @@ the list result in @code{#t} when applying PRED? on them." (list-of string?)) (define alist? - (match-lambda - (() #t) - ((head . tail) (and (pair? head) (alist? tail))) - (_ #f))) + (list-of pair?)) (define serialize-file-like empty-serializer) -- cgit 1.4.1 From 0143e3f291842d2cba138515e616948c7ae8c04e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 20 Mar 2023 14:44:19 +0100 Subject: services: static-networking: 'eval-when' for code used at expansion-time. Reported by bjc on #guix. * gnu/services/base.scm (valid-name, cidr->netmask): Wrap in 'eval-when' since they are used by "compile-time procedures" (macros). --- gnu/services/base.scm | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 190bb8fe24..2c984a0747 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013-2022 Ludovic Courtès +;;; Copyright © 2013-2023 Ludovic Courtès ;;; Copyright © 2015, 2016 Alex Kost ;;; Copyright © 2015, 2016, 2020 Mark H Weaver ;;; Copyright © 2015 Sou Bunnbu @@ -703,9 +703,10 @@ to add @var{device} to the kernel's entropy pool. The service will fail if ;;; /etc/hosts ;;; -(define (valid-name? name) - "Return true if @var{name} is likely to be a valid host name." - (false-if-exception (not (string-any char-set:whitespace name)))) +(eval-when (expand load eval) + (define (valid-name? name) + "Return true if @var{name} is likely to be a valid host name." + (false-if-exception (not (string-any char-set:whitespace name))))) (define-compile-time-procedure (assert-valid-name (name valid-name?)) "Ensure @var{name} is likely to be a valid host name." @@ -2664,16 +2665,17 @@ Write, say, @samp{\"~a/24\"} for a 24-bit network mask.") ipv6-address?)))) (gateway network-route-gateway (default #f))) -(define* (cidr->netmask str #:optional (family AF_INET)) - "Given @var{str}, a string in CIDR notation (e.g., \"1.2.3.4/24\"), return +(eval-when (expand load eval) + (define* (cidr->netmask str #:optional (family AF_INET)) + "Given @var{str}, a string in CIDR notation (e.g., \"1.2.3.4/24\"), return the netmask as a string like \"255.255.255.0\"." - (match (string-split str #\/) - ((ip (= string->number bits)) - (let ((mask (ash (- (expt 2 bits) 1) - (- (if (= family AF_INET6) 128 32) - bits)))) - (inet-ntop family mask))) - (_ #f))) + (match (string-split str #\/) + ((ip (= string->number bits)) + (let ((mask (ash (- (expt 2 bits) 1) + (- (if (= family AF_INET6) 128 32) + bits)))) + (inet-ntop family mask))) + (_ #f)))) (define (cidr->ip str) "Strip the netmask bit of @var{str}, a CIDR-notation IP/netmask address." -- cgit 1.4.1 From 6f4fd8f5b87d9f55013c91ecc3b92fc43269599e Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 13 Mar 2023 19:30:48 +0000 Subject: services: mcron: Restyle mcron-configuration. * doc/guix.texi (Scheduled Job Execution): Sync doc with source. * gnu/services/mcron.scm (mcron-configuration): Restyle. [log-format]: Fix incorrectly formatted text. Signed-off-by: Maxim Cournoyer --- doc/guix.texi | 2 +- gnu/services/mcron.scm | 15 +++++++++++---- 2 files changed, 12 insertions(+), 5 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index fa1f46c2b1..119ff8499b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -19365,7 +19365,7 @@ Log messages to standard output. @item @code{log-format} (default: @code{"~1@@*~a ~a: ~a~%"}) (type: string) @code{(ice-9 format)} format string for log messages. The default value -produces messages like "@samp{@var{pid} @var{name}: @var{message}"} +produces messages like @samp{@var{pid} @var{name}: @var{message}} (@pxref{Invoking mcron, Invoking,, mcron,GNU@tie{}mcron}). Each message is also prefixed by a timestamp by GNU Shepherd. diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm index 52332d6123..6ee333f253 100644 --- a/gnu/services/mcron.scm +++ b/gnu/services/mcron.scm @@ -56,18 +56,25 @@ (list-of gexp?)) (define-configuration/no-serialization mcron-configuration - (mcron (file-like mcron) "The mcron package to use.") + (mcron + (file-like mcron) + "The mcron package to use.") + (jobs (list-of-gexps '()) "This is a list of gexps (@pxref{G-Expressions}), where each gexp corresponds to an mcron job specification (@pxref{Syntax, mcron job specifications,, mcron, GNU@tie{}mcron}).") - (log? (boolean #t) "Log messages to standard output.") + + (log? + (boolean #t) + "Log messages to standard output.") + (log-format (string "~1@*~a ~a: ~a~%") "@code{(ice-9 format)} format string for log messages. The default value -produces messages like \"@samp{@var{pid} @var{name}: -@var{message}\"} (@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}). +produces messages like @samp{@var{pid} @var{name}: @var{message}} +(@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}). Each message is also prefixed by a timestamp by GNU Shepherd.")) (define (job-files mcron jobs) -- cgit 1.4.1 From edb398449f72d95334f78661b74fb9d0c9148eab Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 13 Mar 2023 19:30:49 +0000 Subject: services: mcron: Use match-record. * gnu/services/mcron.scm (mcron-shepherd-services): Use match-record. Signed-off-by: Maxim Cournoyer --- gnu/services/mcron.scm | 68 ++++++++++++++++++++++++-------------------------- 1 file changed, 33 insertions(+), 35 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm index 6ee333f253..9f3afecf62 100644 --- a/gnu/services/mcron.scm +++ b/gnu/services/mcron.scm @@ -143,41 +143,39 @@ files." (display line) (loop))))))))) -(define mcron-shepherd-services - (match-lambda - (($ mcron ()) ;nothing to do! - '()) - (($ mcron jobs log? log-format) - (let ((files (job-files mcron jobs))) - (list (shepherd-service - (provision '(mcron)) - (requirement '(user-processes)) - (modules `((srfi srfi-1) - (srfi srfi-26) - (ice-9 popen) ;for the 'schedule' action - (ice-9 rdelim) - (ice-9 match) - ,@%default-modules)) - (start #~(make-forkexec-constructor - (list (string-append #$mcron "/bin/mcron") - #$@(if log? - #~("--log" "--log-format" #$log-format) - #~()) - #$@files) - - ;; Disable auto-compilation of the job files and set a - ;; sane value for 'PATH'. - #:environment-variables - (cons* "GUILE_AUTO_COMPILE=0" - "PATH=/run/current-system/profile/bin" - (remove (cut string-prefix? "PATH=" <>) - (environ))) - - #:log-file "/var/log/mcron.log")) - (stop #~(make-kill-destructor)) - - (actions - (list (shepherd-schedule-action mcron files))))))))) +(define (mcron-shepherd-services config) + (match-record config (mcron jobs log? log-format) + (if (eq? jobs '()) + '() ; nothing to do + (let ((files (job-files mcron jobs))) + (list (shepherd-service + (provision '(mcron)) + (requirement '(user-processes)) + (modules `((srfi srfi-1) + (srfi srfi-26) + (ice-9 popen) ;for the 'schedule' action + (ice-9 rdelim) + (ice-9 match) + ,@%default-modules)) + (start #~(make-forkexec-constructor + (list (string-append #$mcron "/bin/mcron") + #$@(if log? + #~("--log" "--log-format" #$log-format) + #~()) + #$@files) + + ;; Disable auto-compilation of the job files and + ;; set a sane value for 'PATH'. + #:environment-variables + (cons* "GUILE_AUTO_COMPILE=0" + "PATH=/run/current-system/profile/bin" + (remove (cut string-prefix? "PATH=" <>) + (environ))) + + #:log-file "/var/log/mcron.log")) + (stop #~(make-kill-destructor)) + (actions + (list (shepherd-schedule-action mcron files))))))))) (define mcron-service-type (service-type (name 'mcron) -- cgit 1.4.1 From c88582a6740777b5f15690990b04cdd153905042 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 13 Mar 2023 19:30:50 +0000 Subject: services: mcron: Add log-file and date-format fields. * doc/guix.texi (Scheduled Job Execution): Document it. * gnu/services/mcron.scm (mcron-configuration)[log-file, date-format]: New field. (mcron-shepherd-services): Add log-file and date-format support. Use file-append instead of string-append. Signed-off-by: Maxim Cournoyer --- doc/guix.texi | 6 ++++++ gnu/services/mcron.scm | 34 ++++++++++++++++++++++++++-------- 2 files changed, 32 insertions(+), 8 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 119ff8499b..77ee2c6e30 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -19363,12 +19363,18 @@ specifications,, mcron,GNU@tie{}mcron}). @item @code{log?} (default: @code{#t}) (type: boolean) Log messages to standard output. +@item @code{log-file} (default: @code{"/var/log/mcron.log"}) (type: string) +Log file location. + @item @code{log-format} (default: @code{"~1@@*~a ~a: ~a~%"}) (type: string) @code{(ice-9 format)} format string for log messages. The default value produces messages like @samp{@var{pid} @var{name}: @var{message}} (@pxref{Invoking mcron, Invoking,, mcron,GNU@tie{}mcron}). Each message is also prefixed by a timestamp by GNU Shepherd. +@item @code{date-format} (type: maybe-string) +@code{(srfi srfi-19)} format string for date. + @end table @end deftp @c %end of fragment diff --git a/gnu/services/mcron.scm b/gnu/services/mcron.scm index 9f3afecf62..2ef5980e09 100644 --- a/gnu/services/mcron.scm +++ b/gnu/services/mcron.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2016, 2017, 2018, 2019, 2020 Ludovic Courtès ;;; Copyright © 2022 Maxim Cournoyer +;;; Copyright © 2023 Bruno Victal ;;; ;;; This file is part of GNU Guix. ;;; @@ -33,7 +34,9 @@ mcron-configuration-mcron mcron-configuration-jobs mcron-configuration-log? + mcron-configuration-log-file mcron-configuration-log-format + mcron-configuration-date-format mcron-service-type)) @@ -55,6 +58,8 @@ (define list-of-gexps? (list-of gexp?)) +(define-maybe/no-serialization string) + (define-configuration/no-serialization mcron-configuration (mcron (file-like mcron) @@ -70,12 +75,20 @@ specifications,, mcron, GNU@tie{}mcron}).") (boolean #t) "Log messages to standard output.") + (log-file + (string "/var/log/mcron.log") + "Log file location.") + (log-format (string "~1@*~a ~a: ~a~%") "@code{(ice-9 format)} format string for log messages. The default value produces messages like @samp{@var{pid} @var{name}: @var{message}} (@pxref{Invoking mcron, Invoking,, mcron, GNU@tie{}mcron}). -Each message is also prefixed by a timestamp by GNU Shepherd.")) +Each message is also prefixed by a timestamp by GNU Shepherd.") + + (date-format + maybe-string + "@code{(srfi srfi-19)} format string for date.")) (define (job-files mcron jobs) "Return a list of file-like object for JOBS, a list of gexps." @@ -144,24 +157,29 @@ files." (loop))))))))) (define (mcron-shepherd-services config) - (match-record config (mcron jobs log? log-format) + (match-record config + (mcron jobs log? log-file log-format date-format) (if (eq? jobs '()) - '() ; nothing to do + '() ;nothing to do (let ((files (job-files mcron jobs))) (list (shepherd-service (provision '(mcron)) (requirement '(user-processes)) (modules `((srfi srfi-1) (srfi srfi-26) - (ice-9 popen) ;for the 'schedule' action + (ice-9 popen) ;for the 'schedule' action (ice-9 rdelim) (ice-9 match) ,@%default-modules)) (start #~(make-forkexec-constructor - (list (string-append #$mcron "/bin/mcron") + (list #$(file-append mcron "/bin/mcron") #$@(if log? - #~("--log" "--log-format" #$log-format) - #~()) + `("--log" "--log-format" ,log-format + ,@(if (maybe-value-set? date-format) + (list "--date-format" + date-format) + '())) + '()) #$@files) ;; Disable auto-compilation of the job files and @@ -172,7 +190,7 @@ files." (remove (cut string-prefix? "PATH=" <>) (environ))) - #:log-file "/var/log/mcron.log")) + #:log-file #$log-file)) (stop #~(make-kill-destructor)) (actions (list (shepherd-schedule-action mcron files))))))))) -- cgit 1.4.1 From b7506eb334d1cfceca78682879c69edf525c8ccd Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 6 Mar 2023 12:35:01 +0000 Subject: services: Add x11-socket-directory-service-type. The x11-socket-directory-service misuses activation-service-type to create directories. This kind of usage is incorrect since activation-service-type does not depend on file-systems, hence incompatible with user defined /tmp mount. This commit turns x11-socket-directory-service into a shepherd one-shot service by defining a new x11-socket-directory-service-type. * gnu/services/desktop.scm (x11-socket-directory-service-type): New variable. (x11-socket-directory-service): Deprecate procedure. (desktop-services-for-system): Use new service-type. * gnu/tests/lightdm.scm: Ditto. Reviewed-by: Josselin Poiret Signed-off-by: Maxim Cournoyer --- gnu/services/desktop.scm | 44 +++++++++++++++++++++++++++++++++----------- gnu/tests/lightdm.scm | 2 +- 2 files changed, 34 insertions(+), 12 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index c0178135b0..e37dbf2827 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -14,6 +14,7 @@ ;;; Copyright © 2020 Reza Alizadeh Majd ;;; Copyright © 2021 Brice Waegeneire ;;; Copyright © 2021, 2022 muradm +;;; Copyright © 2023 Bruno Victal ;;; ;;; This file is part of GNU Guix. ;;; @@ -154,7 +155,8 @@ xfce-desktop-service xfce-desktop-service-type - x11-socket-directory-service + x11-socket-directory-service ;deprecated + x11-socket-directory-service-type enlightenment-desktop-configuration enlightenment-desktop-configuration? @@ -1573,18 +1575,38 @@ rules." ;;; X11 socket directory service ;;; -(define x11-socket-directory-service +(define x11-socket-directory-service-type + (let ((x11-socket-directory-shepherd-service + (shepherd-service + (documentation "Create @file{/tmp/.X11-unix} for XWayland.") + (requirement '(file-systems)) + (provision '(x11-socket-directory)) + (one-shot? #t) + (start #~(lambda _ + (let ((directory "/tmp/.X11-unix")) + (mkdir-p directory) + (chmod directory #o1777))))))) + (service-type + (name 'x11-socket-directory-service) + (extensions + (list + (service-extension shepherd-root-service-type + (compose + list + (const x11-socket-directory-shepherd-service))))) + (default-value #f) ; no default value required + (description + "Create @file{/tmp/.X11-unix} for XWayland. When using X11, libxcb +takes care of creating that directory however, when using XWayland, we +need to create it beforehand.")))) + +(define-deprecated x11-socket-directory-service + x11-socket-directory-service-type ;; Return a service that creates /tmp/.X11-unix. When using X11, libxcb ;; takes care of creating that directory. However, when using XWayland, we ;; need to create beforehand. Thus, create it unconditionally here. - (simple-service 'x11-socket-directory - activation-service-type - (with-imported-modules '((guix build utils)) - #~(begin - (use-modules (guix build utils)) - (let ((directory "/tmp/.X11-unix")) - (mkdir-p directory) - (chmod directory #o1777)))))) + (service x11-socket-directory-service-type)) + ;;; ;;; Enlightenment desktop service. @@ -1889,7 +1911,7 @@ applications needing access to be root.") (service ntp-service-type) - x11-socket-directory-service + (service x11-socket-directory-service-type) (service pulseaudio-service-type) (service alsa-service-type) diff --git a/gnu/tests/lightdm.scm b/gnu/tests/lightdm.scm index dda472bd74..6011d2c515 100644 --- a/gnu/tests/lightdm.scm +++ b/gnu/tests/lightdm.scm @@ -50,7 +50,7 @@ (service polkit-service-type) (service elogind-service-type) (service dbus-root-service-type) - x11-socket-directory-service)) + (service x11-socket-directory-service-type))) (define %lightdm-os (operating-system -- cgit 1.4.1 From 72ef1bef07c00cda9b26af70e1fbb3c28b0824ad Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Wed, 22 Mar 2023 11:47:19 +0000 Subject: services: Add fstrim-service-type. * gnu/services/linux.scm (fstrim-service-type): New variable. (fstrim-mcron-job, serialize-fstrim-configuration) (fstrim-serialize-list-of-strings, fstrim-serialize-boolean): New procedure. (mcron-time?): New predicate. (fstrim-configuration): New record. * doc/guix.texi (Linux Services): Document new fstrim-service-type. Signed-off-by: Maxim Cournoyer Modified-by: Maxim Cournoyer --- doc/guix.texi | 62 ++++++++++++++++++++++++++++++ gnu/services/linux.scm | 100 +++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 162 insertions(+) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 5a2dc2a3a3..dfdb26103a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -37485,6 +37485,68 @@ notifications. @end table @end deftp +@subsubheading fstrim Service +@cindex fstrim service +@cindex solid state drives, periodic trim +@cindex solid state drives, trim + +The command @command{fstrim} can be used to discard (or @dfn{trim}) +unused blocks on a mounted file system. + +@c This was copied from the fstrim manpage, with some Texinfo touch-ups. +@quotation Warning +Running @command{fstrim} frequently, or even using +@command{mount -o discard}, might negatively affect the lifetime of +poor-quality SSD devices. For most desktop and server systems a +sufficient trimming frequency is once a week. Note that not all devices +support a queued trim, so each trim command incurs a performance penalty +on whatever else might be trying to use the disk at the time. +@end quotation + +@defvar fstrim-service-type +Type for a service that periodically runs @command{fstrim}, whose value must +be a @code{} object. The service can be instantiated +in its default configuration with: + +@lisp +(service fstrim-service-type) +@end lisp +@end defvar + +@c %start of fragment +@deftp {Data Type} fstrim-configuration +Available @code{fstrim-configuration} fields are: + +@table @asis +@item @code{package} (default: @code{util-linux}) (type: file-like) +The package providing the @command{fstrim} command. + +@item @code{schedule} (default: @code{"0 0 * * 0"}) (type: mcron-time) +Schedule for launching @command{fstrim}. This can be a procedure, a +list or a string. For additional information, see @ref{Guile +Syntax,,Job specification,mcron,the mcron manual}. By default this is +set to run weekly on Sunday at 00:00. + +@item @code{listed-in} (default: @code{("/etc/fstab" "/proc/self/mountinfo")}) (type: maybe-list-of-strings) +List of files in fstab or kernel mountinfo format. All missing or empty +files are silently ignored. The evaluation of the list @emph{stops} +after the first non-empty file. File systems with +@code{X-fstrim.notrim} mount option in fstab are skipped. + +@item @code{verbose?} (default: @code{#t}) (type: boolean) +Verbose execution. + +@item @code{quiet-unsupported?} (default: @code{#t}) (type: boolean) +Suppress error messages if trim operation (ioctl) is unsupported. + +@item @code{extra-arguments} (type: maybe-list-of-strings) +Extra options to append to @command{fstrim} (run @samp{man fstrim} for +more information). + +@end table +@end deftp +@c %end of fragment + @cindex modprobe @cindex kernel module loader @subsubheading Kernel Module Loader Service diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm index 60e2093e1d..d085b375a2 100644 --- a/gnu/services/linux.scm +++ b/gnu/services/linux.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2021 raid5atemyhomework ;;; Copyright © 2021 B. Wilson ;;; Copyright © 2022 Josselin Poiret +;;; Copyright © 2023 Bruno Victal ;;; ;;; This file is part of GNU Guix. ;;; @@ -30,12 +31,15 @@ #:use-module (guix ui) #:use-module (gnu services) #:use-module (gnu services base) + #:use-module (gnu services configuration) + #:use-module (gnu services mcron) #:use-module (gnu services shepherd) #:use-module (gnu packages linux) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (earlyoom-configuration earlyoom-configuration? @@ -50,6 +54,16 @@ earlyoom-configuration-send-notification-command earlyoom-service-type + fstrim-configuration + fstrim-configuration? + fstrim-configuration-package + fstrim-configuration-schedule + fstrim-configuration-listed-in + fstrim-configuration-verbose? + fstrim-configuration-quiet-unsupported? + fstrim-configuration-extra-arguments + fstrim-service-type + kernel-module-loader-service-type rasdaemon-configuration @@ -150,6 +164,92 @@ representation." (compose list earlyoom-shepherd-service)))) (description "Run @command{earlyoom}, the Early OOM daemon."))) + +;;; +;;; fstrim +;;; + +(define (mcron-time? x) + (or (procedure? x) (string? x) (list? x))) + +(define-maybe list-of-strings (prefix fstrim-)) + +(define (fstrim-serialize-boolean field-name value) + (list (format #f "~:[~;--~a~]" value + ;; Drop trailing '?' character. + (string-drop-right (symbol->string field-name) 1)))) + +(define (fstrim-serialize-list-of-strings field-name value) + (list (string-append "--" (symbol->string field-name)) + #~(string-join '#$value ":"))) + +(define-configuration fstrim-configuration + (package + (file-like util-linux) + "The package providing the @command{fstrim} command." + empty-serializer) + (schedule + (mcron-time "0 0 * * 0") + "Schedule for launching @command{fstrim}. This can be a procedure, a list +or a string. For additional information, see @ref{Guile Syntax,, +Job specification, mcron, the mcron manual}. By default this is set to run +weekly on Sunday at 00:00." + empty-serializer) + ;; The following are fstrim-related options. + (listed-in + (maybe-list-of-strings '("/etc/fstab" "/proc/self/mountinfo")) + ;; Note: documentation sourced from the fstrim manpage. + "List of files in fstab or kernel mountinfo format. All missing or +empty files are silently ignored. The evaluation of the list @emph{stops} +after the first non-empty file. File systems with @code{X-fstrim.notrim} mount +option in fstab are skipped.") + (verbose? + (boolean #t) + "Verbose execution.") + (quiet-unsupported? + (boolean #t) + "Suppress error messages if trim operation (ioctl) is unsupported.") + (extra-arguments + maybe-list-of-strings + "Extra options to append to @command{fstrim} (run @samp{man fstrim} for +more information)." + (lambda (_ value) + (if (maybe-value-set? value) + value '()))) + (prefix fstrim-)) + +(define (serialize-fstrim-configuration config) + (concatenate + (filter list? + (map (lambda (field) + ((configuration-field-serializer field) + (configuration-field-name field) + ((configuration-field-getter field) config))) + fstrim-configuration-fields)))) + +(define (fstrim-mcron-job config) + (match-record config (package schedule) + #~(job + ;; Note: The “if” below is to ensure that + ;; lists are ungexp'd correctly since @var{schedule} + ;; can be either a procedure, a string or a list. + #$(if (list? schedule) + `(list ,@schedule) + schedule) + (lambda () + (system* #$(file-append package "/sbin/fstrim") + #$@(serialize-fstrim-configuration config))) + "fstrim"))) + +(define fstrim-service-type + (service-type + (name 'fstrim) + (extensions + (list (service-extension mcron-service-type + (compose list fstrim-mcron-job)))) + (description "Discard unused blocks from file systems.") + (default-value (fstrim-configuration)))) + ;;; ;;; Kernel module loader. -- cgit 1.4.1 From ef71e3290916583973724316e815cee840c1b6d8 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Thu, 23 Mar 2023 16:49:51 -0400 Subject: services: network-manager: Set LINUX_MODULE_DIRECTORY environment variable. Fixes . * gnu/services/networking.scm (network-manager-shepherd-service): Set the LINUX_MODULE_DIRECTORY environment variable. --- gnu/services/networking.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 4632498357..6ab313b97c 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1248,7 +1248,11 @@ project's documentation} for more information." "/lib/NetworkManager/VPN") ;; Override non-existent default users "NM_OPENVPN_USER=" - "NM_OPENVPN_GROUP=")))) + "NM_OPENVPN_GROUP=" + ;; Allow NetworkManager to find the modules. + (string-append + "LINUX_MODULE_DIRECTORY=" + "/run/booted-system/kernel/lib/modules"))))) ;; XXX: Despite the "online" name, this doesn't guarantee ;; WAN connectivity, it merely waits for NetworkManager ;; to finish starting-up. This is required otherwise -- cgit 1.4.1 From 0185b2f9b20565f2c1b9249e6f61d2a8497101cf Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Thu, 23 Mar 2023 15:02:14 +0000 Subject: services: mympd: Require 'syslog service when configured to log to syslog. * gnu/services/audio.scm (mympd-shepherd-service): Depend on 'syslog when configured to log to syslog. Signed-off-by: Maxim Cournoyer Modified-by: Maxim Cournoyer --- gnu/services/audio.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm index d55b804ba9..848da651d7 100644 --- a/gnu/services/audio.scm +++ b/gnu/services/audio.scm @@ -752,7 +752,11 @@ prompting a pin from the user.") (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level))) (shepherd-service (documentation "Run the myMPD daemon.") - (requirement `(loopback user-processes ,@shepherd-requirement)) + (requirement `(loopback user-processes + ,@(if (eq? log-to 'syslog) + '(syslog) + '()) + ,@shepherd-requirement)) (provision '(mympd)) (start #~(begin (let* ((pw (getpwnam #$user)) -- cgit 1.4.1 From 206446b4840279596b3b4522beaee43a3359133d Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Thu, 23 Mar 2023 15:02:13 +0000 Subject: services: audio: Remove redundant list-of-string? predicate. Use list-of-strings? predicate defined in (gnu services configuration). * gnu/services/audio.scm (list-of-string?): Remove predicate. (mpd-serialize-list-of-string): Rename procedure to ... (mpd-serialize-list-of-strings): ... this. (mpd-configuration)[environment-variables]: Switch to list-of-strings. [endpoints]: Switch to maybe-list-of-strings. (mympd-ip-acl)[allow, deny]: Switch to list-of-strings. (mympd-serialize-configuration): Rename serialize-list-of-string to serialize-list-of-strings. * doc/guix.texi (Audio Services): Update it. Signed-off-by: Maxim Cournoyer --- doc/guix.texi | 8 ++++---- gnu/services/audio.scm | 25 +++++++++++-------------- 2 files changed, 15 insertions(+), 18 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index dfdb26103a..7c2feb1dd8 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -33501,7 +33501,7 @@ The group to run mpd as. This is a list of symbols naming Shepherd services that this service will depend on. -@item @code{environment-variables} (default: @code{()}) (type: list-of-string) +@item @code{environment-variables} (default: @code{()}) (type: list-of-strings) A list of strings specifying environment variables. @item @code{log-file} (default: @code{"/var/log/mpd/log"}) (type: maybe-string) @@ -33532,7 +33532,7 @@ The location of the sticker database. @item @code{default-port} (default: @code{6600}) (type: maybe-integer) The default port to run mpd on. -@item @code{endpoints} (type: maybe-list-of-string) +@item @code{endpoints} (type: maybe-list-of-strings) The addresses that mpd will bind to. A port different from @var{default-port} may be specified, e.g. @code{localhost:6602} and IPv6 addresses must be enclosed in square brackets when a different port is used. @@ -33808,10 +33808,10 @@ Whether to preserve caches between service restarts. Available @code{mympd-ip-acl} fields are: @table @asis -@item @code{allow} (default: @code{()}) (type: list-of-string) +@item @code{allow} (default: @code{()}) (type: list-of-strings) Allowed IP addresses. -@item @code{deny} (default: @code{()}) (type: list-of-string) +@item @code{deny} (default: @code{()}) (type: list-of-strings) Disallowed IP addresses. @end table diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm index 848da651d7..73aae9dfcf 100644 --- a/gnu/services/audio.scm +++ b/gnu/services/audio.scm @@ -2,7 +2,7 @@ ;;; Copyright © 2017 Peter Mikkelsen ;;; Copyright © 2019 Ricardo Wurmus ;;; Copyright © 2020 Ludovic Courtès -;;; Copyright © 2022 Bruno Victal +;;; Copyright © 2022⁠–⁠2023 Bruno Victal ;;; ;;; This file is part of GNU Guix. ;;; @@ -137,9 +137,6 @@ str) #\-) "_"))) -(define list-of-string? - (list-of string?)) - (define list-of-symbol? (list-of symbol?)) @@ -159,11 +156,11 @@ (define mpd-serialize-string mpd-serialize-field) (define mpd-serialize-boolean mpd-serialize-field) -(define (mpd-serialize-list-of-string field-name value) +(define (mpd-serialize-list-of-strings field-name value) #~(string-append #$@(map (cut mpd-serialize-string field-name <>) value))) (define-maybe string (prefix mpd-)) -(define-maybe list-of-string (prefix mpd-)) +(define-maybe list-of-strings (prefix mpd-)) (define-maybe boolean (prefix mpd-)) ;;; TODO: Procedures for deprecated fields, to be removed. @@ -349,7 +346,7 @@ will depend on." empty-serializer) (environment-variables - (list-of-string '()) + (list-of-strings '()) "A list of strings specifying environment variables." empty-serializer) @@ -400,7 +397,7 @@ Available values: @code{notice}, @code{info}, @code{verbose}, "The default port to run mpd on.") (endpoints - maybe-list-of-string + maybe-list-of-strings "The addresses that mpd will bind to. A port different from @var{default-port} may be specified, e.g. @code{localhost:6602} and IPv6 addresses must be enclosed in square brackets when a different @@ -409,7 +406,7 @@ To use a Unix domain socket, an absolute path or a path starting with @code{~} can be specified here." (lambda (_ endpoints) (if (maybe-value-set? endpoints) - (mpd-serialize-list-of-string "bind_to_address" endpoints) + (mpd-serialize-list-of-strings "bind_to_address" endpoints) ""))) (address ; TODO: deprecated, remove later @@ -581,11 +578,11 @@ appended to the configuration.") (define-configuration/no-serialization mympd-ip-acl (allow - (list-of-string '()) + (list-of-strings '()) "Allowed IP addresses.") (deny - (list-of-string '()) + (list-of-strings '()) "Disallowed IP addresses.")) (define-maybe/no-serialization integer) @@ -707,12 +704,12 @@ prompting a pin from the user.") ((? string? val) val))) (define (ip-acl-serialize-configuration config) - (define (serialize-list-of-string prefix lst) + (define (serialize-list-of-strings prefix lst) (map (cut format #f "~a~a" prefix <>) lst)) (string-join (append - (serialize-list-of-string "+" (mympd-ip-acl-allow config)) - (serialize-list-of-string "-" (mympd-ip-acl-deny config))) ",")) + (serialize-list-of-strings "+" (mympd-ip-acl-allow config)) + (serialize-list-of-strings "-" (mympd-ip-acl-deny config))) ",")) ;; myMPD configuration fields are serialized as individual files under ;; /config/. -- cgit 1.4.1 From bc30a9ee889fb1b81c43a7f94ea4c2b95a15db75 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Thu, 23 Mar 2023 15:02:16 +0000 Subject: services: mpd: Set PulseAudio-related variables. These variables are necessary for PulseAudio to work properly out-of-the-box for 'non-interactive' users. * doc/guix.texi (Audio Services): Update environment-variables field description for mpd-configuration data type. * gnu/services/audio.scm (mpd-configuration)[environment-variables]: Set PULSE_CLIENTCONFIG and PULSE_CONFIG environment variables to the system-wide PulseAudio configuration. Signed-off-by: Maxim Cournoyer --- doc/guix.texi | 2 +- gnu/services/audio.scm | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 7c2feb1dd8..3e335306f1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -33501,7 +33501,7 @@ The group to run mpd as. This is a list of symbols naming Shepherd services that this service will depend on. -@item @code{environment-variables} (default: @code{()}) (type: list-of-strings) +@item @code{environment-variables} (default: @code{("PULSE_CLIENTCONFIG=/etc/pulse/client.conf" "PULSE_CONFIG=/etc/pulse/daemon.conf")}) (type: list-of-strings) A list of strings specifying environment variables. @item @code{log-file} (default: @code{"/var/log/mpd/log"}) (type: maybe-string) diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm index 73aae9dfcf..4885fb8424 100644 --- a/gnu/services/audio.scm +++ b/gnu/services/audio.scm @@ -346,7 +346,8 @@ will depend on." empty-serializer) (environment-variables - (list-of-strings '()) + (list-of-strings '("PULSE_CLIENTCONFIG=/etc/pulse/client.conf" + "PULSE_CONFIG=/etc/pulse/daemon.conf")) "A list of strings specifying environment variables." empty-serializer) -- cgit 1.4.1 From a7f118d062db4408b23505750c44a1f996496c43 Mon Sep 17 00:00:00 2001 From: r0man Date: Tue, 21 Mar 2023 20:11:41 +0100 Subject: services: xorg-wrapper: Support xorg server input rewriting. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This patch adds support for proper xorg server input rewriting. It uses the lookup-package-direct-input procedure to configure the X server paths dynamically, instead of always using the hard coded package. Something like this is now possible: (define other-mesa (package-input-rewriting/spec `(("mesa" . ,(const other-mesa))))) (xorg-configuration (xorg-configuration (server (other-mesa xorg-server)))) Without this patch the X server would still be configured with mesa (causing version issues), and not with other-mesa (as per the input rewrite). * gnu/services/xorg.scm (xorg-configuration-server-package-path) (xorg-configuration-dri-driver-path, xorg-configuration-xkb-bin-dir) (xorg-configuration-xkb-dir): New procedures. (xorg-wrapper): Use them for dri and xkb paths. Signed-off-by: 宋文武 --- gnu/services/xorg.scm | 23 ++++++++++++++++++++--- 1 file changed, 20 insertions(+), 3 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index c4745cecf5..7295a45b59 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -358,6 +358,22 @@ in @var{modules}." files) #t)))) +(define (xorg-configuration-server-package-path config input path) + "Lookup the direct @var{input} in the xorg server package of @var{config} +and append @var{path} to it." + (let* ((server (xorg-configuration-server config)) + (package (lookup-package-direct-input server input))) + (when package (file-append package path)))) + +(define (xorg-configuration-dri-driver-path config) + (xorg-configuration-server-package-path config "mesa" "/lib/dri")) + +(define (xorg-configuration-xkb-bin-dir config) + (xorg-configuration-server-package-path config "xkbcomp" "/bin")) + +(define (xorg-configuration-xkb-dir config) + (xorg-configuration-server-package-path config "xkeyboard-config" "/share/X11/xkb")) + (define* (xorg-wrapper #:optional (config (xorg-configuration))) "Return a derivation that builds a script to start the X server with the given @var{config}. The resulting script should be used in place of @@ -365,12 +381,13 @@ given @var{config}. The resulting script should be used in place of (define exp ;; Write a small wrapper around the X server. #~(begin - (setenv "XORG_DRI_DRIVER_PATH" (string-append #$mesa "/lib/dri")) - (setenv "XKB_BINDIR" (string-append #$xkbcomp "/bin")) + (setenv "XORG_DRI_DRIVER_PATH" + #$(xorg-configuration-dri-driver-path config)) + (setenv "XKB_BINDIR" #$(xorg-configuration-xkb-bin-dir config)) (let ((X (string-append #$(xorg-configuration-server config) "/bin/X"))) (apply execl X X - "-xkbdir" (string-append #$xkeyboard-config "/share/X11/xkb") + "-xkbdir" #$(xorg-configuration-xkb-dir config) "-config" #$(xorg-configuration->file config) "-configdir" #$(xorg-configuration-directory (xorg-configuration-modules config)) -- cgit 1.4.1 From 547965aa27b6a09cadf42130b7ec7db3f1aee61f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 24 Mar 2023 19:22:39 +0100 Subject: services: herd: Remove workaround for Shepherd < 0.5.0. * gnu/services/herd.scm (load-services/safe): Remove workaround for Shepherd < 0.5.0, released in 2018. --- gnu/services/herd.scm | 24 +++++++----------------- 1 file changed, 7 insertions(+), 17 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index a7c845b4b0..e489ce2b9a 100644 --- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016-2019, 2022 Ludovic Courtès +;;; Copyright © 2016-2019, 2022-2023 Ludovic Courtès ;;; Copyright © 2017, 2020 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. @@ -284,22 +284,12 @@ returns a shepherd object." (define (load-services/safe files) "This is like 'load-services', but make sure only the subset of FILES that -can be safely reloaded is actually reloaded. - -This is done to accommodate the Shepherd < 0.15.0 where services lacked the -'replacement' slot, and where 'register-services' would throw an exception -when passed a service with an already-registered name." - (eval-there `(let* ((services (map primitive-load ',files)) - (slots (map slot-definition-name - (class-slots ))) - (can-replace? (memq 'replacement slots))) - (define (registered? service) - (not (null? (lookup-services (canonical-name service))))) - - (apply register-services - (if can-replace? - services - (remove registered? services)))))) +can be safely reloaded is actually reloaded." + (eval-there `(let ((services (map primitive-load ',files))) + ;; Since version 0.5.0 of the Shepherd, registering a service + ;; that has the same name as an already-registered service + ;; makes it a "replacement" of that previous service. + (apply register-services services)))) (define* (start-service name #:optional (arguments '())) (invoke-action name 'start arguments -- cgit 1.4.1 From 384856c9fbe76d107107f49a575fc5c26e4e332e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 27 Mar 2023 09:42:20 +0200 Subject: services: syslog: Add 'configuration' action. * gnu/services/base.scm (syslog-service-type): Add 'actions' field. --- gnu/services/base.scm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 2c984a0747..5b0b3bb0ab 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -1554,14 +1554,17 @@ Service Switch}, for an example." (shepherd-service-type 'syslog (lambda (config) + (define config-file + (syslog-configuration-config-file config)) + (shepherd-service (documentation "Run the syslog daemon (syslogd).") (provision '(syslogd)) (requirement '(user-processes)) + (actions (list (shepherd-configuration-action config-file))) (start #~(let ((spawn (make-forkexec-constructor (list #$(syslog-configuration-syslogd config) - "--rcfile" - #$(syslog-configuration-config-file config)) + "--rcfile" #$config-file) #:pid-file "/var/run/syslog.pid"))) (lambda () ;; Set the umask such that file permissions are #o640. -- cgit 1.4.1 From 82607c442bb1e88c70f899af07f1bb66b86e83c8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 27 Mar 2023 09:43:01 +0200 Subject: services: network-manager: Add 'configuration' action. * gnu/services/networking.scm (network-manager-shepherd-service): Add 'actions' field. --- gnu/services/networking.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 6ab313b97c..4d1d84788b 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013-2022 Ludovic Courtès +;;; Copyright © 2013-2023 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2016, 2018, 2020 Efraim Flashner ;;; Copyright © 2016 John Darrington @@ -1235,6 +1235,7 @@ project's documentation} for more information." ;; TODO: iwd? is deprecated and should be passed ;; with shepherd-requirement, remove later. ,@(if iwd? '(iwd) '()))) + (actions (list (shepherd-configuration-action conf))) (start #~(lambda _ (let ((pid -- cgit 1.4.1 From 3b9738aeac3dc0d1d2d119abd6370f569da5a1a6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 27 Mar 2023 09:43:43 +0200 Subject: services: ntpd: Add 'configuration' action. * gnu/services/networking.scm (ntp-shepherd-service): Add 'actions' field. --- gnu/services/networking.scm | 1 + 1 file changed, 1 insertion(+) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 4d1d84788b..49f897d8cf 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -536,6 +536,7 @@ restrict source notrap nomodify noquery\n")) (provision '(ntpd)) (documentation "Run the Network Time Protocol (NTP) daemon.") (requirement '(user-processes networking)) + (actions (list (shepherd-configuration-action ntpd.conf))) (start #~(make-forkexec-constructor (list (string-append #$ntp "/bin/ntpd") "-n" "-c" #$ntpd.conf "-u" "ntpd" -- cgit 1.4.1 From f215d801277a60cc1d862ed59c179cb8a482ced5 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Sun, 26 Mar 2023 16:17:22 +0100 Subject: services: fstrim: Fix schedule ungexp. Previously, only the first level of the list would be quoted, resulting in a schedule of the sort: '(next-second (range 0 60 30)) being incorrectly ungexp'd into: (list next-second (0 30)) * gnu/services/linux.scm (fstrim-mcron-job): Fix schedule ungexp. Signed-off-by: Maxim Cournoyer --- gnu/services/linux.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm index d085b375a2..439848919d 100644 --- a/gnu/services/linux.scm +++ b/gnu/services/linux.scm @@ -234,7 +234,7 @@ more information)." ;; lists are ungexp'd correctly since @var{schedule} ;; can be either a procedure, a string or a list. #$(if (list? schedule) - `(list ,@schedule) + #~'(#$@schedule) schedule) (lambda () (system* #$(file-append package "/sbin/fstrim") -- cgit 1.4.1 From bd932c18559880ad70c266fe0ed77bf77d2e837e Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Wed, 29 Mar 2023 17:06:10 +0100 Subject: services: configuration: Fix garbage output in configuration->documentation. Fixes . * gnu/services/configuration.scm (define-configuration-helper): Remove call to display within default-value-thunk. Signed-off-by: Maxim Cournoyer --- gnu/services/configuration.scm | 1 - 1 file changed, 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 174c2f20d2..ed9d95f906 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -264,7 +264,6 @@ does not have a default value" field kind))) (serializer field-serializer) (default-value-thunk (lambda () - (display '#,(id #'stem #'% #'stem)) (if (maybe-value-set? (syntax->datum field-default)) field-default (configuration-missing-default-value -- cgit 1.4.1 From ed5053188565063b353711772fc2dc3ca50e8568 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Sat, 4 Mar 2023 21:17:38 +0000 Subject: services: base: Deprecate 'pam-limits-service' procedure. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Base Services): Replace pam-limits-service with pam-limits-service-type. * gnu/packages/benchmark.scm (python-locust)[description]: Update index anchor to manual. * gnu/services/base.scm (pam-limits-service-type): Set default value. (pam-limits-service): Deprecate procedure. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 37 ++++++++++++++++++++++--------------- gnu/packages/benchmark.scm | 2 +- gnu/services/base.scm | 8 +++++--- 3 files changed, 28 insertions(+), 19 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index c49e51b72e..c5f5558e2c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18959,7 +18959,6 @@ will fail if @var{device} does not exist. @end table @end deftp -@anchor{pam-limits-service} @cindex session limits @cindex ulimit @cindex priority @@ -18967,22 +18966,28 @@ will fail if @var{device} does not exist. @cindex jackd @cindex nofile @cindex open file descriptors -@deffn {Scheme Procedure} pam-limits-service [#:limits @code{'()}] - -Return a service that installs a configuration file for the +@anchor{pam-limits-service-type} +@defvar pam-limits-service-type +Type of the service that installs a configuration file for the @uref{http://linux-pam.org/Linux-PAM-html/sag-pam_limits.html, -@code{pam_limits} module}. The procedure optionally takes a list of -@code{pam-limits-entry} values, which can be used to specify -@code{ulimit} limits and @code{nice} priority limits to user sessions. +@code{pam_limits} module}. The value for this service type is +a file-like object containing a list of @code{pam-limits-entry} values +which can be used to specify @code{ulimit} limits and @code{nice} +priority limits to user sessions. The following limits definition sets two hard and soft limits for all login sessions of users in the @code{realtime} group: @lisp -(pam-limits-service - (list - (pam-limits-entry "@@realtime" 'both 'rtprio 99) - (pam-limits-entry "@@realtime" 'both 'memlock 'unlimited))) +(service + pam-limits-service-type + (plain-file + "limits.conf" + (string-join + (map pam-limits-entry->string + (list (pam-limits-entry "@@realtime" 'both 'rtprio 99) + (pam-limits-entry "@@realtime" 'both 'memlock 'unlimited))) + "\n"))) @end lisp The first entry increases the maximum realtime priority for @@ -18994,9 +18999,11 @@ Another useful example is raising the maximum number of open file descriptors that can be used: @lisp -(pam-limits-service - (list - (pam-limits-entry "*" 'both 'nofile 100000))) +(service + pam-limits-service-type + (plain-file + "limits.conf" + (pam-limits-entry->string (pam-limits-entry "*" 'both 'nofile 100000)))) @end lisp In the above example, the asterisk means the limit should apply to any @@ -19005,7 +19012,7 @@ maximum system value visible in the @file{/proc/sys/fs/file-max} file, else the users would be prevented from login in. For more information about the Pluggable Authentication Module (PAM) limits, refer to the @samp{pam_limits} man page from the @code{linux-pam} package. -@end deffn +@end defvar @defvar greetd-service-type @uref{https://git.sr.ht/~kennylevinsen/greetd, @code{greetd}} is a minimal and diff --git a/gnu/packages/benchmark.scm b/gnu/packages/benchmark.scm index 33e2466da9..fd8513f41d 100644 --- a/gnu/packages/benchmark.scm +++ b/gnu/packages/benchmark.scm @@ -458,7 +458,7 @@ test any system or protocol. Note: Locust will complain if the available open file descriptors limit for the user is too low. To raise such limit on a Guix System, refer to -@samp{info guix --index-search=pam-limits-service}.") +@samp{info guix --index-search=pam-limits-service-type}.") (license license:expat))) (define-public interbench diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 5b0b3bb0ab..acbfb879fc 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -246,7 +246,7 @@ kmscon-service-type pam-limits-service-type - pam-limits-service + pam-limits-service ; deprecated greetd-service-type greetd-configuration @@ -1616,9 +1616,11 @@ information on the configuration file syntax." (description "Install the specified resource usage limits by populating @file{/etc/security/limits.conf} and using the @code{pam_limits} -authentication module.")))) +authentication module.") + (default-value (plain-file "limits.conf" ""))))) -(define* (pam-limits-service #:optional (limits '())) +(define-deprecated (pam-limits-service #:optional (limits '())) + pam-limits-service-type "Return a service that makes selected programs respect the list of pam-limits-entry specified in LIMITS via pam_limits.so." (service pam-limits-service-type -- cgit 1.4.1 From 6d0ad930206dccf382ec65c6504df51b5c798a34 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Sat, 4 Mar 2023 21:17:39 +0000 Subject: services: pam-limits-service-type: Deprecate file-like object support in favour for lists as service value. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * doc/guix.texi (Base Services): Document it. * gnu/local.mk: Register test. * gnu/services/base.scm (pam-limits-service-type): Accept both lists and file-like objects. Deprecate file-like object support. * gnu/tests/pam.scm: New file. Signed-off-by: Ludovic Courtès --- doc/guix.texi | 27 ++++++-------- gnu/local.mk | 1 + gnu/services/base.scm | 36 +++++++++++++------ gnu/tests/pam.scm | 97 +++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 134 insertions(+), 27 deletions(-) create mode 100644 gnu/tests/pam.scm (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index c5f5558e2c..a58ea8f9ec 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -18971,23 +18971,18 @@ will fail if @var{device} does not exist. Type of the service that installs a configuration file for the @uref{http://linux-pam.org/Linux-PAM-html/sag-pam_limits.html, @code{pam_limits} module}. The value for this service type is -a file-like object containing a list of @code{pam-limits-entry} values -which can be used to specify @code{ulimit} limits and @code{nice} -priority limits to user sessions. +a list of @code{pam-limits-entry} values, which can be used to specify +@code{ulimit} limits and @code{nice} priority limits to user sessions. +By default, the value is the empty list. The following limits definition sets two hard and soft limits for all login sessions of users in the @code{realtime} group: @lisp -(service - pam-limits-service-type - (plain-file - "limits.conf" - (string-join - (map pam-limits-entry->string - (list (pam-limits-entry "@@realtime" 'both 'rtprio 99) - (pam-limits-entry "@@realtime" 'both 'memlock 'unlimited))) - "\n"))) +(service pam-limits-service-type + (list + (pam-limits-entry "@@realtime" 'both 'rtprio 99) + (pam-limits-entry "@@realtime" 'both 'memlock 'unlimited))) @end lisp The first entry increases the maximum realtime priority for @@ -18999,11 +18994,9 @@ Another useful example is raising the maximum number of open file descriptors that can be used: @lisp -(service - pam-limits-service-type - (plain-file - "limits.conf" - (pam-limits-entry->string (pam-limits-entry "*" 'both 'nofile 100000)))) +(service pam-limits-service-type + (list + (pam-limits-entry "*" 'both 'nofile 100000))) @end lisp In the above example, the asterisk means the limit should apply to any diff --git a/gnu/local.mk b/gnu/local.mk index aee0b8a645..3a93ab50dd 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -782,6 +782,7 @@ GNU_SYSTEM_MODULES = \ %D%/tests/messaging.scm \ %D%/tests/networking.scm \ %D%/tests/package-management.scm \ + %D%/tests/pam.scm \ %D%/tests/reconfigure.scm \ %D%/tests/rsync.scm \ %D%/tests/samba.scm \ diff --git a/gnu/services/base.scm b/gnu/services/base.scm index acbfb879fc..e063828d3b 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -40,7 +40,7 @@ (define-module (gnu services base) #:use-module (guix store) #:use-module (guix deprecation) - #:autoload (guix diagnostics) (warning &fix-hint) + #:autoload (guix diagnostics) (warning formatted-message &fix-hint) #:autoload (guix i18n) (G_) #:use-module (guix combinators) #:use-module (gnu services) @@ -1588,17 +1588,13 @@ information on the configuration file syntax." (define pam-limits-service-type - (let ((security-limits - ;; Create /etc/security containing the provided "limits.conf" file. - (lambda (limits-file) - `(("security/limits.conf" - ,limits-file)))) - (pam-extension + (let ((pam-extension (lambda (pam) (let ((pam-limits (pam-entry (control "required") (module "pam_limits.so") - (arguments '("conf=/etc/security/limits.conf"))))) + (arguments + '("conf=/etc/security/limits.conf"))))) (if (member (pam-service-name pam) '("login" "greetd" "su" "slim" "gdm-password" "sddm" "sudo" "sshd")) @@ -1606,7 +1602,27 @@ information on the configuration file syntax." (inherit pam) (session (cons pam-limits (pam-service-session pam)))) - pam))))) + pam)))) + + ;; XXX: Using file-like objects is deprecated, use lists instead. + ;; This is to be reduced into the list? case when the deprecated + ;; code gets removed. + ;; Create /etc/security containing the provided "limits.conf" file. + (security-limits + (match-lambda + ((? file-like? obj) + (warning (G_ "Using file-like value for \ +'pam-limits-service-type' is deprecated~%")) + `(("security/limits.conf" ,obj))) + ((? list? lst) + `(("security/limits.conf" + ,(plain-file "limits.conf" + (string-join (map pam-limits-entry->string lst) + "\n" 'suffix))))) + (_ (raise + (formatted-message + (G_ "invalid input for 'pam-limits-service-type'~%"))))))) + (service-type (name 'limits) (extensions @@ -1617,7 +1633,7 @@ information on the configuration file syntax." "Install the specified resource usage limits by populating @file{/etc/security/limits.conf} and using the @code{pam_limits} authentication module.") - (default-value (plain-file "limits.conf" ""))))) + (default-value '())))) (define-deprecated (pam-limits-service #:optional (limits '())) pam-limits-service-type diff --git a/gnu/tests/pam.scm b/gnu/tests/pam.scm new file mode 100644 index 0000000000..5cf13d97d7 --- /dev/null +++ b/gnu/tests/pam.scm @@ -0,0 +1,97 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2023 Bruno Victal +;;; +;;; 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 . + +(define-module (gnu tests pam) + #:use-module (gnu tests) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu system) + #:use-module (gnu system pam) + #:use-module (gnu system vm) + #:use-module (guix gexp) + #:use-module (ice-9 format) + #:export (%test-pam-limits + %test-pam-limits-deprecated)) + + +;;; +;;; pam-limits-service-type +;;; + +(define pam-limit-entries + (list + (pam-limits-entry "@realtime" 'both 'rtprio 99) + (pam-limits-entry "@realtime" 'both 'memlock 'unlimited))) + +(define (run-test-pam-limits config) + "Run tests in a os with pam-limits-service-type configured." + (define os + (marionette-operating-system + (simple-operating-system + (service pam-limits-service-type config)))) + + (define vm + (virtual-machine os)) + + (define name (format #f "pam-limit-service~:[~;-deprecated~]" + (file-like? config))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (gnu build marionette) + (srfi srfi-64)) + + (let ((marionette (make-marionette (list #$vm)))) + + (test-runner-current (system-test-runner #$output)) + + (test-begin #$name) + + (test-assert "/etc/security/limits.conf ready" + (wait-for-file "/etc/security/limits.conf" marionette)) + + (test-equal "/etc/security/limits.conf content matches" + #$(string-join (map pam-limits-entry->string pam-limit-entries) + "\n" 'suffix) + (marionette-eval + '(call-with-input-file "/etc/security/limits.conf" + get-string-all) + marionette)) + + (test-end))))) + + (gexp->derivation (string-append name "-test") test)) + +(define %test-pam-limits + (system-test + (name "pam-limits-service") + (description "Test that pam-limits-service can serialize its config +(as a list) to @file{limits.conf}.") + (value (run-test-pam-limits pam-limit-entries)))) + +(define %test-pam-limits-deprecated + (system-test + (name "pam-limits-service-deprecated") + (description "Test that pam-limits-service can serialize its config +(as a file-like object) to @file{limits.conf}.") + (value (run-test-pam-limits + (plain-file "limits.conf" + (string-join (map pam-limits-entry->string + pam-limit-entries) + "\n" 'suffix)))))) -- cgit 1.4.1 From 6f48efa9b89f3c33f7b2827cae88e87ec64faa09 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Sun, 26 Mar 2023 19:41:29 +0100 Subject: services: configuration: Add user-defined sanitizer support. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This changes the 'custom-serializer' field into a generic 'extra-args' field that can be extended to support new literals. Within extra-args, the literals 'sanitizer' and 'serializer' allow for user-defined sanitization and serialization procedures respectively. The 'empty-serializer' was also added as a literal to be used as before. To prevent confusion between the new “explicit” style of specifying a sanitizer, and the old “implicit” style, the latter has been deprecated, and a warning is issued if it is encountered. * gnu/services/configuration.scm (define-configuration-helper): Rename 'custom-serializer' to 'extra-args'. Add support for literals 'sanitizer', 'serializer' and 'empty-serializer'. Rename procedure 'field-sanitizer' to 'default-field-sanitizer' to avoid syntax clash. Only define default field sanitizers if user-defined ones are absent. (normalize-extra-args): New variable. ()[sanitizer]: New field. * doc/guix.texi (Complex Configurations): Document the newly added literals. * tests/services/configuration.scm: Add tests for the new literals. Signed-off-by: Liliana Marie Prikler --- doc/guix.texi | 29 ++++++- gnu/services/configuration.scm | 90 ++++++++++++++----- tests/services/configuration.scm | 183 ++++++++++++++++++++++++++++++++++++++- 3 files changed, 276 insertions(+), 26 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index a58ea8f9ec..495a930d0d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -41219,7 +41219,7 @@ A clause can have one of the following forms: (@var{field-name} (@var{type} @var{default-value}) @var{documentation} - @var{serializer}) + (serializer @var{serializer})) (@var{field-name} (@var{type}) @@ -41228,7 +41228,18 @@ A clause can have one of the following forms: (@var{field-name} (@var{type}) @var{documentation} - @var{serializer}) + (serializer @var{serializer})) + +(@var{field-name} + (@var{type}) + @var{documentation} + (sanitizer @var{sanitizer}) + +(@var{field-name} + (@var{type}) + @var{documentation} + (sanitizer @var{sanitizer}) + (serializer @var{serializer})) @end example @var{field-name} is an identifier that denotes the name of the field in @@ -41251,6 +41262,20 @@ an object of the record type. @var{documentation} is a string formatted with Texinfo syntax which should provide a description of what setting this field does. +@var{sanitizer} is a procedure which takes one argument, +a user-supplied value, and returns a ``sanitized'' value for the field. +If no sanitizer is specified, a default sanitizer is used, which raises +an error if the value is not of type @var{type}. + +An example of a sanitizer for a field that accepts both strings and +symbols looks like this: +@lisp +(define (sanitize-foo value) + (cond ((string? value) value) + ((symbol? value) (symbol->string value)) + (else (error "bad value")))) +@end lisp + @var{serializer} is the name of a procedure which takes two arguments, the first is the name of the field, and the second is the value corresponding to the field. The procedure should return a string or diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index ed9d95f906..367b85c1be 100644 --- a/gnu/services/configuration.scm +++ b/gnu/services/configuration.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2021, 2022 Maxim Cournoyer ;;; Copyright © 2021 Andrew Tropin ;;; Copyright © 2022 Maxime Devos +;;; Copyright © 2023 Bruno Victal ;;; ;;; This file is part of GNU Guix. ;;; @@ -28,7 +29,8 @@ #:use-module (guix gexp) #:use-module ((guix utils) #:select (source-properties->location)) #:use-module ((guix diagnostics) - #:select (formatted-message location-file &error-location)) + #:select (formatted-message location-file &error-location + warning)) #:use-module ((guix modules) #:select (file-name->module-name)) #:use-module (guix i18n) #:autoload (texinfo) (texi-fragment->stexi) @@ -37,6 +39,7 @@ #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:export (configuration-field @@ -44,6 +47,7 @@ configuration-field-type configuration-missing-field configuration-field-error + configuration-field-sanitizer configuration-field-serializer configuration-field-getter configuration-field-default-value-thunk @@ -116,6 +120,7 @@ does not have a default value" field kind))) (type configuration-field-type) (getter configuration-field-getter) (predicate configuration-field-predicate) + (sanitizer configuration-field-sanitizer) (serializer configuration-field-serializer) (default-value-thunk configuration-field-default-value-thunk) (documentation configuration-field-documentation)) @@ -181,11 +186,44 @@ does not have a default value" field kind))) (values #'(field-type %unset-value))))) (define (define-configuration-helper serialize? serializer-prefix syn) + + (define (normalize-extra-args s) + "Extract and normalize arguments following @var{doc}." + (let loop ((s s) + (sanitizer* %unset-value) + (serializer* %unset-value)) + (syntax-case s (sanitizer serializer empty-serializer) + (((sanitizer proc) tail ...) + (if (maybe-value-set? sanitizer*) + (syntax-violation 'sanitizer "duplicate entry" + #'proc) + (loop #'(tail ...) #'proc serializer*))) + (((serializer proc) tail ...) + (if (maybe-value-set? serializer*) + (syntax-violation 'serializer "duplicate or conflicting entry" + #'proc) + (loop #'(tail ...) sanitizer* #'proc))) + ((empty-serializer tail ...) + (if (maybe-value-set? serializer*) + (syntax-violation 'empty-serializer + "duplicate or conflicting entry" #f) + (loop #'(tail ...) sanitizer* #'empty-serializer))) + (() ; stop condition + (values (list sanitizer* serializer*))) + ((proc) ; TODO: deprecated, to be removed. + (null? (filter-map maybe-value-set? (list sanitizer* serializer*))) + (begin + (warning #f (G_ "specifying serializers after documentation is \ +deprecated, use (serializer ~a) instead~%") (syntax->datum #'proc)) + (values (list %unset-value #'proc))))))) + (syntax-case syn () - ((_ stem (field field-type+def doc custom-serializer ...) ...) + ((_ stem (field field-type+def doc extra-args ...) ...) (with-syntax ((((field-type def) ...) - (map normalize-field-type+def #'(field-type+def ...)))) + (map normalize-field-type+def #'(field-type+def ...))) + (((sanitizer* serializer*) ...) + (map normalize-extra-args #'((extra-args ...) ...)))) (with-syntax (((field-getter ...) (map (lambda (field) @@ -200,21 +238,18 @@ does not have a default value" field kind))) ((field-type default-value) default-value)) #'((field-type def) ...))) + ((field-sanitizer ...) + (map maybe-value #'(sanitizer* ...))) ((field-serializer ...) - (map (lambda (type custom-serializer) + (map (lambda (type proc) (and serialize? - (match custom-serializer - ((serializer) - serializer) - (() - (if serializer-prefix - (id #'stem - serializer-prefix - #'serialize- type) - (id #'stem #'serialize- type)))))) + (or (maybe-value proc) + (if serializer-prefix + (id #'stem serializer-prefix #'serialize- type) + (id #'stem #'serialize- type))))) #'(field-type ...) - #'((custom-serializer ...) ...)))) - (define (field-sanitizer name pred) + #'(serializer* ...)))) + (define (default-field-sanitizer name pred) ;; Define a macro for use as a record field sanitizer, where NAME ;; is the name of the field and PRED is the predicate that tells ;; whether a value is valid for this field. @@ -235,21 +270,29 @@ does not have a default value" field kind))) #`(begin ;; Define field validation macros. - #,@(map field-sanitizer - #'(field ...) - #'(field-predicate ...)) + #,@(filter-map (lambda (name pred sanitizer) + (if sanitizer + #f + (default-field-sanitizer name pred))) + #'(field ...) + #'(field-predicate ...) + #'(field-sanitizer ...)) (define-record-type* #,(id #'stem #'< #'stem #'>) stem #,(id #'stem #'make- #'stem) #,(id #'stem #'stem #'?) - #,@(map (lambda (name getter def) - #`(#,name #,getter (default #,def) + #,@(map (lambda (name getter def sanitizer) + #`(#,name #,getter + (default #,def) (sanitize - #,(id #'stem #'validate- #'stem #'- name)))) + #,(or sanitizer + (id #'stem + #'validate- #'stem #'- name))))) #'(field ...) #'(field-getter ...) - #'(field-default ...)) + #'(field-default ...) + #'(field-sanitizer ...)) (%location #,(id #'stem #'stem #'-source-location) (default (and=> (current-source-location) source-properties->location)) @@ -261,6 +304,9 @@ does not have a default value" field kind))) (type 'field-type) (getter field-getter) (predicate field-predicate) + (sanitizer + (or field-sanitizer + (id #'stem #'validate- #'stem #'- #'field))) (serializer field-serializer) (default-value-thunk (lambda () diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm index 4f8a74dc8a..0392cce927 100644 --- a/tests/services/configuration.scm +++ b/tests/services/configuration.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2021, 2022 Maxim Cournoyer ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2022 Ludovic Courtès +;;; Copyright © 2023 Bruno Victal ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +23,7 @@ #:use-module (gnu services configuration) #:use-module (guix diagnostics) #:use-module (guix gexp) + #:autoload (guix i18n) (G_) #:use-module (srfi srfi-34) #:use-module (srfi srfi-64)) @@ -46,14 +48,14 @@ (port-configuration-port (port-configuration))) (test-equal "wrong type for a field" - '("configuration.scm" 57 11) ;error location + '("configuration.scm" 59 11) ;error location (guard (c ((configuration-error? c) (let ((loc (error-location c))) (list (basename (location-file loc)) (location-line loc) (location-column loc))))) (port-configuration - ;; This is line 56; the test relies on line/column numbers! + ;; This is line 58; the test relies on line/column numbers! (port "This is not a number!")))) (define-configuration port-configuration-cs @@ -109,6 +111,183 @@ (let ((config (configuration-with-prefix))) (serialize-configuration config configuration-with-prefix-fields)))) + +;;; +;;; define-configuration macro, extra-args literals +;;; + +(define (eval-gexp x) + "Get serialized config as string." + (eval (gexp->approximate-sexp x) + (current-module))) + +(define (port? value) + (or (string? value) (number? value))) + +(define (sanitize-port value) + (cond ((number? value) value) + ((string? value) (string->number value)) + (else (raise (formatted-message (G_ "Bad value: ~a") value))))) + +(test-group "Basic sanitizer literal tests" + (define serialize-port serialize-number) + + (define-configuration config-with-sanitizer + (port + (port 80) + "Lorem Ipsum." + (sanitizer sanitize-port))) + + (test-equal "default value, sanitizer" + 80 + (config-with-sanitizer-port (config-with-sanitizer))) + + (test-equal "string value, sanitized to number" + 56 + (config-with-sanitizer-port (config-with-sanitizer + (port "56")))) + + (define (custom-serialize-port field-name value) + (number->string value)) + + (define-configuration config-serializer + (port + (port 80) + "Lorem Ipsum." + (serializer custom-serialize-port))) + + (test-equal "default value, serializer literal" + "80" + (eval-gexp + (serialize-configuration (config-serializer) + config-serializer-fields)))) + +(test-group "empty-serializer as literal/procedure tests" + (define-configuration config-with-literal + (port + (port 80) + "Lorem Ipsum." + empty-serializer)) + + (define-configuration config-with-proc + (port + (port 80) + "Lorem Ipsum." + (serializer empty-serializer))) + + (test-equal "empty-serializer as literal" + "" + (eval-gexp + (serialize-configuration (config-with-literal) + config-with-literal-fields))) + + (test-equal "empty-serializer as procedure" + "" + (eval-gexp + (serialize-configuration (config-with-proc) + config-with-proc-fields)))) + +(test-group "permutation tests" + (define-configuration config-san+empty-ser + (port + (port 80) + "Lorem Ipsum." + (sanitizer sanitize-port) + empty-serializer)) + + (define-configuration config-san+ser + (port + (port 80) + "Lorem Ipsum." + (sanitizer sanitize-port) + (serializer (lambda _ "foo")))) + + (test-equal "default value, sanitizer, permutation" + 80 + (config-san+empty-ser-port (config-san+empty-ser))) + + (test-equal "default value, serializer, permutation" + "foo" + (eval-gexp + (serialize-configuration (config-san+ser) config-san+ser-fields))) + + (test-equal "string value sanitized to number, permutation" + 56 + (config-san+ser-port (config-san+ser + (port "56")))) + + ;; Ordering tests. + (define-configuration config-ser+san + (port + (port 80) + "Lorem Ipsum." + (sanitizer sanitize-port) + (serializer (lambda _ "foo")))) + + (define-configuration config-empty-ser+san + (port + (port 80) + "Lorem Ipsum." + empty-serializer + (sanitizer sanitize-port))) + + (test-equal "default value, sanitizer, permutation 2" + 56 + (config-empty-ser+san-port (config-empty-ser+san + (port "56")))) + + (test-equal "default value, serializer, permutation 2" + "foo" + (eval-gexp + (serialize-configuration (config-ser+san) config-ser+san-fields)))) + +(test-group "duplicated/conflicting entries" + (test-error + "duplicate sanitizer" #t + (macroexpand '(define-configuration dupe-san + (foo + (list '()) + "Lorem Ipsum." + (sanitizer (lambda () #t)) + (sanitizer (lambda () #t)))))) + + (test-error + "duplicate serializer" #t + (macroexpand '(define-configuration dupe-ser + (foo + (list '()) + "Lorem Ipsum." + (serializer (lambda _ "")) + (serializer (lambda _ "")))))) + + (test-error + "conflicting use of serializer + empty-serializer" #t + (macroexpand '(define-configuration ser+empty-ser + (foo + (list '()) + "Lorem Ipsum." + (serializer (lambda _ "lorem")) + empty-serializer))))) + +(test-group "Mix of deprecated and new syntax" + (test-error + "Mix of bare serializer and new syntax" #t + (macroexpand '(define-configuration mixed + (foo + (list '()) + "Lorem Ipsum." + (sanitizer (lambda () #t)) + (lambda _ "lorem"))))) + + (test-error + "Mix of bare serializer and new syntax, permutation)" #t + (macroexpand '(define-configuration mixed + (foo + (list '()) + "Lorem Ipsum." + (lambda _ "lorem") + (sanitizer (lambda () #t))))))) + ;;; ;;; define-maybe macro. -- cgit 1.4.1 From 0fbb356714f4ae3ea18e4997131a0e1746cc923c Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Sun, 26 Mar 2023 19:41:30 +0100 Subject: services: replace bare serializers with (serializer ...) * gnu/home/services/shells.scm (home-zsh-configuration)[environment-variables]: Use (serializer ...). (home-bash-configuration)[aliases, environment-variables]: Likewise. (home-fish-configuration)[abbreviations, aliases] [environment-variables]: Likewise. * gnu/services/audio.scm (mpd-configuration)[music-dir, playlist-dir] [endpoints, address, inputs, archive-plugins, input-cache-size] [decoders, filters, playlist-plugins]: Likewise. * gnu/services/linux.scm (fstrim-configuration)[extra-arguments]: Likewise. * gnu/services/security.scm (fail2ban-jail-configuration)[backend] [log-encoding, extra-content]: Likewise. * tests/services/configuration.scm: Update tests. ("serialize-configuration [deprecated]"): New test. Signed-off-by: Liliana Marie Prikler --- gnu/home/services/shells.scm | 12 +++++------ gnu/services/audio.scm | 45 ++++++++++++++++++++-------------------- gnu/services/linux.scm | 7 ++++--- gnu/services/security.scm | 6 +++--- tests/services/configuration.scm | 11 +++++++++- 5 files changed, 46 insertions(+), 35 deletions(-) (limited to 'gnu/services') diff --git a/gnu/home/services/shells.scm b/gnu/home/services/shells.scm index 3326eb37f4..f05f2221d6 100644 --- a/gnu/home/services/shells.scm +++ b/gnu/home/services/shells.scm @@ -133,7 +133,7 @@ Shell startup process will continue with (environment-variables (alist '()) "Association list of environment variables to set for the Zsh session." - serialize-posix-env-vars) + (serializer serialize-posix-env-vars)) (zshenv (text-config '()) "List of file-like objects, which will be added to @file{.zshenv}. @@ -334,7 +334,7 @@ source ~/.profile rules for the @code{home-environment-variables-service-type} apply here (@pxref{Essential Home Services}). The contents of this field will be added after the contents of the @code{bash-profile} field." - serialize-posix-env-vars) + (serializer serialize-posix-env-vars)) (aliases (alist '()) "Association list of aliases to set for the Bash session. The aliases will be @@ -351,7 +351,7 @@ turns into @example alias ls=\"ls -alF\" @end example" - bash-serialize-aliases) + (serializer bash-serialize-aliases)) (bash-profile (text-config '()) "List of file-like objects, which will be added to @file{.bash_profile}. @@ -536,19 +536,19 @@ with text blocks from other extensions and the base service.")) (environment-variables (alist '()) "Association list of environment variables to set in Fish." - serialize-fish-env-vars) + (serializer serialize-fish-env-vars)) (aliases (alist '()) "Association list of aliases for Fish, both the key and the value should be a string. An alias is just a simple function that wraps a command, If you want something more akin to @dfn{aliases} in POSIX shells, see the @code{abbreviations} field." - serialize-fish-aliases) + (serializer serialize-fish-aliases)) (abbreviations (alist '()) "Association list of abbreviations for Fish. These are words that, when typed in the shell, will automatically expand to the full text." - serialize-fish-abbreviations)) + (serializer serialize-fish-abbreviations))) (define (fish-files-service config) `(("fish/config.fish" diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm index 4885fb8424..c073b85a32 100644 --- a/gnu/services/audio.scm +++ b/gnu/services/audio.scm @@ -370,7 +370,7 @@ Available values: @code{notice}, @code{info}, @code{verbose}, (music-dir ; TODO: deprecated, remove later maybe-string "The directory to scan for music files." - mpd-serialize-deprecated-field) + (serializer mpd-serialize-deprecated-field)) (playlist-directory maybe-string @@ -379,7 +379,7 @@ Available values: @code{notice}, @code{info}, @code{verbose}, (playlist-dir ; TODO: deprecated, remove later maybe-string "The directory to store playlists." - mpd-serialize-deprecated-field) + (serializer mpd-serialize-deprecated-field)) (db-file maybe-string @@ -405,16 +405,17 @@ IPv6 addresses must be enclosed in square brackets when a different port is used. To use a Unix domain socket, an absolute path or a path starting with @code{~} can be specified here." - (lambda (_ endpoints) - (if (maybe-value-set? endpoints) - (mpd-serialize-list-of-strings "bind_to_address" endpoints) - ""))) + (serializer + (lambda (_ endpoints) + (if (maybe-value-set? endpoints) + (mpd-serialize-list-of-strings "bind_to_address" endpoints) + "")))) (address ; TODO: deprecated, remove later maybe-string "The address that mpd will bind to. To use a Unix domain socket, an absolute path can be specified here." - mpd-serialize-deprecated-field) + (serializer mpd-serialize-deprecated-field)) (database maybe-mpd-plugin @@ -431,29 +432,29 @@ To use a Unix domain socket, an absolute path can be specified here." (inputs (list-of-mpd-plugin '()) "List of MPD input plugin configurations." - (lambda (_ x) - (mpd-serialize-list-of-mpd-plugin "input" x))) + (serializer (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "input" x)))) (archive-plugins (list-of-mpd-plugin '()) "List of MPD archive plugin configurations." - (lambda (_ x) - (mpd-serialize-list-of-mpd-plugin "archive_plugin" x))) + (serializer (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "archive_plugin" x)))) (input-cache-size maybe-string "MPD input cache size." - (lambda (_ x) - (if (maybe-value-set? x) - #~(string-append "\ninput_cache {\n" - #$(mpd-serialize-string "size" x) - "}\n") ""))) + (serializer (lambda (_ x) + (if (maybe-value-set? x) + #~(string-append "\ninput_cache {\n" + #$(mpd-serialize-string "size" x) + "}\n") "")))) (decoders (list-of-mpd-plugin '()) "List of MPD decoder plugin configurations." - (lambda (_ x) - (mpd-serialize-list-of-mpd-plugin "decoder" x))) + (serializer (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "decoder" x)))) (resampler maybe-mpd-plugin @@ -462,8 +463,8 @@ To use a Unix domain socket, an absolute path can be specified here." (filters (list-of-mpd-plugin '()) "List of MPD filter plugin configurations." - (lambda (_ x) - (mpd-serialize-list-of-mpd-plugin "filter" x))) + (serializer (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "filter" x)))) (outputs (list-of-mpd-plugin-or-output (list (mpd-output))) @@ -473,8 +474,8 @@ By default this is a single output using pulseaudio.") (playlist-plugins (list-of-mpd-plugin '()) "List of MPD playlist plugin configurations." - (lambda (_ x) - (mpd-serialize-list-of-mpd-plugin "playlist_plugin" x))) + (serializer (lambda (_ x) + (mpd-serialize-list-of-mpd-plugin "playlist_plugin" x)))) (extra-options (alist '()) diff --git a/gnu/services/linux.scm b/gnu/services/linux.scm index 439848919d..4f28044112 100644 --- a/gnu/services/linux.scm +++ b/gnu/services/linux.scm @@ -213,9 +213,10 @@ option in fstab are skipped.") maybe-list-of-strings "Extra options to append to @command{fstrim} (run @samp{man fstrim} for more information)." - (lambda (_ value) - (if (maybe-value-set? value) - value '()))) + (serializer + (lambda (_ value) + (if (maybe-value-set? value) + value '())))) (prefix fstrim-)) (define (serialize-fstrim-configuration config) diff --git a/gnu/services/security.scm b/gnu/services/security.scm index 8116072920..e750bb468b 100644 --- a/gnu/services/security.scm +++ b/gnu/services/security.scm @@ -200,7 +200,7 @@ "Backend to use to detect changes in the @code{log-path}. The default is 'auto. To consult the defaults of the jail configuration, refer to the @file{/etc/fail2ban/jail.conf} file of the @code{fail2ban} package." - fail2ban-jail-configuration-serialize-backend) + (serializer fail2ban-jail-configuration-serialize-backend)) (max-retry maybe-integer "The number of failures before a host get banned @@ -269,7 +269,7 @@ names matching their filter name.") maybe-symbol "The encoding of the log files handled by the jail. Possible values are: @code{'ascii}, @code{'utf-8} and @code{'auto}." - fail2ban-jail-configuration-serialize-log-encoding) + (serializer fail2ban-jail-configuration-serialize-log-encoding)) (log-path (list-of-strings '()) "The file names of the log files to be monitored.") @@ -280,7 +280,7 @@ Possible values are: @code{'ascii}, @code{'utf-8} and @code{'auto}." (text-config '()) "Extra content for the jail configuration, provided as a list of file-like objects." - serialize-text-config) + (serializer serialize-text-config)) (prefix fail2ban-jail-configuration-)) (define list-of-fail2ban-jail-configurations? diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm index 0392cce927..8ad5907f37 100644 --- a/tests/services/configuration.scm +++ b/tests/services/configuration.scm @@ -82,6 +82,9 @@ (format #f "~a = ~a;" name value)) (define-configuration serializable-configuration + (port (number 80) "The port number." (serializer custom-number-serializer))) + +(define-configuration serializable-configuration-deprecated (port (number 80) "The port number." custom-number-serializer)) (test-assert "serialize-configuration" @@ -89,8 +92,14 @@ (let ((config (serializable-configuration))) (serialize-configuration config serializable-configuration-fields)))) +(test-assert "serialize-configuration [deprecated]" + (gexp? + (let ((config (serializable-configuration-deprecated))) + (serialize-configuration + config serializable-configuration-deprecated-fields)))) + (define-configuration serializable-configuration - (port (number 80) "The port number." custom-number-serializer) + (port (number 80) "The port number." (serializer custom-number-serializer)) (no-serialization)) (test-assert "serialize-configuration with no-serialization" -- cgit 1.4.1 From 2c4df1a41af70ebbae4422878ce6a4c8600c6811 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Sun, 26 Mar 2023 19:41:31 +0100 Subject: services: mpd: Fix unintentional API breakage for mixer-type field. * gnu/services/audio.scm (mpd-output)[mixer-type]: Use sanitizer to accept both strings and symbols as values. Signed-off-by: Liliana Marie Prikler --- gnu/services/audio.scm | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm index c073b85a32..bc4aed71dc 100644 --- a/gnu/services/audio.scm +++ b/gnu/services/audio.scm @@ -140,6 +140,11 @@ (define list-of-symbol? (list-of symbol?)) + +;;; +;;; MPD +;;; + (define (mpd-serialize-field field-name value) (let ((field (if (string? field-name) field-name (uglify-field-name field-name))) @@ -294,7 +299,17 @@ disconnect all listeners even when playback is accidentally stopped.") for this audio output: the @code{hardware} mixer, the @code{software} mixer, the @code{null} mixer (allows setting the volume, but with no effect; this can be used as a trick to implement an external mixer -External Mixer) or no mixer (@code{none}).") +External Mixer) or no mixer (@code{none})." + (sanitizer + (lambda (x) ; TODO: deprecated, remove me later. + (cond + ((symbol? x) + (warning (G_ "symbol value for 'mixer-type' is deprecated, \ +use string instead~%")) + (symbol->string x)) + ((string? x) x) + (else + (configuration-field-error #f 'mixer-type x)))))) (replay-gain-handler maybe-string -- cgit 1.4.1 From 7fdadeac11a997583305cb867b4a8828808ae953 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Sun, 26 Mar 2023 19:41:32 +0100 Subject: services: mpd: Use proper records for user and group fields. Deprecate using strings for these fields and prefer user-account (resp. user-group) instead to avoid duplication within account-service-type. Fixes #61570 . * gnu/services/audio.scm (%mpd-user, %mpd-group) (mpd-serialize-user-account, mpd-serialize-user-group) (mpd-user-sanitizer, mpd-group-sanitizer): New variables. (mpd-configuration)[user]: Use user-account as value type. Sanitize via mpd-user-sanitizer. [group]: Use user-group as value type. Sanitize via mpd-group-sanitizer. (mpd-shepherd-service): Adjust accordingly. (mpd-accounts): Likewise. * doc/guix.texi (Audio Services)[Music Player Daemon]: Likewise. Signed-off-by: Liliana Marie Prikler --- doc/guix.texi | 29 +++++++++-------- gnu/services/audio.scm | 87 ++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 86 insertions(+), 30 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 495a930d0d..40decb2f50 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6211,7 +6211,7 @@ Transformation Options}) so it should be lossless. @item --profile=@var{profile} @itemx -p @var{profile} -Create an environment containing the packages installed in @var{profile}. +Create an environment containing the packages installed in @var{profile}. Use @command{guix package} (@pxref{Invoking guix package}) to create and manage profiles. @@ -6657,7 +6657,7 @@ interpreted as packages that will be added to the environment directly. @item --profile=@var{profile} @itemx -p @var{profile} -Create an environment containing the packages installed in @var{profile}. +Create an environment containing the packages installed in @var{profile}. Use @command{guix package} (@pxref{Invoking guix package}) to create and manage profiles. @@ -12667,7 +12667,7 @@ candidates, and even to test their impact on packages that depend on them: @example -guix build elogind --with-source=@dots{}/shepherd-0.9.0rc1.tar.gz +guix build elogind --with-source=@dots{}/shepherd-0.9.0rc1.tar.gz @end example @dots{} or to build from a checkout in a pristine environment: @@ -23783,7 +23783,7 @@ created for. Restricts all controllers to the specified transport. @code{'dual} means both BR/EDR and LE are enabled (if supported by the hardware). -Possible values are: +Possible values are: @itemize @bullet @item @@ -33494,14 +33494,17 @@ Data type representing the configuration of @command{mpd}. @item @code{package} (default: @code{mpd}) (type: file-like) The MPD package. -@item @code{user} (default: @code{"mpd"}) (type: string) +@item @code{user} (default: @code{%mpd-user}) (type: user-account) The user to run mpd as. -@item @code{group} (default: @code{"mpd"}) (type: string) +The default @code{%mpd-user} is a system user with the name ``mpd'', +who is a part of the group @var{group} (see below). +@item @code{group} (default: @code{%mpd-group}) (type: user-group) The group to run mpd as. +The default @code{%mpd-group} is a system group with name ``mpd''. @item @code{shepherd-requirement} (default: @code{()}) (type: list-of-symbol) -This is a list of symbols naming Shepherd services that this service +A list of symbols naming Shepherd services that this service will depend on. @item @code{environment-variables} (default: @code{("PULSE_CLIENTCONFIG=/etc/pulse/client.conf" "PULSE_CONFIG=/etc/pulse/daemon.conf")}) (type: list-of-strings) @@ -41215,7 +41218,7 @@ A clause can have one of the following forms: (@var{field-name} (@var{type} @var{default-value}) @var{documentation}) - + (@var{field-name} (@var{type} @var{default-value}) @var{documentation} @@ -41289,7 +41292,7 @@ A simple serializer procedure could look like this: (define (serialize-boolean field-name value) (let ((value (if value "true" "false"))) #~(string-append #$field-name #$value))) -@end lisp +@end lisp In some cases multiple different configuration records might be defined in the same file, but their serializers for the same type might have to @@ -41307,7 +41310,7 @@ manually specify a custom @var{serializer} for every field. (define (bar-serialize-string field-name value) @dots{}) - + (define-configuration foo-configuration (label (string) @@ -41339,7 +41342,7 @@ macro which is a shorthand of this. (field (string "test") "Some documentation.")) -@end lisp +@end lisp @end defmac @defmac define-maybe type @@ -44145,7 +44148,7 @@ down in its dependency graph. As it turns out, GLib does not have a from /gnu/store/@dots{}-glib-2.62.6/lib/libglib-2.0.so.0 #1 0x00007ffff608a7d6 in gobject_init_ctor () from /gnu/store/@dots{}-glib-2.62.6/lib/libgobject-2.0.so.0 -#2 0x00007ffff7fe275a in call_init (l=, argc=argc@@entry=1, argv=argv@@entry=0x7fffffffcfd8, +#2 0x00007ffff7fe275a in call_init (l=, argc=argc@@entry=1, argv=argv@@entry=0x7fffffffcfd8, env=env@@entry=0x7fffffffcfe8) at dl-init.c:72 #3 0x00007ffff7fe2866 in call_init (env=0x7fffffffcfe8, argv=0x7fffffffcfd8, argc=1, l=) at dl-init.c:118 @@ -44174,7 +44177,7 @@ Starting program: /gnu/store/@dots{}-profile/bin/sh -c exec\ inkscape #0 g_getenv (variable=variable@@entry=0x7ffff60c7a2e "GOBJECT_DEBUG") at ../glib-2.62.6/glib/genviron.c:252 #1 0x00007ffff608a7d6 in gobject_init () at ../glib-2.62.6/gobject/gtype.c:4380 #2 gobject_init_ctor () at ../glib-2.62.6/gobject/gtype.c:4493 -#3 0x00007ffff7fe275a in call_init (l=, argc=argc@@entry=3, argv=argv@@entry=0x7fffffffd088, +#3 0x00007ffff7fe275a in call_init (l=, argc=argc@@entry=3, argv=argv@@entry=0x7fffffffd088, env=env@@entry=0x7fffffffd0a8) at dl-init.c:72 @dots{} @end example diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm index bc4aed71dc..854efd744a 100644 --- a/gnu/services/audio.scm +++ b/gnu/services/audio.scm @@ -140,6 +140,14 @@ (define list-of-symbol? (list-of symbol?)) +;; Helpers for deprecated field types, to be removed later. +(define %lazy-group (make-symbol "%lazy-group")) + +(define (%set-user-group user group) + (user-account + (inherit user) + (group (user-group-name group)))) + ;;; ;;; MPD @@ -164,10 +172,31 @@ (define (mpd-serialize-list-of-strings field-name value) #~(string-append #$@(map (cut mpd-serialize-string field-name <>) value))) +(define (mpd-serialize-user-account field-name value) + (mpd-serialize-string field-name (user-account-name value))) + +(define (mpd-serialize-user-group field-name value) + (mpd-serialize-string field-name (user-group-name value))) + (define-maybe string (prefix mpd-)) (define-maybe list-of-strings (prefix mpd-)) (define-maybe boolean (prefix mpd-)) +(define %mpd-user + (user-account + (name "mpd") + (group %lazy-group) + (system? #t) + (comment "Music Player Daemon (MPD) user") + ;; MPD can use $HOME (or $XDG_CONFIG_HOME) to place its data + (home-directory "/var/lib/mpd") + (shell (file-append shadow "/sbin/nologin")))) + +(define %mpd-group + (user-group + (name "mpd") + (system? #t))) + ;;; TODO: Procedures for deprecated fields, to be removed. (define mpd-deprecated-fields '((music-dir . music-directory) @@ -197,6 +226,33 @@ (define-maybe port (prefix mpd-)) +;;; Procedures for unsupported value types, to be removed. + +(define (mpd-user-sanitizer value) + (cond ((user-account? value) value) + ((string? value) + (warning (G_ "string value for 'user' is deprecated, use \ +user-account instead~%")) + (user-account + (inherit %mpd-user) + (name value) + ;; XXX: This is to be lazily substituted in (…-accounts) + ;; with the value from 'group'. + (group %lazy-group))) + (else + (configuration-field-error #f 'user value)))) + +(define (mpd-group-sanitizer value) + (cond ((user-group? value) value) + ((string? value) + (warning (G_ "string value for 'group' is deprecated, use \ +user-group instead~%")) + (user-group + (inherit %mpd-group) + (name value))) + (else + (configuration-field-error #f 'group value)))) + ;;; ;; Generic MPD plugin record, lists only the most prevalent fields. @@ -347,12 +403,14 @@ to be appended to the audio output configuration.") empty-serializer) (user - (string "mpd") - "The user to run mpd as.") + (user-account %mpd-user) + "The user to run mpd as." + (sanitizer mpd-user-sanitizer)) (group - (string "mpd") - "The group to run mpd as.") + (user-group %mpd-group) + "The group to run mpd as." + (sanitizer mpd-group-sanitizer)) (shepherd-requirement (list-of-symbol '()) @@ -517,7 +575,8 @@ appended to the configuration.") log-file playlist-directory db-file state-file sticker-file environment-variables) - (let* ((config-file (mpd-serialize-configuration config))) + (let ((config-file (mpd-serialize-configuration config)) + (username (user-account-name user))) (shepherd-service (documentation "Run the MPD (Music Player Daemon)") (requirement `(user-processes loopback ,@shepherd-requirement)) @@ -526,7 +585,7 @@ appended to the configuration.") (and=> #$(maybe-value log-file) (compose mkdir-p dirname)) - (let ((user (getpw #$user))) + (let ((user (getpw #$username))) (for-each (lambda (x) (when (and x (not (file-exists? x))) @@ -560,17 +619,11 @@ appended to the configuration.") (define (mpd-accounts config) (match-record config (user group) - (list (user-group - (name group) - (system? #t)) - (user-account - (name user) - (group group) - (system? #t) - (comment "Music Player Daemon (MPD) user") - ;; MPD can use $HOME (or $XDG_CONFIG_HOME) to place its data - (home-directory "/var/lib/mpd") - (shell (file-append shadow "/sbin/nologin")))))) + ;; TODO: Deprecation code, to be removed. + (let ((user (if (eq? (user-account-group user) %lazy-group) + (%set-user-group user group) + user))) + (list user group)))) (define mpd-service-type (service-type -- cgit 1.4.1 From 380faf265b0c3b231ab8b69597d161be5e704e18 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Sun, 26 Mar 2023 19:41:33 +0100 Subject: services: mympd: Use records for user and group fields. * gnu/services/audio.scm (%mympd-user, %mympd-group) (mympd-user-sanitizer, mympd-group-sanitizer): New variables. (mympd-configuration)[user]: Use user-account as value type. Sanitize via mympd-user-sanitizer. [group]: Use user-group as value type. Sanitize via mympd-group-sanitizer. (mympd-serialize-configuration): Adjust accordingly. (mympd-accounts): Likewise. * doc/guix.texi (Audio Services)[myMPD]: Likewise. Signed-off-by: Liliana Marie Prikler --- doc/guix.texi | 7 +++-- gnu/services/audio.scm | 70 ++++++++++++++++++++++++++++++++++++++++---------- 2 files changed, 61 insertions(+), 16 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 40decb2f50..4f72e2f34a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -33738,12 +33738,15 @@ The package object of the myMPD server. This is a list of symbols naming Shepherd services that this service will depend on. -@item @code{user} (default: @code{"mympd"}) (type: string) +@item @code{user} (default: @code{%mympd-user}) (type: user-account) Owner of the @command{mympd} process. -@item @code{group} (default: @code{"nogroup"}) (type: string) +The default @code{%mympd-user} is a system user with the name ``mympd'', +who is a part of the group @var{group} (see below). +@item @code{group} (default: @code{%mympd-group}) (type: user-group) Owner group of the @command{mympd} process. +The default @code{%mympd-group} is a system group with name ``mympd''. @item @code{work-directory} (default: @code{"/var/lib/mympd"}) (type: string) Where myMPD will store its data. diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm index 854efd744a..690409b7a1 100644 --- a/gnu/services/audio.scm +++ b/gnu/services/audio.scm @@ -658,6 +658,48 @@ appended to the configuration.") (define-maybe/no-serialization integer) (define-maybe/no-serialization mympd-ip-acl) +(define %mympd-user + (user-account + (name "mympd") + (group %lazy-group) + (system? #t) + (comment "myMPD user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin")))) + +(define %mympd-group + (user-group + (name "mympd") + (system? #t))) + +;;; TODO: Procedures for unsupported value types, to be removed. +(define (mympd-user-sanitizer value) + (cond ((user-account? value) value) + ((string? value) + (warning (G_ "string value for 'user' is not supported, use \ +user-account instead~%")) + (user-account + (inherit %mympd-user) + (name value) + ;; XXX: this is to be lazily substituted in (…-accounts) + ;; with the value from 'group'. + (group %lazy-group))) + (else + (configuration-field-error #f 'user value)))) + +(define (mympd-group-sanitizer value) + (cond ((user-group? value) value) + ((string? value) + (warning (G_ "string value for 'group' is not supported, use \ +user-group instead~%")) + (user-group + (inherit %mympd-group) + (name value))) + (else + (configuration-field-error #f 'group value)))) +;;; + + ;; XXX: The serialization procedures are insufficient since we require ;; access to multiple fields at once. ;; Fields marked with empty-serializer are never serialized and are @@ -675,13 +717,15 @@ will depend on." empty-serializer) (user - (string "mympd") + (user-account %mympd-user) "Owner of the @command{mympd} process." + (sanitizer mympd-user-sanitizer) empty-serializer) (group - (string "nogroup") + (user-group %mympd-group) "Owner group of the @command{mympd} process." + (sanitizer mympd-group-sanitizer) empty-serializer) (work-directory @@ -816,7 +860,8 @@ prompting a pin from the user.") (match-record config (package shepherd-requirement user work-directory cache-directory log-level log-to) - (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level))) + (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level)) + (username (user-account-name user))) (shepherd-service (documentation "Run the myMPD daemon.") (requirement `(loopback user-processes @@ -826,7 +871,7 @@ prompting a pin from the user.") ,@shepherd-requirement)) (provision '(mympd)) (start #~(begin - (let* ((pw (getpwnam #$user)) + (let* ((pw (getpwnam #$username)) (uid (passwd:uid pw)) (gid (passwd:gid pw))) (for-each (lambda (dir) @@ -836,8 +881,8 @@ prompting a pin from the user.") (make-forkexec-constructor `(#$(file-append package "/bin/mympd") - "--user" #$user - #$@(if (eqv? log-to 'syslog) '("--syslog") '()) + "--user" #$username + #$@(if (eq? log-to 'syslog) '("--syslog") '()) "--workdir" #$work-directory "--cachedir" #$cache-directory) #:environment-variables (list #$log-level*) @@ -846,14 +891,11 @@ prompting a pin from the user.") (define (mympd-accounts config) (match-record config (user group) - (list (user-group (name group) - (system? #t)) - (user-account (name user) - (group group) - (system? #t) - (comment "myMPD user") - (home-directory "/var/empty") - (shell (file-append shadow "/sbin/nologin")))))) + ;; TODO: Deprecation code, to be removed. + (let ((user (if (eq? (user-account-group user) %lazy-group) + (%set-user-group user group) + user))) + (list user group)))) (define (mympd-log-rotation config) (match-record config (log-to) -- cgit 1.4.1 From 1d0158ab9036cff7737cbfb1678f876ae67c4ac2 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer Date: Sun, 2 Apr 2023 23:23:26 -0400 Subject: services: xvnc: Do not create a regular HOME directory for xvnc user. * gnu/services/vnc.scm (%xvnc-accounts) [home-directory]: Define as /var/empty. [shell]: Set to nologin, for good measures. --- gnu/services/vnc.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/vnc.scm b/gnu/services/vnc.scm index 15c3c14fee..d57cf51af2 100644 --- a/gnu/services/vnc.scm +++ b/gnu/services/vnc.scm @@ -17,6 +17,7 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services vnc) + #:use-module (gnu packages admin) #:use-module (gnu packages vnc) #:use-module ((gnu services) #:hide (delete)) #:use-module (gnu system shadow) @@ -191,7 +192,9 @@ CONFIG, a object." (name "xvnc") (group "xvnc") (system? #t) - (comment "User for Xvnc server")))) + (comment "User for Xvnc server") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) (define (xvnc-shepherd-service config) "Return a for Xvnc with CONFIG." -- cgit 1.4.1 From b92880d0118d3a89a879515f8d373d5dbd281cf9 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 27 Feb 2023 00:11:36 +0000 Subject: services: ntp-service-type: Remove deprecated server as strings support. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/networking.scm ()[servers]: Rename accessor to ntp-configuration-servers. (ntp-configuration-servers): Remove helper procedure. (ntp-shepherd-service): Remove helper procedure usage. * tests/networking.scm: Remove obsolete test. Signed-off-by: Ludovic Courtès --- gnu/services/networking.scm | 59 ++++++++++++++++----------------------------- tests/networking.scm | 11 --------- 2 files changed, 21 insertions(+), 49 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 49f897d8cf..19c109d238 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -486,36 +486,19 @@ daemon is responsible for allocating IP addresses to its client."))) ntp-configuration? (ntp ntp-configuration-ntp (default ntp)) - (servers %ntp-configuration-servers ;list of objects + (servers ntp-configuration-servers ;list of objects (default %ntp-servers)) (allow-large-adjustment? ntp-allow-large-adjustment? (default #t))) ;as recommended in the ntpd manual -(define (ntp-configuration-servers ntp-configuration) - ;; A wrapper to support the deprecated form of this field. - (let ((ntp-servers (%ntp-configuration-servers ntp-configuration))) - (match ntp-servers - (((? string?) (? string?) ...) - (format (current-error-port) "warning: Defining NTP servers as strings is \ -deprecated. Please use records instead.\n") - (map (lambda (addr) - (ntp-server - (type 'server) - (address addr) - (options '()))) ntp-servers)) - ((($ ) ($ ) ...) - ntp-servers)))) - (define (ntp-shepherd-service config) (match-record config (ntp servers allow-large-adjustment?) - (let ((servers (ntp-configuration-servers config))) - ;; TODO: Add authentication support. - (define config - (string-append "driftfile /var/run/ntpd/ntp.drift\n" - (string-join (map ntp-server->string servers) - "\n") - " + ;; TODO: Add authentication support. + (define config + (string-append "driftfile /var/run/ntpd/ntp.drift\n" + (string-join (map ntp-server->string servers) "\n") + " # Disable status queries as a workaround for CVE-2013-5211: # . restrict default kod nomodify notrap nopeer noquery limited @@ -529,22 +512,22 @@ restrict -6 ::1 # option by default, as documented in the 'ntp.conf' manual. restrict source notrap nomodify noquery\n")) - (define ntpd.conf - (plain-file "ntpd.conf" config)) + (define ntpd.conf + (plain-file "ntpd.conf" config)) - (list (shepherd-service - (provision '(ntpd)) - (documentation "Run the Network Time Protocol (NTP) daemon.") - (requirement '(user-processes networking)) - (actions (list (shepherd-configuration-action ntpd.conf))) - (start #~(make-forkexec-constructor - (list (string-append #$ntp "/bin/ntpd") "-n" - "-c" #$ntpd.conf "-u" "ntpd" - #$@(if allow-large-adjustment? - '("-g") - '())) - #:log-file "/var/log/ntpd.log")) - (stop #~(make-kill-destructor))))))) + (list (shepherd-service + (provision '(ntpd)) + (documentation "Run the Network Time Protocol (NTP) daemon.") + (requirement '(user-processes networking)) + (actions (list (shepherd-configuration-action ntpd.conf))) + (start #~(make-forkexec-constructor + (list (string-append #$ntp "/bin/ntpd") "-n" + "-c" #$ntpd.conf "-u" "ntpd" + #$@(if allow-large-adjustment? + '("-g") + '())) + #:log-file "/var/log/ntpd.log")) + (stop #~(make-kill-destructor)))))) (define %ntp-accounts (list (user-account diff --git a/tests/networking.scm b/tests/networking.scm index f2421370d2..fbf8db7a02 100644 --- a/tests/networking.scm +++ b/tests/networking.scm @@ -43,17 +43,6 @@ "server some.ntp.server.org iburst version 3 maxpoll 16 prefer" (ntp-server->string %ntp-server-sample)) -(test-equal "ntp configuration servers deprecated form" - (ntp-configuration-servers - (ntp-configuration - (servers (list "example.pool.ntp.org")))) - (ntp-configuration-servers - (ntp-configuration - (servers (list (ntp-server - (type 'server) - (address "example.pool.ntp.org") - (options '()))))))) - ;;; ;;; OpenNTPD -- cgit 1.4.1 From aeb5df82dddfa84d91afd4373189d968e6377574 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 27 Feb 2023 00:11:37 +0000 Subject: services: sddm: Remove 'sddm-service' procedure. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/sddm.scm (sddm-service): Remove procedure. Signed-off-by: Ludovic Courtès --- gnu/services/sddm.scm | 6 ------ 1 file changed, 6 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm index 694ad736dc..9e02f1cc81 100644 --- a/gnu/services/sddm.scm +++ b/gnu/services/sddm.scm @@ -324,9 +324,3 @@ Relogin=" (if (sddm-configuration-relogin? config) (description "Run SDDM, a display and log-in manager for X11 and Wayland.")))) - -(define-deprecated (sddm-service #:optional (config (sddm-configuration))) - sddm-service-type - "Run the @uref{https://github.com/sddm/sddm,SDDM display manager} -with the given @var{config}, a @code{} object." - (service sddm-service-type config)) -- cgit 1.4.1 From 4f27c4e681e1145471cebc13ec8c97756a991fe9 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 27 Feb 2023 00:11:38 +0000 Subject: services: base: Remove 'console-keymap-service-type' variable. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/base.scm (console-keymap-service-type): Remove variable. Signed-off-by: Ludovic Courtès --- gnu/services/base.scm | 15 --------------- 1 file changed, 15 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index e063828d3b..4a358945ea 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -814,21 +814,6 @@ host names." #t ;default to UTF-8 (description "Ensure the Linux virtual terminals run in UTF-8 mode."))) -(define console-keymap-service-type - (shepherd-service-type - 'console-keymap - (lambda (files) - (shepherd-service - (documentation (string-append "Load console keymap (loadkeys).")) - (provision '(console-keymap)) - (start #~(lambda _ - (zero? (system* #$(file-append kbd "/bin/loadkeys") - #$@files)))) - (respawn? #f))) - (description "@emph{This service is deprecated in favor of the -@code{keyboard-layout} field of @code{operating-system}.} Load the given list -of console keymaps with @command{loadkeys}."))) - (define %default-console-font ;; Note: the 'font-gnu-unifont' package cannot be cross-compiled (yet), but ;; its "psf" output is the same whether it's built natively or not, hence -- cgit 1.4.1 From 189d30d7275905c8209066fd88fc634e18064972 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 27 Feb 2023 00:11:39 +0000 Subject: services: base: Remove 'console-font-service' procedure. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/base.scm (console-font-service): Remove procedure. Signed-off-by: Ludovic Courtès --- gnu/services/base.scm | 8 -------- 1 file changed, 8 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 4a358945ea..74215b677a 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -886,14 +886,6 @@ package or any valid argument to @command{setfont}, as in this example: \"/share/consolefonts/ter-132n\"))) ; for HDPI @end example\n"))) -(define* (console-font-service tty #:optional (font "LatGrkCyr-8x16")) - "This procedure is deprecated in favor of @code{console-font-service-type}. - -Return a service that sets up Unicode support in @var{tty} and loads -@var{font} for that tty (fonts are per virtual console in Linux.)" - (simple-service (symbol-append 'console-font- (string->symbol tty)) - console-font-service-type `((,tty . ,font)))) - (define %default-motd (plain-file "motd" "This is the GNU operating system, welcome!\n\n")) -- cgit 1.4.1 From d442b7759662c925243f73678b647c4427ef7ac0 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 27 Feb 2023 00:11:40 +0000 Subject: services: guix-publish: Remove 'compression-level' field. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/base.scm ()[compression-level]: Remove field. (guix-publish-configuration-compression-level): Remove procedure. (default-compression): Remove compression-level helper code. Signed-off-by: Ludovic Courtès --- gnu/services/base.scm | 29 +++++++---------------------- 1 file changed, 7 insertions(+), 22 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 74215b677a..e5c6bf5335 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -223,7 +223,6 @@ guix-publish-configuration-port guix-publish-configuration-host guix-publish-configuration-compression - guix-publish-configuration-compression-level ;deprecated guix-publish-configuration-nar-path guix-publish-configuration-cache guix-publish-configuration-ttl @@ -1986,10 +1985,7 @@ proxy of 'guix-daemon'...~%") (default #f)) (compression guix-publish-configuration-compression (thunked) - (default (default-compression this-record - (current-source-location)))) - (compression-level %guix-publish-configuration-compression-level ;deprecated - (default #f)) + (default (default-compression this-record))) (nar-path guix-publish-configuration-nar-path ;string (default "nar")) (cache guix-publish-configuration-cache ;#f | string @@ -2003,25 +1999,14 @@ proxy of 'guix-daemon'...~%") (negative-ttl guix-publish-configuration-negative-ttl ;#f | integer (default #f))) -(define-deprecated (guix-publish-configuration-compression-level config) - "Return a compression level, the old way." - (match (guix-publish-configuration-compression config) - (((_ level) _ ...) level))) - -(define (default-compression config properties) +(define (default-compression config) "Return the default 'guix publish' compression according to CONFIG, and raise a deprecation warning if the 'compression-level' field was used." - (match (%guix-publish-configuration-compression-level config) - (#f - ;; Default to low compression levels when there's no cache so that users - ;; get good bandwidth by default. - (if (guix-publish-configuration-cache config) - '(("gzip" 5) ("zstd" 19)) - '(("gzip" 3) ("zstd" 3)))) ;zstd compresses faster - (level - (warn-about-deprecation 'compression-level properties - #:replacement 'compression) - `(("gzip" ,level))))) + ;; Default to low compression levels when there's no cache so that users + ;; get good bandwidth by default. + (if (guix-publish-configuration-cache config) + '(("gzip" 5) ("zstd" 19)) + '(("gzip" 3) ("zstd" 3)))) ;zstd compresses faster (define (guix-publish-shepherd-service config) (define (config->compression-options config) -- cgit 1.4.1 From 21e8a10852fc45eae41b6fe6c6053ab047d71ec8 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 27 Feb 2023 00:11:41 +0000 Subject: services: desktop: Remove 'gnome-desktop-service' procedure. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/desktop.scm (gnome-desktop-service): Remove procedure. Signed-off-by: Ludovic Courtès --- gnu/services/desktop.scm | 13 ++++--------- 1 file changed, 4 insertions(+), 9 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index e37dbf2827..f250811190 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -1423,15 +1423,10 @@ rules." (default-value (gnome-desktop-configuration)) (description "Run the GNOME desktop environment."))) -(define-deprecated (gnome-desktop-service #:key (config - (gnome-desktop-configuration))) - gnome-desktop-service-type - "Return a service that adds the @code{gnome} package to the system profile, -and extends polkit with the actions from @code{gnome-settings-daemon}." - (service gnome-desktop-service-type config)) - -;; MATE Desktop service. -;; TODO: Add mate-screensaver. + +;;; +;;; MATE Desktop service. +;;; TODO: Add mate-screensaver. (define-record-type* mate-desktop-configuration make-mate-desktop-configuration -- cgit 1.4.1 From 74c188ecc75df26036a454c2a254bb60c503afa8 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 27 Feb 2023 00:11:42 +0000 Subject: services: desktop: Remove 'mate-desktop-service' procedure. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/desktop.scm (mate-desktop-service): Remove procedure. Signed-off-by: Ludovic Courtès --- gnu/services/desktop.scm | 8 -------- 1 file changed, 8 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index f250811190..9ba38c0dba 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -1456,14 +1456,6 @@ rules." (default-value (mate-desktop-configuration)) (description "Run the MATE desktop environment."))) -(define-deprecated (mate-desktop-service #:key - (config - (mate-desktop-configuration))) - mate-desktop-service-type - "Return a service that adds the @code{mate} package to the system profile, -and extends polkit with the actions from @code{mate-settings-daemon}." - (service mate-desktop-service-type config)) - ;;; ;;; XFCE desktop service. -- cgit 1.4.1 From 6586c114e96585543e70e916902dd38b40d46c96 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 27 Feb 2023 00:11:43 +0000 Subject: services: desktop: Remove 'xfce-desktop-service' procedure. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * gnu/services/desktop.scm (xfce-desktop-service): Remove procedure. Signed-off-by: Ludovic Courtès --- gnu/services/desktop.scm | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index 9ba38c0dba..adea5b38dd 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -1486,16 +1486,7 @@ rules." (default-value (xfce-desktop-configuration)) (description "Run the Xfce desktop environment."))) -(define-deprecated (xfce-desktop-service #:key (config - (xfce-desktop-configuration))) - xfce-desktop-service-type - "Return a service that adds the @code{xfce} package to the system profile, -and extends polkit with the ability for @code{thunar} to manipulate the file -system as root from within a user session, after the user has authenticated -with the administrator's password." - (service xfce-desktop-service-type config)) - -+ + ;;; ;;; Lxqt desktop service. ;;; -- cgit 1.4.1 From dd10ba41847fbe0251bd3cc7ffc7bb640cca7e84 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 3 Apr 2023 12:58:02 +0100 Subject: services: nginx: Make logging level configurable. * gnu/services/web.scm ()[log-level]: New field. (assert-valid-log-level): New procedure. (default-nginx-config): Make log-level configurable. * doc/guix.texi (Web Services): Document it. Signed-off-by: Maxim Cournoyer --- doc/guix.texi | 5 +++++ gnu/services/web.scm | 19 ++++++++++++++++++- 2 files changed, 23 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index fa6c9f46a3..acb6f0c2e1 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -29889,6 +29889,11 @@ started. @item @code{log-directory} (default: @code{"/var/log/nginx"}) The directory to which NGinx will write log files. +@item @code{log-level} (default: @code{'error}) (type: symbol) +Logging level, which can be any of the following values: @code{'debug}, +@code{'info}, @code{'notice}, @code{'warn}, @code{'error}, @code{'crit}, +@code{'alert}, or @code{'emerg}. + @item @code{run-directory} (default: @code{"/var/run/nginx"}) The directory in which NGinx will create a pid file, and write temporary files. diff --git a/gnu/services/web.scm b/gnu/services/web.scm index d56e893527..4fe9c2d9ab 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -15,6 +15,7 @@ ;;; Copyright © 2020 Oleg Pykhalov ;;; Copyright © 2020, 2021 Alexandru-Sergiu Marton ;;; Copyright © 2022 Simen Endsjø +;;; Copyright © 2023 Bruno Victal ;;; ;;; This file is part of GNU Guix. ;;; @@ -51,6 +52,8 @@ #:use-module (gnu packages logging) #:use-module (gnu packages mail) #:use-module (gnu packages rust-apps) + #:autoload (guix i18n) (G_) + #:use-module (guix diagnostics) #:use-module (guix packages) #:use-module (guix records) #:use-module (guix modules) @@ -61,6 +64,7 @@ #:use-module ((guix packages) #:select (package-version)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) + #:use-module (srfi srfi-34) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (httpd-configuration @@ -96,6 +100,7 @@ nginx-configuration-nginx nginx-configuration-shepherd-requirement nginx-configuration-log-directory + nginx-configuration-log-level nginx-configuration-run-directory nginx-configuration-server-blocks nginx-configuration-upstream-blocks @@ -562,6 +567,9 @@ (default '())) ;list of symbols (log-directory nginx-configuration-log-directory ;string (default "/var/log/nginx")) + (log-level nginx-configuration-log-level + (sanitize assert-valid-log-level) + (default 'error)) (run-directory nginx-configuration-run-directory ;string (default "/var/run/nginx")) (server-blocks nginx-configuration-server-blocks @@ -584,6 +592,14 @@ (file nginx-configuration-file ;#f | string | file-like (default #f))) +(define (assert-valid-log-level level) + "Ensure @var{level} is one of @code{'debug}, @code{'info}, @code{'notice}, +@code{'warn}, @code{'error}, @code{'crit}, @code{'alert}, or @code{'emerg}." + (unless (memq level '(debug info notice warn error crit alert emerg)) + (raise + (formatted-message (G_ "unknown log level '~a'~%") level))) + level) + (define (config-domain-strings names) "Return a string denoting the nginx config representation of NAMES, a list of domain names." @@ -692,6 +708,7 @@ of index files." (match-record config (nginx log-directory run-directory + log-level server-blocks upstream-blocks server-names-hash-bucket-size server-names-hash-bucket-max-size @@ -704,7 +721,7 @@ of index files." (flatten "user nginx nginx;\n" "pid " run-directory "/pid;\n" - "error_log " log-directory "/error.log info;\n" + "error_log " log-directory "/error.log " (symbol->string log-level) ";\n" (map emit-load-module modules) (map emit-global-directive global-directives) "http {\n" -- cgit 1.4.1 From 337e681b7a312b6910725ba553918a6a2e442f89 Mon Sep 17 00:00:00 2001 From: Bruno Victal Date: Mon, 3 Apr 2023 12:58:03 +0100 Subject: services: nginx: Add reopen action. This is required to allow log file rotations using rottlog, etc. * gnu/services/web.scm (nginx-shepherd-service): Add reopen shepherd action. Signed-off-by: Maxim Cournoyer --- gnu/services/web.scm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'gnu/services') diff --git a/gnu/services/web.scm b/gnu/services/web.scm index 4fe9c2d9ab..45897d7d6f 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -840,7 +840,11 @@ This has the effect of killing old worker processes and starting new ones, using the same configuration file. It is useful for situations where the same nginx configuration file can point to different things after a reload, such as renewed TLS certificates, or @code{include}d files.") - (procedure (nginx-action "-s" "reload")))))))))) + (procedure (nginx-action "-s" "reload"))) + (shepherd-action + (name 'reopen) + (documentation "Re-open log files.") + (procedure (nginx-action "-s" "reopen")))))))))) (define nginx-service-type (service-type (name 'nginx) -- cgit 1.4.1