Merge remote-tracking branch 'origin/master' into staging

6 files changed, 53 insertions, 39 deletions

diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm
index d55b804ba9..4885fb8424 100644
--- a/gnu/services/audio.scm
+++ b/gnu/services/audio.scm
@@ -2,7 +2,7 @@
 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2022 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2022⁠–⁠2023 Bruno Victal <mirai@makinata.eu>
 ;;;
 ;;; 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,8 @@ will depend on."
    empty-serializer)
 
   (environment-variables
-   (list-of-string '())
+   (list-of-strings '("PULSE_CLIENTCONFIG=/etc/pulse/client.conf"
+                      "PULSE_CONFIG=/etc/pulse/daemon.conf"))
    "A list of strings specifying environment variables."
    empty-serializer)
 
@@ -400,7 +398,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 +407,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 +579,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 +705,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
   ;; <work-directory>/config/.
@@ -752,7 +750,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))
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.
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 <ludo@gnu.org>
+;;; Copyright © 2016-2019, 2022-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -284,22 +284,12 @@ returns a shepherd <service> 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 <service>)))
-                      (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
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")
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 6ab313b97c..49f897d8cf 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 <ludo@gnu.org>
+;;; Copyright © 2013-2023 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016, 2018, 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
@@ -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"
@@ -1235,6 +1236,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
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))