From 73cbb94d1dd8a72405c023adeb89ab6940d0d82e Mon Sep 17 00:00:00 2001
From: 45mg <45mg.writes@gmail.com>
Date: Mon, 22 Sep 2025 18:42:04 +0530
Subject: mapped-devices/luks: Support extra options.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Allow passing extra options to the 'cryptsetup open' command.

* gnu/system/mapped-devices.scm (luks-device-mapping-with-options):
[#:extra-options]: New argument.
(open-luks-device): Use it.
(check-luks-device): Validate it.
* doc/guix.texi (Mapped Devices): Document it.
* gnu/tests/install.scm (%test-encrypted-root-extra-options-os): New
test for it, as well as the previously untested #:allow-discards?
option.
(%encrypted-root-extra-options-os): New os declaration for the test.

Change-Id: I265a431efb0c81ed7cfc984344c6b8a4cc2f1624
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
---
 gnu/system/mapped-devices.scm | 29 +++++++++++++++++++++++------
 1 file changed, 23 insertions(+), 6 deletions(-)

(limited to 'gnu/system')

diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index b0a6beef280..d568bddc4ff 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -43,6 +43,7 @@
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 optargs)
   #:use-module (ice-9 format)
   #:export (%mapped-device
             mapped-device
@@ -200,10 +201,12 @@ option of @command{guix system}.\n")
 ;;; Common device mappings.
 ;;;
 
-(define* (open-luks-device source targets #:key key-file allow-discards?)
+(define* (open-luks-device source targets
+                           #:key key-file allow-discards? (extra-options '()))
   "Return a gexp that maps SOURCE to TARGET as a LUKS device, using
 'cryptsetup'.  When ALLOW-DISCARDS? is true, the use of discard (TRIM)
-requests is allowed for the underlying device."
+requests is allowed for the underlying device.  EXTRA-OPTIONS is a list of
+additional options to be passed to the 'cryptsetup open' command."
   (with-imported-modules (source-module-closure
                           '((gnu build file-systems)
                             (guix build utils))) ;; For mkdir-p
@@ -244,10 +247,13 @@ requests is allowed for the underlying device."
              (let ((cryptsetup #$(file-append cryptsetup-static
                                               "/sbin/cryptsetup"))
                    (cryptsetup-flags (cons*
-                                      "open" "--type" "luks" partition #$target
-                                      (if #$allow-discards?
-                                          '("--allow-discards")
-                                          '()))))
+                                      "open" "--type" "luks"
+                                      (append
+                                       (if #$allow-discards?
+                                           '("--allow-discards")
+                                           '())
+                                       '#$extra-options
+                                       (list partition #$target)))))
                ;; We want to fallback to the password unlock if the keyfile
                ;; fails.
                (or (and keyfile
@@ -271,6 +277,17 @@ requests is allowed for the underlying device."
   "Ensure the source of MD is valid."
   (let ((source   (mapped-device-source md))
         (location (mapped-device-location md)))
+    (let-keywords (mapped-device-arguments md) #t
+                  ((extra-options '())
+                   key-file allow-discards)
+      (unless (list? extra-options)
+        (raise (make-compound-condition
+                (formatted-message (G_ "invalid value ~s for #:extra-options \
+argument of `open-luks-device'")
+                                   extra-options)
+                (condition
+                 (&error-location
+                  (location (source-properties->location location))))))))
     (or (not (zero? (getuid)))
         (if (uuid? source)
             (match (find-partition-by-luks-uuid (uuid-bytevector source))
-- 
cgit v1.3