Merge branch 'master' into core-updates

11 files changed, 220 insertions, 177 deletions

diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 437f8da898..f8f4276283 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013-2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Google LLC
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
@@ -272,7 +272,8 @@ flags are found."
   ;; Note: If we have (guix store database) in the search path and we do *not*
   ;; have (guix store) proper, 'resolve-module' returns an empty (guix store)
   ;; with one sub-module.
-  (cond ((and=> (resolve-module '(guix store) #:ensure #f)
+  (cond ((and=> (parameterize ((current-warning-port (%make-void-port "w0")))
+                  (resolve-module '(guix store) #:ensure #f))
                 (lambda (store)
                   (module-variable store '%store-prefix)))
          =>
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index 8e95d0a16c..4bc32d9bd1 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -119,7 +119,7 @@
                  (bootloader grub-minimal-bootloader)
                  (targets '("/dev/vda"))))
     (initrd #f)
-    (initrd-modules (lambda _ '()))
+    (initrd-modules '())
     (firmware '())
     (host-name "guixygnu")
     (file-systems '())
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index 42e215f614..f02f6e0b8c 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020, 2021 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,7 +32,7 @@
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
-  #:use-module (gnu platform)
+  #:use-module (guix platform)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
@@ -218,7 +219,8 @@ set to the given OS."
       #$(partition-file-system-options partition)
       #$(partition-label partition)
       #$(and=> (partition-uuid partition)
-               uuid-bytevector)))
+               uuid-bytevector)
+      #$(partition-flags partition)))
 
 (define gcrypt-sqlite3&co
   ;; Guile-Gcrypt, Guile-SQLite3, and their propagated inputs.
@@ -295,27 +297,49 @@ used in the image."
       ;; the hdimage format (raw disk-image) is supported.
       (cond
        ((memq format '(disk-image compressed-qcow2)) "hdimage")
-        (else
-         (raise (condition
-                 (&message
-                  (message
-                   (format #f (G_ "Unsupported image type ~a~%.") format))))))))
+       (else
+        (raise (condition
+                (&message
+                 (message
+                  (format #f (G_ "unsupported image type: ~a")
+                          format))))))))
 
     (define (partition->dos-type partition)
       ;; Return the MBR partition type corresponding to the given PARTITION.
       ;; See: https://en.wikipedia.org/wiki/Partition_type.
-      (let ((flags (partition-flags partition)))
+      (let ((flags (partition-flags partition))
+            (file-system (partition-file-system partition)))
         (cond
          ((member 'esp flags) "0xEF")
-         (else "0x83"))))
+         ((string-prefix? "ext" file-system) "0x83")
+         ((or (string=? file-system "vfat")
+              (string=? file-system "fat16")) "0x0E")
+         ((string=? file-system "fat32") "0x0C")
+         (else
+          (raise (condition
+                  (&message
+                   (message
+                    (format #f (G_ "unsupported partition type: ~a")
+                            file-system)))))))))
 
     (define (partition->gpt-type partition)
-      ;; Return the genimage GPT partition type code corresponding to PARTITION.
-      ;; See https://github.com/pengutronix/genimage/blob/master/README.rst
-      (let ((flags (partition-flags partition)))
+      ;; Return the genimage GPT partition type code corresponding to the
+      ;; given PARTITION.  See:
+      ;; https://github.com/pengutronix/genimage/blob/master/README.rst
+      (let ((flags (partition-flags partition))
+            (file-system (partition-file-system partition)))
         (cond
-          ((member 'esp flags) "U")
-          (else "L"))))
+         ((member 'esp flags) "U")
+         ((string-prefix? "ext" file-system) "L")
+         ((or (string=? file-system "vfat")
+              (string=? file-system "fat16")
+              (string=? file-system "fat32")) "F")
+         (else
+          (raise (condition
+                  (&message
+                   (message
+                    (format #f (G_ "unsupported partition type: ~a")
+                            file-system)))))))))
 
     (define (partition-image partition)
       ;; Return as a file-like object, an image of the given PARTITION.  A
@@ -382,24 +406,28 @@ used in the image."
                     (partition-type-values image partition)))
         (let ((label (partition-label partition))
               (image (partition-image partition))
-              (offset (partition-offset partition)))
+              (offset (partition-offset partition))
+              (bootable (if (memq 'boot (partition-flags partition))
+                            "true" "false" )))
           #~(format #f "~/partition ~a {
   ~/~/~a = ~a
   ~/~/image = \"~a\"
   ~/~/offset = \"~a\"
+  ~/~/bootable = \"~a\"
   ~/}"
                     #$label
                     #$partition-type-attribute
                     #$partition-type-value
                     #$image
-                    #$offset))))
+                    #$offset
+                    #$bootable))))
 
     (define (genimage-type-options image-type image)
       (cond
-        ((equal? image-type "hdimage")
-         (format #f "~%~/~/gpt = ~a~%~/"
-                 (if (gpt-image? image) "true" "false")))
-        (else "")))
+       ((equal? image-type "hdimage")
+        (format #f "~%~/~/gpt = ~a~%~/"
+                (if (gpt-image? image) "true" "false")))
+       (else "")))
 
     (let* ((format (image-format image))
            (image-type (format->image-type format))
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 4c38c46a89..6da09b855a 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -23,7 +23,7 @@
   #:use-module (gnu bootloader grub)
   #:use-module (gnu image)
   #:use-module (gnu packages ssh)
-  #:use-module (gnu platforms hurd)
+  #:use-module (guix platforms x86)
   #:use-module (gnu services)
   #:use-module (gnu services ssh)
   #:use-module (gnu system)
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 5b625e56c5..b9ff6dcfea 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -22,7 +22,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
-  #:use-module (gnu platforms arm)
+  #:use-module (guix platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index aaec458766..99c4ed6ceb 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -21,7 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
-  #:use-module (gnu platforms arm)
+  #:use-module (guix platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 1bfac7a8bb..7e8910427e 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -21,7 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
-  #:use-module (gnu platforms arm)
+  #:use-module (guix platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu system)
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index d25d55e528..68cb65f115 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -21,7 +21,7 @@
   #:use-module (gnu bootloader u-boot)
   #:use-module (gnu image)
   #:use-module (gnu packages linux)
-  #:use-module (gnu platforms arm)
+  #:use-module (guix platforms arm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
   #:use-module (gnu services networking)
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 073d7df1db..a3646b1d54 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -1,11 +1,12 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2017, 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -31,8 +32,10 @@
   #:use-module (guix store)
   #:use-module (guix monads)
   #:use-module (guix modules)
-  #:use-module ((guix packages) #:select (package-version))
+  #:use-module ((guix packages) #:select (package-version supported-package?))
+  #:use-module (guix platform)
   #:use-module ((guix store) #:select (%store-prefix))
+  #:use-module (guix utils)
   #:use-module (gnu installer)
   #:use-module (gnu system locale)
   #:use-module (gnu services avahi)
@@ -252,7 +255,9 @@ the user's target storage device rather than on the RAM disk."
   (service-type (name 'configuration-template)
                 (extensions
                  (list (service-extension etc-service-type
-                                          /etc/configuration-files)))))
+                                          /etc/configuration-files)))
+                (description "Install the operating system configuration file
+templates under @file{/etc/configuration}.")))
 
 (define %configuration-template-service
   (service configuration-template-service-type #t))
@@ -281,11 +286,7 @@ the user's target storage device rather than on the RAM disk."
          (provision '(maybe-uvesafb))
          (requirement '(file-systems))
          (start #~(lambda ()
-                    ;; uvesafb is only supported on x86 and x86_64.
-                    (or (not (and (string-suffix? "linux-gnu" %host-type)
-                                  (or (string-prefix? "x86_64" %host-type)
-                                      (string-prefix? "i686" %host-type))))
-                        (file-exists? "/dev/fb0")
+                    (or (file-exists? "/dev/fb0")
                         (invoke #+(file-append kmod "/bin/modprobe")
                                 "uvesafb"
                                 (string-append "v86d=" #$v86d "/sbin/v86d")
@@ -303,7 +304,10 @@ the user's target storage device rather than on the RAM disk."
     "Load the @code{uvesafb} kernel module with the right options.")
    (default-value #t)))
 
-(define %installation-services
+(define* (%installation-services #:key (system (or (and=>
+                                                    (%current-target-system)
+                                                    platform-target->system)
+                                                   (%current-system))))
   ;; List of services of the installation system.
   (let ((motd (plain-file "motd" "
 \x1b[1;37mWelcome to the installation of GNU Guix!\x1b[0m
@@ -320,119 +324,125 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
     (define bare-bones-os
       (load "examples/bare-bones.tmpl"))
 
-    (list (service virtual-terminal-service-type)
-
-          (service kmscon-service-type
-                   (kmscon-configuration
-                    (virtual-terminal "tty1")
-                    (login-program (installer-program))))
-
-          (login-service (login-configuration
-                          (motd motd)))
-
-          ;; Documentation.  The manual is in UTF-8, but
-          ;; 'console-font-service' sets up Unicode support and loads a font
-          ;; with all the useful glyphs like em dash and quotation marks.
-          (service documentation-service-type "tty2")
-
-          ;; Documentation add-on.
-          %configuration-template-service
-
-          ;; A bunch of 'root' ttys.
-          (normal-tty "tty3")
-          (normal-tty "tty4")
-          (normal-tty "tty5")
-          (normal-tty "tty6")
-
-          ;; The usual services.
-          (syslog-service)
-
-          ;; Use the Avahi daemon to discover substitute servers on the local
-          ;; network.  It can be faster than fetching from remote servers.
-          (service avahi-service-type)
-
-          ;; The build daemon.  Register the default substitute server key(s)
-          ;; as trusted to allow the installation process to use substitutes by
-          ;; default.
-          (service guix-service-type
-                   (guix-configuration (authorize-key? #t)))
-
-          ;; Start udev so that useful device nodes are available.
-          ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for
-          ;; regulations-compliant WiFi access.
-          (udev-service #:rules (list lvm2 crda))
-
-          ;; Add the 'cow-store' service, which users have to start manually
-          ;; since it takes the installation directory as an argument.
-          (cow-store-service)
-
-          ;; Install Unicode support and a suitable font.
-          (service console-font-service-type
-                   (map (match-lambda
-                          ("tty2"
-                           ;; Use a font that contains characters such as
-                           ;; curly quotes as found in the manual.
-                           '("tty2" . "LatGrkCyr-8x16"))
-                          (tty
-                           ;; Use a font that doesn't have more than 256
-                           ;; glyphs so that we can use colors with varying
-                           ;; brightness levels (see note in setfont(8)).
-                           `(,tty . "lat9u-16")))
-                        '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
-
-          ;; To facilitate copy/paste.
-          (service gpm-service-type)
-
-          ;; Add an SSH server to facilitate remote installs.
-          (service openssh-service-type
-                   (openssh-configuration
-                    (port-number 22)
-                    (permit-root-login #t)
-                    ;; The root account is passwordless, so make sure
-                    ;; a password is set before allowing logins.
-                    (allow-empty-passwords? #f)
-                    (password-authentication? #t)
-
-                    ;; Don't start it upfront.
-                    (%auto-start? #f)))
-
-          ;; Since this is running on a USB stick with a overlayfs as the root
-          ;; file system, use an appropriate cache configuration.
-          (nscd-service (nscd-configuration
-                         (caches %nscd-minimal-caches)))
-
-          ;; Having /bin/sh is a good idea.  In particular it allows Tramp
-          ;; connections to this system to work.
-          (service special-files-service-type
-                   `(("/bin/sh" ,(file-append bash "/bin/sh"))))
-
-          ;; Loopback device, needed by OpenSSH notably.
-          (service static-networking-service-type
-                   (list %loopback-static-networking))
-
-          (service wpa-supplicant-service-type)
-          (dbus-service)
-          (service connman-service-type
-                   (connman-configuration
-                    (disable-vpn? #t)))
-
-          ;; Keep a reference to BARE-BONES-OS to make sure it can be
-          ;; installed without downloading/building anything.  Also keep the
-          ;; things needed by 'profile-derivation' to minimize the amount of
-          ;; download.
-          (service gc-root-service-type
-                   (append
-                    (list bare-bones-os
-                          glibc-utf8-locales
-                          texinfo
-                          guile-3.0)
-                    %default-locale-libcs))
-
-          ;; Machines without Kernel Mode Setting (those with many old and
-          ;; current AMD GPUs, SiS GPUs, ...) need uvesafb to show the GUI
-          ;; installer.  Some may also need a kernel parameter like nomodeset
-          ;; or vga=793, but we leave that for the user to specify in GRUB.
-          (service uvesafb-service-type))))
+    (append
+     ;; Generic services
+     (list (service virtual-terminal-service-type)
+
+           (service kmscon-service-type
+                    (kmscon-configuration
+                     (virtual-terminal "tty1")
+                     (login-program (installer-program))))
+
+           (login-service (login-configuration
+                           (motd motd)))
+
+           ;; Documentation.  The manual is in UTF-8, but
+           ;; 'console-font-service' sets up Unicode support and loads a font
+           ;; with all the useful glyphs like em dash and quotation marks.
+           (service documentation-service-type "tty2")
+
+           ;; Documentation add-on.
+           %configuration-template-service
+
+           ;; A bunch of 'root' ttys.
+           (normal-tty "tty3")
+           (normal-tty "tty4")
+           (normal-tty "tty5")
+           (normal-tty "tty6")
+
+           ;; The usual services.
+           (syslog-service)
+
+           ;; Use the Avahi daemon to discover substitute servers on the local
+           ;; network.  It can be faster than fetching from remote servers.
+           (service avahi-service-type)
+
+           ;; The build daemon.  Register the default substitute server key(s)
+           ;; as trusted to allow the installation process to use substitutes by
+           ;; default.
+           (service guix-service-type
+                    (guix-configuration (authorize-key? #t)))
+
+           ;; Start udev so that useful device nodes are available.
+           ;; Use device-mapper rules for cryptsetup & co; enable the CRDA for
+           ;; regulations-compliant WiFi access.
+           (udev-service #:rules (list lvm2 crda))
+
+           ;; Add the 'cow-store' service, which users have to start manually
+           ;; since it takes the installation directory as an argument.
+           (cow-store-service)
+
+           ;; Install Unicode support and a suitable font.
+           (service console-font-service-type
+                    (map (match-lambda
+                           ("tty2"
+                            ;; Use a font that contains characters such as
+                            ;; curly quotes as found in the manual.
+                            '("tty2" . "LatGrkCyr-8x16"))
+                           (tty
+                            ;; Use a font that doesn't have more than 256
+                            ;; glyphs so that we can use colors with varying
+                            ;; brightness levels (see note in setfont(8)).
+                            `(,tty . "lat9u-16")))
+                         '("tty1" "tty2" "tty3" "tty4" "tty5" "tty6")))
+
+           ;; To facilitate copy/paste.
+           (service gpm-service-type)
+
+           ;; Add an SSH server to facilitate remote installs.
+           (service openssh-service-type
+                    (openssh-configuration
+                     (port-number 22)
+                     (permit-root-login #t)
+                     ;; The root account is passwordless, so make sure
+                     ;; a password is set before allowing logins.
+                     (allow-empty-passwords? #f)
+                     (password-authentication? #t)
+
+                     ;; Don't start it upfront.
+                     (%auto-start? #f)))
+
+           ;; Since this is running on a USB stick with a overlayfs as the root
+           ;; file system, use an appropriate cache configuration.
+           (nscd-service (nscd-configuration
+                          (caches %nscd-minimal-caches)))
+
+           ;; Having /bin/sh is a good idea.  In particular it allows Tramp
+           ;; connections to this system to work.
+           (service special-files-service-type
+                    `(("/bin/sh" ,(file-append bash "/bin/sh"))))
+
+           ;; Loopback device, needed by OpenSSH notably.
+           (service static-networking-service-type
+                    (list %loopback-static-networking))
+
+           (service wpa-supplicant-service-type)
+           (dbus-service)
+           (service connman-service-type
+                    (connman-configuration
+                     (disable-vpn? #t)))
+
+           ;; Keep a reference to BARE-BONES-OS to make sure it can be
+           ;; installed without downloading/building anything.  Also keep the
+           ;; things needed by 'profile-derivation' to minimize the amount of
+           ;; download.
+           (service gc-root-service-type
+                    (append
+                     (list bare-bones-os
+                           glibc-utf8-locales
+                           texinfo
+                           guile-3.0)
+                     %default-locale-libcs)))
+
+     ;; Specific system services
+
+     ;; Machines without Kernel Mode Setting (those with many old and
+     ;; current AMD GPUs, SiS GPUs, ...) need uvesafb to show the GUI
+     ;; installer.  Some may also need a kernel parameter like nomodeset
+     ;; or vga=793, but we leave that for the user to specify in GRUB.
+     `(,@(if (supported-package? v86d system)
+             (list (service uvesafb-service-type))
+             '())))))
 
 (define %issue
   ;; Greeting.
@@ -496,7 +506,7 @@ Access documentation at any time by pressing Alt-F2.\x1b[0m
                   (comment "Guest of GNU"))))
 
     (issue %issue)
-    (services %installation-services)
+    (services (%installation-services))
 
     ;; We don't need setuid programs, except for 'passwd', which can be handy
     ;; if one is to allow remote SSH login to the machine being installed.
diff --git a/gnu/system/linux-container.scm b/gnu/system/linux-container.scm
index eeb0f68c02..24077e347a 100644
--- a/gnu/system/linux-container.scm
+++ b/gnu/system/linux-container.scm
@@ -129,8 +129,7 @@ containerized OS.  EXTRA-FILE-SYSTEMS is a list of file systems to add to OS."
                  static-networking-service-type
                  dhcp-client-service-type
                  network-manager-service-type
-                 connman-service-type
-                 wicd-service-type)
+                 connman-service-type)
                 (list))))
 
   (define services-to-add
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 96a381d5fe..e6b8970c12 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2017, 2018 Mark H Weaver <mhw@netris.org>
 ;;;
@@ -202,7 +202,8 @@ option of @command{guix system}.\n")
            ;; XXX: 'use-modules' should be at the top level.
            (use-modules (rnrs bytevectors) ;bytevector?
                         ((gnu build file-systems)
-                         #:select (find-partition-by-luks-uuid))
+                         #:select (find-partition-by-luks-uuid
+                                   system*/tty))
                         ((guix build utils) #:select (mkdir-p)))
 
            ;; Create '/run/cryptsetup/' if it does not exist, as device locking
@@ -211,28 +212,32 @@ option of @command{guix system}.\n")
 
            ;; Use 'cryptsetup-static', not 'cryptsetup', to avoid pulling the
            ;; whole world inside the initrd (for when we're in an initrd).
-           (zero? (system* #$(file-append cryptsetup-static "/sbin/cryptsetup")
-                           "open" "--type" "luks"
-
-                           ;; Note: We cannot use the "UUID=source" syntax here
-                           ;; because 'cryptsetup' implements it by searching the
-                           ;; udev-populated /dev/disk/by-id directory but udev may
-                           ;; be unavailable at the time we run this.
-                           (if (bytevector? source)
-                               (or (let loop ((tries-left 10))
-                                     (and (positive? tries-left)
-                                          (or (find-partition-by-luks-uuid source)
-                                              ;; If the underlying partition is
-                                              ;; not found, try again after
-                                              ;; waiting a second, up to ten
-                                              ;; times.  FIXME: This should be
-                                              ;; dealt with in a more robust way.
-                                              (begin (sleep 1)
-                                                     (loop (- tries-left 1))))))
-                                   (error "LUKS partition not found" source))
-                               source)
-
-                           #$target)))))))
+           ;; 'cryptsetup open' requires standard input to be a tty to allow
+           ;; for interaction but shepherd sets standard input to /dev/null;
+           ;; thus, explicitly request a tty.
+           (zero? (system*/tty
+                   #$(file-append cryptsetup-static "/sbin/cryptsetup")
+                   "open" "--type" "luks"
+
+                   ;; Note: We cannot use the "UUID=source" syntax here
+                   ;; because 'cryptsetup' implements it by searching the
+                   ;; udev-populated /dev/disk/by-id directory but udev may
+                   ;; be unavailable at the time we run this.
+                   (if (bytevector? source)
+                       (or (let loop ((tries-left 10))
+                             (and (positive? tries-left)
+                                  (or (find-partition-by-luks-uuid source)
+                                      ;; If the underlying partition is
+                                      ;; not found, try again after
+                                      ;; waiting a second, up to ten
+                                      ;; times.  FIXME: This should be
+                                      ;; dealt with in a more robust way.
+                                      (begin (sleep 1)
+                                             (loop (- tries-left 1))))))
+                           (error "LUKS partition not found" source))
+                       source)
+
+                   #$target)))))))
 
 (define (close-luks-device source targets)
   "Return a gexp that closes TARGET, a LUKS device."