[bug#55407] [PATCH] system: Improve warning when using LUKS mapped devices without UUIDs.

[Maxim Cournoyer]

This corrects two problems with the previous mapped devices warning:

1. It wasn't clear how to correct the situation.
2. The output would be repeated twice, as the procedure is called
twice during a system reconfigure.

* gnu/system.scm (operating-system-bootloader-crypto-devices): Memoize
procedure.  Produce a single message for the combined problematic devices.
Add a hint to help users fix the warning.
---
 gnu/system.scm | 42 +++++++++++++++++++++++-------------------
 1 file changed, 23 insertions(+), 19 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index c3810cbeeb..b090eeae01 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -33,6 +33,7 @@
 (define-module (gnu system)
   #:use-module (guix inferior)
   #:use-module (guix store)
+  #:use-module (guix memoization)
   #:use-module (guix monads)
   #:use-module (guix gexp)
   #:use-module (guix records)
@@ -78,7 +79,9 @@ (define-module (gnu system)
   #:use-module (gnu system uuid)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system mapped-devices)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -600,25 +603,26 @@ (define (operating-system-boot-mapped-devices os)
                (any file-system-needed-for-boot? users)))
            devices)))
 
-(define (operating-system-bootloader-crypto-devices os)
-  "Return the subset of mapped devices that the bootloader must open.
-Only devices specified by uuid are supported."
-  (define (valid-crypto-device? dev)
-    (or (uuid? dev)
-        (begin
-          (warning (G_ "\
-mapped-device '~a' may not be mounted by the bootloader.~%")
-                   dev)
-          #f)))
-  (filter-map (match-lambda
-                ((and (= mapped-device-type type)
-                      (= mapped-device-source source))
-                 (and (eq? luks-device-mapping type)
-                      (valid-crypto-device? source)
-                      source))
-                (_ #f))
-              ;; XXX: Ordering is important, we trust the returned one.
-              (operating-system-boot-mapped-devices os)))
+(define operating-system-bootloader-crypto-devices
+  (mlambda (os)                         ;to avoid duplicated output
+    "Return the sources of the LUKS mapped devices specified by UUID."
+    ;; XXX: Device ordering is important, we trust the returned one.
+    (let ((luks-devices (filter (lambda (m)
+                                  (eq? luks-device-mapping
+                                       (mapped-device-type m)))
+                                (operating-system-boot-mapped-devices os))))
+      (receive (uuid-crypto-devices non-uuid-crypto-devices)
+          (partition (compose uuid? mapped-device-source) luks-devices)
+        (when (not (null? non-uuid-crypto-devices))
+          (warning (N_ "\
+the following mapped device may not be mounted by the bootloader: ~s
+hint: specify the mapped device source via its LUKS UUID.~%"
+                       "\
+the following mapped devices may not be mounted by the bootloader: ~s
+hint: specify the mapped device sources via their LUKS UUID.~%"
+                       (length non-uuid-crypto-devices))
+                   (map mapped-device-source non-uuid-crypto-devices)))
+        (map mapped-device-source uuid-crypto-devices)))))
 
 (define (device-mapping-services os)
   "Return the list of device-mapping services for OS as a list."
-- 
2.36.0