bug#37851: Grub installation only checks for encrypted /boot folder

[Miguel Arruga Vivas <rosen644835@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1179 bytes --]

Hi Ludo’,

El Tue, 22 Oct 2019 16:12:49 +0200
Ludovic Courtès <ludo@gnu.org> escribió:
> Hola Miguel,
> 
> Miguel Arruga Vivas <rosen644835@gmail.com> skribis:
> > (...)
> > +cryptomount -a  
> 
> Does that cause GRUB to mount all the LUKS partitions it was aware of
> at installation time, or does it cause it to scan all the partitions
> in search of a LUKS signature?

That patch is the first one, it mounts everything it can find, unlike
this one.

The only option I've seen was to modify boot-parameters (as in #35394,
wink wink nudge nudge) in order to store the needed partitions.  I've
reduced it this time to one patch, is it somehow easier to read this
way?  I could split it in two stages (one add the boot-parameters
field, the other one to make use of it) or squash the three for the
other feature into one if that easier for the review.  The main issues
I've found is that the source of the device-mappings needed for boot up
has to be declared by the UUID to ensure they are not system
dependent.  Also, the warning is shown several times and the message
isn't quite good, any idea how to fix/improve this?

Happy hacking!
Miguel

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-system-Use-of-mapped-devices-for-boot-process.patch --]
[-- Type: text/x-patch, Size: 12753 bytes --]

From f6438d1175a1d60d842ab502255a7685b05f4e7d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Miguel=20=C3=81ngel=20Arruga=20Vivas?=
 <rosen644835@gmail.com>
Date: Sun, 27 Oct 2019 01:35:59 +0200
Subject: [PATCH] system: Use of mapped-devices for boot process.

* gnu/bootloader/depthcharge.scm (depthcharge-configuration-file): New
parameter crypto-devices, not used.
* gnu/bootloader/extlinux.scm (extlinux-configuration-file): Likewise.
* gnu/bootloader/grub.scm (grub-configuration-file)[declaration]: New
parameter crypto-devices, used to ensure unlock every encrypted
partition needed by the bootloader.
[device-uuid->gexp]: New function, emits cryptomount calls.
[body]: Map crypto-devices with device-uuid->gexp.
* gnu/machine/ssh.scm (roll-back-managed-host): Use the crypto-devices
stored from the selected generation in the call to the bootloader
configuration generator.
* gnu/scripts/system.scm (reinstall-bootloader): Likewise.
* gnu/system.scm (define-module)[export]: Export new accessor
boot-parameters-crypto-devices.
(boot-parameters)[crypto-devices]: New field.
(read-boot-parameters)[uuid-sexp->uuid]: New function.
(read-boot-parameters)[body]: Read new field crypto-devices.
(operating-system-boot-parameters-file): Add the new field.
(operating-system-boot-crypto-devices): New function.  Warn about
devices without an UUID.  They are ignored as they would be dependant
on the hardware configuration.
(operating-system-bootcfg): Use operating-system-boot-crypto-devices in
the call to the bootloader configuration generator.
(operating-system-boot-parameters): Use
operating-system-boot-crypto-devices to store the needed devices.
---
 gnu/bootloader/depthcharge.scm |  1 +
 gnu/bootloader/extlinux.scm    |  1 +
 gnu/bootloader/grub.scm        | 14 ++++++++++++
 gnu/machine/ssh.scm            |  3 +++
 gnu/system.scm                 | 40 ++++++++++++++++++++++++++++++++++
 guix/scripts/system.scm        |  2 ++
 6 files changed, 61 insertions(+)

diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm
index 58cc3f3932..fe4302e93c 100644
--- a/gnu/bootloader/depthcharge.scm
+++ b/gnu/bootloader/depthcharge.scm
@@ -82,6 +82,7 @@
 (define* (depthcharge-configuration-file config entries
                                          #:key
                                          (system (%current-system))
+                                         (crypto-devices '())
                                          (old-entries '()))
   (match entries
     ((entry)
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 40108584a8..3defeab3dd 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -28,6 +28,7 @@
 (define* (extlinux-configuration-file config entries
                                       #:key
                                       (system (%current-system))
+                                      (crypto-devices '())
                                       (old-entries '()))
   "Return the U-Boot configuration file corresponding to CONFIG, a
 <u-boot-configuration> object, and where the store is available at STORE-FS, a
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index d984d5f5e3..8b5cf848af 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -316,6 +317,7 @@ code."
 (define* (grub-configuration-file config entries
                                   #:key
                                   (system (%current-system))
+                                  (crypto-devices '())
                                   (old-entries '()))
   "Return the GRUB configuration file corresponding to CONFIG, a
 <bootloader-configuration> object, and where the store is available at
@@ -345,6 +347,17 @@ entries corresponding to old generations of the system."
                   #$(grub-root-search device kernel)
                   #$kernel (string-join (list #$@arguments))
                   #$initrd))))
+  (define (device-uuid->gexp device-uuid)
+    (let* ((uuid-string (uuid->string device-uuid))
+           ;; XXX: My tests only worked with UUID values without
+           ;; any hyphen character.
+           (filtered-uuid (string-filter (lambda (c)
+                                           (not (eqv? c #\-)))
+                                         uuid-string)))
+      #~(format port "# Unlock encrypted device ~a
+cryptomount -u ~a~%"
+                #$uuid-string
+                #$filtered-uuid)))
   (define sugar
     (eye-candy config
                (menu-entry-device (first all-entries))
@@ -370,6 +383,7 @@ keymap ~a~%" keymap)))))
                   "# This file was generated from your Guix configuration.  Any changes
 # will be lost upon reconfiguration.
 ")
+          #$@(map device-uuid->gexp crypto-devices)
           #$sugar
           #$keyboard-layout-config
           (format port "
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 6e3ed0e092..e8750bbe81 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -435,11 +435,14 @@ an environment type of 'managed-host."
                                             (drop boot-parameters 2)))
                        (bootloader -> (operating-system-bootloader
                                        (machine-operating-system machine)))
+                       (crypto-devices -> (boot-parameters-crypto-devices
+                                           (second boot-parameters)))
                        (bootcfg (lower-object
                                  ((bootloader-configuration-file-generator
                                    (bootloader-configuration-bootloader
                                     bootloader))
                                   bootloader entries
+                                  #:crypto-devices crypto-devices
                                   #:old-entries old-entries)))
                        (remote-result (machine-remote-eval machine remote-exp)))
     (when (eqv? 'error remote-result)
diff --git a/gnu/system.scm b/gnu/system.scm
index a353b1a5c8..9835fddf89 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
+;;; Copyright © 2019 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -119,6 +120,7 @@
             boot-parameters-bootloader-menu-entries
             boot-parameters-store-device
             boot-parameters-store-mount-point
+            boot-parameters-crypto-devices
             boot-parameters-kernel
             boot-parameters-kernel-arguments
             boot-parameters-initrd
@@ -256,6 +258,7 @@ directly by the user."
    boot-parameters-bootloader-menu-entries)
   (store-device     boot-parameters-store-device)
   (store-mount-point boot-parameters-store-mount-point)
+  (crypto-devices   boot-parameters-crypto-devices)
   (kernel           boot-parameters-kernel)
   (kernel-arguments boot-parameters-kernel-arguments)
   (initrd           boot-parameters-initrd))
@@ -286,6 +289,14 @@ file system labels."
            device
            (file-system-label device)))))
 
+  (define uuid-sexp->uuid
+    (match-lambda
+      (('uuid (? symbol? type) (? bytevector? bv))
+       (bytevector->uuid bv type))
+      (x
+       (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
+       #f)))
+
   (match (read port)
     (('boot-parameters ('version 0)
                        ('label label) ('root-device root)
@@ -324,6 +335,11 @@ file system labels."
          (('initrd (? string? file))
           file)))
 
+      (crypto-devices
+       (match (assq 'crypto-devices rest)
+         ((_ device-list) (map uuid-sexp->uuid device-list))
+         (#f              '())))
+
       (store-device
        ;; Linux device names like "/dev/sda1" are not suitable GRUB device
        ;; identifiers, so we just filter them out.
@@ -438,6 +454,23 @@ from the initrd."
                (any file-system-needed-for-boot? users)))
            devices)))
 
+(define (operating-system-boot-crypto-devices os)
+  (define (crypto-device? device)
+    (let ((type (mapped-device-type device)))
+      (eq? type luks-device-mapping)))
+  (define (with-uuid? device)
+    (if (uuid? (mapped-device-source device))
+        #t
+        (begin
+          (warning (G_ "the source from mapped-device at ~a is not an UUID.
+It will be ignored for the bootloader configuration.~%")
+                   (mapped-device-location device))
+          #f)))
+  (let* ((mapped-devices (operating-system-boot-mapped-devices os))
+         (crypto-devices (filter crypto-device? mapped-devices))
+         (valid-devices (filter with-uuid? crypto-devices)))
+    (map mapped-device-source valid-devices)))
+
 (define (device-mapping-services os)
   "Return the list of device-mapping services for OS as a list."
   (map device-mapping-service
@@ -989,6 +1022,7 @@ entry."
 a list of <menu-entry>, to populate the \"old entries\" menu."
   (let* ((root-fs         (operating-system-root-file-system os))
          (root-device     (file-system-device root-fs))
+         (crypto-devices  (operating-system-boot-crypto-devices os))
          (params          (operating-system-boot-parameters
                            os root-device
                            #:system-kernel-arguments? #t))
@@ -999,6 +1033,7 @@ a list of <menu-entry>, to populate the \"old entries\" menu."
        (bootloader-configuration-bootloader bootloader-conf)))
 
     (generate-config-file bootloader-conf (list entry)
+                          #:crypto-devices crypto-devices
                           #:old-entries old-entries)))
 
 (define* (operating-system-boot-parameters os root-device
@@ -1011,6 +1046,7 @@ such as '--root' and '--load' to <boot-parameters>."
          (bootloader      (bootloader-configuration-bootloader
                            (operating-system-bootloader os)))
          (bootloader-name (bootloader-name bootloader))
+         (crypto-devices  (operating-system-boot-crypto-devices os))
          (label           (operating-system-label os)))
     (boot-parameters
      (label label)
@@ -1024,6 +1060,7 @@ such as '--root' and '--load' to <boot-parameters>."
      (bootloader-name bootloader-name)
      (bootloader-menu-entries
       (bootloader-configuration-menu-entries (operating-system-bootloader os)))
+     (crypto-devices crypto-devices)
      (store-device (ensure-not-/dev (file-system-device store)))
      (store-mount-point (file-system-mount-point store)))))
 
@@ -1070,6 +1107,9 @@ being stored into the \"parameters\" file)."
                             (or (and=> (operating-system-bootloader os)
                                        bootloader-configuration-menu-entries)
                                 '())))
+                    (crypto-devices
+                     #$(map device->sexp
+                            (boot-parameters-crypto-devices params)))
                     (store
                      (device
                       #$(device->sexp (boot-parameters-store-device params)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 27b014db68..95cffec52d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -392,12 +392,14 @@ STORE is an open connection to the store."
                        %system-profile old-generations))
          (entries (cons (boot-parameters->menu-entry params)
                         (boot-parameters-bootloader-menu-entries params)))
+         (crypto-devices (boot-parameters-crypto-devices params))
          (old-entries (map boot-parameters->menu-entry old-params)))
     (run-with-store store
       (mlet* %store-monad
           ((bootcfg (lower-object
                      ((bootloader-configuration-file-generator bootloader)
                       bootloader-config entries
+                      #:crypto-devices crypto-devices
                       #:old-entries old-entries)))
            (drvs -> (list bootcfg)))
         (mbegin %store-monad
-- 
2.23.0