mapped-devices: Add ‘arguments’ field.

Fixes <https://issues.guix.gnu.org/70826>.

This allows users to specify extra arguments specific to the underlying
mapped device type.

* gnu/system/mapped-devices.scm (<mapped-device>)[arguments]: New field.
(device-mapping-service-type): Honor it.
* guix/scripts/system.scm (check-mapped-devices): Likewise.
* gnu/system/linux-initrd.scm (raw-initrd): Likewise.
* doc/guix.texi (Mapped Devices): Document it.

Reported-by: 45mg <45mg.writes@gmail.com>
Change-Id: Idef5a3e68535c412f13bae9a92c81c49053d4f4a

2 files changed, 12 insertions, 5 deletions

diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
index 72da8e55d30..17c2e6f6bfd 100644
--- a/gnu/system/linux-initrd.scm
+++ b/gnu/system/linux-initrd.scm
@@ -229,7 +229,8 @@ upon error."
                   (targets (mapped-device-targets md))
                   (type    (mapped-device-type md))
                   (open    (mapped-device-kind-open type)))
-             (open source targets)))
+             (apply open source targets
+                    (mapped-device-arguments md))))
          mapped-devices))
 
   (define file-system-scan-commands
diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
index 667a4955703..c09a0f1ef17 100644
--- a/gnu/system/mapped-devices.scm
+++ b/gnu/system/mapped-devices.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2022, 2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2022, 2024-2025 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Andreas Enge <andreas@enge.fr>
 ;;; Copyright © 2017, 2018 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
@@ -51,6 +51,7 @@
             mapped-device-target
             mapped-device-targets
             mapped-device-type
+            mapped-device-arguments
             mapped-device-location
 
             mapped-device-kind
@@ -83,6 +84,8 @@
   (source    mapped-device-source)                ;string | list of strings
   (targets   mapped-device-targets)               ;list of strings
   (type      mapped-device-type)                  ;<mapped-device-kind>
+  (arguments mapped-device-arguments              ;list passed to open/close/check
+             (default '()))
   (location  mapped-device-location
              (default (current-source-location)) (innate)))
 
@@ -128,13 +131,16 @@ specifications to 'targets'."
    'device-mapping
    (match-lambda
      (($ <mapped-device> source targets
-                         ($ <mapped-device-type> open close modules))
+                         ($ <mapped-device-type> open close modules)
+                         arguments)
       (shepherd-service
        (provision (list (symbol-append 'device-mapping- (string->symbol (string-join targets "-")))))
        (requirement '(udev))
        (documentation "Map a device node using Linux's device mapper.")
-       (start #~(lambda () #$(open source targets)))
-       (stop #~(lambda _ (not #$(close source targets))))
+       (start #~(lambda ()
+                  #$(apply open source targets arguments)))
+       (stop #~(lambda _
+                 (not #$(apply close source targets arguments))))
        (modules (append %default-modules modules))
        (respawn? #f))))
    (description "Map a device node using Linux's device mapper.")))