services: base: Use 'match-record' instead of 'match'.

* gnu/services/base.scm (agetty-shepherd-service)
(mingetty-shepherd-service)
(nscd.conf-file)
(udev-shepherd-service)
(udev-etc)
(gpm-shepherd-service)
(network-set-up/linux)
(network-tear-down/linux)
(static-networking-shepherd-service)
(greetd-agreety-tty-session-command)
(greetd-agreety-tty-xdg-session-command): Use 'match-record' instead of
'match'.
(guix-accounts): Use <guix-configuration> accessors.
(udev-service-type): Use <udev-configuration> accessors.

1 files changed, 460 insertions, 462 deletions

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d99548573d..370696a55e 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -977,148 +977,148 @@ to use as the tty.  This is primarily useful for headless systems."
                ((device-name _ ...)
                 device-name))))))))
 
-(define agetty-shepherd-service
-  (match-lambda
-    (($ <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")))))
-
-         ;; 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")
-                                     #~())
+(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")))))
+
+      ;; 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")
+                                  #~())
 ;;; 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)
-                                     #~())))
-                       (const #f))                 ; never start.
-                   args)))))
-         (stop #~(make-kill-destructor)))))))
+                           #$@(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)
+                                  #~())))
+                    (const #f))                   ; never start.
+                args)))))
+      (stop #~(make-kill-destructor))))))
 
 (define agetty-service-type
   (service-type (name 'agetty)
@@ -1148,42 +1148,42 @@ the tty to run, among other things."
   (clear-on-logout? mingetty-clear-on-logout?       ;Boolean
                     (default #t)))
 
-(define mingetty-shepherd-service
-  (match-lambda
-    (($ <mingetty-configuration> mingetty tty auto-login login-program
-                                 login-pause? clear-on-logout?)
-     (list
-      (shepherd-service
-       (documentation "Run mingetty on an tty.")
-       (provision (list (symbol-append 'term- (string->symbol tty))))
-
-       ;; 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 (XXX).
-       (requirement '(user-processes host-name udev virtual-terminal))
-
-       (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
-
-                        #$@(if clear-on-logout?
-                               #~()
-                               #~("--noclear"))
-                        #$@(if auto-login
-                               #~("--autologin" #$auto-login)
-                               #~())
-                        #$@(if login-program
-                               #~("--loginprog" #$login-program)
-                               #~())
-                        #$@(if login-pause?
-                               #~("--loginpause")
-                               #~()))))
-       (stop   #~(make-kill-destructor)))))))
+(define (mingetty-shepherd-service config)
+  (match-record config <mingetty-configuration>
+    (mingetty tty auto-login login-program
+              login-pause? clear-on-logout?)
+    (list
+     (shepherd-service
+      (documentation "Run mingetty on an tty.")
+      (provision (list (symbol-append 'term- (string->symbol tty))))
+
+      ;; 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 (XXX).
+      (requirement '(user-processes host-name udev virtual-terminal))
+
+      (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
+
+                       #$@(if clear-on-logout?
+                              #~()
+                              #~("--noclear"))
+                       #$@(if auto-login
+                              #~("--autologin" #$auto-login)
+                              #~())
+                       #$@(if login-program
+                              #~("--loginprog" #$login-program)
+                              #~())
+                       #$@(if login-pause?
+                              #~("--loginpause")
+                              #~()))))
+      (stop   #~(make-kill-destructor))))))
 
 (define mingetty-service-type
   (service-type (name 'mingetty)
@@ -1260,46 +1260,47 @@ the tty to run, among other things."
 (define (nscd.conf-file config)
   "Return the @file{nscd.conf} configuration file for @var{config}, an
 @code{<nscd-configuration>} object."
-  (define cache->config
-    (match-lambda
-      (($ <nscd-cache> (= symbol->string database)
-                       positive-ttl negative-ttl size check-files?
-                       persistent? shared? max-size propagate?)
-       (string-append "\nenable-cache\t" database "\tyes\n"
-
-                      "positive-time-to-live\t" database "\t"
-                      (number->string positive-ttl) "\n"
-                      "negative-time-to-live\t" database "\t"
-                      (number->string negative-ttl) "\n"
-                      "suggested-size\t" database "\t"
-                      (number->string 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-size) "\n"
-                      "auto-propagate\t" database "\t"
-                      (if propagate? "yes\n" "no\n")))))
-
-  (match config
-    (($ <nscd-configuration> log-file debug-level caches)
-     (plain-file "nscd.conf"
-                 (string-append "\
+  (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"
+
+                       "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 "\
 # 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.
@@ -1797,17 +1798,15 @@ proxy of 'guix-daemon'...~%")
 
 (define (guix-accounts config)
   "Return the user accounts and user groups for CONFIG."
-  (match config
-    (($ <guix-configuration> _ build-group build-accounts)
-     (cons (user-group
-            (name build-group)
-            (system? #t)
-
-            ;; Use a fixed GID so that we can create the store with the right
-            ;; owner.
-            (id 30000))
-           (guix-build-accounts build-accounts
-                                #:group build-group)))))
+  (cons (user-group
+         (name (guix-configuration-build-group config))
+         (system? #t)
+
+         ;; Use a fixed GID so that we can create the store with the right
+         ;; owner.
+         (id 30000))
+        (guix-build-accounts (guix-configuration-build-accounts config)
+                             #:group (guix-configuration-build-group config))))
 
 (define (guix-activation config)
   "Return the activation gexp for CONFIG."
@@ -2130,95 +2129,94 @@ item of @var{packages}."
   (udev-rule "90-kvm.rules"
              "KERNEL==\"kvm\", GROUP=\"kvm\", MODE=\"0660\"\n"))
 
-(define udev-shepherd-service
+(define (udev-shepherd-service config)
   ;; Return a <shepherd-service> for UDEV with RULES.
-  (match-lambda
-    (($ <udev-configuration> udev)
-     (list
-      (shepherd-service
-       (provision '(udev))
-
-       ;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can
-       ;; be added: see
-       ;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>.
-       (requirement '(root-file-system))
-
-       (documentation "Populate the /dev directory, dynamically.")
-       (start
-        (with-imported-modules (source-module-closure
-                                '((gnu build linux-boot)))
-          #~(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))))))
-
-              ;; 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 ((pid (fork+exec-command
-                          (list udevd)
-                          #:environment-variables
-                          (cons*
-                           ;; The first one is for udev, the second one for
-                           ;; eudev.
-                           "UDEV_CONFIG_FILE=/etc/udev/udev.conf"
-                           "EUDEV_RULES_DIRECTORY=/etc/udev/rules.d"
-                           (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")
-
-                ;; 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
-       ;; 'user-processes', i.e., before its own 'stop' method was called.
-       ;; Thus, make sure it is not respawned.
-       (respawn? #f)
-       ;; We need additional modules.
-       (modules `((gnu build linux-boot)        ;'make-static-device-nodes'
-                  ,@%default-modules)))))))
+  (let ((udev (udev-configuration-udev config)))
+    (list
+     (shepherd-service
+      (provision '(udev))
+
+      ;; Udev needs /dev to be a 'devtmpfs' mount so that new device nodes can
+      ;; be added: see
+      ;; <http://www.linuxfromscratch.org/lfs/view/development/chapter07/udev.html>.
+      (requirement '(root-file-system))
+
+      (documentation "Populate the /dev directory, dynamically.")
+      (start
+       (with-imported-modules (source-module-closure
+                               '((gnu build linux-boot)))
+         #~(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))))))
+
+             ;; 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 ((pid (fork+exec-command
+                         (list udevd)
+                         #:environment-variables
+                         (cons*
+                          ;; The first one is for udev, the second one for
+                          ;; eudev.
+                          "UDEV_CONFIG_FILE=/etc/udev/udev.conf"
+                          "EUDEV_RULES_DIRECTORY=/etc/udev/rules.d"
+                          (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")
+
+               ;; 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
+      ;; 'user-processes', i.e., before its own 'stop' method was called.
+      ;; Thus, make sure it is not respawned.
+      (respawn? #f)
+      ;; We need additional modules.
+      (modules `((gnu build linux-boot)           ;'make-static-device-nodes'
+                 ,@%default-modules))))))
 
 (define udev.conf
   (computed-file "udev.conf"
@@ -2226,14 +2224,15 @@ item of @var{packages}."
                      (lambda (port)
                        (format port "udev_rules=\"/etc/udev/rules.d\"~%")))))
 
-(define udev-etc
-  (match-lambda
-    (($ <udev-configuration> udev rules)
-     `(("udev"
-        ,(file-union
-          "udev" `(("udev.conf" ,udev.conf)
-                   ("rules.d" ,(udev-rules-union (cons* udev kvm-udev-rule
-                                                        rules))))))))))
+(define (udev-etc config)
+  (match-record config <udev-configuration>
+    (udev rules)
+    `(("udev"
+       ,(file-union "udev"
+                    `(("udev.conf" ,udev.conf)
+                      ("rules.d"
+                       ,(udev-rules-union (cons* udev kvm-udev-rule
+                                                 rules)))))))))
 
 (define udev-service-type
   (service-type (name 'udev)
@@ -2243,11 +2242,11 @@ item of @var{packages}."
                        (service-extension etc-service-type udev-etc)))
                 (compose concatenate)           ;concatenate the list of rules
                 (extend (lambda (config rules)
-                          (match config
-                            (($ <udev-configuration> udev initial-rules)
-                             (udev-configuration
-                              (udev udev)
-                              (rules (append initial-rules rules)))))))
+                          (let ((initial-rules
+                                 (udev-configuration-rules config)))
+                            (udev-configuration
+                             (inherit config)
+                             (rules (append initial-rules rules))))))
                 (default-value (udev-configuration))
                 (description
                  "Run @command{udev}, which populates the @file{/dev}
@@ -2385,23 +2384,23 @@ instance."
   (options  gpm-configuration-options             ;list of strings
             (default %default-gpm-options)))
 
-(define gpm-shepherd-service
-  (match-lambda
-    (($ <gpm-configuration> gpm options)
-     (list (shepherd-service
-            (requirement '(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-shepherd-service config)
+  (match-record config <gpm-configuration>
+    (gpm options)
+    (list (shepherd-service
+           (requirement '(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)
@@ -2654,32 +2653,64 @@ to CONFIG."
                              "/servers/socket/2")
                      #f))))
 
-(define network-set-up/linux
-  (match-lambda
-    (($ <static-networking> addresses links routes)
-     (scheme-file "set-up-network"
-                  (with-extensions (list guile-netlink)
-                    #~(begin
-                        (use-modules (ip addr) (ip link) (ip route))
-
-                        #$@(map (lambda (address)
-                                  #~(begin
-                                      (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 (match-lambda
-                                  (($ <network-link> name type arguments)
-                                   #~(link-add #$name #$type
-                                               #:type-args '#$arguments)))
-                                links)
-                        #$@(map (lambda (route)
-                                  #~(route-add #$(network-route-destination route)
+(define (network-set-up/linux config)
+  (match-record config <static-networking>
+    (addresses links routes)
+    (scheme-file "set-up-network"
+                 (with-extensions (list guile-netlink)
+                   #~(begin
+                       (use-modules (ip addr) (ip link) (ip route))
+
+                       #$@(map (lambda (address)
+                                 #~(begin
+                                     (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 (match-lambda
+                                 (($ <network-link> name type arguments)
+                                  #~(link-add #$name #$type
+                                              #:type-args '#$arguments)))
+                               links)
+                       #$@(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)
+    (scheme-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))
+
+                       ;; 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?
@@ -2687,80 +2718,47 @@ to CONFIG."
                                                #:via
                                                #$(network-route-gateway route)
                                                #:src
-                                               #$(network-route-source route)))
-                                routes)
-                        #t))))))
-
-(define network-tear-down/linux
-  (match-lambda
-    (($ <static-networking> addresses links routes)
-     (scheme-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))
-
-                        ;; 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 (match-lambda
-                                  (($ <network-link> name type arguments)
-                                   #~(false-if-netlink-error
-                                      (link-del #$name))))
-                                links)
-                        #$@(map (lambda (address)
+                                               #$(network-route-source route))))
+                               routes)
+                       #$@(map (match-lambda
+                                 (($ <network-link> name type arguments)
                                   #~(false-if-netlink-error
-                                     (addr-del #$(network-address-device
-                                                  address)
-                                               #$(network-address-value address)
-                                               #:ipv6?
-                                               #$(network-address-ipv6? address))))
-                                addresses)
-                        #f))))))
+                                     (link-del #$name))))
+                               links)
+                       #$@(map (lambda (address)
+                                 #~(false-if-netlink-error
+                                    (addr-del #$(network-address-device
+                                                 address)
+                                              #$(network-address-value address)
+                                              #:ipv6?
+                                              #$(network-address-ipv6? address))))
+                               addresses)
+                       #f)))))
 
 (define (static-networking-shepherd-service config)
-  (match config
-    (($ <static-networking> addresses links routes
-                            provision requirement name-servers)
-     (let ((loopback? (and provision (memq 'loopback provision))))
-       (shepherd-service
+  (match-record config <static-networking>
+    (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.
-                   (load #$(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.
+       (start #~(lambda _
+                  ;; Return #t if successfully started.
                   (load #$(let-system (system target)
                             (if (string-contains (or target system) "-linux")
-                                (network-tear-down/linux config)
-                                (network-tear-down/hurd config))))))
-        (respawn? #f))))))
+                                (network-set-up/linux config)
+                                (network-set-up/hurd config))))))
+       (stop #~(lambda _
+                 ;; Return #f is successfully stopped.
+                 (load #$(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))
@@ -2873,33 +2871,33 @@ to handle."
   (extra-env greetd-agreety-extra-env (default '()))
   (xdg-env? greetd-agreety-xdg-env? (default #t)))
 
-(define greetd-agreety-tty-session-command
-  (match-lambda
-    (($ <greetd-agreety-session> _ command args extra-env)
-     (program-file
-      "agreety-tty-session-command"
-      #~(begin
-          (use-modules (ice-9 match))
-          (for-each (match-lambda ((var . val) (setenv var val)))
-                    (quote (#$@extra-env)))
-          (apply execl #$command #$command (list #$@args)))))))
-
-(define greetd-agreety-tty-xdg-session-command
-  (match-lambda
-    (($ <greetd-agreety-session> _ command args extra-env)
-     (program-file
-      "agreety-tty-xdg-session-command"
-      #~(begin
-          (use-modules (ice-9 match))
-          (let*
-              ((username (getenv "USER"))
-               (useruid (passwd:uid (getpwuid username)))
-               (useruid (number->string useruid)))
-            (setenv "XDG_SESSION_TYPE" "tty")
-            (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid)))
-          (for-each (match-lambda ((var . val) (setenv var val)))
-                    (quote (#$@extra-env)))
-          (apply execl #$command #$command (list #$@args)))))))
+(define (greetd-agreety-tty-session-command config)
+  (match-record config <greetd-agreety-session>
+    (command command-args extra-env)
+    (program-file
+     "agreety-tty-session-command"
+     #~(begin
+         (use-modules (ice-9 match))
+         (for-each (match-lambda ((var . val) (setenv var val)))
+                   (quote (#$@extra-env)))
+         (apply execl #$command #$command (list #$@command-args))))))
+
+(define (greetd-agreety-tty-xdg-session-command config)
+  (match-record config <greetd-agreety-session>
+    (command command-args extra-env)
+    (program-file
+     "agreety-tty-xdg-session-command"
+     #~(begin
+         (use-modules (ice-9 match))
+         (let*
+             ((username (getenv "USER"))
+              (useruid (passwd:uid (getpwuid username)))
+              (useruid (number->string useruid)))
+           (setenv "XDG_SESSION_TYPE" "tty")
+           (setenv "XDG_RUNTIME_DIR" (string-append "/run/user/" useruid)))
+         (for-each (match-lambda ((var . val) (setenv var val)))
+                   (quote (#$@extra-env)))
+         (apply execl #$command #$command (list #$@command-args))))))
 
 (define-gexp-compiler (greetd-agreety-session-compiler
                        (session <greetd-agreety-session>)