[bug#73654,v2] mapped-devices: luks: Support passing --allow-discards during open

  From: Sisiutl <sisiutl@egregore.fun>

* gnu/system/mapped-devices.scm (open-luks-device): Support opening
LUKS devices with the --allow-discards option.
* gnu/system/mapped-devices.scm (luks-device-mapping-with-options):
Pass through the allow-discards? keyword argument.
* doc/guix.texi (Mapped Devices): Update documentation for the
luks-device-mapping-with-options procedure.

Signed-off-by: Sören Tempel <soeren@soeren-tempel.net>
---
Not the author of the original patchset, but I needed this for my
own setup as well so I might as well pick up the slack.  I made
the following changes since the v1:

* Mention allow-discards? in the docstring of open-luks-device.
* Reference the new option in luks-device-mapping-with-options.
* Expand the related documentation in doc/guix.texi.
* Revise the commit message slightly.
* Restore the linefeed.

 doc/guix.texi                 | 11 +++++++++-
 gnu/system/mapped-devices.scm | 39 ++++++++++++++++++++---------------
 2 files changed, 32 insertions(+), 18 deletions(-)


base-commit: c4f297a664869a18126b66eb5209de1fcceb42d8
  

Hi,

soeren@soeren-tempel.net writes:

> From: Sisiutl <sisiutl@egregore.fun>
>
> * gnu/system/mapped-devices.scm (open-luks-device): Support opening
> LUKS devices with the --allow-discards option.
> * gnu/system/mapped-devices.scm (luks-device-mapping-with-options):
> Pass through the allow-discards? keyword argument.
> * doc/guix.texi (Mapped Devices): Update documentation for the
> luks-device-mapping-with-options procedure.
>
> Signed-off-by: Sören Tempel <soeren@soeren-tempel.net>

I'd use a 'Co-authored-by' if significantly modified or 'Modified-by' if
lightly touched git trailers here.  Signed-off-by is currently used in
Guix to denote someone else's work pushed by a committer.

> ---
> Not the author of the original patchset, but I needed this for my
> own setup as well so I might as well pick up the slack.  I made
> the following changes since the v1:
>
> * Mention allow-discards? in the docstring of open-luks-device.
> * Reference the new option in luks-device-mapping-with-options.
> * Expand the related documentation in doc/guix.texi.
> * Revise the commit message slightly.
> * Restore the linefeed.

Sounds good.

>  doc/guix.texi                 | 11 +++++++++-
>  gnu/system/mapped-devices.scm | 39 ++++++++++++++++++++---------------
>  2 files changed, 32 insertions(+), 18 deletions(-)
>
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 05c855c5ea..bc3ba1f2ed 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -18461,7 +18461,7 @@ Mapped Devices
>  @code{dm-crypt} Linux kernel module.
>  @end defvar
>  
> -@deffn {Procedure} luks-device-mapping-with-options [#:key-file]
> +@deffn {Procedure} luks-device-mapping-with-options [#:key-file #:allow-discards?]
>  Return a @code{luks-device-mapping} object, which defines LUKS block
>  device encryption using the @command{cryptsetup} command from the
>  package with the same name.  It relies on the @code{dm-crypt} Linux
> @@ -18483,6 +18483,15 @@ Mapped Devices
>   (type (luks-device-mapping-with-options
>          #:key-file "/crypto.key")))
>  @end lisp
> +
> +If @code{allow-discards?} is provided, then the use of discard (TRIM)
> +requests is allowed for the underlying device.

I'd streamline this sentence into:

--8<---------------cut here---------------start------------->8---
@code{allow-discards?} allows the use of discard (TRIM) requests for the
underlying device.
--8<---------------cut here---------------end--------------->8---

> + This is useful for
> +Solid State Drives.

I'd use 'solid state drives', un-capitalized or @acronym{SSD, Solid
State Drives}.

> However, this option can have a negative security
> +impact because it can make filesystem-level operations visible on the

The GNU convention is to use 'file system', not filesystem.

> +physical device.  For more information, refer to the description of
> +the @code{--allow-discards} option in the @code{cryptsetup-open(8)}
> +man page.
> +
>  @end deffn
>  
>  @defvar raid-device-mapping
> diff --git a/gnu/system/mapped-devices.scm b/gnu/system/mapped-devices.scm
> index 931c371425..c3eaf9ff6e 100644
> --- a/gnu/system/mapped-devices.scm
> +++ b/gnu/system/mapped-devices.scm
> @@ -194,9 +194,10 @@ (define (check-device-initrd-modules device linux-modules location)
>  ;;; Common device mappings.
>  ;;;
>  
> -(define* (open-luks-device source targets #:key key-file)
> +(define* (open-luks-device source targets #:key key-file allow-discards?)
>    "Return a gexp that maps SOURCE to TARGET as a LUKS device, using
> -'cryptsetup'."
> +'cryptsetup'.  When ALLOW-DISCARDS? is true, the use of discard (TRIM) requests is
> +allowed for the underlying device."
>    (with-imported-modules (source-module-closure
>                            '((gnu build file-systems)
>                              (guix build utils))) ;; For mkdir-p
> @@ -234,17 +235,19 @@ (define* (open-luks-device source targets #:key key-file)
>                                              (loop (- tries-left 1))))))
>                            (error "LUKS partition not found" source))
>                        source)))
> -             ;; We want to fallback to the password unlock if the keyfile fails.
> -             (or (and keyfile
> -                      (zero? (system*/tty
> -                              #$(file-append cryptsetup-static "/sbin/cryptsetup")
> -                              "open" "--type" "luks"
> -                              "--key-file" keyfile
> -                              partition #$target)))
> -                 (zero? (system*/tty
> -                         #$(file-append cryptsetup-static "/sbin/cryptsetup")
> -                         "open" "--type" "luks"
> -                         partition #$target)))))))))
> +             (let* ((cryptsetup-flags (list "open" "--type" "luks" partition #$target))
> +                    (cryptsetup-flags (if allow-discards?
> +                                          (cons "--allow-discards" cryptsetup-flags)
> +                                          cryptsetup-flags)))

Theres' not need for a let* and reusing the same variable; you can
instead use the following list splicing trick:

--8<---------------cut here---------------start------------->8---
(let ((options `(,@(if allow-discards?
                       "--allow-discards"
                       '())
                 "open" "--type" "luks" partition #$target)))
  [...])
--8<---------------cut here---------------end--------------->8---

> +               ;; We want to fallback to the password unlock if the keyfile fails.
> +               (or (and keyfile
> +                        (zero? (apply system*/tty
> +                                      #$(file-append cryptsetup-static "/sbin/cryptsetup")
> +                                      "--key-file" keyfile
> +                                      cryptsetup-flags)))
> +                   (zero? (apply system*/tty
> +                                 #$(file-append cryptsetup-static "/sbin/cryptsetup")
> +                                 cryptsetup-flags))))))))))

You'll want to nest the apply under the (zero? ... call and ensure it
fits under 80 characters, which is in our coding style guidelines.

>  (define (close-luks-device source targets)
>    "Return a gexp that closes TARGET, a LUKS device."
> @@ -286,13 +289,15 @@ (define luks-device-mapping
>                ((gnu build file-systems)
>                 #:select (find-partition-by-luks-uuid system*/tty))))))
>  
> -(define* (luks-device-mapping-with-options #:key key-file)
> +(define* (luks-device-mapping-with-options #:key key-file allow-discards?)
>    "Return a luks-device-mapping object with open modified to pass the arguments
> -into the open-luks-device procedure."
> +(key-file and allow-discards?) into the open-luks-device procedure."

I would drop the above doc change.  'Arguments' already cover it in a
more abstract (and maintainable) fashion.

>    (mapped-device-kind
>     (inherit luks-device-mapping)
> -   (open (λ (source targets) (open-luks-device source targets
> -                                               #:key-file key-file)))))
> +   (open (λ (source targets)
> +           (open-luks-device source targets
> +                             #:key-file key-file
> +                             #:allow-discards? allow-discards?)))))

The rest LGTM.  Could you please send a new revision taking into account
my review comments?