Package: guix-patches;
Reported by: chayleaf <chayleaf <at> pavluk.org>
Date: Wed, 29 Dec 2021 22:15:01 UTC
Severity: normal
Tags: patch
Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: chayleaf <chayleaf <at> pavluk.org> To: guix-patches <at> gnu.org Cc: chayleaf <chayleaf <at> pavluk.org>, chayleaf <chayleaf <at> protonmail.com> Subject: [PATCH] gnu: system: Add crypt-key field for mapped filesystems Date: Wed, 29 Dec 2021 21:57:13 +0000
From: chayleaf <chayleaf <at> protonmail.com>
This is a patch that adds a new field for mapped-filesystem that allows
one to specify the LUKS encryption key via G-Expressions.
An example use case is using a key stored on an external device.
Sorry if I made a mistake anywhere, I'm new to both Lisp and mailing
lists.
* gnu/system/mapped-devices.scm (mapped-device-kind):
Add crypt-key field.
(open-luks-device): Use crypt-key as the encryption key if it's
provided.
* gnu/system/linux-initrd.scm (raw-initrd)[device-mapping-commands]:
Utilize the crypt-key field.
* doc/guix.texi (Mapped Devices): Add crypt-key to mapped-device docs.
Signed-off-by: chayleaf <chayleaf <at> pavluk.org>
---
doc/guix.texi | 7 ++++
gnu/system/linux-initrd.scm | 11 ++---
gnu/system/mapped-devices.scm | 77 +++++++++++++++++++++++------------
3 files changed, 63 insertions(+), 32 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index ebfcfee7f7..22495b0cbd 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -15125,6 +15125,13 @@ there are several. The format is identical to @var{target}.
@item type
This must be a @code{mapped-device-kind} object, which specifies how
@var{source} is mapped to @var{target}.
+
+@item crypt-key
+A G-Expression (see @pxref{G-Expressions}) or a bytevector to be used as the
+encryption key for this device. If none is specified, the user will be asked
+to enter their passphrase. It can be used for fetching the key from an
+external device or avoiding to enter the passhprase two times with encrypted
+@code{/boot}.
@end table
@end deftp
diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index c78dd09205..36700d91ae 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -203,11 +203,12 @@ (define* (raw-initrd file-systems
(define device-mapping-commands
;; List of gexps to open the mapped devices.
(map (lambda (md)
- (let* ((source (mapped-device-source md))
- (targets (mapped-device-targets md))
- (type (mapped-device-type md))
- (open (mapped-device-kind-open type)))
- (open source targets)))
+ (let* ((source (mapped-device-source md))
+ (targets (mapped-device-targets md))
+ (type (mapped-device-type md))
+ (crypt-key (mapped-device-crypt-key md))
+ (open (mapped-device-kind-open type)))
+ (open source targets #:crypt-key crypt-key)))
mapped-devices))
(define file-system-scan-commands
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 96a381d5fe..4f680b71fe 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -50,6 +50,7 @@ (define-module (gnu system mapped-devices)
mapped-device-target
mapped-device-targets
mapped-device-type
+ mapped-device-crypt-key
mapped-device-location
mapped-device-kind
@@ -80,6 +81,8 @@ (define-record-type* <mapped-device> %mapped-device
(source mapped-device-source) ;string | list of strings
(targets mapped-device-targets) ;list of strings
(type mapped-device-type) ;<mapped-device-kind>
+ (crypt-key mapped-device-crypt-key ;bytevector | gexp
+ (default (const #f)))
(location mapped-device-location
(default (current-source-location)) (innate)))
@@ -107,7 +110,7 @@ (define-deprecated (mapped-device-target md)
(define-record-type* <mapped-device-type> mapped-device-kind
make-mapped-device-kind
mapped-device-kind?
- (open mapped-device-kind-open) ;source target -> gexp
+ (open mapped-device-kind-open) ;source target #:key (crypt-key #f) -> gexp
(close mapped-device-kind-close ;source target -> gexp
(default (const #~(const #f))))
(check mapped-device-kind-check ;source -> Boolean
@@ -188,7 +191,10 @@ (define missing
;;; Common device mappings.
;;;
-(define (open-luks-device source targets)
+(define* (open-luks-device source targets #:key
+ (crypt-key #f)
+ #:allow-other-keys
+ #:rest rest)
"Return a gexp that maps SOURCE to TARGET as a LUKS device, using
'cryptsetup'."
(with-imported-modules (source-module-closure
@@ -200,7 +206,9 @@ (define (open-luks-device source targets)
(uuid-bytevector source)
source)))
;; XXX: 'use-modules' should be at the top level.
- (use-modules (rnrs bytevectors) ;bytevector?
+ (use-modules (ice-9 binary-ports) ;put-bytevector
+ (ice-9 popen) ;open-pipe*
+ (rnrs bytevectors) ;bytevector?
((gnu build file-systems)
#:select (find-partition-by-luks-uuid))
((guix build utils) #:select (mkdir-p)))
@@ -211,28 +219,37 @@ (define (open-luks-device source targets)
;; 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)))))))
+ (let ((crypt-key #$crypt-key)
+ (cryptsetup-cmdline (list #$(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)))
+ (or (and (bytevector? crypt-key)
+ (let ((port (apply open-pipe*
+ (cons OPEN_WRITE
+ (append cryptsetup-cmdline
+ (list "--key-file" "-"))))))
+ (put-bytevector port crypt-key)
+ (zero? (status:exit-val (close-pipe port)))))
+ (zero? (apply system* cryptsetup-cmdline)))))))))
(define (close-luks-device source targets)
"Return a gexp that closes TARGET, a LUKS device."
@@ -271,7 +288,10 @@ (define luks-device-mapping
(close close-luks-device)
(check check-luks-device)))
-(define (open-raid-device sources targets)
+(define* (open-raid-device sources targets #:key
+ (crypt-key #f)
+ #:allow-other-keys
+ #:rest rest)
"Return a gexp that assembles SOURCES (a list of devices) to the RAID device
TARGET (e.g., \"/dev/md0\"), using 'mdadm'."
(match targets
@@ -312,7 +332,10 @@ (define raid-device-mapping
(open open-raid-device)
(close close-raid-device)))
-(define (open-lvm-device source targets)
+(define* (open-lvm-device source targets #:key
+ (crypt-key #f)
+ #:allow-other-keys
+ #:rest rest)
#~(and
(zero? (system* #$(file-append lvm2-static "/sbin/lvm")
"vgchange" "--activate" "ay" #$source))
--
2.34.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.