From f6438d1175a1d60d842ab502255a7685b05f4e7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Miguel=20=C3=81ngel=20Arruga=20Vivas?= 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 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 ;;; Copyright © 2017 Leo Famulari ;;; Copyright © 2017 Mathieu Othacehe +;;; Copyright © 2019 Miguel Ángel Arruga Vivas ;;; ;;; 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 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 ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2019 Meiyo Peng +;;; Copyright © 2019 Miguel Ángel Arruga Vivas ;;; ;;; 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 , 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 , 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 ." (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 ." (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