From patchwork Wed Dec 29 21:57:13 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: chayleaf X-Patchwork-Id: 35760 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 0B78D27BBEA; Wed, 29 Dec 2021 23:40:50 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.9 required=5.0 tests=BAYES_00,MAILING_LIST_MULTI, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5D56327BBE9 for ; Wed, 29 Dec 2021 23:40:49 +0000 (GMT) Received: from localhost ([::1]:36900 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n2iYq-0006Wo-GU for patchwork@mira.cbaines.net; Wed, 29 Dec 2021 18:40:48 -0500 Received: from eggs.gnu.org ([209.51.188.92]:55656) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n2hDq-0005Tx-96 for guix-patches@gnu.org; Wed, 29 Dec 2021 17:15:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:39021) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n2hDp-0001pu-Va for guix-patches@gnu.org; Wed, 29 Dec 2021 17:15:01 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n2hDp-0006hM-SE for guix-patches@gnu.org; Wed, 29 Dec 2021 17:15:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#52882] [PATCH] gnu: system: Add crypt-key field for mapped filesystems Resent-From: chayleaf Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 29 Dec 2021 22:15:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 52882 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 52882@debbugs.gnu.org Cc: chayleaf , chayleaf X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.164081606325668 (code B ref -1); Wed, 29 Dec 2021 22:15:01 +0000 Received: (at submit) by debbugs.gnu.org; 29 Dec 2021 22:14:23 +0000 Received: from localhost ([127.0.0.1]:50564 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n2hDC-0006fv-Nz for submit@debbugs.gnu.org; Wed, 29 Dec 2021 17:14:23 -0500 Received: from lists.gnu.org ([209.51.188.17]:56912) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n2gwk-00069L-Nx for submit@debbugs.gnu.org; Wed, 29 Dec 2021 16:57:23 -0500 Received: from eggs.gnu.org ([209.51.188.92]:52608) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n2gwk-0001Bv-EB for guix-patches@gnu.org; Wed, 29 Dec 2021 16:57:22 -0500 Received: from [129.159.192.69] (port=40830 helo=mail.pavluk.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n2gwi-0006hg-BB for guix-patches@gnu.org; Wed, 29 Dec 2021 16:57:22 -0500 Received: by mail.pavluk.org (Postfix, from userid 1006) id 723AE801914A; Wed, 29 Dec 2021 21:57:17 +0000 (GMT) From: chayleaf Date: Wed, 29 Dec 2021 21:57:13 +0000 Message-Id: <20211229215713.1671606-1-chayleaf@pavluk.org> X-Mailer: git-send-email 2.27.0 MIME-Version: 1.0 X-Host-Lookup-Failed: Reverse DNS lookup failed for 129.159.192.69 (failed) Received-SPF: pass client-ip=129.159.192.69; envelope-from=chayleaf@pavluk.org; helo=mail.pavluk.org X-Spam_score_int: 41 X-Spam_score: 4.1 X-Spam_bar: ++++ X-Spam_report: (4.1 / 5.0 requ) RCVD_IN_PBL=3.335, RDNS_NONE=0.793, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=no autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Wed, 29 Dec 2021 17:14:21 -0500 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Mailman-Approved-At: Wed, 29 Dec 2021 18:40:05 -0500 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches From: chayleaf 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 --- 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 (source mapped-device-source) ;string | list of strings (targets mapped-device-targets) ;list of strings (type mapped-device-type) ; + (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-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))