summary refs log tree commit diff
path: root/gnu
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2020-08-25 12:39:11 +0200
committerMathieu Othacehe <othacehe@gnu.org>2020-08-25 12:39:11 +0200
commitdac7dd1b0b40c9f8c81b5147c68f6387c2b16bfd (patch)
tree7ee1acfecb728fec3a2b0c2373970449c82622a7 /gnu
parent5fe12be0dd03d1a316343549f8c131d931f21a9a (diff)
downloadguix-dac7dd1b0b40c9f8c81b5147c68f6387c2b16bfd.tar.gz
Remove "guile-zlib" extension when unused.
This is a follow-up of 755f365b02b42a5d1e8ef3000dadef069553a478.

As (zlib) is autoloaded in (gnu build linux-modules), "guile-zlib" is needed
as an extension only when it is effectively used.

* gnu/installer.scm (installer-program): Remove "guile-zlib" from the extensions.
* gnu/machine/ssh.scm (machine-check-initrd-modules): Ditto.
* gnu/services.scm (activation-script): Ditto.
* gnu/services/base.scm (default-serial-port): Ditto,
(agetty-shepherd-service): ditto,
(udev-service-type): ditto.
* gnu/system/image.scm (gcrypt-sqlite3&co): Ditto.
* gnu/system/shadow.scm (account-shepherd-service): Ditto.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/installer.scm3
-rw-r--r--gnu/machine/ssh.scm35
-rw-r--r--gnu/services.scm46
-rw-r--r--gnu/services/base.scm428
-rw-r--r--gnu/system/image.scm2
-rw-r--r--gnu/system/shadow.scm12
6 files changed, 255 insertions, 271 deletions
diff --git a/gnu/installer.scm b/gnu/installer.scm
index 576ac90a4b..5c3192d7a6 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -342,8 +342,7 @@ selected keymap."
     ;; packages …), etc. modules.
     (with-extensions (list guile-gcrypt guile-newt
                            guile-parted guile-bytestructures
-                           guile-json-3 guile-git guile-zlib
-                           guix)
+                           guile-json-3 guile-git guix)
       (with-imported-modules `(,@(source-module-closure
                                   `(,@modules
                                     (gnu services herd)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index ee5032e281..4e31baa4b9 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -21,7 +21,6 @@
   #:use-module (gnu bootloader)
   #:use-module (gnu machine)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
-  #:autoload   (gnu packages guile) (guile-zlib)
   #:use-module (gnu system)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system uuid)
@@ -249,24 +248,22 @@ not available in the initrd."
                                 '((gnu build file-systems)
                                   (gnu build linux-modules)
                                   (gnu system uuid)))
-          (with-extensions (list guile-zlib)
-            #~(begin
-                (use-modules (gnu build file-systems)
-                             (gnu build linux-modules)
-                             (gnu system uuid))
-
-                (define dev
-                  #$(cond ((string? device) device)
-                          ((uuid? device) #~(find-partition-by-uuid
-                                             (string->uuid
-                                              #$(uuid->string device))))
-                          ((file-system-label? device)
-                           #~(find-partition-by-label
-                              #$(file-system-label->string device)))))
-
-                (missing-modules dev
-                                 '#$(operating-system-initrd-modules
-                                     (machine-operating-system machine))))))))
+          #~(begin
+              (use-modules (gnu build file-systems)
+                           (gnu build linux-modules)
+                           (gnu system uuid))
+
+              (define dev
+                #$(cond ((string? device) device)
+                        ((uuid? device) #~(find-partition-by-uuid
+                                           (string->uuid
+                                            #$(uuid->string device))))
+                        ((file-system-label? device)
+                         #~(find-partition-by-label
+                            #$(file-system-label->string device)))))
+
+              (missing-modules dev '#$(operating-system-initrd-modules
+                                       (machine-operating-system machine)))))))
 
     (remote-let ((missing remote-exp))
       (unless (null? missing)
diff --git a/gnu/services.scm b/gnu/services.scm
index 3e59c6401f..11ba21e824 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -35,7 +35,6 @@
   #:use-module (guix modules)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
-  #:use-module (gnu packages guile)
   #:use-module (gnu packages hurd)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
@@ -586,29 +585,28 @@ ACTIVATION-SCRIPT-TYPE."
                 (with-imported-modules (source-module-closure
                                         '((gnu build activation)
                                           (guix build utils)))
-                  (with-extensions (list guile-zlib)
-                    #~(begin
-                        (use-modules (gnu build activation)
-                                     (guix build utils))
-
-                        ;; Make sure the user accounting database exists.  If
-                        ;; it does not exist, 'setutxent' does not create it
-                        ;; and thus there is no accounting at all.
-                        (close-port (open-file "/var/run/utmpx" "a0"))
-
-                        ;; Same for 'wtmp', which is populated by mingetty et
-                        ;; al.
-                        (mkdir-p "/var/log")
-                        (close-port (open-file "/var/log/wtmp" "a0"))
-
-                        ;; Set up /run/current-system.  Among other things
-                        ;; this sets up locales, which the activation snippets
-                        ;; executed below may expect.
-                        (activate-current-system)
-
-                        ;; Run the services' activation snippets.
-                        ;; TODO: Use 'load-compiled'.
-                        (for-each primitive-load '#$actions))))))
+                  #~(begin
+                      (use-modules (gnu build activation)
+                                   (guix build utils))
+
+                      ;; Make sure the user accounting database exists.  If it
+                      ;; does not exist, 'setutxent' does not create it and
+                      ;; thus there is no accounting at all.
+                      (close-port (open-file "/var/run/utmpx" "a0"))
+
+                      ;; Same for 'wtmp', which is populated by mingetty et
+                      ;; al.
+                      (mkdir-p "/var/log")
+                      (close-port (open-file "/var/log/wtmp" "a0"))
+
+                      ;; Set up /run/current-system.  Among other things this
+                      ;; sets up locales, which the activation snippets
+                      ;; executed below may expect.
+                      (activate-current-system)
+
+                      ;; Run the services' activation snippets.
+                      ;; TODO: Use 'load-compiled'.
+                      (for-each primitive-load '#$actions)))))
 
 (define (gexps->activation-gexp gexps)
   "Return a gexp that runs the activation script containing GEXPS."
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 966e7fe024..491f35702a 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -50,7 +50,6 @@
                 #:select (coreutils glibc glibc-utf8-locales))
   #:use-module (gnu packages package-management)
   #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
-  #:use-module ((gnu packages guile) #:select (guile-zlib))
   #:use-module (gnu packages linux)
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
@@ -837,38 +836,36 @@ the message of the day, among other things."
 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'
-    (with-extensions (list guile-zlib)
-      #~(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
   (match-lambda
@@ -893,124 +890,122 @@ to use as the tty.  This is primarily useful for headless systems."
          (start
           (with-imported-modules  (source-module-closure
                                    '((gnu build linux-boot)))
-            (with-extensions (list guile-zlib)
-              #~(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))))))
+            #~(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)))))))
 
 (define agetty-service-type
@@ -1944,73 +1939,70 @@ item of @var{packages}."
          (start
           (with-imported-modules (source-module-closure
                                   '((gnu build linux-boot)))
-            (with-extensions (list guile-zlib)
-              #~(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.
-                           (string-append "UDEV_CONFIG_FILE=" #$udev.conf)
-                           (string-append "EUDEV_RULES_DIRECTORY="
-                                          #$(file-append
-                                             rules "/lib/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)))))
+            #~(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.
+                             (string-append "UDEV_CONFIG_FILE=" #$udev.conf)
+                             (string-append "EUDEV_RULES_DIRECTORY="
+                                            #$(file-append
+                                               rules "/lib/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
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 19c99a3dfa..36f56e237d 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -141,7 +141,7 @@
            (match (package-transitive-propagated-inputs package)
              (((labels packages) ...)
               packages))))
-   (list guile-gcrypt guile-sqlite3 guile-zlib)))
+   (list guile-gcrypt guile-sqlite3)))
 
 (define-syntax-rule (with-imported-modules* gexp* ...)
   (with-extensions gcrypt-sqlite3&co
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index f642d250b0..a69339bc07 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -34,7 +34,6 @@
   #:use-module ((gnu packages admin)
                 #:select (shadow))
   #:use-module (gnu packages bash)
-  #:use-module (gnu packages guile)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -325,12 +324,11 @@ accounts among ACCOUNTS+GROUPS."
          (start (with-imported-modules (source-module-closure
                                         '((gnu build activation)
                                           (gnu system accounts)))
-                  (with-extensions (list guile-zlib)
-                    #~(lambda ()
-                        (activate-user-home
-                         (map sexp->user-account
-                              (list #$@(map user-account->gexp accounts))))
-                        #t))))                       ;success
+                  #~(lambda ()
+                      (activate-user-home
+                       (map sexp->user-account
+                            (list #$@(map user-account->gexp accounts))))
+                      #t)))                       ;success
          (documentation "Create user home directories."))))
 
 (define (shells-file shells)