gnu: libnma: Depend on GTK 4.x only on supported platforms.

[jackhill/guix/guix.git] / gnu / system / mapped-devices.scm

diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 559c27b..e6b8970 100644 (file)
--- 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 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>
 ;;;
@@ -130,7 +130,8 @@ specifications to 'targets'."
        (documentation "Map a device node using Linux's device mapper.")
        (start #~(lambda () #$(open source targets)))
        (stop #~(lambda _ (not #$(close source targets))))
-       (respawn? #f))))))
+       (respawn? #f))))
+   (description "Map a device node using Linux's device mapper.")))
 
 (define (device-mapping-service mapped-device)
   "Return a service that sets up @var{mapped-device}."
@@ -191,7 +192,8 @@ option of @command{guix system}.\n")
   "Return a gexp that maps SOURCE to TARGET as a LUKS device, using
 'cryptsetup'."
   (with-imported-modules (source-module-closure
-                          '((gnu build file-systems)))
+                          '((gnu build file-systems)
+                            (guix build utils))) ;; For mkdir-p
     (match targets
       ((target)
        #~(let ((source #$(if (uuid? source)
@@ -200,32 +202,42 @@ 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
+           ;; is mandatory for LUKS2.
+           (mkdir-p "/run/cryptsetup/")
 
            ;; 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."