Merge remote-tracking branch 'savannah/master' into core-updates

Conflicts:
	gnu/local.mk
	gnu/packages/autotools.scm
	gnu/packages/cmake.scm
	gnu/packages/gnuzilla.scm
	gnu/packages/haskell.scm
	gnu/packages/pdf.scm
	gnu/packages/python-xyz.scm
	gnu/packages/samba.scm
	gnu/packages/tex.scm
	gnu/packages/tls.scm
	gnu/packages/wxwidgets.scm

9 files changed, 1049 insertions, 215 deletions

diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm
index c60053f33c..d55b804ba9 100644
--- a/gnu/services/audio.scm
+++ b/gnu/services/audio.scm
@@ -2,6 +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>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,19 +21,108 @@
 
 (define-module (gnu services audio)
   #:use-module (guix gexp)
+  #:use-module (guix deprecation)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
   #:use-module (gnu services)
+  #:use-module (gnu services admin)
+  #:use-module (gnu services configuration)
   #:use-module (gnu services shepherd)
+  #:use-module (gnu services admin)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages mpd)
   #:use-module (guix records)
-  #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:export (mpd-output
             mpd-output?
+            mpd-output-name
+            mpd-output-type
+            mpd-output-enabled?
+            mpd-output-format
+            mpd-output-tags?
+            mpd-output-always-on?
+            mpd-output-mixer-type
+            mpd-output-replay-gain-handler
+            mpd-output-extra-options
+
+            mpd-plugin
+            mpd-plugin?
+            mpd-plugin-plugin
+            mpd-plugin-name
+            mpd-plugin-enabled?
+            mpd-plugin-extra-options
+
+            mpd-partition
+            mpd-partition?
+            mpd-partition-name
+            mpd-partition-extra-options
+
             mpd-configuration
             mpd-configuration?
-            mpd-service-type))
+            mpd-configuration-package
+            mpd-configuration-user
+            mpd-configuration-group
+            mpd-configuration-shepherd-requirement
+            mpd-configuration-log-file
+            mpd-configuration-log-level
+            mpd-configuration-music-directory
+            mpd-configuration-music-dir
+            mpd-configuration-playlist-directory
+            mpd-configuration-playlist-dir
+            mpd-configuration-db-file
+            mpd-configuration-state-file
+            mpd-configuration-sticker-file
+            mpd-configuration-default-port
+            mpd-configuration-endpoints
+            mpd-configuration-address
+            mpd-configuration-database
+            mpd-configuration-partitions
+            mpd-configuration-neighbors
+            mpd-configuration-inputs
+            mpd-configuration-archive-plugins
+            mpd-configuration-input-cache-size
+            mpd-configuration-decoders
+            mpd-configuration-resampler
+            mpd-configuration-filters
+            mpd-configuration-outputs
+            mpd-configuration-playlist-plugins
+            mpd-configuration-extra-options
+            mpd-service-type
+
+            mympd-service-type
+            mympd-configuration
+            mympd-configuration?
+            mympd-configuration-package
+            mympd-configuration-shepherd-requirement
+            mympd-configuration-user
+            mympd-configuration-group
+            mympd-configuration-work-directory
+            mympd-configuration-cache-directory
+            mympd-configuration-acl
+            mympd-configuration-covercache-ttl
+            mympd-configuration-http?
+            mympd-configuration-host
+            mympd-configuration-port
+            mympd-configuration-log-level
+            mympd-configuration-log-to
+            mympd-configuration-lualibs
+            mympd-configuration-uri
+            mympd-configuration-script-acl
+            mympd-configuration-ssl?
+            mympd-configuration-ssl-port
+            mympd-configuration-ssl-cert
+            mympd-configuration-ssl-key
+            mympd-configuration-pin-hash
+            mympd-configuration-save-caches?
+            mympd-ip-acl
+            mympd-ip-acl?
+            mympd-ip-acl-allow
+            mympd-ip-acl-deny))
 
 ;;; Commentary:
 ;;;
@@ -40,150 +130,433 @@
 ;;;
 ;;; Code:
 
-(define-record-type* <mpd-output>
-  mpd-output make-mpd-output
-  mpd-output?
-  (type          mpd-output-type
-                 (default "pulse"))
-  (name          mpd-output-name
-                 (default "MPD"))
-  (enabled?      mpd-output-enabled?
-                 (default #t))
-  (tags?         mpd-output-tags?
-                 (default #t))
-  (always-on?    mpd-output-always-on?
-                 (default #f))
-  (mixer-type    mpd-output-mixer-type
-                 ;; valid: hardware, software, null, none
-                 (default #f))
-  (extra-options mpd-output-extra-options
-                 (default '())))
-
-(define-record-type* <mpd-configuration>
-  mpd-configuration make-mpd-configuration
-  mpd-configuration?
-  (user         mpd-configuration-user
-                (default "mpd"))
-  (music-dir    mpd-configuration-music-dir
-                (default "~/Music"))
-  (playlist-dir mpd-configuration-playlist-dir
-                (default "~/.mpd/playlists"))
-  (db-file      mpd-configuration-db-file
-                (default "~/.mpd/tag_cache"))
-  (state-file   mpd-configuration-state-file
-                (default "~/.mpd/state"))
-  (sticker-file mpd-configuration-sticker-file
-                (default "~/.mpd/sticker.sql"))
-  (port         mpd-configuration-port
-                (default "6600"))
-  (address      mpd-configuration-address
-                (default "any"))
-  (outputs      mpd-configuration-outputs
-                (default (list (mpd-output)))))
-
-(define (mpd-output->string output)
-  "Convert the OUTPUT of type <mpd-output> to a configuration file snippet."
-  (let ((extra (string-join
-                (map (match-lambda
-                       ((key . value)
-                        (format #f "  ~a \"~a\""
-                                (string-map
-                                 (lambda (c) (if (char=? c #\-) #\_ c))
-                                 (symbol->string key))
-                                value)))
-                     (mpd-output-extra-options output))
-                "\n")))
-    (format #f "\
-audio_output {
-  type \"~a\"
-  name \"~a\"
-~:[  enabled \"no\"~%~;~]\
-~:[  tags \"no\"~%~;~]\
-~:[~;  always_on \"yes\"~%~]\
-~@[  mixer_type \"~a\"~%~]\
-~a~%}~%"
-            (mpd-output-type output)
-            (mpd-output-name output)
-            (mpd-output-enabled? output)
-            (mpd-output-tags? output)
-            (mpd-output-always-on? output)
-            (mpd-output-mixer-type output)
-            extra)))
-
-(define (mpd-config->file config)
-  (apply
-   mixed-text-file "mpd.conf"
-   "pid_file \"" (mpd-file-name config "pid") "\"\n"
-   (append (map mpd-output->string
-                (mpd-configuration-outputs config))
-           (map (match-lambda
-                  ((config-name config-val)
-                   (string-append config-name " \"" (config-val config) "\"\n")))
-                `(("user" ,mpd-configuration-user)
-                  ("music_directory" ,mpd-configuration-music-dir)
-                  ("playlist_directory" ,mpd-configuration-playlist-dir)
-                  ("db_file" ,mpd-configuration-db-file)
-                  ("state_file" ,mpd-configuration-state-file)
-                  ("sticker_file" ,mpd-configuration-sticker-file)
-                  ("port" ,mpd-configuration-port)
-                  ("bind_to_address" ,mpd-configuration-address))))))
-
-(define (mpd-file-name config file)
-  "Return a path in /var/run/mpd/ that is writable
-   by @code{user} from @code{config}."
-  (string-append "/var/run/mpd/"
-                 (mpd-configuration-user config)
-                 "/" file))
+(define (uglify-field-name field-name)
+  (let ((str (symbol->string field-name)))
+    (string-join (string-split (if (string-suffix? "?" str)
+                                   (string-drop-right str 1)
+                                   str)
+                               #\-) "_")))
+
+(define list-of-string?
+  (list-of string?))
+
+(define list-of-symbol?
+  (list-of symbol?))
+
+(define (mpd-serialize-field field-name value)
+  (let ((field (if (string? field-name) field-name
+                   (uglify-field-name field-name)))
+        (value (cond
+                ((boolean? value) (if value "yes" "no"))
+                ((string? value) value)
+                (else (object->string value)))))
+    #~(format #f "~a ~s~%" #$field #$value)))
+
+(define (mpd-serialize-alist field-name value)
+  #~(string-append #$@(generic-serialize-alist list mpd-serialize-field
+                                               value)))
+
+(define mpd-serialize-string mpd-serialize-field)
+(define mpd-serialize-boolean mpd-serialize-field)
+
+(define (mpd-serialize-list-of-string 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 boolean (prefix mpd-))
+
+;;; TODO: Procedures for deprecated fields, to be removed.
+
+(define mpd-deprecated-fields '((music-dir . music-directory)
+                                (playlist-dir . playlist-directory)
+                                (address . endpoints)))
+
+(define (port? value) (or (string? value) (integer? value)))
+
+(define (mpd-serialize-deprecated-field field-name value)
+  (if (maybe-value-set? value)
+      (begin
+        (warn-about-deprecation
+         field-name #f
+         #:replacement (assoc-ref mpd-deprecated-fields field-name))
+        (match field-name
+          ('playlist-dir (mpd-serialize-string "playlist_directory" value))
+          ('music-dir (mpd-serialize-string "music_directory" value))
+          ('address (mpd-serialize-string "bind_to_address" value))))
+      ""))
+
+(define (mpd-serialize-port field-name value)
+  (when (string? value)
+    (warning
+     (G_ "string value for '~a' is deprecated, use integer instead~%")
+     field-name))
+  (mpd-serialize-field "port" value))
+
+(define-maybe port (prefix mpd-))
+
+;;;
+
+;; Generic MPD plugin record, lists only the most prevalent fields.
+(define-configuration mpd-plugin
+  (plugin
+   maybe-string
+   "Plugin name.")
+
+  (name
+   maybe-string
+   "Name.")
+
+  (enabled?
+   maybe-boolean
+   "Whether the plugin is enabled/disabled.")
+
+  (extra-options
+   (alist '())
+   "An association list of option symbols/strings to string values
+to be appended to the plugin configuration. See
+@uref{https://mpd.readthedocs.io/en/latest/plugins.html,MPD plugin reference}
+for available options.")
+
+  (prefix mpd-))
+
+(define (mpd-serialize-mpd-plugin field-name value)
+  #~(format #f "~a {~%~a}~%"
+            '#$field-name
+            #$(serialize-configuration value mpd-plugin-fields)))
+
+(define (mpd-serialize-list-of-mpd-plugin field-name value)
+  #~(string-append #$@(map (cut mpd-serialize-mpd-plugin field-name <>)
+                           value)))
+
+(define list-of-mpd-plugin? (list-of mpd-plugin?))
+
+(define-maybe mpd-plugin (prefix mpd-))
+
+(define-configuration mpd-partition
+  (name
+   string
+   "Partition name.")
+
+  (extra-options
+   (alist '())
+   "An association list of option symbols/strings to string values
+to be appended to the partition configuration. See
+@uref{https://mpd.readthedocs.io/en/latest/user.html#configuring-partitions,Configuring Partitions}
+for available options.")
+
+  (prefix mpd-))
+
+(define (mpd-serialize-mpd-partition field-name value)
+  #~(format #f "partition {~%~a}~%"
+            #$(serialize-configuration value mpd-partition-fields)))
+
+(define (mpd-serialize-list-of-mpd-partition field-name value)
+  #~(string-append #$@(map (cut mpd-serialize-mpd-partition #f <>) value)))
+
+(define list-of-mpd-partition?
+  (list-of mpd-partition?))
+
+(define-configuration mpd-output
+  (name
+   (string "MPD")
+   "The name of the audio output.")
+
+  (type
+   (string "pulse")
+   "The type of audio output.")
+
+  (enabled?
+   (boolean #t)
+   "Specifies whether this audio output is enabled when MPD is started. By
+default, all audio outputs are enabled. This is just the default
+setting when there is no state file; with a state file, the previous
+state is restored.")
+
+  (format
+   maybe-string
+   "Force a specific audio format on output. See
+@uref{https://mpd.readthedocs.io/en/latest/user.html#audio-output-format,Global Audio Format}
+for a more detailed description.")
+
+  (tags?
+   (boolean #t)
+   "If set to @code{#f}, then MPD will not send tags to this output. This
+is only useful for output plugins that can receive tags, for example the
+@code{httpd} output plugin.")
+
+  (always-on?
+   (boolean #f)
+   "If set to @code{#t}, then MPD attempts to keep this audio output always
+open. This may be useful for streaming servers, when you don’t want to
+disconnect all listeners even when playback is accidentally stopped.")
+
+  (mixer-type
+   (string "none")
+   "This field accepts a string that specifies which mixer should be used
+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}).")
+
+  (replay-gain-handler
+   maybe-string
+   "This field accepts a string that specifies how
+@uref{https://mpd.readthedocs.io/en/latest/user.html#replay-gain,Replay Gain}
+is to be applied. @code{software} uses an internal software volume control,
+@code{mixer} uses the configured (hardware) mixer control and @code{none}
+disables replay gain on this audio output.")
+
+  (extra-options
+   (alist '())
+   "An association list of option symbols/strings to string values
+to be appended to the audio output configuration.")
+
+  (prefix mpd-))
+
+(define (mpd-serialize-mpd-output field-name value)
+  #~(format #f "audio_output {~%~a}~%"
+            #$(serialize-configuration value mpd-output-fields)))
+
+(define (mpd-serialize-list-of-mpd-plugin-or-output field-name value)
+  (let ((plugins outputs (partition mpd-plugin? value)))
+    #~(string-append #$@(map (cut mpd-serialize-mpd-plugin "audio_output" <>)
+                             plugins)
+                     #$@(map (cut mpd-serialize-mpd-output #f <>) outputs))))
+
+(define list-of-mpd-plugin-or-output?
+  (list-of (lambda (x)
+             (or (mpd-output? x) (mpd-plugin? x)))))
+
+(define-configuration mpd-configuration
+  (package
+   (file-like mpd)
+   "The MPD package."
+   empty-serializer)
+
+  (user
+   (string "mpd")
+   "The user to run mpd as.")
+
+  (group
+   (string "mpd")
+   "The group to run mpd as.")
+
+  (shepherd-requirement
+   (list-of-symbol '())
+   "This is a list of symbols naming Shepherd services that this service
+will depend on."
+   empty-serializer)
+
+  (environment-variables
+   (list-of-string '())
+   "A list of strings specifying environment variables."
+   empty-serializer)
+
+  (log-file
+   (maybe-string "/var/log/mpd/log")
+   "The location of the log file. Set to @code{syslog} to use the
+local syslog daemon or @code{%unset-value} to omit this directive
+from the configuration file.")
+
+  (log-level
+   maybe-string
+   "Supress any messages below this threshold.
+Available values: @code{notice}, @code{info}, @code{verbose},
+@code{warning} and @code{error}.")
+
+  (music-directory
+   maybe-string
+   "The directory to scan for music files.")
+
+  (music-dir ; TODO: deprecated, remove later
+   maybe-string
+   "The directory to scan for music files."
+   mpd-serialize-deprecated-field)
+
+  (playlist-directory
+   maybe-string
+   "The directory to store playlists.")
+
+  (playlist-dir ; TODO: deprecated, remove later
+   maybe-string
+   "The directory to store playlists."
+   mpd-serialize-deprecated-field)
+
+  (db-file
+   maybe-string
+   "The location of the music database.")
+
+  (state-file
+   maybe-string
+   "The location of the file that stores current MPD's state.")
+
+  (sticker-file
+   maybe-string
+   "The location of the sticker database.")
+
+  (default-port
+   (maybe-port 6600)
+   "The default port to run mpd on.")
+
+  (endpoints
+   maybe-list-of-string
+   "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.
+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)
+         "")))
+
+  (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)
+
+  (database
+   maybe-mpd-plugin
+   "MPD database plugin configuration.")
+
+  (partitions
+   (list-of-mpd-partition '())
+   "List of MPD \"partitions\".")
+
+  (neighbors
+   (list-of-mpd-plugin '())
+   "List of MPD neighbor plugin configurations.")
+
+  (inputs
+   (list-of-mpd-plugin '())
+   "List of MPD input plugin configurations."
+   (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)))
+
+  (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") "")))
+
+  (decoders
+   (list-of-mpd-plugin '())
+   "List of MPD decoder plugin configurations."
+   (lambda (_ x)
+     (mpd-serialize-list-of-mpd-plugin "decoder" x)))
+
+  (resampler
+   maybe-mpd-plugin
+   "MPD resampler plugin configuration.")
+
+  (filters
+   (list-of-mpd-plugin '())
+   "List of MPD filter plugin configurations."
+   (lambda (_ x)
+     (mpd-serialize-list-of-mpd-plugin "filter" x)))
+
+  (outputs
+   (list-of-mpd-plugin-or-output (list (mpd-output)))
+   "The audio outputs that MPD can use.
+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)))
+
+  (extra-options
+   (alist '())
+   "An association list of option symbols/strings to string values to be
+appended to the configuration.")
+
+  (prefix mpd-))
+
+(define (mpd-serialize-configuration configuration)
+  (mixed-text-file
+   "mpd.conf"
+   (serialize-configuration configuration mpd-configuration-fields)))
+
+(define (mpd-log-rotation config)
+  (match-record config <mpd-configuration> (log-file)
+    (log-rotation
+     (files (list log-file))
+     (post-rotate #~(begin
+                      (use-modules (gnu services herd))
+                      (with-shepherd-action 'mpd ('reopen) #f))))))
 
 (define (mpd-shepherd-service config)
-  (shepherd-service
-   (documentation "Run the MPD (Music Player Daemon)")
-   (requirement '(user-processes))
-   (provision '(mpd))
-   (start #~(make-forkexec-constructor
-             (list #$(file-append mpd "/bin/mpd")
-                   "--no-daemon"
-                   #$(mpd-config->file config))
-             #:environment-variables
-             ;; Required to detect PulseAudio when run under a user account.
-             (list (string-append
-                    "XDG_RUNTIME_DIR=/run/user/"
-                    (number->string
-                     (passwd:uid
-                      (getpwnam #$(mpd-configuration-user config))))))
-             #:log-file #$(mpd-file-name config "log")))
-   (stop  #~(make-kill-destructor))))
-
-(define (mpd-service-activation config)
-  (with-imported-modules '((guix build utils))
-    #~(begin
-        (use-modules (guix build utils))
-        (define %user
-          (getpw #$(mpd-configuration-user config)))
-
-        (let ((directory #$(mpd-file-name config ".mpd")))
-          (mkdir-p directory)
-          (chown directory (passwd:uid %user) (passwd:gid %user))
-
-          ;; Make /var/run/mpd/USER user-owned as well.
-          (chown (dirname directory)
-                 (passwd:uid %user) (passwd:gid %user))))))
-
-
-(define %mpd-accounts
-  ;; Default account and group for MPD.
-  (list (user-group (name "mpd") (system? #t))
-        (user-account
-         (name "mpd")
-         (group "mpd")
-         (system? #t)
-         (comment "Music Player Daemon (MPD) user")
-
-         ;; Note: /var/run/mpd hosts one sub-directory per user, of which
-         ;; /var/run/mpd/mpd corresponds to the "mpd" user.
-         (home-directory "/var/run/mpd/mpd")
-
-         (shell (file-append shadow "/sbin/nologin")))))
+  (match-record config <mpd-configuration> (user package shepherd-requirement
+                                            log-file playlist-directory
+                                            db-file state-file sticker-file
+                                            environment-variables)
+    (let* ((config-file (mpd-serialize-configuration config)))
+      (shepherd-service
+       (documentation "Run the MPD (Music Player Daemon)")
+       (requirement `(user-processes loopback ,@shepherd-requirement))
+       (provision '(mpd))
+       (start #~(begin
+                  (and=> #$(maybe-value log-file)
+                         (compose mkdir-p dirname))
+
+                  (let ((user (getpw #$user)))
+                    (for-each
+                     (lambda (x)
+                       (when (and x (not (file-exists? x)))
+                         (mkdir-p x)
+                         (chown x (passwd:uid user) (passwd:gid user))))
+                     (list #$(maybe-value playlist-directory)
+                           (and=> #$(maybe-value db-file) dirname)
+                           (and=> #$(maybe-value state-file) dirname)
+                           (and=> #$(maybe-value sticker-file) dirname))))
+
+                  (make-forkexec-constructor
+                   (list #$(file-append package "/bin/mpd")
+                         "--no-daemon"
+                         #$config-file)
+                   #:environment-variables '#$environment-variables)))
+       (stop  #~(make-kill-destructor))
+       (actions
+        (list (shepherd-configuration-action config-file)
+              (shepherd-action
+               (name 'reopen)
+               (documentation "Re-open log files and flush caches.")
+               (procedure
+                #~(lambda (pid)
+                    (if pid
+                        (begin
+                          (kill pid SIGHUP)
+                          (format #t
+                                  "Issued SIGHUP to Service MPD (PID ~a)."
+                                  pid))
+                        (format #t "Service MPD is not running.")))))))))))
+
+(define (mpd-accounts config)
+  (match-record config <mpd-configuration> (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"))))))
 
 (define mpd-service-type
   (service-type
@@ -193,7 +566,242 @@ audio_output {
     (list (service-extension shepherd-root-service-type
                              (compose list mpd-shepherd-service))
           (service-extension account-service-type
-                             (const %mpd-accounts))
-          (service-extension activation-service-type
-                             mpd-service-activation)))
+                             mpd-accounts)
+          (service-extension rottlog-service-type
+                             (compose list mpd-log-rotation))))
    (default-value (mpd-configuration))))
+
+
+;;;
+;;; myMPD
+;;;
+
+(define (string-or-symbol? x)
+  (or (symbol? x) (string? x)))
+
+(define-configuration/no-serialization mympd-ip-acl
+  (allow
+   (list-of-string '())
+   "Allowed IP addresses.")
+
+  (deny
+   (list-of-string '())
+   "Disallowed IP addresses."))
+
+(define-maybe/no-serialization integer)
+(define-maybe/no-serialization mympd-ip-acl)
+
+;; 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
+;; used for command-line arguments or by the service definition.
+(define-configuration/no-serialization mympd-configuration
+  (package
+    (file-like mympd)
+    "The package object of the myMPD server."
+    empty-serializer)
+
+  (shepherd-requirement
+   (list-of-symbol '())
+   "This is a list of symbols naming Shepherd services that this service
+will depend on."
+   empty-serializer)
+
+  (user
+   (string "mympd")
+   "Owner of the @command{mympd} process."
+   empty-serializer)
+
+  (group
+   (string "nogroup")
+   "Owner group of the @command{mympd} process."
+   empty-serializer)
+
+  (work-directory
+   (string "/var/lib/mympd")
+   "Where myMPD will store its data."
+   empty-serializer)
+
+  (cache-directory
+   (string "/var/cache/mympd")
+   "Where myMPD will store its cache."
+   empty-serializer)
+
+  (acl
+   maybe-mympd-ip-acl
+   "ACL to access the myMPD webserver.")
+
+  (covercache-ttl
+   (maybe-integer 31)
+   "How long to keep cached covers, @code{0} disables cover caching.")
+
+  (http?
+   (boolean #t)
+   "HTTP support.")
+
+  (host
+   (string "[::]")
+   "Host name to listen on.")
+
+  (port
+   (maybe-port 80)
+   "HTTP port to listen on.")
+
+  (log-level
+   (integer 5)
+   "How much detail to include in logs, possible values: @code{0} to @code{7}.")
+
+  (log-to
+   (string-or-symbol "/var/log/mympd/log")
+   "Where to send logs. By default, the service logs to
+@file{/var/log/mympd.log}. The alternative is @code{'syslog}, which
+sends output to the running syslog service under the @samp{daemon} facility."
+   empty-serializer)
+
+  (lualibs
+   (maybe-string "all")
+   "See
+@url{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.")
+
+  (uri
+   maybe-string
+   "Override URI to myMPD.
+See @url{https://github.com/jcorporation/myMPD/issues/950}.")
+
+  (script-acl
+   (maybe-mympd-ip-acl (mympd-ip-acl
+                        (allow '("127.0.0.1"))))
+   "ACL to access the myMPD script backend.")
+
+  (ssl?
+   (boolean #f)
+   "SSL/TLS support.")
+
+  (ssl-port
+   (maybe-port 443)
+   "Port to listen for HTTPS.")
+
+  (ssl-cert
+   maybe-string
+   "Path to PEM encoded X.509 SSL/TLS certificate (public key).")
+
+  (ssl-key
+   maybe-string
+   "Path to PEM encoded SSL/TLS private key.")
+
+  (pin-hash
+   maybe-string
+   "SHA-256 hashed pin used by myMPD to control settings access by
+prompting a pin from the user.")
+
+  (save-caches?
+   maybe-boolean
+   "Whether to preserve caches between service restarts."))
+
+(define (mympd-serialize-configuration config)
+  (define serialize-value
+    (match-lambda
+      ((? boolean? val) (if val "true" "false"))
+      ((? integer? val) (number->string val))
+      ((? mympd-ip-acl? val) (ip-acl-serialize-configuration val))
+      ((? string? val) val)))
+
+  (define (ip-acl-serialize-configuration config)
+    (define (serialize-list-of-string 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))) ","))
+
+  ;; myMPD configuration fields are serialized as individual files under
+  ;; <work-directory>/config/.
+  (match-record config <mympd-configuration> (work-directory acl
+                                              covercache-ttl http? host port
+                                              log-level lualibs uri script-acl
+                                              ssl? ssl-port ssl-cert ssl-key
+                                              pin-hash save-caches?)
+    (define (serialize-field filename value)
+      (when (maybe-value-set? value)
+        (list (format #f "~a/config/~a" work-directory filename)
+              (mixed-text-file filename (serialize-value value)))))
+
+    (let ((filename-to-field `(("acl" . ,acl)
+                               ("covercache_keep_days" . ,covercache-ttl)
+                               ("http"                 . ,http?)
+                               ("http_host"            . ,host)
+                               ("http_port"            . ,port)
+                               ("loglevel"             . ,log-level)
+                               ("lualibs"              . ,lualibs)
+                               ("mympd_uri"            . ,uri)
+                               ("scriptacl"            . ,script-acl)
+                               ("ssl"                  . ,ssl?)
+                               ("ssl_port"             . ,ssl-port)
+                               ("ssl_cert"             . ,ssl-cert)
+                               ("ssl_key"              . ,ssl-key)
+                               ("pin_hash"             . ,pin-hash)
+                               ("save_caches"          . ,save-caches?))))
+      (filter list?
+              (generic-serialize-alist list serialize-field
+                                       filename-to-field)))))
+
+(define (mympd-shepherd-service config)
+  (match-record config <mympd-configuration> (package shepherd-requirement
+                                              user work-directory
+                                              cache-directory log-level log-to)
+    (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level)))
+      (shepherd-service
+       (documentation "Run the myMPD daemon.")
+       (requirement `(loopback user-processes ,@shepherd-requirement))
+       (provision '(mympd))
+       (start #~(begin
+                  (let* ((pw (getpwnam #$user))
+                         (uid (passwd:uid pw))
+                         (gid (passwd:gid pw)))
+                    (for-each (lambda (dir)
+                                (mkdir-p dir)
+                                (chown dir uid gid))
+                              (list #$work-directory #$cache-directory)))
+
+                  (make-forkexec-constructor
+                   `(#$(file-append package "/bin/mympd")
+                     "--user" #$user
+                     #$@(if (eqv? log-to 'syslog) '("--syslog") '())
+                     "--workdir" #$work-directory
+                     "--cachedir" #$cache-directory)
+                   #:environment-variables (list #$log-level*)
+                   #:log-file #$(if (string? log-to) log-to #f))))
+       (stop #~(make-kill-destructor))))))
+
+(define (mympd-accounts config)
+  (match-record config <mympd-configuration> (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"))))))
+
+(define (mympd-log-rotation config)
+  (match-record config <mympd-configuration> (log-to)
+    (if (string? log-to)
+        (list (log-rotation
+               (files (list log-to))))
+        '())))
+
+(define mympd-service-type
+  (service-type
+   (name 'mympd)
+   (extensions
+    (list  (service-extension shepherd-root-service-type
+                              (compose list mympd-shepherd-service))
+           (service-extension account-service-type
+                              mympd-accounts)
+           (service-extension special-files-service-type
+                              mympd-serialize-configuration)
+           (service-extension rottlog-service-type
+                              mympd-log-rotation)))
+   (description "Run myMPD, a frontend for MPD. (Music Player Daemon)")
+   (default-value (mympd-configuration))))
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 9e799445d2..7ad1e765bd 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -20,6 +20,7 @@
 ;;; Copyright © 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2022 Justin Veilleux <terramorpha@cock.li>
 ;;; Copyright © 2022 ( <paren@disroot.org>
+;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -64,6 +65,7 @@
                 #:select (coreutils glibc glibc-utf8-locales tar
                           canonical-package))
   #:use-module ((gnu packages compression) #:select (gzip))
+  #:use-module (gnu packages fonts)
   #:autoload   (gnu packages guile-xyz) (guile-netlink)
   #:autoload   (gnu packages hurd) (hurd)
   #:use-module (gnu packages package-management)
@@ -103,6 +105,13 @@
             console-font-service
             virtual-terminal-service-type
 
+            host
+            host?
+            host-address
+            host-canonical-name
+            host-aliases
+            hosts-service-type
+
             static-networking
             static-networking?
             static-networking-addresses
@@ -685,6 +694,72 @@ to add @var{device} to the kernel's entropy pool.  The service will fail if
            (rngd-configuration
             (rng-tools rng-tools)
             (device device))))
+
+;;;
+;;; /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))))
+
+(define-compile-time-procedure (assert-valid-name (name valid-name?))
+  "Ensure @var{name} is likely to be a valid host name."
+  ;; TODO: RFC compliant implementation.
+  (unless (valid-name? name)
+    (raise
+     (make-compound-condition
+      (formatted-message (G_ "host name '~a' contains invalid characters")
+                         name)
+      (condition (&error-location
+                  (location
+                   (source-properties->location procedure-call-location)))))))
+  name)
+
+(define-record-type* <host> %host
+  ;; XXX: Using the record type constructor becomes tiresome when
+  ;; there's multiple records to make.
+  make-host host?
+  (address        host-address)
+  (canonical-name host-canonical-name
+                  (sanitize assert-valid-name))
+  (aliases        host-aliases
+                  (default '())
+                  (sanitize (cut map assert-valid-name <>))))
+
+(define* (host address canonical-name #:optional (aliases '()))
+  "Return a new record for the host at @var{address} with the given
+@var{canonical-name} and possibly @var{aliases}.
+
+@var{address} must be a string denoting a valid IPv4 or IPv6 address, and
+@var{canonical-name} and the strings listed in @var{aliases} must be valid
+host names."
+  (%host
+   (address address)
+   (canonical-name canonical-name)
+   (aliases aliases)))
+
+(define hosts-service-type
+  ;; Extend etc-service-type with a entry for @file{/etc/hosts}.
+  (let* ((serialize-host-record
+          (lambda (record)
+            (match-record record <host> (address canonical-name aliases)
+              (format #f "~a~/~a~{~^~/~a~}~%" address canonical-name aliases))))
+         (host-etc-service
+          (lambda (lst)
+            `(("hosts" ,(plain-file "hosts"
+                                    (format #f "~{~a~}"
+                                            (map serialize-host-record
+                                                 lst))))))))
+    (service-type
+     (name 'etc-hosts)
+     (extensions
+      (list
+       (service-extension etc-service-type
+                          host-etc-service)))
+     (compose concatenate)
+     (extend append)
+     (description "Populate the @file{/etc/hosts} file."))))
 
 
 ;;;
@@ -749,10 +824,11 @@ to add @var{device} to the kernel's entropy pool.  The service will fail if
 of console keymaps with @command{loadkeys}.")))
 
 (define %default-console-font
-  ;; Note: 'LatGrkCyr-8x16' has the advantage of providing three common
-  ;; scripts as well as glyphs for em dash, quotation marks, and other Unicode
-  ;; codepoints notably found in the UTF-8 manual.
-  "LatGrkCyr-8x16")
+  ;; 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
+  ;; 'ungexp-native'.
+  #~(string-append #+font-gnu-unifont:psf
+                   "/share/consolefonts/Unifont-APL8x16.psf.gz"))
 
 (define (console-font-shepherd-services tty+font)
   "Return a list of Shepherd services for each pair in TTY+FONT."
@@ -2502,7 +2578,7 @@ notably to select, copy, and paste text.  The default options use the
                   ;; TODO: Make this configurable.
                   #:environment-variables
                   (list (string-append "XDG_DATA_DIRS="
-                                       #$font-gnu-unifont "/share"))))
+                                       #+font-gnu-unifont "/share"))))
         (stop #~(make-kill-destructor)))))
    (description "Start the @command{kmscon} virtual terminal emulator for the
 Linux @dfn{kernel mode setting} (KMS).")))
@@ -3071,6 +3147,7 @@ to handle."
        (default-session-command (greetd-default-session-command config)))
     (mixed-text-file
      config-file-name
+     "[general]\n"
      "source_profile = " (if source-profile? "true" "false") "\n"
      "[terminal]\n"
      "vt = " terminal-vt "\n"
diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm
index 6b0291dc00..02d1aa1796 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -34,6 +34,7 @@
   #:autoload   (texinfo) (texi-fragment->stexi)
   #:autoload   (texinfo serialize) (stexi->texi)
   #:use-module (ice-9 curried-definitions)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
@@ -370,6 +371,8 @@ DEFAULT."
                      (cond
                       ((package? val)
                        (symbol->string (package->symbol val)))
+                      (((list-of package?) val)
+                       (format #f "(~{~a~^ ~})" (map package->symbol val)))
                       (else (str val))))
 
                    `(entry (% (heading
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index fe1f0fd20a..4724294433 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -3,10 +3,10 @@
 ;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@gmail.com>
-;;; Copyright © 2017, 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2017, 2020, 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2017 Nikita <nikita@n0.is>
 ;;; Copyright © 2018, 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018, 2023 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2017, 2019 Christopher Baines <mail@cbaines.net>
 ;;; Copyright © 2019 Tim Gesthuizen <tim.gesthuizen@yahoo.de>
 ;;; Copyright © 2019 David Wilson <david@daviwil.com>
@@ -59,6 +59,7 @@
   #:use-module (gnu packages xdisorg)
   #:use-module (gnu packages scanner)
   #:use-module (gnu packages suckless)
+  #:use-module (gnu packages sugar)
   #:use-module (gnu packages linux)
   #:use-module (gnu packages libusb)
   #:use-module (gnu packages lxqt)
@@ -73,6 +74,7 @@
   #:use-module (guix utils)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:export (<upower-configuration>
@@ -143,6 +145,10 @@
             lxqt-desktop-configuration?
             lxqt-desktop-service-type
 
+            sugar-desktop-configuration
+            sugar-desktop-configuration?
+            sugar-desktop-service-type
+
             xfce-desktop-configuration
             xfce-desktop-configuration?
             xfce-desktop-service
@@ -183,11 +189,19 @@
 (define (bool value)
   (if value "true\n" "false\n"))
 
-(define (package-direct-input-selector input)
+(define (package-direct-input-selector tree)
+  "Return a procedure that selects TREE from the inputs of PACKAGE.  If TREE
+is a list, it recursively searches it until it locates the last item of TREE."
   (lambda (package)
-    (match (assoc-ref (package-direct-inputs package) input)
-      ((package . _) package))))
-
+    (let loop ((tree (if (pair? tree)
+                         tree
+                         (list tree)))
+               (package package))
+      (if (null? tree)
+          package
+          (loop (cdr tree)
+                (car (assoc-ref (package-direct-inputs package)
+                                (car tree))))))))
 
 
 ;;;
@@ -1339,28 +1353,44 @@ rules.")
 (define-record-type* <gnome-desktop-configuration> gnome-desktop-configuration
   make-gnome-desktop-configuration
   gnome-desktop-configuration?
-  (gnome gnome-package (default gnome)))
+  (gnome gnome-desktop-configuration-gnome
+         (default gnome)))
 
-(define (gnome-packages config packages)
-  "Return the list of GNOME dependencies from CONFIG which names are part of
-the given PACKAGES list."
-  (let ((gnome (gnome-package config)))
-    (map (lambda (name)
-           ((package-direct-input-selector name) gnome))
-         packages)))
+(define (gnome-package gnome name)
+  "Return the package NAME among the GNOME package inputs.  NAME can be a
+single name or a tree-like, e.g. @code{'(\"gnome-boxes\" \"spice-gtk\")} to
+denote the spice-gtk input of the gnome-boxes input of the GNOME meta-package."
+  ((package-direct-input-selector name) gnome))
+
+(define (gnome-packages gnome names)
+  "Return the package NAMES among the GNOME package inputs."
+  (map (cut gnome-package gnome <>) names))
 
 (define (gnome-udev-rules config)
   "Return the list of GNOME dependencies that provide udev rules."
-  (gnome-packages config '("gnome-settings-daemon")))
+  (let ((gnome (gnome-desktop-configuration-gnome config)))
+    (gnome-packages gnome '("gnome-settings-daemon"))))
 
 (define (gnome-polkit-settings config)
   "Return the list of GNOME dependencies that provide polkit actions and
 rules."
-  (gnome-packages config
-                  '("gnome-settings-daemon"
-                    "gnome-control-center"
-                    "gnome-system-monitor"
-                    "gvfs")))
+  (let ((gnome (gnome-desktop-configuration-gnome config)))
+    (gnome-packages gnome
+                    '("gnome-settings-daemon"
+                      "gnome-control-center"
+                      "gnome-system-monitor"
+                      "gvfs"
+                      ;; spice-gtk provides polkit actions for USB redirection
+                      ;; in GNOME Boxes.
+                      ("gnome-boxes" "spice-gtk")))))
+
+(define (gnome-setuid-programs config)
+  "Return the list of GNOME setuid programs."
+  (let* ((gnome (gnome-desktop-configuration-gnome config))
+         (spice-gtk (gnome-package gnome '("gnome-boxes" "spice-gtk"))))
+    (map file-like->setuid-program
+         (list (file-append spice-gtk
+                            "/libexec/spice-client-glib-usb-acl-helper")))))
 
 (define gnome-desktop-service-type
   (service-type
@@ -1370,9 +1400,10 @@ rules."
                              gnome-udev-rules)
           (service-extension polkit-service-type
                              gnome-polkit-settings)
+          (service-extension setuid-program-service-type
+                             gnome-setuid-programs)
           (service-extension profile-service-type
-                             (compose list
-                                      gnome-package))))
+                             (compose list gnome-desktop-configuration-gnome))))
    (default-value (gnome-desktop-configuration))
    (description "Run the GNOME desktop environment.")))
 
@@ -1493,6 +1524,38 @@ rules."
 
 
 ;;;
+;;; Sugar desktop service.
+;;;
+
+(define-record-type* <sugar-desktop-configuration> sugar-desktop-configuration
+  make-sugar-desktop-configuration
+  sugar-desktop-configuration?
+  (sugar sugar-package (default sugar))
+  (gobject-introspection
+   sugar-gobject-introspection (default gobject-introspection))
+  (activities
+   sugar-activities (default (list sugar-help-activity))))
+
+(define (sugar-polkit-settings config)
+  "Return the list of packages that provide polkit actions and rules."
+  (list (sugar-package config)))
+
+(define sugar-desktop-service-type
+  (service-type
+   (name 'sugar-desktop)
+   (extensions
+    (list (service-extension polkit-service-type
+                             sugar-polkit-settings)
+          (service-extension profile-service-type
+                             (lambda (config)
+                               (cons* (sugar-package config)
+                                      (sugar-gobject-introspection config)
+                                      (sugar-activities config))))))
+   (default-value (sugar-desktop-configuration))
+   (description "Run the Sugar desktop environment.")))
+
+
+;;;
 ;;; X11 socket directory service
 ;;;
 
diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm
index 65bf0b5a7f..2dfedc553e 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -126,7 +126,18 @@
             nar-herder-configuration-storage
             nar-herder-configuration-storage-limit
             nar-herder-configuration-storage-nar-removal-criteria
-            nar-herder-configuration-log-level))
+            nar-herder-configuration-log-level
+            nar-herder-configuration-cached-compressions
+            nar-herder-configuration-cached-compression-min-uses
+            nar-herder-configuration-cached-compression-workers
+            nar-herder-configuration-cached-compression-nar-source
+
+            nar-herder-cached-compression-configuration
+            nar-herder-cached-compression-configuration?
+            nar-herder-cached-compression-configuration-type
+            nar-herder-cached-compression-configuration-level
+            nar-herder-cached-compression-configuration-directory
+            nar-herder-cached-compression-configuration-directory-max-size))
 
 ;;;; Commentary:
 ;;;
@@ -828,17 +839,67 @@ ca-certificates.crt file in the system profile."
   (negative-ttl  nar-herder-configuration-negative-ttl
                  (default #f))
   (log-level     nar-herder-configuration-log-level
-                 (default 'DEBUG)))
+                 (default 'DEBUG))
+  (cached-compressions
+   nar-herder-configuration-cached-compressions
+   (default '()))
+  (cached-compression-min-uses
+   nar-herder-configuration-cached-compression-min-uses
+   (default 3))
+  (cached-compression-workers
+   nar-herder-configuration-cached-compression-workers
+   (default 2))
+  (cached-compression-nar-source
+   nar-herder-configuration-cached-compression-nar-source
+   (default #f)))
 
+(define-record-type* <nar-herder-cached-compression-configuration>
+  nar-herder-cached-compression-configuration
+  make-nar-herder-cached-compression-configuration
+  nar-herder-cached-compression-configuration?
+  (type                nar-herder-cached-compression-configuration-type)
+  (level               nar-herder-cached-compression-configuration-level
+                       (default #f))
+  (directory           nar-herder-cached-compression-configuration-directory
+                       (default #f))
+  (directory-max-size
+   nar-herder-cached-compression-configuration-directory-max-size
+   (default #f)))
 
 (define (nar-herder-shepherd-services config)
+  (define (cached-compression-configuration->options cached-compression)
+    (match-record
+        cached-compression
+        <nar-herder-cached-compression-configuration>
+      (type level directory directory-max-size)
+
+      `(,(simple-format #f "--enable-cached-compression=~A~A"
+                        type
+                        (if level
+                            (simple-format #f ":~A" level)
+                            ""))
+        ,@(if directory
+              (list
+               (simple-format #f "--cached-compression-directory=~A=~A"
+                              type
+                              directory))
+              '())
+        ,@(if directory-max-size
+              (list
+               (simple-format #f "--cached-compression-directory-max-size=~A=~A"
+                              type
+                              directory-max-size))
+              '()))))
+
   (match-record config <nar-herder-configuration>
     (package user group
              mirror
              database database-dump
              host port
              storage storage-limit storage-nar-removal-criteria
-             ttl negative-ttl log-level)
+             ttl negative-ttl log-level
+             cached-compressions cached-compression-min-uses
+             cached-compression-workers cached-compression-nar-source)
 
     (unless (or mirror storage)
       (error "nar-herder: mirror or storage must be set"))
@@ -882,6 +943,24 @@ ca-certificates.crt file in the system profile."
                              '())
                       #$@(if log-level
                              (list (simple-format #f "--log-level=~A" log-level))
+                             '())
+                      #$@(append-map
+                          cached-compression-configuration->options
+                          cached-compressions)
+                      #$@(if cached-compression-min-uses
+                             (list (simple-format
+                                    #f "--cached-compression-min-uses=~A"
+                                    cached-compression-min-uses))
+                             '())
+                      #$@(if cached-compression-workers
+                             (list (simple-format
+                                    #f "--cached-compression-workers=~A"
+                                    cached-compression-workers))
+                             '())
+                      #$@(if cached-compression-nar-source
+                             (list (simple-format
+                                    #f "--cached-compression-nar-source=~A"
+                                    cached-compression-nar-source))
                              '()))
                 #:user #$user
                 #:group #$group
diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm
index 7e3864fec2..0b9094cda1 100644
--- a/gnu/services/lightdm.scm
+++ b/gnu/services/lightdm.scm
@@ -151,7 +151,7 @@ icon themes."
    "The name of the cursor theme to use.")
   (cursor-theme-size
    (number 16)
-   "The size to use for the the cursor theme.")
+   "The size to use for the cursor theme.")
   (allow-debugging?
    maybe-boolean
    "Set to #t to enable debug log level.")
diff --git a/gnu/services/monitoring.scm b/gnu/services/monitoring.scm
index 44e2e8886c..bbf8b10f8b 100644
--- a/gnu/services/monitoring.scm
+++ b/gnu/services/monitoring.scm
@@ -662,9 +662,11 @@ $DB['PASSWORD'] = " (let ((file (location-file %location))
                               (string-append "trim(file_get_contents('"
                                              db-secret-file "'));\n"))
                           (begin
-                            (display-hint (format #f (G_ "~a:~a:~a: ~a:
+                            (display-hint (G_ "~a:~a:~a: ~a:
 Consider using @code{db-secret-file} instead of @code{db-password} for better
-security.") file line column 'zabbix-front-end-configuration))
+security.")
+                                          file line column
+                                          'zabbix-front-end-configuration)
                             (format #f "'~a';~%" db-password))))
                      "
 // Schema name. Used for IBM DB2 and PostgreSQL.
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 89ce16f6af..dacf64c2d1 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -20,6 +20,7 @@
 ;;; Copyright © 2021 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2022, 2023 Andrew Tropin <andrew@trop.in>
 ;;; Copyright © 2023 Declan Tsien <declantsien@riseup.net>
+;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -80,7 +81,9 @@
   #:use-module (json)
   #:re-export (static-networking-service
                static-networking-service-type)
-  #:export (%facebook-host-aliases
+  #:export (%facebook-host-aliases ;deprecated
+            block-facebook-hosts-service-type
+
             dhcp-client-service-type
             dhcp-client-configuration
             dhcp-client-configuration?
@@ -235,39 +238,36 @@
 ;;;
 ;;; Code:
 
-(define %facebook-host-aliases
+(define facebook-host-aliases
   ;; This is the list of known Facebook hosts to be added to /etc/hosts if you
   ;; are to block it.
-  "\
-# Block Facebook IPv4.
-127.0.0.1   www.facebook.com
-127.0.0.1   facebook.com
-127.0.0.1   login.facebook.com
-127.0.0.1   www.login.facebook.com
-127.0.0.1   fbcdn.net
-127.0.0.1   www.fbcdn.net
-127.0.0.1   fbcdn.com
-127.0.0.1   www.fbcdn.com
-127.0.0.1   static.ak.fbcdn.net
-127.0.0.1   static.ak.connect.facebook.com
-127.0.0.1   connect.facebook.net
-127.0.0.1   www.connect.facebook.net
-127.0.0.1   apps.facebook.com
-
-# Block Facebook IPv6.
-fe80::1%lo0 facebook.com
-fe80::1%lo0 login.facebook.com
-fe80::1%lo0 www.login.facebook.com
-fe80::1%lo0 fbcdn.net
-fe80::1%lo0 www.fbcdn.net
-fe80::1%lo0 fbcdn.com
-fe80::1%lo0 www.fbcdn.com
-fe80::1%lo0 static.ak.fbcdn.net
-fe80::1%lo0 static.ak.connect.facebook.com
-fe80::1%lo0 connect.facebook.net
-fe80::1%lo0 www.connect.facebook.net
-fe80::1%lo0 apps.facebook.com\n")
-
+  (let ((domains '("facebook.com" "www.facebook.com"
+                   "login.facebook.com" "www.login.facebook.com"
+                   "fbcdn.net" "www.fbcdn.net" "fbcdn.com" "www.fbcdn.com"
+                   "static.ak.fbcdn.net" "static.ak.connect.facebook.com"
+                   "connect.facebook.net" "www.connect.facebook.net"
+                   "apps.facebook.com")))
+    (append-map (lambda (name)
+                  (map (lambda (addr)
+                         (host addr name))
+                       (list "127.0.0.1" "::1"))) domains)))
+
+(define-deprecated %facebook-host-aliases
+  block-facebook-hosts-service-type
+  (string-join
+   (map (lambda (x)
+          (string-append (host-address x) "\t"
+                         (host-canonical-name x) "\n"))
+        facebook-host-aliases)))
+
+(define block-facebook-hosts-service-type
+  (service-type
+   (name 'block-facebook-hosts)
+   (extensions
+    (list (service-extension hosts-service-type
+                             (const facebook-host-aliases))))
+   (default-value #f)
+   (description "Add a list of known Facebook hosts to @file{/etc/hosts}")))
 
 (define-record-type* <dhcp-client-configuration>
   dhcp-client-configuration make-dhcp-client-configuration
diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm
index b66c7a8563..23ccb8d403 100644
--- a/gnu/services/telephony.scm
+++ b/gnu/services/telephony.scm
@@ -267,7 +267,7 @@ consistent state."))
 CONFIG, a <jami-configuration> object."
   (match-record config <jami-configuration>
     (libjami dbus enable-logging? debug? auto-answer?)
-    `(,(file-append libjami "/libexec/jamid")
+    `(,#~(string-append #$libjami:bin "/libexec/jamid")
       "--persistent"                    ;stay alive after client quits
       ,@(if enable-logging?
             '()                         ;logs go to syslog by default
@@ -524,7 +524,8 @@ argument, either a registered username or the fingerprint of the account.")
                    #:environment-variables
                    ;; This is so that the cx.ring.Ring service D-Bus
                    ;; definition is found by dbus-daemon.
-                   (list (string-append "XDG_DATA_DIRS=" #$libjami "/share"))))
+                   (list (string-append "XDG_DATA_DIRS="
+                                        #$libjami:bin "/share"))))
                (stop #~(make-kill-destructor)))
 
               (shepherd-service
@@ -595,7 +596,8 @@ argument, either a registered username or the fingerprint of the account.")
                     ;; Start the daemon.
                     (define daemon-pid
                       ((make-forkexec-constructor/container
-                        '#$(jami-configuration->command-line-arguments config)
+                        (list #$@(jami-configuration->command-line-arguments
+                                  config))
                         #:mappings
                         (list (file-system-mapping
                                (source "/dev/log") ;for syslog