Subject: bug#70826: [PATCH] system: Allow distinguishing <mapped-device-type>s.

From: Ludovic Courtès <[email-masked]>
Date: Tue, 06 May 2025 11:26:12 +0200

Hi 45mg,

Did you have a chance to look into the proposed change below?

Thanks,
Ludo’.

Ludovic Courtès <[email-masked]> writes:

> Hi,
>
> 45mg <[email-masked]> skribis:
>
>> We use <mapped-device-type> records to represent the different types of
>> mapped devices (LUKS, RAID, LVM).  When variables are defined for these
>> records, we can distinguish them with eq?; when they are created by
>> procedures, like luks-device-mapping-with-options, this does not work.
>> Therefore, add a 'name' field to <mapped-device-type> to distinguish
>> them.
>>
>> * gnu/system/mapped-devices.scm (<mapped-device-type>): Add name field.
>> (luks-device-mapping, raid-device-mapping, lvm-device-mapping):
>> Initialize it with appropriate values for each of these types.
>> * gnu/system.scm (operating-system-bootloader-crypto-devices): Use it to
>> identify LUKS mapped devices.
>>
>> Change-Id: I4c85824f74316f07239374d9df6c007dd47a9d0c
>> ---
>>
>> I've tested this on my system; in conjunction with [1], I can finally mount my
>> LUKS volume with the no_read_workqueue and no_write_workqueue flags.
>>
>> [1] [bug#77499] [PATCH] mapped-devices/luks: Support extra options.
>> https://issues.guix.gnu.org/77499
>> https://yhetil.org/guix/fb6[email-masked]/
>
> You can add a “Fixes” line for the bug it fixes.
>
>>      (let* ((luks-devices (filter (lambda (m)
>> -                                   (eq? luks-device-mapping
>> -                                        (mapped-device-type m)))
>> +                                   (eq? (mapped-device-kind-name
>> +                                         (mapped-device-type m))
>> +                                        'luks))
>
> [...]
>
>>  (define-record-type* <mapped-device-type> mapped-device-kind
>>    make-mapped-device-kind
>>    mapped-device-kind?
>> +  (name      mapped-device-kind-name)
>
> As a rule of thumb, I think comparing by identity (as was done before)
> is more robust and cleaner: that avoids the whole problem of this
> secondary name space where name clashes may occur involuntarily.
>
> But this problem the patch fixes was introduced by
> ‘luks-device-mapping-with-options’ I believe, which returns a new device
> type.
>
> If we take a step back, I wonder if a better solution would not be to
> add an ‘arguments’ field to <mapped-device>, following the same pattern
> as <package>.
>
> Here’s a preliminary patch to illustrate that:
>
> diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm
> index 72da8e55d3..17c2e6f6bf 100644
> --- a/gnu/system/linux-initrd.scm
> +++ b/gnu/system/linux-initrd.scm
> @@ -229,7 +229,8 @@ (define* (raw-initrd file-systems
>                    (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 667a495570..29d0dc95cf 100644
> --- a/gnu/system/mapped-devices.scm
> +++ b/gnu/system/mapped-devices.scm
> @@ -83,6 +83,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>
> +  (arguments mapped-device-arguments              ;list passed to open/close/check
> +             (default '()))
>    (location  mapped-device-location
>               (default (current-source-location)) (innate)))
>  
> @@ -128,13 +130,16 @@ (define device-mapping-service-type
>     '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.")))
> diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
> index 23eb215561..8a56f1cc63 100644
> --- a/guix/scripts/system.scm
> +++ b/guix/scripts/system.scm
> @@ -680,9 +680,10 @@ (define (check-mapped-devices os)
>                              (mapped-device-type md))))
>                  ;; We expect CHECK to raise an exception with a detailed
>                  ;; '&message' if something goes wrong.
> -                (check md
> +                (apply check md
>                         #:needed-for-boot? (needed-for-boot? md)
> -                       #:initrd-modules initrd-modules)))
> +                       #:initrd-modules initrd-modules
> +                       (mapped-device-arguments md))))
>              (operating-system-mapped-devices os)))
>  
>  (define (check-initrd-modules os)
>
>
> WDYT?
>
> Ludo’.