bug#57307: [PATCH 1/2] bootloader: Convert device in menu-entry to proper sexp.

[Josselin Poiret]

Previously, menu-entry->sexp didn't try to convert `device` to a
proper sexp, which was inserted directly into the boot parameters
G-exp, leading to a G-exp input error.  Now convert both uuid and
file-system-label possibilities to sexps, and add parsing code to
sexp->menu-entry.  This fixes #57307.

* gnu/bootloader.scm (menu-entry->sexp, sexp->menu-entry): Take
non-string devices into account.
---
 gnu/bootloader.scm | 24 ++++++++++++++++++++----
 1 file changed, 20 insertions(+), 4 deletions(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 9cf5457873..1f08ab170e 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -21,6 +21,8 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu bootloader)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system uuid)
   #:use-module (guix discovery)
   #:use-module (guix gexp)
   #:use-module (guix profiles)
@@ -105,12 +107,19 @@ (define-record-type* <menu-entry>
 
 (define (menu-entry->sexp entry)
   "Return ENTRY serialized as an sexp."
+  (define (device->sexp device)
+    (match device
+      ((? uuid? uuid)
+       `(uuid ,(uuid-type uuid) ,(uuid->string uuid)))
+      ((? file-system-label? label)
+       `(label ,(file-system-label->string label)))
+      (_ device)))
   (match entry
     (($ <menu-entry> label device mount-point linux linux-arguments initrd #f
                      ())
      `(menu-entry (version 0)
                   (label ,label)
-                  (device ,device)
+                  (device ,(device->sexp device))
                   (device-mount-point ,mount-point)
                   (linux ,linux)
                   (linux-arguments ,linux-arguments)
@@ -119,7 +128,7 @@ (define (menu-entry->sexp entry)
                      multiboot-kernel multiboot-arguments multiboot-modules)
      `(menu-entry (version 0)
                   (label ,label)
-                  (device ,device)
+                  (device ,(device->sexp device))
                   (device-mount-point ,mount-point)
                   (multiboot-kernel ,multiboot-kernel)
                   (multiboot-arguments ,multiboot-arguments)
@@ -128,6 +137,13 @@ (define (menu-entry->sexp entry)
 (define (sexp->menu-entry sexp)
   "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
 record."
+  (define (sexp->device device-sexp)
+    (match device-sexp
+      (('uuid type uuid-string)
+       (uuid uuid-string type))
+      (('label label)
+       (file-system-label label))
+      (_ device-sexp)))
   (match sexp
     (('menu-entry ('version 0)
                   ('label label) ('device device)
@@ -136,7 +152,7 @@ (define (sexp->menu-entry sexp)
                   ('initrd initrd) _ ...)
      (menu-entry
       (label label)
-      (device device)
+      (device (sexp->device device))
       (device-mount-point mount-point)
       (linux linux)
       (linux-arguments linux-arguments)
@@ -149,7 +165,7 @@ (define (sexp->menu-entry sexp)
                   ('multiboot-modules multiboot-modules) _ ...)
      (menu-entry
       (label label)
-      (device device)
+      (device (sexp->device device))
       (device-mount-point mount-point)
       (multiboot-kernel multiboot-kernel)
       (multiboot-arguments multiboot-arguments)

base-commit: b8f2eb286ec52c97048e23d326d94ae5772797e8
-- 
2.37.1