[bug#57496] [PATCH v3 1/3] gnu: bootloader: Extend `<menu-entry>' for chain-loader.

[typ22]

From: tiantian <typ22@foxmail.com>

* gnu/bootloader.scm (<menu-entry>)[chain-loader]: New field.
(menu-entry->sexp, sexp->menu-entry): Support chain-loader.
* doc/guix.texi (Bootloader Configuration): Document it.

Co-Authored-By: Julien Lepiller <julien@lepiller.eu>
---
v2:
Correct the document and specify all fields of <menu-entry> in the pattern
of menu-entry->sexp.

Now still judge linux, multiboot-kernel and chain-loader. Because if don't
judge, the menu-entry that all of linux, linux-multiboot and chainloader
are #f will match the first one.

Then produce Error message:
guix system: error: #<unspecified>: invalid G-expression input

This error message does not help.

v3:
correct the document and delete an extra blank line.

all:
The documents are mainly corrected by Julien Lepiller.
Thank you here.

 doc/guix.texi      | 18 ++++++++++++++++++
 gnu/bootloader.scm | 33 +++++++++++++++++++++++++++------
 2 files changed, 45 insertions(+), 6 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 957b9a668e..cc64a7ed70 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -37536,6 +37536,24 @@ Bootloader Configuration
              @dots{}))
 @end lisp
 
+@item @code{chain-loader} (default: @code{#f})
+A string that can be accepted by @code{grub}'s @code{chainloader}
+directive. This has no effect if either @code{linux} or
+@code{multiboot-kernel} fields are specified. The following is an
+example of chainloading a different GNU/Linux system.
+
+@lisp
+(bootloader
+ (bootloader-configuration
+  ;; @dots{}
+  (menu-entries
+   (list
+    (menu-entry
+     (label "GNU/Linux")
+     (device (uuid "1C31-A17C" 'fat))
+     (chain-loader "/EFI/GNULinux/grubx64.efi"))))))
+@end lisp
+
 @end table
 @end deftp
 
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 77c05e8946..9e8b545d10 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -46,6 +46,7 @@ (define-module (gnu bootloader)
             menu-entry-multiboot-kernel
             menu-entry-multiboot-arguments
             menu-entry-multiboot-modules
+            menu-entry-chain-loader
 
             menu-entry->sexp
             sexp->menu-entry
@@ -104,8 +105,10 @@ (define-record-type* <menu-entry>
   (multiboot-arguments menu-entry-multiboot-arguments
                        (default '()))      ; list of string-valued gexps
   (multiboot-modules menu-entry-multiboot-modules
-                     (default '())))       ; list of multiboot commands, where
+                     (default '()))        ; list of multiboot commands, where
                                            ; a command is a list of <string>
+  (chain-loader     menu-entry-chain-loader
+                    (default #f)))         ; string, path of efi file
 
 (define (menu-entry->sexp entry)
   "Return ENTRY serialized as an sexp."
@@ -117,8 +120,9 @@ (define (menu-entry->sexp entry)
        `(label ,(file-system-label->string label)))
       (_ device)))
   (match entry
-    (($ <menu-entry> label device mount-point linux linux-arguments initrd #f
-                     ())
+    (($ <menu-entry> label device mount-point
+                     (? identity linux) linux-arguments initrd
+                     #f () () #f)
      `(menu-entry (version 0)
                   (label ,label)
                   (device ,(device->sexp device))
@@ -127,14 +131,22 @@ (define (menu-entry->sexp entry)
                   (linux-arguments ,linux-arguments)
                   (initrd ,initrd)))
     (($ <menu-entry> label device mount-point #f () #f
-                     multiboot-kernel multiboot-arguments multiboot-modules)
+                     (? identity multiboot-kernel) multiboot-arguments
+                     multiboot-modules #f)
      `(menu-entry (version 0)
                   (label ,label)
                   (device ,(device->sexp device))
                   (device-mount-point ,mount-point)
                   (multiboot-kernel ,multiboot-kernel)
                   (multiboot-arguments ,multiboot-arguments)
-                  (multiboot-modules ,multiboot-modules)))))
+                  (multiboot-modules ,multiboot-modules)))
+    (($ <menu-entry> label device mount-point #f () #f #f () ()
+                     (? identity chain-loader))
+     `(menu-entry (version 0)
+                  (label ,label)
+                  (device ,(device->sexp device))
+                  (device-mount-point ,mount-point)
+                  (chain-loader ,chain-loader)))))
 
 (define (sexp->menu-entry sexp)
   "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
@@ -171,7 +183,16 @@ (define (sexp->menu-entry sexp)
       (device-mount-point mount-point)
       (multiboot-kernel multiboot-kernel)
       (multiboot-arguments multiboot-arguments)
-      (multiboot-modules multiboot-modules)))))
+      (multiboot-modules multiboot-modules)))
+    (('menu-entry ('version 0)
+                  ('label label) ('device device)
+                  ('device-mount-point mount-point)
+                  ('chain-loader chain-loader) _ ...)
+     (menu-entry
+      (label label)
+      (device (sexp->device device))
+      (device-mount-point mount-point)
+      (chain-loader chain-loader)))))
 
 
 ;;;

base-commit: 6beadc82df204f315d06ea35f2e232bb32f8e440
-- 
2.37.2