Subject: [WIP v2] services: root-file-system: In 'stop' method, find and kill processes that are writing to our filesystems, and then umount the filesystems.

From: Danny Milosavljevic <[email-masked]>
Date: Fri, 25 Apr 2025 19:58:40 +0200

* gnu/services/base.scm (%root-file-system-shepherd-service): In 'stop'
method, find and kill processes that are writing to our filesystems, and then
umount the filesystems.

Change-Id: I358eb6d131e74018be939075ebf226a2d5457bfb
---
 gnu/services/base.scm | 2844 +++++++++++++++++++++++------------------
 1 file changed, 1610 insertions(+), 1234 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 8c6563c99d..23b9181b51 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -61,15 +61,15 @@ (define-module (gnu services base)
   #:use-module (gnu packages admin)
   #:use-module ((gnu packages linux)
                 #:select (alsa-utils btrfs-progs crda eudev
-                          e2fsprogs f2fs-tools fuse gpm kbd lvm2 rng-tools
-                          util-linux xfsprogs))
+                                     e2fsprogs f2fs-tools fuse gpm kbd lvm2 rng-tools
+                                     util-linux xfsprogs))
   #:use-module (gnu packages bash)
   #:use-module ((gnu packages base)
                 #:select (coreutils glibc glibc/hurd
-                          glibc-utf8-locales
-                          libc-utf8-locales-for-target
-                          make-glibc-utf8-locales
-                          tar canonical-package))
+                                    glibc-utf8-locales
+                                    libc-utf8-locales-for-target
+                                    make-glibc-utf8-locales
+                                    tar canonical-package))
   #:use-module ((gnu packages cross-base)
                 #:select (cross-libc))
   #:use-module ((gnu packages compression) #:select (gzip))
@@ -346,12 +346,360 @@ (define %root-file-system-shepherd-service
   (shepherd-service
    (documentation "Take care of the root file system.")
    (provision '(root-file-system))
+   ;; Is it possible to have (gnu build linux-boot) loaded already?
+   ;; In that case, I'd like to move a lot of stuff there.
+   (modules '((ice-9 textual-ports)
+              (ice-9 control)
+              (ice-9 string-fun)
+              (ice-9 match)
+              (ice-9 ftw) ; scandir
+              (srfi srfi-1)        ; filter, for-each, find.
+              (srfi srfi-26)       ; cut
+              (ice-9 exceptions))) ; guard
    (start #~(const #t))
    (stop #~(lambda _
-             ;; Return #f if successfully stopped.
+             ;;; Return #f if successfully stopped.
+
+             ;;; Beginning of inlined module (fuser)
+
+             (define log (make-parameter (lambda args
+                                           (apply format (current-error-port) args))))
+             (define PROC-DIR-NAME "/proc")
+             (define DEFAULT-SILENT-ERRORS
+               (list ENOENT ESRCH))
+
+             (define* (call-with-safe-syscall thunk
+                                              #:key
+                                              (on-error #f)
+                                              (silent-errors DEFAULT-SILENT-ERRORS)
+                                              (error-message-format #f)
+                                              (error-context '()))
+               "Call THUNK, handling system errors:
+- If ERROR-MESSAGE-FORMAT and the error is not in SILENT-ERRORS, calls format
+with ERROR-MESSAGE-FORMAT and ERROR-CONTEXT and (strerror errno) as arguments.
+- Return ON-ERROR on error."
+               (catch 'system-error
+                      thunk
+                      (lambda args
+                        (let ((errno (system-error-errno args)))
+                          (unless (member errno silent-errors)
+                            (when error-message-format
+                              (apply format
+                                     (current-error-port)
+                                     error-message-format
+                                     (append
+                                      error-context
+                                      (list (strerror errno))))))
+                          on-error))))
+
+             (define (safe-stat path)
+               "Get stat info for PATH--or #f if not possible."
+               (call-with-safe-syscall (lambda () (stat path))
+                                       #:error-message-format "Error: Cannot stat ~s: ~a~%"
+                                       #:error-context (list path)
+                                       #:silent-errors '()
+                                       #:on-error #f))
+
+             (define (safe-umount path)
+               "Umount PATH--if possible.."
+               (call-with-safe-syscall (lambda () (umount path))
+                                       #:error-message-format "Error: Cannot umount ~s: ~a~%"
+                                       #:error-context (list path)
+                                       #:silent-errors '()
+                                       #:on-error 'error))
+
+             (define (safe-lstat path)
+               "Get lstat info for PATH--or #f if not possible."
+               (call-with-safe-syscall (lambda () (lstat path))
+                                       #:error-message-format "Error: Cannot lstat ~s: ~a~%"
+                                       #:error-context (list path)
+                                       #:on-error #f))
+
+             (define (safe-scandir path)
+               "scandir PATH--or #f if not possible."
+               (let ((result (scandir path)))
+                 (if result
+                     result
+                     (begin
+                       ((log) "Error: Cannot scandir ~s: ?~%" path)
+                       '()))))
+
+;;; Processes
+
+             (define (safe-get-fd-flags pid fd)
+               "Get flags for FD in PID--or #f if not possible."
+               (let ((fdinfo-path (format #f "~a/~a/fdinfo/~a" PROC-DIR-NAME pid fd)))
+                 (call-with-safe-syscall (lambda ()
+                                           (call-with-input-file fdinfo-path
+                                             (lambda (port)
+                                               ;; Find 'flags:' line and parse octal value
+                                               (let loop ()
+                                                 (let ((line (get-line port)))
+                                                   (cond ((eof-object? line) #f)
+                                                         ((string-prefix? "flags:\t" line)
+                                                          (match (string-split line #\tab)
+                                                            ((_ flags-str)
+                                                             (catch 'invalid-argument
+                                                                    (lambda ()
+                                                                      (string->number flags-str 8))
+                                                                    (lambda args
+                                                                      #f)))
+                                                            (_ #f)))
+                                                         (else (loop))))))))
+                                         #:error-message-format "Error: Cannot read ~s: ~a~%"
+                                         #:error-context (list fdinfo-path)
+                                         #:on-error #f)))
+
+             (define (safe-get-processes)
+               "Get a list of all PIDs from proc--or #f if not possible."
+               (let ((proc-dir PROC-DIR-NAME))
+                 (catch 'system-error
+                        (lambda ()
+                          ;; Keep only numbers.
+                          (filter-map string->number (safe-scandir proc-dir)))
+                        ;; FIXME is errno even useful?
+                        (lambda scan-err
+                          ((log) "Error scanning ~s: ~a~%"
+                           proc-dir (strerror (system-error-errno scan-err)))
+                          '()))))
+
+             (define (safe-fd-on-device? pid fd target-device)
+               "Return whether fd FD on pid PID is on device TARGET-DEVICE."
+               (let* ((fd-path (readlink (format #f "~a/~a/fd/~a" PROC-DIR-NAME pid fd)))
+                      (stat (safe-lstat fd-path)))
+                 (and stat (eqv? (stat:dev stat)
+                                 target-device))))
+
+             (define (safe-get-process-fds pid)
+               "Get a list of all FDs of PID from proc--or #f if not possible."
+               (let ((fd-dir (format #f "~a/~a/fd" PROC-DIR-NAME pid)))
+                 ;; Keep only numbers.
+                 (filter-map string->number (safe-scandir fd-dir))))
+
+             (define (filter-process-fd-flags pid fds predicate)
+               "Get FLAGS from proc for PID and call PREDICATE with (FD FLAGS) each."
+               (filter (lambda (fd)
+                         (predicate fd (safe-get-fd-flags pid fd)))
+                       fds))
+
+             (define (safe-get-process-command pid)
+               "Return command of process PID--or #f if not possible."
+               (let ((cmdline-path (format #f "~a/~a/cmdline" PROC-DIR-NAME pid)))
+                 (call-with-safe-syscall (lambda ()
+                                           (call-with-input-file cmdline-path
+                                             (lambda (port)
+                                               (let ((full-cmdline (get-string-all port)))
+                                                 (match (string-split full-cmdline #\nul)
+                                                   ((command-name . _) command-name))))))
+                                         #:error-message-format "Error: Cannot read ~s: ~a~%"
+                                         #:error-context (list cmdline-path)
+                                         #:on-error #f)))
+
+             (define (safe-kill-process pid kill-signal)
+               "Kill process PID with KILL-SIGNAL if possible."
+               (call-with-safe-syscall (lambda ()
+                                         (kill pid kill-signal)
+                                         #t)
+                                       #:on-error 'error
+                                       #:silent-errors '()
+                                       #:error-message-format
+                                       "Error: Failed to kill process ~a: ~a~%"
+                                       #:error-context '()))
+
+;;; Mounts
+
+             (define (safe-get-device mount-point)
+               "Get the device ID (st_dev) of MOUNT-POINT--or #f if not possible."
+               (and=>
+                (safe-stat mount-point)
+                stat:dev))
+
+             (define (safe-parse-mountinfo path)
+               "Read and parse /proc/self/mountinfo (or specified path).
+Return a list of parsed entries, where each entry is:
+(list mount-id parent-id mount-point-string)
+Return '() on file read error or if file is unparseable."
+               (call-with-safe-syscall ; TODO: call-with-input-file is not actually a syscall.
+                (lambda ()
+                  (let ((entries '()))
+                    (call-with-input-file path
+                      (lambda (port)
+                        (let loop ()
+                          (let ((line (get-line port)))
+                            (unless (eof-object? line)
+                              (match (string-split line #\space)
+                                ;;       mnt_id par_id major:minor root mount_point ...
+                                ((m-id-str p-id-str _ _ mp . _)
+                                 ;; Attempt to parse IDs, skip line on error
+                                 (catch 'invalid-argument
+                                        (lambda ()
+                                          (let ((mount-id (string->number m-id-str))
+                                                (parent-id (string->number p-id-str)))
+                                            ;; Add successfully parsed entry to list
+                                            (set! entries (cons (list mount-id parent-id mp)
+                                                                entries))
+                                            (loop))) ; Continue to next line
+                                        (lambda args
+                                          ((log)
+                                           "Warning: Skipping mountinfo line due to parse error: ~s (~a)~%"
+                                           line args)
+                                          (loop))))
+                                (_ (loop))))))))
+                    ;; Return parsed entries in file order
+                    (reverse entries)))
+                #:error-message-format "Error: Cannot read or parse mountinfo file ~s: ~a"
+                #:error-context (list path)
+                #:on-error '()))
+
+             (define (safe-find-nested-mounts root-mount-point target-device)
+               "Find mount points that block the unmounting of ROOT-MOUNT-POINT.
+TARGET-DEVICE argument is ignored.
+Mountpoints are returned depth-first (in the order they can be unmounted).
+ROOT-MOUNT-POINT is included."
+               (let* ((mountinfo (safe-parse-mountinfo (format #f "~a/self/mountinfo" PROC-DIR-NAME))))
+                 (define (safe-find-mounts-via-mountinfo accumulator lives root-mount-point)
+                   (if (member root-mount-point accumulator)
+                       ((log) "Cycle detected~%"))
+                   (let ((accumulator (cons root-mount-point accumulator)))
+                     (if (= lives 0)
+                         (begin
+                           ((log) "Error: Recursive mountpoints too deep.~%")
+                           accumulator)
+                         (let ((root-entry (find (lambda (entry)
+                                                   (match entry
+                                                     ((_ _ mp) (string=? mp root-mount-point))
+                                                     (_ #f))) ; Should not happen
+                                                 mountinfo)))
+                           (if root-entry
+                               (let ((root-mount-id (car root-entry)))
+                                 (fold (lambda (entry accumulator)
+                                         (match entry
+                                           ((_ parent-id mp)
+                                            (if (= parent-id root-mount-id)
+                                                (safe-find-mounts-via-mountinfo accumulator
+                                                                                (- lives 1)
+                                                                                mp)
+                                                accumulator))
+                                           (_ accumulator)))
+                                       accumulator
+                                       mountinfo))
+                               (begin
+                                 ((log) "Error: Could not find mount ID for ~s in parsed mountinfo~%"
+                                  root-mount-point)
+                                 accumulator))))))
+                 (safe-find-mounts-via-mountinfo '() 100 root-mount-point)))
+
+             ;;; End of inlined module (fuser)
+
+             (define MOUNT-POINT "/")
+
+             (define O_ACCMODE #o0003)
+
+             (define (flags-has-write-access? flags)
+               "Given open FLAGS, return whether it (probably) signifies write access."
+               (and flags (not (= (logand flags O_ACCMODE)
+                                  O_RDONLY))))
+
+             (define (ask-to-kill? pid command)
+               "Ask whether to kill process with id PID (and command COMMAND)"
+               ((log) "~%Process Found: PID ~a  Command: ~s~%" pid command)
+               ((log) "Kill process ~a? [y/N] " pid)
+               (force-output (current-error-port))
+               (let ((response (read-char (current-input-port))))
+                 (if (not (eof-object? response))
+                     ;; Consume rest of line.
+                     (read-line (current-input-port)))
+                 (or (eqv? response #\y)
+                     (eqv? response #\Y))))
+
              (sync)
 
-             (let ((null (%make-void-port "w")))
+             (let* ((null (%make-void-port "w"))
+                    (call-with-io-file (lambda (file-name proc)
+                                         (let ((port (open file-name O_RDWR)))
+                                           (set-current-input-port port)
+                                           (set-current-output-port port)
+                                           (set-current-error-port port)
+                                           (catch #t (lambda ()
+                                                       (proc)
+                                                       (set-current-input-port null)
+                                                       (set-current-output-port null)
+                                                       (set-current-error-port null)
+                                                       (close port))
+                                                  (lambda args
+                                                    (set-current-input-port null)
+                                                    (set-current-output-port null)
+                                                    (set-current-error-port null)
+                                                    (close port)))))))
+               (let-syntax ((with-mounted-filesystem (syntax-rules ()
+                                               ((_ source mountpoint file-system-type options exp ...)
+                                                (call-with-mounted-filesystem source mountpoint file-system-type options
+                                                                              (lambda () (begin exp ...)))))))
+
+               (define (call-with-logging thunk)
+                 (with-mounted-filesystem "none" "/proc" "proc" 0
+                   (with-mounted-filesystem "none" "/dev" "devtmpfs" 0
+                     (catch 'system-error
+                       (lambda ()
+                         (mknod "/dev/tty" 'char-special #o600 (+ (* 5 256) 0)))
+                         (const #f))
+                     ;; we don't have chvt :(
+                     ;; (it would need to use %ioctl fd VT_ACTIVATE int on /dev/tty)
+                     ;(chvt 12)
+                     (call-with-io-file "/dev/tty" thunk))))
+
+               (define (get-clean-ups)
+                 ;; We rarely (or ever) log--and if we did have a logger
+                 ;; at all times, we'd show up on our own shitlist.
+                 ;; So: open logger, log, close logger--on every message.
+                 (parameterize ((log (lambda args
+                                       (call-with-logging
+                                        (lambda ()
+                                          (format (current-error-port) args))))))
+                   (let* ((root-device (safe-get-device MOUNT-POINT))
+                          (mounts (safe-find-nested-mounts MOUNT-POINT root-device))
+                          (mount-devices (map safe-get-device mounts)))
+                     (let* ((our-pid (getpid))
+                            (pids (filter (lambda (pid)
+                                            (not (= pid our-pid)))
+                                          (safe-get-processes)))
+                            (pids (filter (lambda (pid)
+                                            (match (filter-process-fd-flags pid
+                                                    (safe-get-process-fds pid)
+                                                    (lambda (fd flags)
+                                                      (and (flags-has-write-access? flags)
+                                                           (find (lambda (target-device)
+                                                                   (safe-fd-on-device? pid fd target-device))
+                                                                 mount-devices))))
+                                              ((x . _) #t)
+                                              (_ #f)))
+                                          pids)))
+                       (list pids mounts mount-devices)))))
+
+               (define (call-with-mounted-filesystem source mountpoint file-system-type options proc)
+                 (mount source mountpoint file-system-type options #:update-mtab? #f)
+                 (catch #t
+                        (lambda ()
+                          (proc)
+                          (umount mountpoint))
+                        (lambda args
+                          (umount mountpoint))))
+
+               ;; This will take care of setting up a logger for the entire runtime of the function.
+               (define (kill-processes pids mounts mount-devices signal)
+                 (call-with-logging
+                  (lambda ()
+                    (let ((error-port (current-error-port)))
+                      ((log) "Searched for processes writing on devices ~s (mount points ~s)...~%" mount-devices mounts)
+                      (format error-port "Found ~a process(es) matching the criteria.~%" (length pids))
+                      (for-each (lambda (pid)
+                                  (let ((command (safe-get-process-command pid)))
+                                    (if (ask-to-kill? pid command)
+                                        (safe-kill-process pid signal)
+                                        (format error-port "Skipping PID ~a (~s).~%" pid command))))
+                                pids)
+                      (format error-port "~%Process scan complete.~%")))))
+               
                ;; Redirect the default output ports.
                (set-current-output-port null)
                (set-current-error-port null)
@@ -363,18 +711,46 @@ (define %root-file-system-shepherd-service
                ;; root file system can be re-mounted read-only.
                (let loop ((n 10))
                  (unless (catch 'system-error
-                           (lambda ()
-                             (mount #f "/" #f
-                                    (logior MS_REMOUNT MS_RDONLY)
-                                    #:update-mtab? #f)
-                             #t)
-                           (const #f))
+                                (lambda ()
+                                  (mount #f "/" #f
+                                         (logior MS_REMOUNT MS_RDONLY)
+                                         #:update-mtab? #f)
+                                  #t)
+                                (const #f))
+                   (when (zero? n)
+                     ;; 1. Send SIGTERM to all writing processes (if any)
+                     (match (get-clean-ups)
+                       ((pids mounts mount-devices)
+                        (when (> (length pids) 0)
+                          (kill-processes pids mounts mount-devices SIGTERM)
+                          ((@ (fibers) sleep) 5))))
+
+                     ;; 2. Send SIGKILL to all writing processes
+                     (match (get-clean-ups)
+                       ((pids mounts mount-devices)
+                        (when (> (length pids) 0)
+                          (kill-processes pids mounts mount-devices SIGKILL)
+                          ((@ (fibers) sleep) 5))
+
+                        ;; 3. Unmount filesystems
+                        (for-each safe-umount mounts)))
+
+                     ;; Should have been unmounted already--but we are paranoid
+                     ;; (and possibly were blocking ourselves anyway).
+                     (catch 'system-error
+                            (lambda ()
+                              (mount #f "/" #f
+                                     (logior MS_REMOUNT MS_RDONLY)
+                                     #:update-mtab? #f)
+                              #t)
+                            (const #f))
+                     ((@ (fibers) sleep) 10))
                    (unless (zero? n)
                      ;; Yield to the other fibers.  That gives logging fibers
                      ;; an opportunity to close log files so the 'mount' call
                      ;; doesn't fail with EBUSY.
                      ((@ (fibers) sleep) 1)
-                     (loop (- n 1)))))
+                     (loop (- n 1))))))
 
                #f)))
    (respawn? #f)))
@@ -425,57 +801,57 @@ (define (file-system-shepherd-service file-system)
     (and (or mount? create?)
          (with-imported-modules (source-module-closure
                                  '((gnu build file-systems)))
-           (shepherd-service
-            (provision (list (file-system->shepherd-service-name file-system)))
-            (requirement `(root-file-system
-                           udev
-                           ,@(map dependency->shepherd-service-name dependencies)
-                           ,@requirements))
-            (documentation "Check, mount, and unmount the given file system.")
-            (start #~(lambda args
-                       #$(if create?
-                             #~(mkdir-p #$target)
-                             #t)
+                                (shepherd-service
+                                 (provision (list (file-system->shepherd-service-name file-system)))
+                                 (requirement `(root-file-system
+                                                udev
+                                                ,@(map dependency->shepherd-service-name dependencies)
+                                                ,@requirements))
+                                 (documentation "Check, mount, and unmount the given file system.")
+                                 (start #~(lambda args
+                                            #$(if create?
+                                                  #~(mkdir-p #$target)
+                                                  #t)
 
-                       #$(if mount?
-                             #~(let (($PATH (getenv "PATH")))
-                                 ;; Make sure fsck.ext2 & co. can be found.
-                                 (dynamic-wind
-                                   (lambda ()
-                                     ;; Don’t display the PATH settings.
-                                     (with-output-to-port (%make-void-port "w")
-                                       (lambda ()
-                                         (set-path-environment-variable "PATH"
-                                                                        '("bin" "sbin")
-                                                                        '#$packages))))
-                                   (lambda ()
-                                     (mount-file-system
-                                      (spec->file-system
-                                       '#$(file-system->spec file-system))
-                                      #:root "/"))
-                                   (lambda ()
-                                     (setenv "PATH" $PATH))))
-                             #t)
-                       #t))
-            (stop #~(lambda args
-                      ;; Normally there are no processes left at this point, so
-                      ;; TARGET can be safely unmounted.
+                                            #$(if mount?
+                                                  #~(let (($PATH (getenv "PATH")))
+                                                      ;; Make sure fsck.ext2 & co. can be found.
+                                                      (dynamic-wind
+                                                          (lambda ()
+                                                            ;; Don’t display the PATH settings.
+                                                            (with-output-to-port (%make-void-port "w")
+                                                              (lambda ()
+                                                                (set-path-environment-variable "PATH"
+                                                                                               '("bin" "sbin")
+                                                                                               '#$packages))))
+                                                          (lambda ()
+                                                            (mount-file-system
+                                                             (spec->file-system
+                                                              '#$(file-system->spec file-system))
+                                                             #:root "/"))
+                                                          (lambda ()
+                                                            (setenv "PATH" $PATH))))
+                                                  #t)
+                                            #t))
+                                 (stop #~(lambda args
+                                           ;; Normally there are no processes left at this point, so
+                                           ;; TARGET can be safely unmounted.
 
-                      ;; Make sure PID 1 doesn't keep TARGET busy.
-                      (chdir "/")
+                                           ;; Make sure PID 1 doesn't keep TARGET busy.
+                                           (chdir "/")
 
-                      #$(if (file-system-mount-may-fail? file-system)
-                            #~(catch 'system-error
-                                (lambda () (umount #$target))
-                                (const #f))
-                            #~(umount #$target))
-                      #f))
+                                           #$(if (file-system-mount-may-fail? file-system)
+                                                 #~(catch 'system-error
+                                                          (lambda () (umount #$target))
+                                                          (const #f))
+                                                 #~(umount #$target))
+                                           #f))
 
-            ;; We need additional modules.
-            (modules `(((gnu build file-systems)
-                        #:select (mount-file-system))
-                       (gnu system file-systems)
-                       ,@%default-modules)))))))
+                                 ;; We need additional modules.
+                                 (modules `(((gnu build file-systems)
+                                             #:select (mount-file-system))
+                                            (gnu system file-systems)
+                                            ,@%default-modules)))))))
 
 (define (file-system-shepherd-services file-systems)
   "Return the list of Shepherd services for FILE-SYSTEMS."
@@ -523,12 +899,12 @@ (define (file-system-shepherd-services file-systems)
                  (for-each (lambda (mount-point)
                              (format #t "unmounting '~a'...~%" mount-point)
                              (catch 'system-error
-                               (lambda ()
-                                 (umount mount-point))
-                               (lambda args
-                                 (let ((errno (system-error-errno args)))
-                                   (format #t "failed to unmount '~a': ~a~%"
-                                           mount-point (strerror errno))))))
+                                    (lambda ()
+                                      (umount mount-point))
+                                    (lambda args
+                                      (let ((errno (system-error-errno args)))
+                                        (format #t "failed to unmount '~a': ~a~%"
+                                                mount-point (strerror errno))))))
                            (filter (negate known?) (mount-points)))
                  #f))))
 
@@ -635,12 +1011,12 @@ (define (urandom-seed-shepherd-service _)
                     ;; available. So, we handle a failed read or any other error
                     ;; reported by the operating system.
                     (let ((buf (catch 'system-error
-                                 (lambda ()
-                                   (call-with-input-file "/dev/hwrng"
-                                     (lambda (hwrng)
-                                       (get-bytevector-n hwrng 512))))
-                                 ;; Silence is golden...
-                                 (const #f))))
+                                      (lambda ()
+                                        (call-with-input-file "/dev/hwrng"
+                                          (lambda (hwrng)
+                                            (get-bytevector-n hwrng 512))))
+                                      ;; Silence is golden...
+                                      (const #f))))
                       (when buf
                         (call-with-output-file "/dev/urandom"
                           (lambda (urandom)
@@ -711,23 +1087,23 @@ (define-record-type* <rngd-configuration>
 
 (define rngd-service-type
   (shepherd-service-type
-    'rngd
-    (lambda (config)
-      (define rng-tools (rngd-configuration-rng-tools config))
-      (define device (rngd-configuration-device config))
+   'rngd
+   (lambda (config)
+     (define rng-tools (rngd-configuration-rng-tools config))
+     (define device (rngd-configuration-device config))
 
-      (define rngd-command
-        (list (file-append rng-tools "/sbin/rngd")
-              "-f" "-r" device))
+     (define rngd-command
+       (list (file-append rng-tools "/sbin/rngd")
+             "-f" "-r" device))
 
-      (shepherd-service
-        (documentation "Add TRNG to entropy pool.")
-        (requirement '(user-processes udev))
-        (provision '(trng))
-        (start #~(make-forkexec-constructor '#$rngd-command))
-        (stop #~(make-kill-destructor))))
-    (rngd-configuration)
-    (description "Run the @command{rngd} random number generation daemon to
+     (shepherd-service
+      (documentation "Add TRNG to entropy pool.")
+      (requirement '(user-processes udev))
+      (provision '(trng))
+      (start #~(make-forkexec-constructor '#$rngd-command))
+      (stop #~(make-kill-destructor))))
+   (rngd-configuration)
+   (description "Run the @command{rngd} random number generation daemon to
 supply entropy to the kernel's pool.")))
 
 (define-deprecated (rngd-service #:key (rng-tools rng-tools)
@@ -791,7 +1167,7 @@ (define hosts-service-type
   (let* ((serialize-host-record
           (lambda (record)
             (match-record record <host> (address canonical-name aliases)
-              (format #f "~a~/~a~{~^~/~a~}~%" address canonical-name aliases))))
+                          (format #f "~a~/~a~{~^~/~a~}~%" address canonical-name aliases))))
          (host-etc-service
           (lambda (lst)
             `(("hosts" ,(plain-file "hosts"
@@ -1041,7 +1417,7 @@ (define-record-type* <agetty-configuration>
   (extra-options    agetty-extra-options          ;list of strings
                     (default '()))
   (shepherd-requirement agetty-shepherd-requirement  ;list of SHEPHERD requirements
-                    (default '()))
+                        (default '()))
 ;;; XXX Unimplemented for now!
 ;;; (issue-file     agetty-issue-file             ;file-like
 ;;;                 (default #f))
@@ -1052,189 +1428,189 @@ (define (default-serial-port)
 to use as the tty.  This is primarily useful for headless systems."
   (with-imported-modules (source-module-closure
                           '((gnu build linux-boot))) ;for 'find-long-options'
-    #~(begin
-        ;; console=device,options
-        ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial).
-        ;; options: BBBBPNF. P n|o|e, N number of bits,
-        ;; F flow control (r RTS)
-        (let* ((not-comma (char-set-complement (char-set #\,)))
-               (command (linux-command-line))
-               (agetty-specs (find-long-options "agetty.tty" command))
-               (console-specs (filter (lambda (spec)
-                                        (and (string-prefix? "tty" spec)
-                                             (not (or
-                                                   (string-prefix? "tty0" spec)
-                                                   (string-prefix? "tty1" spec)
-                                                   (string-prefix? "tty2" spec)
-                                                   (string-prefix? "tty3" spec)
-                                                   (string-prefix? "tty4" spec)
-                                                   (string-prefix? "tty5" spec)
-                                                   (string-prefix? "tty6" spec)
-                                                   (string-prefix? "tty7" spec)
-                                                   (string-prefix? "tty8" spec)
-                                                   (string-prefix? "tty9" spec)))))
-                                      (find-long-options "console" command)))
-               (specs (append agetty-specs console-specs)))
-          (match specs
-            (() #f)
-            ((spec _ ...)
-             ;; Extract device name from first spec.
-             (match (string-tokenize spec not-comma)
-               ((device-name _ ...)
-                device-name))))))))
+                         #~(begin
+                             ;; console=device,options
+                             ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial).
+                             ;; options: BBBBPNF. P n|o|e, N number of bits,
+                             ;; F flow control (r RTS)
+                             (let* ((not-comma (char-set-complement (char-set #\,)))
+                                    (command (linux-command-line))
+                                    (agetty-specs (find-long-options "agetty.tty" command))
+                                    (console-specs (filter (lambda (spec)
+                                                             (and (string-prefix? "tty" spec)
+                                                                  (not (or
+                                                                        (string-prefix? "tty0" spec)
+                                                                        (string-prefix? "tty1" spec)
+                                                                        (string-prefix? "tty2" spec)
+                                                                        (string-prefix? "tty3" spec)
+                                                                        (string-prefix? "tty4" spec)
+                                                                        (string-prefix? "tty5" spec)
+                                                                        (string-prefix? "tty6" spec)
+                                                                        (string-prefix? "tty7" spec)
+                                                                        (string-prefix? "tty8" spec)
+                                                                        (string-prefix? "tty9" spec)))))
+                                                           (find-long-options "console" command)))
+                                    (specs (append agetty-specs console-specs)))
+                               (match specs
+                                 (() #f)
+                                 ((spec _ ...)
+                                  ;; Extract device name from first spec.
+                                  (match (string-tokenize spec not-comma)
+                                    ((device-name _ ...)
+                                     device-name))))))))
 
 (define (agetty-shepherd-service config)
   (match-record config <agetty-configuration>
-    (agetty tty term baud-rate auto-login
-            login-program login-pause? eight-bits? no-reset? remote? flow-control?
-            host no-issue? init-string no-clear? local-line extract-baud?
-            skip-login? no-newline? login-options chroot hangup? keep-baud? timeout
-            detect-case? wait-cr? no-hints? no-hostname? long-hostname?
-            erase-characters kill-characters chdir delay nice extra-options
-            shepherd-requirement)
-    (list
-     (shepherd-service
-      (documentation "Run agetty on a tty.")
-      (provision (list (symbol-append 'term- (string->symbol (or tty "console")))))
+                (agetty tty term baud-rate auto-login
+                        login-program login-pause? eight-bits? no-reset? remote? flow-control?
+                        host no-issue? init-string no-clear? local-line extract-baud?
+                        skip-login? no-newline? login-options chroot hangup? keep-baud? timeout
+                        detect-case? wait-cr? no-hints? no-hostname? long-hostname?
+                        erase-characters kill-characters chdir delay nice extra-options
+                        shepherd-requirement)
+                (list
+                 (shepherd-service
+                  (documentation "Run agetty on a tty.")
+                  (provision (list (symbol-append 'term- (string->symbol (or tty "console")))))
 
-      ;; Since the login prompt shows the host name, wait for the 'host-name'
-      ;; service to be done.  Also wait for udev essentially so that the tty
-      ;; text is not lost in the middle of kernel messages (see also
-      ;; mingetty-shepherd-service).
-      (requirement (cons* 'user-processes 'host-name 'udev
-                          shepherd-requirement))
+                  ;; Since the login prompt shows the host name, wait for the 'host-name'
+                  ;; service to be done.  Also wait for udev essentially so that the tty
+                  ;; text is not lost in the middle of kernel messages (see also
+                  ;; mingetty-shepherd-service).
+                  (requirement (cons* 'user-processes 'host-name 'udev
+                                      shepherd-requirement))
 
-      (modules '((ice-9 match) (gnu build linux-boot)))
-      (start
-       (with-imported-modules  (source-module-closure
-                                '((gnu build linux-boot)))
-         #~(lambda args
-             (let ((defaulted-tty #$(or tty (default-serial-port))))
-               (apply
-                (if defaulted-tty
-                    (make-forkexec-constructor
-                     (list #$(file-append util-linux "/sbin/agetty")
-                           #$@extra-options
-                           #$@(if eight-bits?
-                                  #~("--8bits")
-                                  #~())
-                           #$@(if no-reset?
-                                  #~("--noreset")
-                                  #~())
-                           #$@(if remote?
-                                  #~("--remote")
-                                  #~())
-                           #$@(if flow-control?
-                                  #~("--flow-control")
-                                  #~())
-                           #$@(if host
-                                  #~("--host" #$host)
-                                  #~())
-                           #$@(if no-issue?
-                                  #~("--noissue")
-                                  #~())
-                           #$@(if init-string
-                                  #~("--init-string" #$init-string)
-                                  #~())
-                           #$@(if no-clear?
-                                  #~("--noclear")
-                                  #~())
+                  (modules '((ice-9 match) (gnu build linux-boot)))
+                  (start
+                   (with-imported-modules  (source-module-closure
+                                            '((gnu build linux-boot)))
+                                           #~(lambda args
+                                               (let ((defaulted-tty #$(or tty (default-serial-port))))
+                                                 (apply
+                                                  (if defaulted-tty
+                                                      (make-forkexec-constructor
+                                                       (list #$(file-append util-linux "/sbin/agetty")
+                                                             #$@extra-options
+                                                             #$@(if eight-bits?
+                                                                    #~("--8bits")
+                                                                    #~())
+                                                             #$@(if no-reset?
+                                                                    #~("--noreset")
+                                                                    #~())
+                                                             #$@(if remote?
+                                                                    #~("--remote")
+                                                                    #~())
+                                                             #$@(if flow-control?
+                                                                    #~("--flow-control")
+                                                                    #~())
+                                                             #$@(if host
+                                                                    #~("--host" #$host)
+                                                                    #~())
+                                                             #$@(if no-issue?
+                                                                    #~("--noissue")
+                                                                    #~())
+                                                             #$@(if init-string
+                                                                    #~("--init-string" #$init-string)
+                                                                    #~())
+                                                             #$@(if no-clear?
+                                                                    #~("--noclear")
+                                                                    #~())
 ;;; FIXME This doesn't work as expected. According to agetty(8), if this option
 ;;; is not passed, then the default is 'auto'. However, in my tests, when that
 ;;; option is selected, agetty never presents the login prompt, and the
 ;;; term-ttyS0 service respawns every few seconds.
-                           #$@(if local-line
-                                  #~(#$(match local-line
-                                         ('auto "--local-line=auto")
-                                         ('always "--local-line=always")
-                                         ('never "-local-line=never")))
-                                  #~())
-                           #$@(if tty
-                                  #~()
-                                  #~("--keep-baud"))
-                           #$@(if extract-baud?
-                                  #~("--extract-baud")
-                                  #~())
-                           #$@(if skip-login?
-                                  #~("--skip-login")
-                                  #~())
-                           #$@(if no-newline?
-                                  #~("--nonewline")
-                                  #~())
-                           #$@(if login-options
-                                  #~("--login-options" #$login-options)
-                                  #~())
-                           #$@(if chroot
-                                  #~("--chroot" #$chroot)
-                                  #~())
-                           #$@(if hangup?
-                                  #~("--hangup")
-                                  #~())
-                           #$@(if keep-baud?
-                                  #~("--keep-baud")
-                                  #~())
-                           #$@(if timeout
-                                  #~("--timeout" #$(number->string timeout))
-                                  #~())
-                           #$@(if detect-case?
-                                  #~("--detect-case")
-                                  #~())
-                           #$@(if wait-cr?
-                                  #~("--wait-cr")
-                                  #~())
-                           #$@(if no-hints?
-                                  #~("--nohints?")
-                                  #~())
-                           #$@(if no-hostname?
-                                  #~("--nohostname")
-                                  #~())
-                           #$@(if long-hostname?
-                                  #~("--long-hostname")
-                                  #~())
-                           #$@(if erase-characters
-                                  #~("--erase-chars" #$erase-characters)
-                                  #~())
-                           #$@(if kill-characters
-                                  #~("--kill-chars" #$kill-characters)
-                                  #~())
-                           #$@(if chdir
-                                  #~("--chdir" #$chdir)
-                                  #~())
-                           #$@(if delay
-                                  #~("--delay" #$(number->string delay))
-                                  #~())
-                           #$@(if nice
-                                  #~("--nice" #$(number->string nice))
-                                  #~())
-                           #$@(if auto-login
-                                  (list "--autologin" auto-login)
-                                  '())
-                           #$@(if login-program
-                                  #~("--login-program" #$login-program)
-                                  #~())
-                           #$@(if login-pause?
-                                  #~("--login-pause")
-                                  #~())
-                           defaulted-tty
-                           #$@(if baud-rate
-                                  #~(#$baud-rate)
-                                  #~())
-                           #$@(if term
-                                  #~(#$term)
-                                  #~())))
-                    #$(if tty
-                          #~(const #f)         ;always fail to start
-                          #~(lambda _          ;succeed, but don't do anything
-                              (format #t "~a: \
+                                                             #$@(if local-line
+                                                                    #~(#$(match local-line
+                                                                           ('auto "--local-line=auto")
+                                                                           ('always "--local-line=always")
+                                                                           ('never "-local-line=never")))
+                                                                    #~())
+                                                             #$@(if tty
+                                                                    #~()
+                                                                    #~("--keep-baud"))
+                                                             #$@(if extract-baud?
+                                                                    #~("--extract-baud")
+                                                                    #~())
+                                                             #$@(if skip-login?
+                                                                    #~("--skip-login")
+                                                                    #~())
+                                                             #$@(if no-newline?
+                                                                    #~("--nonewline")
+                                                                    #~())
+                                                             #$@(if login-options
+                                                                    #~("--login-options" #$login-options)
+                                                                    #~())
+                                                             #$@(if chroot
+                                                                    #~("--chroot" #$chroot)
+                                                                    #~())
+                                                             #$@(if hangup?
+                                                                    #~("--hangup")
+                                                                    #~())
+                                                             #$@(if keep-baud?
+                                                                    #~("--keep-baud")
+                                                                    #~())
+                                                             #$@(if timeout
+                                                                    #~("--timeout" #$(number->string timeout))
+                                                                    #~())
+                                                             #$@(if detect-case?
+                                                                    #~("--detect-case")
+                                                                    #~())
+                                                             #$@(if wait-cr?
+                                                                    #~("--wait-cr")
+                                                                    #~())
+                                                             #$@(if no-hints?
+                                                                    #~("--nohints?")
+                                                                    #~())
+                                                             #$@(if no-hostname?
+                                                                    #~("--nohostname")
+                                                                    #~())
+                                                             #$@(if long-hostname?
+                                                                    #~("--long-hostname")
+                                                                    #~())
+                                                             #$@(if erase-characters
+                                                                    #~("--erase-chars" #$erase-characters)
+                                                                    #~())
+                                                             #$@(if kill-characters
+                                                                    #~("--kill-chars" #$kill-characters)
+                                                                    #~())
+                                                             #$@(if chdir
+                                                                    #~("--chdir" #$chdir)
+                                                                    #~())
+                                                             #$@(if delay
+                                                                    #~("--delay" #$(number->string delay))
+                                                                    #~())
+                                                             #$@(if nice
+                                                                    #~("--nice" #$(number->string nice))
+                                                                    #~())
+                                                             #$@(if auto-login
+                                                                    (list "--autologin" auto-login)
+                                                                    '())
+                                                             #$@(if login-program
+                                                                    #~("--login-program" #$login-program)
+                                                                    #~())
+                                                             #$@(if login-pause?
+                                                                    #~("--login-pause")
+                                                                    #~())
+                                                             defaulted-tty
+                                                             #$@(if baud-rate
+                                                                    #~(#$baud-rate)
+                                                                    #~())
+                                                             #$@(if term
+                                                                    #~(#$term)
+                                                                    #~())))
+                                                      #$(if tty
+                                                            #~(const #f)         ;always fail to start
+                                                            #~(lambda _          ;succeed, but don't do anything
+                                                                (format #t "~a: \
 no serial port console requested; doing nothing~%"
-                                      '#$(car provision))
-                              'idle)))
-                args)))))
-      (stop #~(let ((stop (make-kill-destructor)))
-                (lambda (running)
-                  (if (eq? 'idle running)
-                      #f
-                      (stop running)))))))))
+                                                                        '#$(car provision))
+                                                                'idle)))
+                                                  args)))))
+                  (stop #~(let ((stop (make-kill-destructor)))
+                            (lambda (running)
+                              (if (eq? 'idle running)
+                                  #f
+                                  (stop running)))))))))
 
 (define agetty-service-type
   (service-type (name 'agetty)
@@ -1290,61 +1666,61 @@ (define (mingetty-shepherd-service config)
                   login-pause? clear-on-logout? delay
                   print-issue print-hostname nice
                   working-directory root-directory shepherd-requirement)
-    (list
-     (shepherd-service
-      (documentation "Run mingetty on an tty.")
-      (provision (list (symbol-append 'term- (string->symbol tty))))
+                (list
+                 (shepherd-service
+                  (documentation "Run mingetty on an tty.")
+                  (provision (list (symbol-append 'term- (string->symbol tty))))
 
-      (requirement shepherd-requirement)
+                  (requirement shepherd-requirement)
 
-      (start  #~(make-forkexec-constructor
-                 (list #$(file-append mingetty "/sbin/mingetty")
+                  (start  #~(make-forkexec-constructor
+                             (list #$(file-append mingetty "/sbin/mingetty")
 
-                       ;; Avoiding 'vhangup' allows us to avoid 'setfont'
-                       ;; errors down the path where various ioctls get
-                       ;; EIO--see 'hung_up_tty_ioctl' in driver/tty/tty_io.c
-                       ;; in Linux.
-                       "--nohangup" #$tty
+                                   ;; Avoiding 'vhangup' allows us to avoid 'setfont'
+                                   ;; errors down the path where various ioctls get
+                                   ;; EIO--see 'hung_up_tty_ioctl' in driver/tty/tty_io.c
+                                   ;; in Linux.
+                                   "--nohangup" #$tty
 
-                       #$@(if clear-on-logout?
-                              #~()
-                              #~("--noclear"))
-                       #$@(if auto-login
-                              #~("--autologin" #$auto-login)
-                              #~())
-                       #$@(if login-program
-                              #~("--loginprog" #$login-program)
-                              #~())
-                       #$@(if login-pause?
-                              #~("--loginpause")
-                              #~())
-                       #$@(if delay
-                              #~("--delay" #$(number->string delay))
-                              #~())
-                       #$@(match print-issue
-                            (#t
-                             #~())
-                            ('no-nl
-                             #~("--nonewline"))
-                            (#f
-                             #~("--noissue")))
-                       #$@(match print-hostname
-                            (#t
-                             #~())
-                            ('long
-                             #~("--long-hostname"))
-                            (#f
-                             #~("--nohostname")))
-                       #$@(if nice
-                              #~("--nice" #$(number->string nice))
-                              #~())
-                       #$@(if working-directory
-                              #~("--chdir" #$working-directory)
-                              #~())
-                       #$@(if root-directory
-                              #~("--chroot" #$root-directory)
-                              #~()))))
-      (stop   #~(make-kill-destructor))))))
+                                   #$@(if clear-on-logout?
+                                          #~()
+                                          #~("--noclear"))
+                                   #$@(if auto-login
+                                          #~("--autologin" #$auto-login)
+                                          #~())
+                                   #$@(if login-program
+                                          #~("--loginprog" #$login-program)
+                                          #~())
+                                   #$@(if login-pause?
+                                          #~("--loginpause")
+                                          #~())
+                                   #$@(if delay
+                                          #~("--delay" #$(number->string delay))
+                                          #~())
+                                   #$@(match print-issue
+                                        (#t
+                                         #~())
+                                        ('no-nl
+                                         #~("--nonewline"))
+                                        (#f
+                                         #~("--noissue")))
+                                   #$@(match print-hostname
+                                        (#t
+                                         #~())
+                                        ('long
+                                         #~("--long-hostname"))
+                                        (#f
+                                         #~("--nohostname")))
+                                   #$@(if nice
+                                          #~("--nice" #$(number->string nice))
+                                          #~())
+                                   #$@(if working-directory
+                                          #~("--chdir" #$working-directory)
+                                          #~())
+                                   #$@(if root-directory
+                                          #~("--chroot" #$root-directory)
+                                          #~()))))
+                  (stop   #~(make-kill-destructor))))))
 
 (define mingetty-service-type
   (service-type (name 'mingetty)
@@ -1374,12 +1750,12 @@ (define-record-type* <nscd-configuration> nscd-configuration
                  (default '()))
   (glibc      nscd-configuration-glibc            ;file-like
               (default (let-system (system target)
-                         ;; Unless we're cross-compiling, arrange to use nscd
-                         ;; from 'glibc-final' instead of pulling in a second
-                         ;; glibc copy.
-                         (if target
-                             (cross-libc target)
-                             (canonical-package glibc))))))
+                                   ;; Unless we're cross-compiling, arrange to use nscd
+                                   ;; from 'glibc-final' instead of pulling in a second
+                                   ;; glibc copy.
+                                   (if target
+                                       (cross-libc target)
+                                       (canonical-package glibc))))))
 
 (define-record-type* <nscd-cache> nscd-cache make-nscd-cache
   nscd-cache?
@@ -1388,7 +1764,7 @@ (define-record-type* <nscd-cache> nscd-cache make-nscd-cache
   (negative-time-to-live nscd-cache-negative-time-to-live
                          (default 20))             ;integer
   (suggested-size        nscd-cache-suggested-size ;integer ("default module
-                                                   ;of hash table")
+                                        ;of hash table")
                          (default 211))
   (check-files?          nscd-cache-check-files?  ;Boolean
                          (default #t))
@@ -1446,45 +1822,45 @@ (define (nscd.conf-file config)
 @code{<nscd-configuration>} object."
   (define (cache->config cache)
     (match-record cache <nscd-cache>
-      (database positive-time-to-live negative-time-to-live
-                suggested-size check-files?
-                persistent? shared? max-database-size auto-propagate?)
-      (let ((database (symbol->string database)))
-        (string-append "\nenable-cache\t" database "\tyes\n"
+                  (database positive-time-to-live negative-time-to-live
+                            suggested-size check-files?
+                            persistent? shared? max-database-size auto-propagate?)
+                  (let ((database (symbol->string database)))
+                    (string-append "\nenable-cache\t" database "\tyes\n"
 
-                       "positive-time-to-live\t" database "\t"
-                       (number->string positive-time-to-live) "\n"
-                       "negative-time-to-live\t" database "\t"
-                       (number->string negative-time-to-live) "\n"
-                       "suggested-size\t" database "\t"
-                       (number->string suggested-size) "\n"
-                       "check-files\t" database "\t"
-                       (if check-files? "yes\n" "no\n")
-                       "persistent\t" database "\t"
-                       (if persistent? "yes\n" "no\n")
-                       "shared\t" database "\t"
-                       (if shared? "yes\n" "no\n")
-                       "max-db-size\t" database "\t"
-                       (number->string max-database-size) "\n"
-                       "auto-propagate\t" database "\t"
-                       (if auto-propagate? "yes\n" "no\n")))))
+                                   "positive-time-to-live\t" database "\t"
+                                   (number->string positive-time-to-live) "\n"
+                                   "negative-time-to-live\t" database "\t"
+                                   (number->string negative-time-to-live) "\n"
+                                   "suggested-size\t" database "\t"
+                                   (number->string suggested-size) "\n"
+                                   "check-files\t" database "\t"
+                                   (if check-files? "yes\n" "no\n")
+                                   "persistent\t" database "\t"
+                                   (if persistent? "yes\n" "no\n")
+                                   "shared\t" database "\t"
+                                   (if shared? "yes\n" "no\n")
+                                   "max-db-size\t" database "\t"
+                                   (number->string max-database-size) "\n"
+                                   "auto-propagate\t" database "\t"
+                                   (if auto-propagate? "yes\n" "no\n")))))
 
   (match-record config <nscd-configuration>
-    (log-file debug-level caches)
-    (plain-file "nscd.conf"
-                (string-append "\
+                (log-file debug-level caches)
+                (plain-file "nscd.conf"
+                            (string-append "\
 # Configuration of libc's name service cache daemon (nscd).\n\n"
-                               (if log-file
-                                   (string-append "logfile\t" log-file)
-                                   "")
-                               "\n"
-                               (if debug-level
-                                   (string-append "debug-level\t"
-                                                  (number->string debug-level))
-                                   "")
-                               "\n"
-                               (string-concatenate
-                                (map cache->config caches))))))
+                                           (if log-file
+                                               (string-append "logfile\t" log-file)
+                                               "")
+                                           "\n"
+                                           (if debug-level
+                                               (string-append "debug-level\t"
+                                                              (number->string debug-level))
+                                               "")
+                                           "\n"
+                                           (string-concatenate
+                                            (map cache->config caches))))))
 
 (define (nscd-action-procedure nscd config option)
   ;; XXX: This is duplicated from mcron; factorize.
@@ -1498,15 +1874,15 @@ (define (nscd-action-procedure nscd config option)
           (match (read-line pipe 'concat)
             ((? eof-object?)
              (catch 'system-error
-               (lambda ()
-                 (zero? (close-pipe pipe)))
-               (lambda args
-                 ;; There's a race with the SIGCHLD handler, which could
-                 ;; call 'waitpid' before 'close-pipe' above does.  If we
-                 ;; get ECHILD, that means we lost the race; in that case, we
-                 ;; cannot tell what the exit code was (FIXME).
-                 (or (= ECHILD (system-error-errno args))
-                     (apply throw args)))))
+                    (lambda ()
+                      (zero? (close-pipe pipe)))
+                    (lambda args
+                      ;; There's a race with the SIGCHLD handler, which could
+                      ;; call 'waitpid' before 'close-pipe' above does.  If we
+                      ;; get ECHILD, that means we lost the race; in that case, we
+                      ;; cannot tell what the exit code was (FIXME).
+                      (or (= ECHILD (system-error-errno args))
+                          (apply throw args)))))
             (line
              (display line)
              (loop)))))))
@@ -1656,8 +2032,8 @@ (define syslog.conf "/etc/syslog.conf")
 
 (define (syslog-etc configuration)
   (match-record configuration <syslog-configuration>
-    (config-file)
-    (list `(,(basename syslog.conf) ,config-file))))
+                (config-file)
+                (list `(,(basename syslog.conf) ,config-file))))
 
 (define (syslog-shepherd-service config)
   (define config-file
@@ -1818,43 +2194,43 @@ (define (substitute-key-authorization keys guix)
 archive' public keys, with GUIX."
   (define default-acl
     (with-extensions (list guile-gcrypt)
-      (with-imported-modules `(((guix config) => ,(make-config.scm))
-                               ,@(source-module-closure '((guix pki))
-                                                        #:select? not-config?))
-        (computed-file "acl"
-                       #~(begin
-                           (use-modules (guix pki)
-                                        (gcrypt pk-crypto)
-                                        (ice-9 rdelim))
+                     (with-imported-modules `(((guix config) => ,(make-config.scm))
+                                              ,@(source-module-closure '((guix pki))
+                                                                       #:select? not-config?))
+                                            (computed-file "acl"
+                                                           #~(begin
+                                                               (use-modules (guix pki)
+                                                                            (gcrypt pk-crypto)
+                                                                            (ice-9 rdelim))
 
-                           (define keys
-                             (map (lambda (file)
-                                    (call-with-input-file file
-                                      (compose string->canonical-sexp
-                                               read-string)))
-                                  '(#$@keys)))
+                                                               (define keys
+                                                                 (map (lambda (file)
+                                                                        (call-with-input-file file
+                                                                          (compose string->canonical-sexp
+                                                                                   read-string)))
+                                                                      '(#$@keys)))
 
-                           (call-with-output-file #$output
-                             (lambda (port)
-                               (write-acl (public-keys->acl keys)
-                                          port))))))))
+                                                               (call-with-output-file #$output
+                                                                 (lambda (port)
+                                                                   (write-acl (public-keys->acl keys)
+                                                                              port))))))))
 
   (with-imported-modules '((guix build utils))
-    #~(begin
-        (use-modules (guix build utils))
-        (define acl-file #$%acl-file)
-        ;; If the ACL already exists, move it out of the way.  Create a backup
-        ;; if it's a regular file: it's likely that the user manually updated
-        ;; it with 'guix archive --authorize'.
-        (if (file-exists? acl-file)
-            (if (and (symbolic-link? acl-file)
-                     (store-file-name? (readlink acl-file)))
-                (delete-file acl-file)
-                (rename-file acl-file (string-append acl-file ".bak")))
-            (mkdir-p (dirname acl-file)))
+                         #~(begin
+                             (use-modules (guix build utils))
+                             (define acl-file #$%acl-file)
+                             ;; If the ACL already exists, move it out of the way.  Create a backup
+                             ;; if it's a regular file: it's likely that the user manually updated
+                             ;; it with 'guix archive --authorize'.
+                             (if (file-exists? acl-file)
+                                 (if (and (symbolic-link? acl-file)
+                                          (store-file-name? (readlink acl-file)))
+                                     (delete-file acl-file)
+                                     (rename-file acl-file (string-append acl-file ".bak")))
+                                 (mkdir-p (dirname acl-file)))
 
-        ;; Installed the declared ACL.
-        (symlink #+default-acl acl-file))))
+                             ;; Installed the declared ACL.
+                             (symlink #+default-acl acl-file))))
 
 (define (install-channels-file channels)
   "Return a gexp with code to install CHANNELS, a list of channels, in
@@ -1864,22 +2240,22 @@ (define (install-channels-file channels)
                  `(list ,@(map channel->code channels))))
 
   (with-imported-modules '((guix build utils))
-    #~(begin
-        (use-modules (guix build utils))
+                         #~(begin
+                             (use-modules (guix build utils))
 
-        ;; If channels.scm already exists, move it out of the way. Create a
-        ;; backup if it's a regular file: it's likely that the user
-        ;; manually defined it.
-        (if (file-exists? "/etc/guix/channels.scm")
-            (if (and (symbolic-link? "/etc/guix/channels.scm")
-                     (store-file-name? (readlink "/etc/guix/channels.scm")))
-                (delete-file "/etc/guix/channels.scm")
-                (rename-file "/etc/guix/channels.scm"
-                             "/etc/guix/channels.scm.bak"))
-            (mkdir-p "/etc/guix"))
+                             ;; If channels.scm already exists, move it out of the way. Create a
+                             ;; backup if it's a regular file: it's likely that the user
+                             ;; manually defined it.
+                             (if (file-exists? "/etc/guix/channels.scm")
+                                 (if (and (symbolic-link? "/etc/guix/channels.scm")
+                                          (store-file-name? (readlink "/etc/guix/channels.scm")))
+                                     (delete-file "/etc/guix/channels.scm")
+                                     (rename-file "/etc/guix/channels.scm"
+                                                  "/etc/guix/channels.scm.bak"))
+                                 (mkdir-p "/etc/guix"))
 
-        ;; Installed the declared channels.
-        (symlink #+channels-file "/etc/guix/channels.scm"))))
+                             ;; Installed the declared channels.
+                             (symlink #+channels-file "/etc/guix/channels.scm"))))
 
 (define %default-authorized-guix-keys
   ;; List of authorized substitute keys.
@@ -1890,33 +2266,33 @@ (define (guix-machines-files-installation machines)
   "Return a gexp to install MACHINES, a list of gexps, as
 /etc/guix/machines.scm, which is used for offloading."
   (with-imported-modules '((guix build utils))
-    #~(begin
-        (use-modules (guix build utils))
+                         #~(begin
+                             (use-modules (guix build utils))
 
-        (define machines-file
-          "/etc/guix/machines.scm")
+                             (define machines-file
+                               "/etc/guix/machines.scm")
 
-        ;; If MACHINES-FILE already exists, move it out of the way.
-        ;; Create a backup if it's a regular file: it's likely that the
-        ;; user manually updated it.
-        (let ((stat (false-if-exception (lstat machines-file))))
-          (if stat
-              (if (and (eq? 'symlink (stat:type stat))
-                       (store-file-name? (readlink machines-file)))
-                  (delete-file machines-file)
-                  (rename-file machines-file
-                               (string-append machines-file ".bak")))
-              (mkdir-p (dirname machines-file))))
+                             ;; If MACHINES-FILE already exists, move it out of the way.
+                             ;; Create a backup if it's a regular file: it's likely that the
+                             ;; user manually updated it.
+                             (let ((stat (false-if-exception (lstat machines-file))))
+                               (if stat
+                                   (if (and (eq? 'symlink (stat:type stat))
+                                            (store-file-name? (readlink machines-file)))
+                                       (delete-file machines-file)
+                                       (rename-file machines-file
+                                                    (string-append machines-file ".bak")))
+                                   (mkdir-p (dirname machines-file))))
 
-        ;; Installed the declared machines file.
-        (symlink #+(scheme-file "machines.scm"
-                                #~((@ (srfi srfi-1) append-map)
-                                   (lambda (entry)
-                                     (if (build-machine? entry)
-                                         (list entry)
-                                         entry))
-                                   #$machines))
-                 machines-file))))
+                             ;; Installed the declared machines file.
+                             (symlink #+(scheme-file "machines.scm"
+                                                     #~((@ (srfi srfi-1) append-map)
+                                                        (lambda (entry)
+                                                          (if (build-machine? entry)
+                                                              (list entry)
+                                                              entry))
+                                                        #$machines))
+                                      machines-file))))
 
 (define (run-with-writable-store)
   "Return a wrapper that runs the given command under the specified UID and
@@ -1925,31 +2301,31 @@ (define (run-with-writable-store)
   (program-file "run-with-writable-store"
                 (with-imported-modules (source-module-closure
                                         '((guix build syscalls)))
-                  #~(begin
-                      (use-modules (guix build syscalls)
-                                   (ice-9 match))
+                                       #~(begin
+                                           (use-modules (guix build syscalls)
+                                                        (ice-9 match))
 
-                      (define (ensure-writable-store store)
-                        ;; Create a new mount namespace and remount STORE with
-                        ;; write permissions if it's read-only.
-                        (unshare CLONE_NEWNS)
-                        (let ((fs (statfs store)))
-                          (unless (zero? (logand (file-system-mount-flags fs)
-                                                 ST_RDONLY))
-                            (mount store store "none"
-                                   (logior MS_BIND MS_REMOUNT)))))
+                                           (define (ensure-writable-store store)
+                                             ;; Create a new mount namespace and remount STORE with
+                                             ;; write permissions if it's read-only.
+                                             (unshare CLONE_NEWNS)
+                                             (let ((fs (statfs store)))
+                                               (unless (zero? (logand (file-system-mount-flags fs)
+                                                                      ST_RDONLY))
+                                                 (mount store store "none"
+                                                        (logior MS_BIND MS_REMOUNT)))))
 
-                      (match (command-line)
-                        ((_ user group command args ...)
-                         (ensure-writable-store #$(%store-prefix))
-                         (let ((uid (or (string->number user)
-                                        (passwd:uid (getpwnam user))))
-                               (gid (or (string->number group)
-                                        (group:gid (getgrnam group)))))
-                           (setgroups #())
-                           (setgid gid)
-                           (setuid uid)
-                           (apply execl command command args))))))))
+                                           (match (command-line)
+                                             ((_ user group command args ...)
+                                              (ensure-writable-store #$(%store-prefix))
+                                              (let ((uid (or (string->number user)
+                                                             (passwd:uid (getpwnam user))))
+                                                    (gid (or (string->number group)
+                                                             (group:gid (getgrnam group)))))
+                                                (setgroups #())
+                                                (setgid gid)
+                                                (setuid uid)
+                                                (apply execl command command args))))))))
 
 (define (guix-ownership-change-program)
   "Return a program that changes ownership of the store and other data files
@@ -1958,61 +2334,61 @@ (define (guix-ownership-change-program)
    "validate-guix-ownership"
    (with-imported-modules (source-module-closure
                            '((guix build utils)))
-     #~(begin
-         (use-modules (guix build utils)
-                      (ice-9 ftw)
-                      (ice-9 match))
+                          #~(begin
+                              (use-modules (guix build utils)
+                                           (ice-9 ftw)
+                                           (ice-9 match))
 
-         (define (lchown file uid gid)
-           (let ((parent (open (dirname file) O_DIRECTORY)))
-             (chown-at parent (basename file) uid gid
-                       AT_SYMLINK_NOFOLLOW)
-             (close-port parent)))
+                              (define (lchown file uid gid)
+                                (let ((parent (open (dirname file) O_DIRECTORY)))
+                                  (chown-at parent (basename file) uid gid
+                                            AT_SYMLINK_NOFOLLOW)
+                                  (close-port parent)))
 
-         (define (change-ownership directory uid gid)
-           ;; chown -R UID:GID DIRECTORY
-           (file-system-fold (const #t)                              ;enter?
-                             (lambda (file stat result)              ;leaf
-                               (if (eq? 'symlink (stat:type stat))
-                                   (lchown file uid gid)
-                                   (chown file uid gid)))
-                             (const #t)           ;down
-                             (lambda (directory stat result) ;up
-                               (chown directory uid gid))
-                             (const #t)           ;skip
-                             (lambda (file stat errno result)
-                               (format (current-error-port)
-                                       "i/o error: ~a: ~a~%"
-                                       file (strerror errno))
-                               #f)
-                             #t                   ;seed
-                             directory
-                             lstat))
+                              (define (change-ownership directory uid gid)
+                                ;; chown -R UID:GID DIRECTORY
+                                (file-system-fold (const #t)                              ;enter?
+                                                  (lambda (file stat result)              ;leaf
+                                                    (if (eq? 'symlink (stat:type stat))
+                                                        (lchown file uid gid)
+                                                        (chown file uid gid)))
+                                                  (const #t)           ;down
+                                                  (lambda (directory stat result) ;up
+                                                    (chown directory uid gid))
+                                                  (const #t)           ;skip
+                                                  (lambda (file stat errno result)
+                                                    (format (current-error-port)
+                                                            "i/o error: ~a: ~a~%"
+                                                            file (strerror errno))
+                                                    #f)
+                                                  #t                   ;seed
+                                                  directory
+                                                  lstat))
 
-         (define (claim-data-ownership uid gid)
-           (format #t "Changing file ownership for /gnu/store \
+                              (define (claim-data-ownership uid gid)
+                                (format #t "Changing file ownership for /gnu/store \
 and data directories to ~a:~a...~%"
-                   uid gid)
-           (change-ownership #$(%store-prefix) uid gid)
-           (let ((excluded '("." ".." "profiles" "userpool")))
-             (for-each (lambda (directory)
-                         (change-ownership (in-vicinity "/var/guix" directory)
-                                           uid gid))
-                       (scandir "/var/guix"
-                                (lambda (file)
-                                  (not (member file
-                                               excluded))))))
-           (chown "/var/guix" uid gid)
-           (change-ownership "/etc/guix" uid gid)
-           (mkdir-p "/var/log/guix")
-           (change-ownership "/var/log/guix" uid gid))
+                                        uid gid)
+                                (change-ownership #$(%store-prefix) uid gid)
+                                (let ((excluded '("." ".." "profiles" "userpool")))
+                                  (for-each (lambda (directory)
+                                              (change-ownership (in-vicinity "/var/guix" directory)
+                                                                uid gid))
+                                            (scandir "/var/guix"
+                                                     (lambda (file)
+                                                       (not (member file
+                                                                    excluded))))))
+                                (chown "/var/guix" uid gid)
+                                (change-ownership "/etc/guix" uid gid)
+                                (mkdir-p "/var/log/guix")
+                                (change-ownership "/var/log/guix" uid gid))
 
-         (match (command-line)
-           ((_ (= string->number (? integer? uid))
-               (= string->number (? integer? gid)))
-            (setlocale LC_ALL "C.UTF-8")          ;for file name decoding
-            (setvbuf (current-output-port) 'line)
-            (claim-data-ownership uid gid)))))))
+                              (match (command-line)
+                                ((_ (= string->number (? integer? uid))
+                                    (= string->number (? integer? gid)))
+                                 (setlocale LC_ALL "C.UTF-8")          ;for file name decoding
+                                 (setvbuf (current-output-port) 'line)
+                                 (claim-data-ownership uid gid)))))))
 
 (define-record-type* <guix-configuration>
   guix-configuration make-guix-configuration
@@ -2079,23 +2455,23 @@ (define shepherd-set-http-proxy-action
    (documentation
     "Change the HTTP(S) proxy used by 'guix-daemon' and restart it.")
    (procedure #~(lambda* (_ #:optional proxy)
-                  (let ((environment (environ)))
-                    ;; A bit of a hack: communicate PROXY to the 'start'
-                    ;; method via environment variables.
-                    (if proxy
-                        (begin
-                          (format #t "changing HTTP/HTTPS \
+                         (let ((environment (environ)))
+                           ;; A bit of a hack: communicate PROXY to the 'start'
+                           ;; method via environment variables.
+                           (if proxy
+                               (begin
+                                 (format #t "changing HTTP/HTTPS \
 proxy of 'guix-daemon' to ~s...~%"
-                                  proxy)
-                          (setenv "http_proxy" proxy))
-                        (begin
-                          (format #t "clearing HTTP/HTTPS \
+                                         proxy)
+                                 (setenv "http_proxy" proxy))
+                               (begin
+                                 (format #t "clearing HTTP/HTTPS \
 proxy of 'guix-daemon'...~%")
-                          (unsetenv "http_proxy")))
-                    (perform-service-action (lookup-service 'guix-daemon)
-                                            'restart)
-                    (environ environment)
-                    #t)))))
+                                 (unsetenv "http_proxy")))
+                           (perform-service-action (lookup-service 'guix-daemon)
+                                                   'restart)
+                           (environ environment)
+                           #t)))))
 
 (define shepherd-discover-action
   ;; Shepherd action to enable or disable substitute servers discovery.
@@ -2105,208 +2481,208 @@ (define shepherd-discover-action
     "Enable or disable substitute servers discovery and restart the
 'guix-daemon'.")
    (procedure #~(lambda* (_ status)
-                  (let ((environment (environ)))
-                    (if (and status
-                             (string=? status "on"))
-                        (begin
-                          (format #t "enable substitute servers discovery~%")
-                          (setenv "discover" "on"))
-                        (begin
-                          (format #t "disable substitute servers discovery~%")
-                          (unsetenv "discover")))
-                    (perform-service-action (lookup-service 'guix-daemon)
-                                            'restart)
-                    (environ environment)
-                    #t)))))
+                         (let ((environment (environ)))
+                           (if (and status
+                                    (string=? status "on"))
+                               (begin
+                                 (format #t "enable substitute servers discovery~%")
+                                 (setenv "discover" "on"))
+                               (begin
+                                 (format #t "disable substitute servers discovery~%")
+                                 (unsetenv "discover")))
+                           (perform-service-action (lookup-service 'guix-daemon)
+                                                   'restart)
+                           (environ environment)
+                           #t)))))
 
 (define (guix-shepherd-services config)
   "Return a <shepherd-service> for the Guix daemon service with CONFIG."
   (define locales
     (let-system (system target)
-      (if (target-hurd? (or target system))
-          (make-glibc-utf8-locales glibc/hurd)
-          glibc-utf8-locales)))
+                (if (target-hurd? (or target system))
+                    (make-glibc-utf8-locales glibc/hurd)
+                    glibc-utf8-locales)))
 
   (match-record config <guix-configuration>
-    (guix privileged?
-          build-group build-accounts chroot? authorize-key? authorized-keys
-          use-substitutes? substitute-urls max-silent-time timeout
-          log-compression discover? extra-options log-file
-          http-proxy tmpdir chroot-directories environment
-          socket-directory-permissions socket-directory-group
-          socket-directory-user)
-    (list (shepherd-service
-           (provision '(guix-ownership))
-           (requirement '(user-processes user-homes))
-           (one-shot? #t)
-           (start #~(lambda ()
-                      (let* ((store #$(%store-prefix))
-                             (stat (lstat store))
-                             (privileged? #$(guix-configuration-privileged?
-                                             config))
-                             (change-ownership #$(guix-ownership-change-program))
-                             (with-writable-store #$(run-with-writable-store)))
-                        ;; Check whether we're switching from privileged to
-                        ;; unprivileged guix-daemon, or vice versa, and adjust
-                        ;; file ownership accordingly.  Spawn a child process
-                        ;; if and only if something needs to be changed.
-                        ;;
-                        ;; Note: This service remains in 'starting' state for
-                        ;; as long as CHANGE-OWNERSHIP is running.  That way,
-                        ;; 'guix-daemon' starts only once we're done.
-                        (cond ((and (not privileged?)
-                                    (or (zero? (stat:uid stat))
-                                        (zero? (stat:gid stat))))
-                               (let ((user (getpwnam "guix-daemon")))
-                                 (format #t "Changing to unprivileged guix-daemon.~%")
-                                 (zero?
-                                  (system* with-writable-store "0" "0"
-                                           change-ownership
-                                           (number->string (passwd:uid user))
-                                           (number->string (passwd:gid user))))))
-                              ((and privileged?
-                                    (and (not (zero? (stat:uid stat)))
-                                         (not (zero? (stat:gid stat)))))
-                               (format #t "Changing to privileged guix-daemon.~%")
-                               (zero? (system* with-writable-store "0" "0"
-                                               change-ownership "0" "0")))
-                              (else #t)))))
-           (documentation "Ensure that the store and other data files used by
+                (guix privileged?
+                      build-group build-accounts chroot? authorize-key? authorized-keys
+                      use-substitutes? substitute-urls max-silent-time timeout
+                      log-compression discover? extra-options log-file
+                      http-proxy tmpdir chroot-directories environment
+                      socket-directory-permissions socket-directory-group
+                      socket-directory-user)
+                (list (shepherd-service
+                       (provision '(guix-ownership))
+                       (requirement '(user-processes user-homes))
+                       (one-shot? #t)
+                       (start #~(lambda ()
+                                  (let* ((store #$(%store-prefix))
+                                         (stat (lstat store))
+                                         (privileged? #$(guix-configuration-privileged?
+                                                         config))
+                                         (change-ownership #$(guix-ownership-change-program))
+                                         (with-writable-store #$(run-with-writable-store)))
+                                    ;; Check whether we're switching from privileged to
+                                    ;; unprivileged guix-daemon, or vice versa, and adjust
+                                    ;; file ownership accordingly.  Spawn a child process
+                                    ;; if and only if something needs to be changed.
+                                    ;;
+                                    ;; Note: This service remains in 'starting' state for
+                                    ;; as long as CHANGE-OWNERSHIP is running.  That way,
+                                    ;; 'guix-daemon' starts only once we're done.
+                                    (cond ((and (not privileged?)
+                                                (or (zero? (stat:uid stat))
+                                                    (zero? (stat:gid stat))))
+                                           (let ((user (getpwnam "guix-daemon")))
+                                             (format #t "Changing to unprivileged guix-daemon.~%")
+                                             (zero?
+                                              (system* with-writable-store "0" "0"
+                                                       change-ownership
+                                                       (number->string (passwd:uid user))
+                                                       (number->string (passwd:gid user))))))
+                                          ((and privileged?
+                                                (and (not (zero? (stat:uid stat)))
+                                                     (not (zero? (stat:gid stat)))))
+                                           (format #t "Changing to privileged guix-daemon.~%")
+                                           (zero? (system* with-writable-store "0" "0"
+                                                           change-ownership "0" "0")))
+                                          (else #t)))))
+                       (documentation "Ensure that the store and other data files used by
 guix-daemon have the right ownership."))
 
-          (shepherd-service
-           (documentation "Run the Guix daemon.")
-           (provision '(guix-daemon))
-           (requirement `(user-processes
-                          guix-ownership
-                          ,@(if discover? '(avahi-daemon) '())))
-           (actions (list shepherd-set-http-proxy-action
-                          shepherd-discover-action))
-           (modules '((srfi srfi-1)
-                      (ice-9 match)
-                      (gnu build shepherd)
-                      (guix build utils)))
-           (start
-            (with-imported-modules `(((guix config) => ,(make-config.scm))
-                                     ,@(source-module-closure
-                                        '((gnu build shepherd)
-                                          (guix build utils))
-                                        #:select? not-config?))
-              #~(lambda args
-                  (define proxy
-                    ;; HTTP/HTTPS proxy.  The 'http_proxy' variable is set by
-                    ;; the 'set-http-proxy' action.
-                    (or (getenv "http_proxy") #$http-proxy))
+                      (shepherd-service
+                       (documentation "Run the Guix daemon.")
+                       (provision '(guix-daemon))
+                       (requirement `(user-processes
+                                      guix-ownership
+                                      ,@(if discover? '(avahi-daemon) '())))
+                       (actions (list shepherd-set-http-proxy-action
+                                      shepherd-discover-action))
+                       (modules '((srfi srfi-1)
+                                  (ice-9 match)
+                                  (gnu build shepherd)
+                                  (guix build utils)))
+                       (start
+                        (with-imported-modules `(((guix config) => ,(make-config.scm))
+                                                 ,@(source-module-closure
+                                                    '((gnu build shepherd)
+                                                      (guix build utils))
+                                                    #:select? not-config?))
+                                               #~(lambda args
+                                                   (define proxy
+                                                     ;; HTTP/HTTPS proxy.  The 'http_proxy' variable is set by
+                                                     ;; the 'set-http-proxy' action.
+                                                     (or (getenv "http_proxy") #$http-proxy))
 
-                  (define discover?
-                    (or (getenv "discover") #$discover?))
+                                                   (define discover?
+                                                     (or (getenv "discover") #$discover?))
 
-                  (define daemon-command
-                    (cons* #$@(if privileged?
-                                  #~()
-                                  #~(#$(run-with-writable-store)
-                                     "guix-daemon" "guix-daemon"))
+                                                   (define daemon-command
+                                                     (cons* #$@(if privileged?
+                                                                   #~()
+                                                                   #~(#$(run-with-writable-store)
+                                                                        "guix-daemon" "guix-daemon"))
 
-                           #$(file-append guix "/bin/guix-daemon")
-                           #$@(if privileged?
-                                  #~("--build-users-group" #$build-group)
-                                  #~())
-                           "--max-silent-time"
-                           #$(number->string max-silent-time)
-                           "--timeout" #$(number->string timeout)
-                           "--log-compression"
-                           #$(symbol->string log-compression)
-                           #$@(if use-substitutes?
-                                  '()
-                                  '("--no-substitutes"))
-                           (string-append "--discover="
-                                          (if discover? "yes" "no"))
-                           "--substitute-urls" #$(string-join substitute-urls)
-                           #$@extra-options
+                                                            #$(file-append guix "/bin/guix-daemon")
+                                                            #$@(if privileged?
+                                                                   #~("--build-users-group" #$build-group)
+                                                                   #~())
+                                                            "--max-silent-time"
+                                                            #$(number->string max-silent-time)
+                                                            "--timeout" #$(number->string timeout)
+                                                            "--log-compression"
+                                                            #$(symbol->string log-compression)
+                                                            #$@(if use-substitutes?
+                                                                   '()
+                                                                   '("--no-substitutes"))
+                                                            (string-append "--discover="
+                                                                           (if discover? "yes" "no"))
+                                                            "--substitute-urls" #$(string-join substitute-urls)
+                                                            #$@extra-options
 
-                           #$@(if chroot?
-                                  '()
-                                  '("--disable-chroot"))
-                           ;; Add CHROOT-DIRECTORIES and all their dependencies
-                           ;; (if these are store items) to the chroot.
-                           (append-map
-                            (lambda (file)
-                              (append-map (lambda (directory)
-                                            (list "--chroot-directory"
-                                                  directory))
-                                          (call-with-input-file file
-                                            read)))
-                            '#$(map references-file
-                                    chroot-directories))))
+                                                            #$@(if chroot?
+                                                                   '()
+                                                                   '("--disable-chroot"))
+                                                            ;; Add CHROOT-DIRECTORIES and all their dependencies
+                                                            ;; (if these are store items) to the chroot.
+                                                            (append-map
+                                                             (lambda (file)
+                                                               (append-map (lambda (directory)
+                                                                             (list "--chroot-directory"
+                                                                                   directory))
+                                                                           (call-with-input-file file
+                                                                             read)))
+                                                             '#$(map references-file
+                                                                     chroot-directories))))
 
-                  (define environment-variables
-                    (append (list #$@(if tmpdir
-                                         (list (string-append "TMPDIR=" tmpdir))
-                                         '())
+                                                   (define environment-variables
+                                                     (append (list #$@(if tmpdir
+                                                                          (list (string-append "TMPDIR=" tmpdir))
+                                                                          '())
 
-                                  ;; Make sure we run in a UTF-8 locale so that
-                                  ;; 'guix offload' correctly restores nars
-                                  ;; that contain UTF-8 file names such as
-                                  ;; 'nss-certs'.  See
-                                  ;; <https://bugs.gnu.org/32942>.
-                                  (string-append "GUIX_LOCPATH="
-                                                 #$locales "/lib/locale")
-                                  "LC_ALL=en_US.utf8"
-                                  ;; Make 'tar' and 'gzip' available so
-                                  ;; that 'guix perform-download' can use
-                                  ;; them when downloading from Software
-                                  ;; Heritage via '(guix swh)'.
-                                  (string-append "PATH="
-                                                 #$(file-append tar "/bin") ":"
-                                                 #$(file-append gzip "/bin")))
-                            (if proxy
-                                (list (string-append "http_proxy=" proxy)
-                                      (string-append "https_proxy=" proxy))
-                                '())
-                            '#$environment))
+                                                                   ;; Make sure we run in a UTF-8 locale so that
+                                                                   ;; 'guix offload' correctly restores nars
+                                                                   ;; that contain UTF-8 file names such as
+                                                                   ;; 'nss-certs'.  See
+                                                                   ;; <https://bugs.gnu.org/32942>.
+                                                                   (string-append "GUIX_LOCPATH="
+                                                                                  #$locales "/lib/locale")
+                                                                   "LC_ALL=en_US.utf8"
+                                                                   ;; Make 'tar' and 'gzip' available so
+                                                                   ;; that 'guix perform-download' can use
+                                                                   ;; them when downloading from Software
+                                                                   ;; Heritage via '(guix swh)'.
+                                                                   (string-append "PATH="
+                                                                                  #$(file-append tar "/bin") ":"
+                                                                                  #$(file-append gzip "/bin")))
+                                                             (if proxy
+                                                                 (list (string-append "http_proxy=" proxy)
+                                                                       (string-append "https_proxy=" proxy))
+                                                                 '())
+                                                             '#$environment))
 
-                  ;; Ensure that a fresh directory is used, in case the old
-                  ;; one was more permissive and processes have a file
-                  ;; descriptor referencing it hanging around, ready to use
-                  ;; with openat.
-                  (false-if-exception
-                   (delete-file-recursively "/var/guix/daemon-socket"))
+                                                   ;; Ensure that a fresh directory is used, in case the old
+                                                   ;; one was more permissive and processes have a file
+                                                   ;; descriptor referencing it hanging around, ready to use
+                                                   ;; with openat.
+                                                   (false-if-exception
+                                                    (delete-file-recursively "/var/guix/daemon-socket"))
 
-                  (match args
-                    (((= string->number (? integer? pid)))
-                     ;; Start the guix-daemon in the same mnt namespace as
-                     ;; PID.  This is necessary when running the installer.
-                     ;; Assume /var/guix/daemon-socket was created by a
-                     ;; previous 'start' call without arguments.
-                     (fork+exec-command/container
-                      daemon-command
-                      #:pid pid
-                      #:environment-variables environment-variables
-                      #:log-file #$log-file))
-                    (()
-                     ;; Default to socket activation.
-                     (let ((socket (endpoint
-                                    (make-socket-address
-                                     AF_UNIX
-                                     "/var/guix/daemon-socket/socket")
-                                    #:name "socket"
-                                    #:socket-owner
-                                    (or #$socket-directory-user
-                                        #$(if privileged? 0 "guix-daemon"))
-                                    #:socket-group
-                                    (or #$socket-directory-group
-                                        #$(if privileged? 0 "guix-daemon"))
-                                    #:socket-directory-permissions
-                                    #$socket-directory-permissions)))
-                       ((make-systemd-constructor daemon-command
-                                                  (list socket)
-                                                  #:environment-variables
-                                                  environment-variables
-                                                  #:log-file #$log-file))))))))
-           (stop #~(lambda (value)
-                     (if (or (process? value) (integer? value))
-                         ((make-kill-destructor) value)
-                         ((make-systemd-destructor) value))))))))
+                                                   (match args
+                                                     (((= string->number (? integer? pid)))
+                                                      ;; Start the guix-daemon in the same mnt namespace as
+                                                      ;; PID.  This is necessary when running the installer.
+                                                      ;; Assume /var/guix/daemon-socket was created by a
+                                                      ;; previous 'start' call without arguments.
+                                                      (fork+exec-command/container
+                                                       daemon-command
+                                                       #:pid pid
+                                                       #:environment-variables environment-variables
+                                                       #:log-file #$log-file))
+                                                     (()
+                                                      ;; Default to socket activation.
+                                                      (let ((socket (endpoint
+                                                                     (make-socket-address
+                                                                      AF_UNIX
+                                                                      "/var/guix/daemon-socket/socket")
+                                                                     #:name "socket"
+                                                                     #:socket-owner
+                                                                     (or #$socket-directory-user
+                                                                         #$(if privileged? 0 "guix-daemon"))
+                                                                     #:socket-group
+                                                                     (or #$socket-directory-group
+                                                                         #$(if privileged? 0 "guix-daemon"))
+                                                                     #:socket-directory-permissions
+                                                                     #$socket-directory-permissions)))
+                                                        ((make-systemd-constructor daemon-command
+                                                                                   (list socket)
+                                                                                   #:environment-variables
+                                                                                   environment-variables
+                                                                                   #:log-file #$log-file))))))))
+                       (stop #~(lambda (value)
+                                 (if (or (process? value) (integer? value))
+                                     ((make-kill-destructor) value)
+                                     ((make-systemd-destructor) value))))))))
 
 (define (guix-accounts config)
   "Return the user accounts and user groups for CONFIG."
@@ -2339,39 +2715,39 @@ (define (guix-accounts config)
 (define (guix-activation config)
   "Return the activation gexp for CONFIG."
   (match-record config <guix-configuration>
-    (guix generate-substitute-key? authorize-key? authorized-keys channels)
-    #~(begin
-        ;; Assume that the store has BUILD-GROUP as its group.  We could
-        ;; otherwise call 'chown' here, but the problem is that on a COW overlayfs,
-        ;; chown leads to an entire copy of the tree, which is a bad idea.
+                (guix generate-substitute-key? authorize-key? authorized-keys channels)
+                #~(begin
+                    ;; Assume that the store has BUILD-GROUP as its group.  We could
+                    ;; otherwise call 'chown' here, but the problem is that on a COW overlayfs,
+                    ;; chown leads to an entire copy of the tree, which is a bad idea.
 
-        ;; Generate a key pair and optionally authorize substitute server keys.
-        (unless (or #$(not generate-substitute-key?)
-                    (file-exists? "/etc/guix/signing-key.pub"))
-          (system* #$(file-append guix "/bin/guix") "archive"
-                   "--generate-key"))
+                    ;; Generate a key pair and optionally authorize substitute server keys.
+                    (unless (or #$(not generate-substitute-key?)
+                                (file-exists? "/etc/guix/signing-key.pub"))
+                      (system* #$(file-append guix "/bin/guix") "archive"
+                               "--generate-key"))
 
-        ;; Optionally install /etc/guix/acl...
-        #$(if authorize-key?
-              (substitute-key-authorization authorized-keys guix)
-              #~#f)
+                    ;; Optionally install /etc/guix/acl...
+                    #$(if authorize-key?
+                          (substitute-key-authorization authorized-keys guix)
+                          #~#f)
 
-        ;; ... and /etc/guix/channels.scm...
-        #$(and channels (install-channels-file channels))
+                    ;; ... and /etc/guix/channels.scm...
+                    #$(and channels (install-channels-file channels))
 
-        ;; ... and /etc/guix/machines.scm.
-        #$(if (null? (guix-configuration-build-machines config))
-              #~#f
-              (guix-machines-files-installation
-               #~(list #$@(guix-configuration-build-machines config)))))))
+                    ;; ... and /etc/guix/machines.scm.
+                    #$(if (null? (guix-configuration-build-machines config))
+                          #~#f
+                          (guix-machines-files-installation
+                           #~(list #$@(guix-configuration-build-machines config)))))))
 
 (define-record-type* <guix-extension>
   guix-extension make-guix-extension
   guix-extension?
   (authorized-keys guix-extension-authorized-keys ;list of file-like
-                    (default '()))
+                   (default '()))
   (substitute-urls guix-extension-substitute-urls ;list of strings
-                    (default '()))
+                   (default '()))
   (build-machines  guix-extension-build-machines  ;list of gexps
                    (default '()))
   (chroot-directories guix-extension-chroot-directories ;list of file-like/strings
@@ -2471,67 +2847,67 @@ (define (guix-publish-shepherd-service config)
                    lst))))
 
   (match-record config <guix-publish-configuration>
-    (guix port host nar-path cache workers ttl negative-ttl
-          cache-bypass-threshold advertise?)
-    (let ((command #~(list #$(file-append guix "/bin/guix")
-                           "publish" "-u" "guix-publish"
-                           "-p" #$(number->string port)
-                           #$@(config->compression-options config)
-                           (string-append "--nar-path=" #$nar-path)
-                           (string-append "--listen=" #$host)
-                           #$@(if advertise?
-                                  #~("--advertise")
-                                  #~())
-                           #$@(if workers
-                                  #~((string-append "--workers="
-                                                    #$(number->string
-                                                       workers)))
-                                  #~())
-                           #$@(if ttl
-                                  #~((string-append "--ttl="
-                                                    #$(number->string ttl)
-                                                    "s"))
-                                  #~())
-                           #$@(if negative-ttl
-                                  #~((string-append "--negative-ttl="
-                                                    #$(number->string negative-ttl)
-                                                    "s"))
-                                  #~())
-                           #$@(if cache
-                                  #~((string-append "--cache=" #$cache)
-                                     #$(string-append
-                                        "--cache-bypass-threshold="
-                                        (number->string
-                                         cache-bypass-threshold)))
-                                  #~())))
-          (options #~(#:environment-variables
-                      ;; Make sure we run in a UTF-8 locale so we can produce
-                      ;; nars for packages that contain UTF-8 file names such
-                      ;; as 'nss-certs'.  See <https://bugs.gnu.org/26948>.
-                      (list (string-append "GUIX_LOCPATH="
-                                           #$(libc-utf8-locales-for-target)
-                                           "/lib/locale")
-                            "LC_ALL=en_US.utf8")
-                      #:log-file "/var/log/guix-publish.log"))
-          (endpoints #~(let ((ai (false-if-exception
-                                  (getaddrinfo #$host
-                                               #$(number->string port)
-                                               AI_NUMERICSERV))))
-                         (if (pair? ai)
-                             (list (endpoint (addrinfo:addr (car ai))))
-                             '()))))
-      (list (shepherd-service
-             (provision '(guix-publish))
-             (requirement `(user-processes
-                            guix-daemon
-                            ,@(if advertise? '(avahi-daemon) '())))
+                (guix port host nar-path cache workers ttl negative-ttl
+                      cache-bypass-threshold advertise?)
+                (let ((command #~(list #$(file-append guix "/bin/guix")
+                                       "publish" "-u" "guix-publish"
+                                       "-p" #$(number->string port)
+                                       #$@(config->compression-options config)
+                                       (string-append "--nar-path=" #$nar-path)
+                                       (string-append "--listen=" #$host)
+                                       #$@(if advertise?
+                                              #~("--advertise")
+                                              #~())
+                                       #$@(if workers
+                                              #~((string-append "--workers="
+                                                                #$(number->string
+                                                                   workers)))
+                                              #~())
+                                       #$@(if ttl
+                                              #~((string-append "--ttl="
+                                                                #$(number->string ttl)
+                                                                "s"))
+                                              #~())
+                                       #$@(if negative-ttl
+                                              #~((string-append "--negative-ttl="
+                                                                #$(number->string negative-ttl)
+                                                                "s"))
+                                              #~())
+                                       #$@(if cache
+                                              #~((string-append "--cache=" #$cache)
+                                                 #$(string-append
+                                                    "--cache-bypass-threshold="
+                                                    (number->string
+                                                     cache-bypass-threshold)))
+                                              #~())))
+                      (options #~(#:environment-variables
+                                  ;; Make sure we run in a UTF-8 locale so we can produce
+                                  ;; nars for packages that contain UTF-8 file names such
+                                  ;; as 'nss-certs'.  See <https://bugs.gnu.org/26948>.
+                                  (list (string-append "GUIX_LOCPATH="
+                                                       #$(libc-utf8-locales-for-target)
+                                                       "/lib/locale")
+                                        "LC_ALL=en_US.utf8")
+                                  #:log-file "/var/log/guix-publish.log"))
+                      (endpoints #~(let ((ai (false-if-exception
+                                              (getaddrinfo #$host
+                                                           #$(number->string port)
+                                                           AI_NUMERICSERV))))
+                                     (if (pair? ai)
+                                         (list (endpoint (addrinfo:addr (car ai))))
+                                         '()))))
+                  (list (shepherd-service
+                         (provision '(guix-publish))
+                         (requirement `(user-processes
+                                        guix-daemon
+                                        ,@(if advertise? '(avahi-daemon) '())))
 
-             ;; Use lazy socket activation unless ADVERTISE? is true: in that
-             ;; case the process should start right away to advertise itself.
-             (start #~(make-systemd-constructor
-                       #$command #$endpoints #$@options
-                       #:lazy-start? #$(not advertise?)))
-             (stop #~(make-systemd-destructor)))))))
+                         ;; Use lazy socket activation unless ADVERTISE? is true: in that
+                         ;; case the process should start right away to advertise itself.
+                         (start #~(make-systemd-constructor
+                                   #$command #$endpoints #$@options
+                                   #:lazy-start? #$(not advertise?)))
+                         (stop #~(make-systemd-destructor)))))))
 
 (define %guix-publish-accounts
   (list (user-group (name "guix-publish") (system? #t))
@@ -2547,14 +2923,14 @@ (define (guix-publish-activation config)
   (let ((cache (guix-publish-configuration-cache config)))
     (if cache
         (with-imported-modules '((guix build utils))
-          #~(begin
-              (use-modules (guix build utils))
+                               #~(begin
+                                   (use-modules (guix build utils))
 
-              (mkdir-p #$cache)
-              (let* ((pw  (getpw "guix-publish"))
-                     (uid (passwd:uid pw))
-                     (gid (passwd:gid pw)))
-                (chown #$cache uid gid))))
+                                   (mkdir-p #$cache)
+                                   (let* ((pw  (getpw "guix-publish"))
+                                          (uid (passwd:uid pw))
+                                          (gid (passwd:gid pw)))
+                                     (chown #$cache uid gid))))
         #t)))
 
 (define guix-publish-service-type
@@ -2592,24 +2968,24 @@ (define (udev-configurations-union subdirectory packages)
   (define build
     (with-imported-modules '((guix build union)
                              (guix build utils))
-      #~(begin
-          (use-modules (guix build union)
-                       (guix build utils)
-                       (srfi srfi-1)
-                       (srfi srfi-26))
+                           #~(begin
+                               (use-modules (guix build union)
+                                            (guix build utils)
+                                            (srfi srfi-1)
+                                            (srfi srfi-26))
 
-          (define %standard-locations
-            '(#$(string-append "/lib/udev/" subdirectory)
-                #$(string-append "/libexec/udev/" subdirectory)))
+                               (define %standard-locations
+                                 '(#$(string-append "/lib/udev/" subdirectory)
+                                     #$(string-append "/libexec/udev/" subdirectory)))
 
-          (define (configuration-sub-directory directory)
-            ;; Return the sub-directory of DIRECTORY containing udev
-            ;; configurations, or #f if none was found.
-            (find directory-exists?
-                  (map (cut string-append directory <>) %standard-locations)))
+                               (define (configuration-sub-directory directory)
+                                 ;; Return the sub-directory of DIRECTORY containing udev
+                                 ;; configurations, or #f if none was found.
+                                 (find directory-exists?
+                                       (map (cut string-append directory <>) %standard-locations)))
 
-          (union-build #$output
-                       (filter-map configuration-sub-directory '#$packages)))))
+                               (union-build #$output
+                                            (filter-map configuration-sub-directory '#$packages)))))
 
   (computed-file (string-append "udev-" subdirectory) build))
 
@@ -2635,19 +3011,19 @@ (define (file->udev-configuration-file subdirectory file-name file)
  of FILE."
   (computed-file file-name
                  (with-imported-modules '((guix build utils))
-                   #~(begin
-                       (use-modules (guix build utils))
+                                        #~(begin
+                                            (use-modules (guix build utils))
 
-                       (define configuration-directory
-                         (string-append #$output
-                                        "/lib/udev/"
-                                        #$subdirectory))
+                                            (define configuration-directory
+                                              (string-append #$output
+                                                             "/lib/udev/"
+                                                             #$subdirectory))
 
-                       (define file-copy-dest
-                         (string-append configuration-directory "/" #$file-name))
+                                            (define file-copy-dest
+                                              (string-append configuration-directory "/" #$file-name))
 
-                       (mkdir-p configuration-directory)
-                       (copy-file #$file file-copy-dest)))))
+                                            (mkdir-p configuration-directory)
+                                            (copy-file #$file file-copy-dest)))))
 
 (define (file->udev-rule file-name file)
   "Return a directory with a udev rule file FILE-NAME which is a copy of FILE."
@@ -2683,65 +3059,65 @@ (define (udev-shepherd-service config)
       (start
        (with-imported-modules (source-module-closure
                                '((gnu build linux-boot)))
-         #~(lambda ()
-             (define udevd
-               ;; 'udevd' from eudev.
-               #$(file-append udev "/sbin/udevd"))
+                              #~(lambda ()
+                                  (define udevd
+                                    ;; 'udevd' from eudev.
+                                    #$(file-append udev "/sbin/udevd"))
 
-             (define (wait-for-udevd)
-               ;; Wait until someone's listening on udevd's control
-               ;; socket.
-               (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0)))
-                 (let try ()
-                   (catch 'system-error
-                     (lambda ()
-                       (connect sock PF_UNIX "/run/udev/control")
-                       (close-port sock))
-                     (lambda args
-                       (format #t "waiting for udevd...~%")
-                       (usleep 500000)
-                       (try))))))
+                                  (define (wait-for-udevd)
+                                    ;; Wait until someone's listening on udevd's control
+                                    ;; socket.
+                                    (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0)))
+                                      (let try ()
+                                        (catch 'system-error
+                                               (lambda ()
+                                                 (connect sock PF_UNIX "/run/udev/control")
+                                                 (close-port sock))
+                                               (lambda args
+                                                 (format #t "waiting for udevd...~%")
+                                                 (usleep 500000)
+                                                 (try))))))
 
-             ;; Allow udev to find the modules.
-             (setenv "LINUX_MODULE_DIRECTORY"
-                     "/run/booted-system/kernel/lib/modules")
+                                  ;; Allow udev to find the modules.
+                                  (setenv "LINUX_MODULE_DIRECTORY"
+                                          "/run/booted-system/kernel/lib/modules")
 
-             (let* ((kernel-release
-                     (utsname:release (uname)))
-                    (linux-module-directory
-                     (getenv "LINUX_MODULE_DIRECTORY"))
-                    (directory
-                     (string-append linux-module-directory "/"
-                                    kernel-release))
-                    (old-umask (umask #o022)))
-               ;; If we're in a container, DIRECTORY might not exist,
-               ;; for instance because the host runs a different
-               ;; kernel.  In that case, skip it; we'll just miss a few
-               ;; nodes like /dev/fuse.
-               (when (file-exists? directory)
-                 (make-static-device-nodes directory))
-               (umask old-umask))
+                                  (let* ((kernel-release
+                                          (utsname:release (uname)))
+                                         (linux-module-directory
+                                          (getenv "LINUX_MODULE_DIRECTORY"))
+                                         (directory
+                                          (string-append linux-module-directory "/"
+                                                         kernel-release))
+                                         (old-umask (umask #o022)))
+                                    ;; If we're in a container, DIRECTORY might not exist,
+                                    ;; for instance because the host runs a different
+                                    ;; kernel.  In that case, skip it; we'll just miss a few
+                                    ;; nodes like /dev/fuse.
+                                    (when (file-exists? directory)
+                                      (make-static-device-nodes directory))
+                                    (umask old-umask))
 
-             (let ((pid (fork+exec-command
-                         (list udevd)
-                         #:environment-variables
-                         (cons*
-                          (string-append "LINUX_MODULE_DIRECTORY="
-                                         (getenv "LINUX_MODULE_DIRECTORY"))
-                          (default-environment-variables)))))
-               ;; Wait until udevd is up and running.  This appears to
-               ;; be needed so that the events triggered below are
-               ;; actually handled.
-               (wait-for-udevd)
+                                  (let ((pid (fork+exec-command
+                                              (list udevd)
+                                              #:environment-variables
+                                              (cons*
+                                               (string-append "LINUX_MODULE_DIRECTORY="
+                                                              (getenv "LINUX_MODULE_DIRECTORY"))
+                                               (default-environment-variables)))))
+                                    ;; Wait until udevd is up and running.  This appears to
+                                    ;; be needed so that the events triggered below are
+                                    ;; actually handled.
+                                    (wait-for-udevd)
 
-               ;; Trigger device node creation.
-               (system* #$(file-append udev "/bin/udevadm")
-                        "trigger" "--action=add")
+                                    ;; Trigger device node creation.
+                                    (system* #$(file-append udev "/bin/udevadm")
+                                             "trigger" "--action=add")
 
-               ;; Wait for things to settle down.
-               (system* #$(file-append udev "/bin/udevadm")
-                        "settle")
-               pid))))
+                                    ;; Wait for things to settle down.
+                                    (system* #$(file-append udev "/bin/udevadm")
+                                             "settle")
+                                    pid))))
       (stop #~(make-kill-destructor))
 
       ;; When halting the system, 'udev' is actually killed by
@@ -2760,27 +3136,27 @@ (define udev.conf
 
 (define (udev-etc config)
   (match-record config <udev-configuration>
-    (udev rules hardware)
-    (let* ((hardware
-            (udev-configurations-union "hwdb.d" (cons* udev hardware)))
-           (hwdb.bin
-            (computed-file
-             "hwdb.bin"
-             (with-imported-modules '((guix build utils))
-               #~(begin
-                   (use-modules (guix build utils))
-                   (setenv "UDEV_HWDB_PATH" #$hardware)
-                   (invoke #+(file-append udev "/bin/udevadm")
-                           "hwdb"
-                           "--update"
-                           "-o" #$output))))))
-    `(("udev"
-       ,(file-union "udev"
-                    `(("udev.conf" ,udev.conf)
-                      ("rules.d"
-                       ,(udev-rules-union (cons* udev kvm-udev-rule
-                                                 rules)))
-                      ("hwdb.bin" ,hwdb.bin))))))))
+                (udev rules hardware)
+                (let* ((hardware
+                        (udev-configurations-union "hwdb.d" (cons* udev hardware)))
+                       (hwdb.bin
+                        (computed-file
+                         "hwdb.bin"
+                         (with-imported-modules '((guix build utils))
+                                                #~(begin
+                                                    (use-modules (guix build utils))
+                                                    (setenv "UDEV_HWDB_PATH" #$hardware)
+                                                    (invoke #+(file-append udev "/bin/udevadm")
+                                                            "hwdb"
+                                                            "--update"
+                                                            "-o" #$output))))))
+                  `(("udev"
+                     ,(file-union "udev"
+                                  `(("udev.conf" ,udev.conf)
+                                    ("rules.d"
+                                     ,(udev-rules-union (cons* udev kvm-udev-rule
+                                                               rules)))
+                                    ("hwdb.bin" ,hwdb.bin))))))))
 
 (define udev-service-type
   (service-type (name 'udev)
@@ -2856,7 +3232,7 @@ (define (swap-space->shepherd-service-name space)
                           (else
                            target))))))
 
-; TODO Remove after deprecation
+                                        ; TODO Remove after deprecation
 (define (swap-deprecated->shepherd-service-name sdep)
   (symbol-append 'swap-
                  (string->symbol
@@ -2881,7 +3257,7 @@ (define swap-service-type
        (cond ((swap-space? swap)
               (map dependency->shepherd-service-name
                    (swap-space-dependencies swap)))
-             ; TODO Remove after deprecation
+                                        ; TODO Remove after deprecation
              ((and (string? swap) (string-prefix? "/dev/mapper/" swap))
               (list (symbol-append 'device-mapping-
                                    (string->symbol (basename swap)))))
@@ -2900,7 +3276,7 @@ (define swap-service-type
                           #$(file-system-label->string target)))
                       (else
                        target))))
-             ; TODO Remove after deprecation
+                                        ; TODO Remove after deprecation
              ((uuid? swap)
               #~(find-partition-by-uuid #$(uuid-bytevector swap)))
              ((file-system-label? swap)
@@ -2910,33 +3286,33 @@ (define swap-service-type
               swap)))
 
      (with-imported-modules (source-module-closure '((gnu build file-systems)))
-       (shepherd-service
-        (provision (list (swap->shepherd-service-name swap)))
-        (requirement `(,@(if (target-hurd?) '() '(udev)) ,@requirements))
-        (documentation "Enable the given swap space.")
-        (modules `((gnu build file-systems)
-                   ,@%default-modules))
-        (start #~(lambda ()
-                   (let ((device #$device-lookup))
-                     (and device
-                          (begin
-                            #$(if (target-hurd?)
-                                  #~(system* "swapon" device)
-                                  #~(restart-on-EINTR
-                                     (swapon device
-                                             #$(if (swap-space? swap)
-                                                   (swap-space->flags-bit-mask
-                                                    swap)
-                                                   0))))
-                            #t)))))
-        (stop #~(lambda _
-                  (let ((device #$device-lookup))
-                    (when device
-                      #$(if (target-hurd?)
-                            #~(system* "swapoff" device)
-                            #~(restart-on-EINTR (swapoff device))))
-                    #f)))
-        (respawn? #f))))
+                            (shepherd-service
+                             (provision (list (swap->shepherd-service-name swap)))
+                             (requirement `(,@(if (target-hurd?) '() '(udev)) ,@requirements))
+                             (documentation "Enable the given swap space.")
+                             (modules `((gnu build file-systems)
+                                        ,@%default-modules))
+                             (start #~(lambda ()
+                                        (let ((device #$device-lookup))
+                                          (and device
+                                               (begin
+                                                 #$(if (target-hurd?)
+                                                       #~(system* "swapon" device)
+                                                       #~(restart-on-EINTR
+                                                          (swapon device
+                                                                  #$(if (swap-space? swap)
+                                                                        (swap-space->flags-bit-mask
+                                                                         swap)
+                                                                        0))))
+                                                 #t)))))
+                             (stop #~(lambda _
+                                       (let ((device #$device-lookup))
+                                         (when device
+                                           #$(if (target-hurd?)
+                                                 #~(system* "swapoff" device)
+                                                 #~(restart-on-EINTR (swapoff device))))
+                                         #f)))
+                             (respawn? #f))))
    (description "Turn on the virtual memory swap area.")))
 
 (define (swap-service swap)
@@ -2956,21 +3332,21 @@ (define-record-type* <gpm-configuration>
 
 (define (gpm-shepherd-service config)
   (match-record config <gpm-configuration>
-    (gpm options)
-    (list (shepherd-service
-           (requirement '(user-processes udev))
-           (provision '(gpm))
-           ;; 'gpm' runs in the background and sets a PID file.
-           ;; Note that it requires running as "root".
-           (start #~(make-forkexec-constructor
-                     (list #$(file-append gpm "/sbin/gpm")
-                           #$@options)
-                     #:pid-file "/var/run/gpm.pid"
-                     #:pid-file-timeout 3))
-           (stop #~(lambda (_)
-                     ;; Return #f if successfully stopped.
-                     (not (zero? (system* #$(file-append gpm "/sbin/gpm")
-                                          "-k")))))))))
+                (gpm options)
+                (list (shepherd-service
+                       (requirement '(user-processes udev))
+                       (provision '(gpm))
+                       ;; 'gpm' runs in the background and sets a PID file.
+                       ;; Note that it requires running as "root".
+                       (start #~(make-forkexec-constructor
+                                 (list #$(file-append gpm "/sbin/gpm")
+                                       #$@options)
+                                 #:pid-file "/var/run/gpm.pid"
+                                 #:pid-file-timeout 3))
+                       (stop #~(lambda (_)
+                                 ;; Return #f if successfully stopped.
+                                 (not (zero? (system* #$(file-append gpm "/sbin/gpm")
+                                                      "-k")))))))))
 
 (define gpm-service-type
   (service-type (name 'gpm)
@@ -3235,38 +3611,38 @@ (define (network-set-up/hurd config)
       (program-file "set-up-pflocal" #~(begin 'nothing-to-do! #t))
       (program-file "set-up-pfinet"
                     (with-imported-modules '((guix build utils))
-                      #~(begin
-                          (use-modules (guix build utils)
-                                       (ice-9 format))
+                                           #~(begin
+                                               (use-modules (guix build utils)
+                                                            (ice-9 format))
 
-                          ;; TODO: Do that without forking.
-                          (let ((options '#$(static-networking->hurd-pfinet-options
-                                             config)))
-                            (format #t "starting '~a~{ ~s~}'~%"
-                                    #$(file-append hurd "/hurd/pfinet")
-                                    options)
-                            (apply invoke #$(file-append hurd "/bin/settrans")
-                                   "--active"
-                                   "--create"
-                                   "--keep-active"
-                                   "/servers/socket/2"
-                                   #$(file-append hurd "/hurd/pfinet")
-                                   options)))))))
+                                               ;; TODO: Do that without forking.
+                                               (let ((options '#$(static-networking->hurd-pfinet-options
+                                                                  config)))
+                                                 (format #t "starting '~a~{ ~s~}'~%"
+                                                         #$(file-append hurd "/hurd/pfinet")
+                                                         options)
+                                                 (apply invoke #$(file-append hurd "/bin/settrans")
+                                                        "--active"
+                                                        "--create"
+                                                        "--keep-active"
+                                                        "/servers/socket/2"
+                                                        #$(file-append hurd "/hurd/pfinet")
+                                                        options)))))))
 
 (define (network-tear-down/hurd config)
   (program-file "tear-down-pfinet"
                 (with-imported-modules '((guix build utils))
-                  #~(begin
-                      (use-modules (guix build utils))
+                                       #~(begin
+                                           (use-modules (guix build utils))
 
-                      ;; Forcefully terminate pfinet.  XXX: In theory this
-                      ;; should just undo the addresses and routes of CONFIG;
-                      ;; this could be done using ioctls like SIOCDELRT, but
-                      ;; these are IPv4-only; another option would be to use
-                      ;; fsysopts but that seems to crash pfinet.
-                      (invoke #$(file-append hurd "/bin/settrans") "-fg"
-                              "/servers/socket/2")
-                      #f))))
+                                           ;; Forcefully terminate pfinet.  XXX: In theory this
+                                           ;; should just undo the addresses and routes of CONFIG;
+                                           ;; this could be done using ioctls like SIOCDELRT, but
+                                           ;; these are IPv4-only; another option would be to use
+                                           ;; fsysopts but that seems to crash pfinet.
+                                           (invoke #$(file-append hurd "/bin/settrans") "-fg"
+                                                   "/servers/socket/2")
+                                           #f))))
 
 (define (network-set-up/linux config)
   (define max-set-up-duration
@@ -3274,199 +3650,199 @@ (define (network-set-up/linux config)
     60)
 
   (match-record config <static-networking>
-    (addresses links routes)
-    (program-file "set-up-network"
-                  (with-extensions (list guile-netlink)
-                    #~(begin
-                        (use-modules (ip addr) (ip link) (ip route)
-                                     (srfi srfi-1)
-                                     (ice-9 format)
-                                     (ice-9 match))
+                (addresses links routes)
+                (program-file "set-up-network"
+                              (with-extensions (list guile-netlink)
+                                               #~(begin
+                                                   (use-modules (ip addr) (ip link) (ip route)
+                                                                (srfi srfi-1)
+                                                                (ice-9 format)
+                                                                (ice-9 match))
 
-                        (define (match-link-by field-accessor value)
-                          (fold (lambda (link result)
-                                  (if (equal? (field-accessor link) value)
-                                      link
-                                      result))
-                                #f
-                                (get-links)))
+                                                   (define (match-link-by field-accessor value)
+                                                     (fold (lambda (link result)
+                                                             (if (equal? (field-accessor link) value)
+                                                                 link
+                                                                 result))
+                                                           #f
+                                                           (get-links)))
 
-                        (define (alist->keyword+value alist)
-                          (fold (match-lambda*
-                                  (((k . v) r)
-                                   (cons* (symbol->keyword k) v r))) '() alist))
+                                                   (define (alist->keyword+value alist)
+                                                     (fold (match-lambda*
+                                                             (((k . v) r)
+                                                              (cons* (symbol->keyword k) v r))) '() alist))
 
-                        ;; FIXME: It is interesting that "modprobe bonding" creates an
-                        ;; interface bond0 straigt away.  If we won't have bonding
-                        ;; module, and execute `ip link add name bond0 type bond' we
-                        ;; will get
-                        ;;
-                        ;; RTNETLINK answers: File exists
-                        ;;
-                        ;; This breaks our configuration if we want to
-                        ;; use `bond0' name.  Create (force modprobe
-                        ;; bonding) and delete the interface to free up
-                        ;; bond0 name.
-                        #$(let lp ((links links))
-                            (cond
-                             ((null? links) #f)
-                             ((and (network-link? (car links))
-                                   ;; Type is not mandatory
-                                   (false-if-exception
-                                    (eq? (network-link-type (car links)) 'bond)))
-                              #~(begin
-                                  (false-if-exception (link-add "bond0" "bond"))
-                                  (link-del "bond0")))
-                             (else (lp (cdr links)))))
+                                                   ;; FIXME: It is interesting that "modprobe bonding" creates an
+                                                   ;; interface bond0 straigt away.  If we won't have bonding
+                                                   ;; module, and execute `ip link add name bond0 type bond' we
+                                                   ;; will get
+                                                   ;;
+                                                   ;; RTNETLINK answers: File exists
+                                                   ;;
+                                                   ;; This breaks our configuration if we want to
+                                                   ;; use `bond0' name.  Create (force modprobe
+                                                   ;; bonding) and delete the interface to free up
+                                                   ;; bond0 name.
+                                                   #$(let lp ((links links))
+                                                       (cond
+                                                        ((null? links) #f)
+                                                        ((and (network-link? (car links))
+                                                              ;; Type is not mandatory
+                                                              (false-if-exception
+                                                               (eq? (network-link-type (car links)) 'bond)))
+                                                         #~(begin
+                                                             (false-if-exception (link-add "bond0" "bond"))
+                                                             (link-del "bond0")))
+                                                        (else (lp (cdr links)))))
 
-                        #$@(map (match-lambda
-                                  (($ <network-link> name type mac-address arguments)
-                                   (cond
-                                    ;; Create a new interface
-                                    ((and (string? name) (symbol? type))
-                                     #~(begin
-                                         (link-add #$name (symbol->string '#$type) #:type-args '#$arguments)
-                                         ;; XXX: If we add routes, addresses must be
-                                         ;; already assigned, and interfaces must be
-                                         ;; up. It doesn't matter if they won't have
-                                         ;; carrier or anything.
-                                         (link-set #$name #:up #t)))
+                                                   #$@(map (match-lambda
+                                                             (($ <network-link> name type mac-address arguments)
+                                                              (cond
+                                                               ;; Create a new interface
+                                                               ((and (string? name) (symbol? type))
+                                                                #~(begin
+                                                                    (link-add #$name (symbol->string '#$type) #:type-args '#$arguments)
+                                                                    ;; XXX: If we add routes, addresses must be
+                                                                    ;; already assigned, and interfaces must be
+                                                                    ;; up. It doesn't matter if they won't have
+                                                                    ;; carrier or anything.
+                                                                    (link-set #$name #:up #t)))
 
-                                    ;; Amend an existing interface
-                                    ((and (string? name)
-                                          (eq? type #f))
-                                     #~(let ((link (match-link-by link-name #$name)))
-                                         (if link
-                                             (apply link-set
-                                                    (link-id link)
-                                                    (alist->keyword+value '#$arguments))
-                                             (format #t (G_ "Interface with name '~a' not found~%") #$name))))
-                                    ((string? mac-address)
-                                     #~(let ((link (match-link-by link-addr #$mac-address)))
-                                         (if link
-                                             (apply link-set
-                                                    (link-id link)
-                                                    (alist->keyword+value '#$arguments))
-                                             (format #t (G_ "Interface with mac-address '~a' not found~%") #$mac-address)))))))
-                                links)
+                                                               ;; Amend an existing interface
+                                                               ((and (string? name)
+                                                                     (eq? type #f))
+                                                                #~(let ((link (match-link-by link-name #$name)))
+                                                                    (if link
+                                                                        (apply link-set
+                                                                               (link-id link)
+                                                                               (alist->keyword+value '#$arguments))
+                                                                        (format #t (G_ "Interface with name '~a' not found~%") #$name))))
+                                                               ((string? mac-address)
+                                                                #~(let ((link (match-link-by link-addr #$mac-address)))
+                                                                    (if link
+                                                                        (apply link-set
+                                                                               (link-id link)
+                                                                               (alist->keyword+value '#$arguments))
+                                                                        (format #t (G_ "Interface with mac-address '~a' not found~%") #$mac-address)))))))
+                                                           links)
 
-                        ;; 'wait-for-link' below could wait forever when
-                        ;; passed a non-existent device.  To ensure timely
-                        ;; completion, install an alarm.
-                        (alarm #$max-set-up-duration)
+                                                   ;; 'wait-for-link' below could wait forever when
+                                                   ;; passed a non-existent device.  To ensure timely
+                                                   ;; completion, install an alarm.
+                                                   (alarm #$max-set-up-duration)
 
-                        #$@(map (lambda (address)
-                                  #~(let ((device
-                                           #$(network-address-device address)))
-                                      ;; Before going any further, wait for the
-                                      ;; device to show up.
-                                      (format #t "Waiting for network device '~a'...~%"
-                                              device)
-                                      (wait-for-link device)
+                                                   #$@(map (lambda (address)
+                                                             #~(let ((device
+                                                                      #$(network-address-device address)))
+                                                                 ;; Before going any further, wait for the
+                                                                 ;; device to show up.
+                                                                 (format #t "Waiting for network device '~a'...~%"
+                                                                         device)
+                                                                 (wait-for-link device)
 
-                                      (addr-add #$(network-address-device address)
-                                                #$(network-address-value address)
-                                                #:ipv6?
-                                                #$(network-address-ipv6? address))
-                                      ;; FIXME: loopback?
-                                      (link-set #$(network-address-device address)
-                                                #:multicast-on #t
-                                                #:up #t)))
-                                addresses)
+                                                                 (addr-add #$(network-address-device address)
+                                                                           #$(network-address-value address)
+                                                                           #:ipv6?
+                                                                           #$(network-address-ipv6? address))
+                                                                 ;; FIXME: loopback?
+                                                                 (link-set #$(network-address-device address)
+                                                                           #:multicast-on #t
+                                                                           #:up #t)))
+                                                           addresses)
 
-                        #$@(map (lambda (route)
-                                  #~(route-add #$(network-route-destination route)
-                                               #:device
-                                               #$(network-route-device route)
-                                               #:ipv6?
-                                               #$(network-route-ipv6? route)
-                                               #:via
-                                               #$(network-route-gateway route)
-                                               #:src
-                                               #$(network-route-source route)))
-                                routes)
-                        #t)))))
+                                                   #$@(map (lambda (route)
+                                                             #~(route-add #$(network-route-destination route)
+                                                                          #:device
+                                                                          #$(network-route-device route)
+                                                                          #:ipv6?
+                                                                          #$(network-route-ipv6? route)
+                                                                          #:via
+                                                                          #$(network-route-gateway route)
+                                                                          #:src
+                                                                          #$(network-route-source route)))
+                                                           routes)
+                                                   #t)))))
 
 (define (network-tear-down/linux config)
   (match-record config <static-networking>
-    (addresses links routes)
-    (program-file "tear-down-network"
-                  (with-extensions (list guile-netlink)
-                    #~(begin
-                        (use-modules (ip addr) (ip link) (ip route)
-                                     (netlink error)
-                                     (srfi srfi-34))
+                (addresses links routes)
+                (program-file "tear-down-network"
+                              (with-extensions (list guile-netlink)
+                                               #~(begin
+                                                   (use-modules (ip addr) (ip link) (ip route)
+                                                                (netlink error)
+                                                                (srfi srfi-34))
 
-                        (define-syntax-rule (false-if-netlink-error exp)
-                          (guard (c ((netlink-error? c) #f))
-                            exp))
+                                                   (define-syntax-rule (false-if-netlink-error exp)
+                                                     (guard (c ((netlink-error? c) #f))
+                                                            exp))
 
-                        ;; Wrap calls in 'false-if-netlink-error' so this
-                        ;; script goes as far as possible undoing the effects
-                        ;; of "set-up-network".
+                                                   ;; Wrap calls in 'false-if-netlink-error' so this
+                                                   ;; script goes as far as possible undoing the effects
+                                                   ;; of "set-up-network".
 
-                        #$@(map (lambda (route)
-                                  #~(false-if-netlink-error
-                                     (route-del #$(network-route-destination route)
-                                                #:device
-                                                #$(network-route-device route)
-                                                #:ipv6?
-                                                #$(network-route-ipv6? route)
-                                                #:via
-                                                #$(network-route-gateway route)
-                                                #:src
-                                                #$(network-route-source route))))
-                                routes)
+                                                   #$@(map (lambda (route)
+                                                             #~(false-if-netlink-error
+                                                                (route-del #$(network-route-destination route)
+                                                                           #:device
+                                                                           #$(network-route-device route)
+                                                                           #:ipv6?
+                                                                           #$(network-route-ipv6? route)
+                                                                           #:via
+                                                                           #$(network-route-gateway route)
+                                                                           #:src
+                                                                           #$(network-route-source route))))
+                                                           routes)
 
-                        ;; Cleanup addresses first, they might be assigned to
-                        ;; created bonds, vlans or bridges.
-                        #$@(map (lambda (address)
-                                  #~(false-if-netlink-error
-                                     (addr-del #$(network-address-device
-                                                  address)
-                                               #$(network-address-value address)
-                                               #:ipv6?
-                                               #$(network-address-ipv6? address))))
-                                addresses)
+                                                   ;; Cleanup addresses first, they might be assigned to
+                                                   ;; created bonds, vlans or bridges.
+                                                   #$@(map (lambda (address)
+                                                             #~(false-if-netlink-error
+                                                                (addr-del #$(network-address-device
+                                                                             address)
+                                                                          #$(network-address-value address)
+                                                                          #:ipv6?
+                                                                          #$(network-address-ipv6? address))))
+                                                           addresses)
 
-                        ;; It is now safe to delete some links
-                        #$@(map (match-lambda
-                                  (($ <network-link> name type mac-address arguments)
-                                   (cond
-                                    ;; We delete interfaces that were created
-                                    ((and (string? name) (symbol? type))
-                                     #~(false-if-netlink-error
-                                        (link-del #$name)))
-                                    (else #t))))
-                                links)
-                        #f)))))
+                                                   ;; It is now safe to delete some links
+                                                   #$@(map (match-lambda
+                                                             (($ <network-link> name type mac-address arguments)
+                                                              (cond
+                                                               ;; We delete interfaces that were created
+                                                               ((and (string? name) (symbol? type))
+                                                                #~(false-if-netlink-error
+                                                                   (link-del #$name)))
+                                                               (else #t))))
+                                                           links)
+                                                   #f)))))
 
 (define (static-networking-shepherd-service config)
   (match-record config <static-networking>
-    (addresses links routes provision requirement name-servers)
-    (let ((loopback? (and provision (memq 'loopback provision))))
-      (shepherd-service
+                (addresses links routes provision requirement name-servers)
+                (let ((loopback? (and provision (memq 'loopback provision))))
+                  (shepherd-service
 
-       (documentation
-        "Bring up the networking interface using a static IP address.")
-       (requirement requirement)
-       (provision provision)
+                   (documentation
+                    "Bring up the networking interface using a static IP address.")
+                   (requirement requirement)
+                   (provision provision)
 
-       (start #~(lambda _
-                  ;; Return #t if successfully started.
-                  (zero? (system*
-                          #$(let-system (system target)
-                              (if (string-contains (or target system) "-linux")
-                                  (network-set-up/linux config)
-                                  (network-set-up/hurd config)))))))
-       (stop #~(lambda _
-                 ;; Return #f is successfully stopped.
-                 (zero? (system*
-                         #$(let-system (system target)
-                             (if (string-contains (or target system) "-linux")
-                                 (network-tear-down/linux config)
-                                 (network-tear-down/hurd config)))))))
-       (respawn? #f)))))
+                   (start #~(lambda _
+                              ;; Return #t if successfully started.
+                              (zero? (system*
+                                      #$(let-system (system target)
+                                                    (if (string-contains (or target system) "-linux")
+                                                        (network-set-up/linux config)
+                                                        (network-set-up/hurd config)))))))
+                   (stop #~(lambda _
+                             ;; Return #f is successfully stopped.
+                             (zero? (system*
+                                     #$(let-system (system target)
+                                                   (if (string-contains (or target system) "-linux")
+                                                       (network-tear-down/linux config)
+                                                       (network-tear-down/hurd config)))))))
+                   (respawn? #f)))))
 
 (define (static-networking-shepherd-services networks)
   (map static-networking-shepherd-service networks))
@@ -3700,35 +4076,35 @@ (define (make-greetd-sway-greeter-command sway sway-config)
     (program-file
      "greeter-sway-command"
      (with-imported-modules '((guix build utils))
-       #~(begin
-           (use-modules (guix build utils))
+                            #~(begin
+                                (use-modules (guix build utils))
 
-           (let* ((username (getenv "USER"))
-                  (user (getpwnam username))
-                  (useruid (passwd:uid user))
-                  (usergid (passwd:gid user))
-                  (useruid-s (number->string useruid))
-                  ;; /run/user/<greeter-user-uid> won't exist yet
-                  ;; this will contain WAYLAND_DISPLAY socket file
-                  ;; and log-file below
-                  (user-home-dir "/tmp/.greeter-home")
-                  (user-xdg-runtime-dir (string-append user-home-dir "/run"))
-                  (user-xdg-cache-dir (string-append user-home-dir "/cache"))
-                  (log-file (string-append (number->string (getpid)) ".log"))
-                  (log-file (string-append user-home-dir "/" log-file)))
-             (for-each (lambda (d)
-                         (mkdir-p d)
-                         (chown d useruid usergid) (chmod d #o700))
-                       (list user-home-dir
-                             user-xdg-runtime-dir
-                             user-xdg-cache-dir))
-             (setenv "HOME" user-home-dir)
-             (setenv "XDG_CACHE_DIR" user-xdg-cache-dir)
-             (setenv "XDG_RUNTIME_DIR" user-xdg-runtime-dir)
-             (dup2 (open-fdes log-file
-                              (logior O_CREAT O_WRONLY O_APPEND) #o640) 1)
-             (dup2 1 2)
-             (execl #$sway-bin #$sway-bin "-d" "-c" #$sway-config)))))))
+                                (let* ((username (getenv "USER"))
+                                       (user (getpwnam username))
+                                       (useruid (passwd:uid user))
+                                       (usergid (passwd:gid user))
+                                       (useruid-s (number->string useruid))
+                                       ;; /run/user/<greeter-user-uid> won't exist yet
+                                       ;; this will contain WAYLAND_DISPLAY socket file
+                                       ;; and log-file below
+                                       (user-home-dir "/tmp/.greeter-home")
+                                       (user-xdg-runtime-dir (string-append user-home-dir "/run"))
+                                       (user-xdg-cache-dir (string-append user-home-dir "/cache"))
+                                       (log-file (string-append (number->string (getpid)) ".log"))
+                                       (log-file (string-append user-home-dir "/" log-file)))
+                                  (for-each (lambda (d)
+                                              (mkdir-p d)
+                                              (chown d useruid usergid) (chmod d #o700))
+                                            (list user-home-dir
+                                                  user-xdg-runtime-dir
+                                                  user-xdg-cache-dir))
+                                  (setenv "HOME" user-home-dir)
+                                  (setenv "XDG_CACHE_DIR" user-xdg-cache-dir)
+                                  (setenv "XDG_RUNTIME_DIR" user-xdg-runtime-dir)
+                                  (dup2 (open-fdes log-file
+                                                   (logior O_CREAT O_WRONLY O_APPEND) #o640) 1)
+                                  (dup2 1 2)
+                                  (execl #$sway-bin #$sway-bin "-d" "-c" #$sway-config)))))))
 
 (define-record-type* <greetd-wlgreet-configuration>
   greetd-wlgreet-configuration make-greetd-wlgreet-configuration
@@ -3795,21 +4171,21 @@ (define (make-greetd-wlgreet-config-color section-name color)
 
 (define (make-greetd-wlgreet-config command color)
   (match-record color <greetd-wlgreet-configuration>
-    (output-mode scale background headline prompt prompt-error border)
-    (mixed-text-file
-     "wlgreet.toml"
-     "command = \"" command "\"\n"
-     "outputMode = \"" output-mode "\"\n"
-     "scale = " (number->string scale) "\n"
-     (apply string-append
-            (map (match-lambda
-                   ((section-name . color)
-                    (make-greetd-wlgreet-config-color section-name color)))
-                 `(("background" . ,background)
-                   ("headline" . ,headline)
-                   ("prompt" . ,prompt)
-                   ("prompt-error" . ,prompt-error)
-                   ("border" . ,border)))))))
+                (output-mode scale background headline prompt prompt-error border)
+                (mixed-text-file
+                 "wlgreet.toml"
+                 "command = \"" command "\"\n"
+                 "outputMode = \"" output-mode "\"\n"
+                 "scale = " (number->string scale) "\n"
+                 (apply string-append
+                        (map (match-lambda
+                               ((section-name . color)
+                                (make-greetd-wlgreet-config-color section-name color)))
+                             `(("background" . ,background)
+                               ("headline" . ,headline)
+                               ("prompt" . ,prompt)
+                               ("prompt-error" . ,prompt-error)
+                               ("border" . ,border)))))))
 
 (define-record-type* <greetd-wlgreet-sway-session>
   greetd-wlgreet-sway-session make-greetd-wlgreet-sway-session
@@ -3836,18 +4212,18 @@ (define (warn-deprecated-greetd-wlgreet-sway-session-wlgreet-session value)
 (define (make-greetd-wlgreet-sway-session-sway-config session)
   (match-record session <greetd-wlgreet-sway-session>
                 (sway sway-configuration wlgreet wlgreet-configuration command)
-    (let ((wlgreet-bin (file-append wlgreet "/bin/wlgreet"))
-          (wlgreet-config-file
-           (make-greetd-wlgreet-config command wlgreet-configuration))
-          (swaymsg-bin (file-append sway "/bin/swaymsg")))
-      (mixed-text-file
-       "wlgreet-sway-config"
-       (if sway-configuration
-           #~(string-append "include " #$sway-configuration "\n")
-           "")
-       "xwayland disable\n"
-       "exec \"" wlgreet-bin " --config " wlgreet-config-file
-       "; " swaymsg-bin " exit\"\n"))))
+                (let ((wlgreet-bin (file-append wlgreet "/bin/wlgreet"))
+                      (wlgreet-config-file
+                       (make-greetd-wlgreet-config command wlgreet-configuration))
+                      (swaymsg-bin (file-append sway "/bin/swaymsg")))
+                  (mixed-text-file
+                   "wlgreet-sway-config"
+                   (if sway-configuration
+                       #~(string-append "include " #$sway-configuration "\n")
+                       "")
+                   "xwayland disable\n"
+                   "exec \"" wlgreet-bin " --config " wlgreet-config-file
+                   "; " swaymsg-bin " exit\"\n"))))
 
 (define (greetd-wlgreet-session-to-config session config)
   (let* ((wlgreet (or (greetd-wlgreet config)
@@ -3880,10 +4256,10 @@ (define-gexp-compiler (greetd-wlgreet-sway-session-compiler
                 session
                 (greetd-wlgreet-sway-session-wlgreet-session session)))))
     (match-record s <greetd-wlgreet-sway-session> (sway)
-      (lower-object
-       (make-greetd-sway-greeter-command
-        sway
-        (make-greetd-wlgreet-sway-session-sway-config s))))))
+                  (lower-object
+                   (make-greetd-sway-greeter-command
+                    sway
+                    (make-greetd-wlgreet-sway-session-sway-config s))))))
 
 (define-record-type* <greetd-gtkgreet-sway-session>
   greetd-gtkgreet-sway-session make-greetd-gtkgreet-sway-session
@@ -3899,26 +4275,26 @@ (define-record-type* <greetd-gtkgreet-sway-session>
 (define (make-greetd-gtkgreet-sway-session-sway-config session)
   (match-record session <greetd-gtkgreet-sway-session>
                 (sway sway-configuration gtkgreet gtkgreet-style command)
-    (let ((gtkgreet-bin (file-append gtkgreet "/bin/gtkgreet"))
-          (swaymsg-bin (file-append sway "/bin/swaymsg")))
-      (mixed-text-file
-       "gtkgreet-sway-config"
-       (if sway-configuration
-           #~(string-append "include " #$sway-configuration "\n")
-           "")
-       "xwayland disable\n"
-       "exec \"" gtkgreet-bin " -l"
-       (if gtkgreet-style #~(string-append " -s " #$gtkgreet-style) "")
-       " -c " command "; " swaymsg-bin " exit\"\n"))))
+                (let ((gtkgreet-bin (file-append gtkgreet "/bin/gtkgreet"))
+                      (swaymsg-bin (file-append sway "/bin/swaymsg")))
+                  (mixed-text-file
+                   "gtkgreet-sway-config"
+                   (if sway-configuration
+                       #~(string-append "include " #$sway-configuration "\n")
+                       "")
+                   "xwayland disable\n"
+                   "exec \"" gtkgreet-bin " -l"
+                   (if gtkgreet-style #~(string-append " -s " #$gtkgreet-style) "")
+                   " -c " command "; " swaymsg-bin " exit\"\n"))))
 
 (define-gexp-compiler (greetd-gtkgreet-sway-session-compiler
                        (session <greetd-gtkgreet-sway-session>)
                        system target)
   (match-record session <greetd-gtkgreet-sway-session> (sway)
-    (lower-object
-     (make-greetd-sway-greeter-command
-      sway
-      (make-greetd-gtkgreet-sway-session-sway-config session)))))
+                (lower-object
+                 (make-greetd-sway-greeter-command
+                  sway
+                  (make-greetd-gtkgreet-sway-session-sway-config session)))))
 
 (define-record-type* <greetd-terminal-configuration>
   greetd-terminal-configuration make-greetd-terminal-configuration
@@ -3963,13 +4339,13 @@ (define (make-greetd-terminal-configuration-file config)
 
 (define %greetd-file-systems
   (list (file-system
-          (device "none")
-          (mount-point "/run/greetd/pam_mount")
-          (type "tmpfs")
-          (check? #f)
-          (flags '(no-suid no-dev no-exec))
-          (options "mode=0755")
-          (create-mount-point? #t))))
+         (device "none")
+         (mount-point "/run/greetd/pam_mount")
+         (type "tmpfs")
+         (check? #f)
+         (flags '(no-suid no-dev no-exec))
+         (options "mode=0755")
+         (create-mount-point? #t))))
 
 (define %greetd-pam-mount-rules
   `((debug (@ (enable "0")))
@@ -4107,23 +4483,23 @@ (define %base-services
 
         (service shepherd-system-log-service-type)
         (service agetty-service-type (agetty-configuration
-                                       (extra-options '("-L")) ; no carrier detect
-                                       (term "vt100")
-                                       (tty #f) ; automatic
-                                       (shepherd-requirement '(syslogd))))
+                                      (extra-options '("-L")) ; no carrier detect
+                                      (term "vt100")
+                                      (tty #f) ; automatic
+                                      (shepherd-requirement '(syslogd))))
 
         (service mingetty-service-type (mingetty-configuration
-                                         (tty "tty1")))
+                                        (tty "tty1")))
         (service mingetty-service-type (mingetty-configuration
-                                         (tty "tty2")))
+                                        (tty "tty2")))
         (service mingetty-service-type (mingetty-configuration
-                                         (tty "tty3")))
+                                        (tty "tty3")))
         (service mingetty-service-type (mingetty-configuration
-                                         (tty "tty4")))
+                                        (tty "tty4")))
         (service mingetty-service-type (mingetty-configuration
-                                         (tty "tty5")))
+                                        (tty "tty5")))
         (service mingetty-service-type (mingetty-configuration
-                                         (tty "tty6")))
+                                        (tty "tty6")))
 
         (service static-networking-service-type
                  (list %loopback-static-networking))
@@ -4147,7 +4523,7 @@ (define %base-services
         ;; less critical, but handy.
         (service udev-service-type
                  (udev-configuration
-                   (rules (list lvm2 fuse alsa-utils crda))))
+                  (rules (list lvm2 fuse alsa-utils crda))))
 
         (service sysctl-service-type)

base-commit: 55d9b6ff118e777d3e56e5544e51d1c998619727
-- 
2.49.0