[bug#57496] [PATCH v4 2/3] gnu: bootloader: grub: Add support for chain-loader.

[bug#57496] [PATCH v4 2/3] gnu: bootloader: grub: Add support for chain-loader.

[typ22]

From: tiantian <typ22@foxmail.com>

* gnu/bootloader/grub.scm (grub-configuration-file): Add support for
chain-loader.
---

It is no different from v3 patch.

 gnu/bootloader/grub.scm | 73 ++++++++++++++++++++++++-----------------
 1 file changed, 43 insertions(+), 30 deletions(-)

diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 4f18c9b518..7283257354 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -374,44 +374,57 @@ (define* (grub-configuration-file config entries
     (let ((label (menu-entry-label entry))
           (linux (menu-entry-linux entry))
           (device (menu-entry-device entry))
-          (device-mount-point (menu-entry-device-mount-point entry)))
-      (if linux
-          (let ((arguments (menu-entry-linux-arguments entry))
-                (linux (normalize-file linux
-                                       device-mount-point
-                                       store-directory-prefix))
-                (initrd (normalize-file (menu-entry-initrd entry)
-                                        device-mount-point
-                                        store-directory-prefix)))
-         ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
-         ;; Use the right file names for LINUX and INITRD in case
-         ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
-         ;; separate partition.
-
-         ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
-         ;; initrd paths, to allow booting from a Btrfs subvolume.
-         #~(format port "menuentry ~s {
+          (device-mount-point (menu-entry-device-mount-point entry))
+          (multiboot-kernel (menu-entry-multiboot-kernel entry))
+          (chain-loader (menu-entry-chain-loader entry)))
+      (cond
+       (linux
+        (let ((arguments (menu-entry-linux-arguments entry))
+              (linux (normalize-file linux
+                                     device-mount-point
+                                     store-directory-prefix))
+              (initrd (normalize-file (menu-entry-initrd entry)
+                                      device-mount-point
+                                      store-directory-prefix)))
+          ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
+          ;; Use the right file names for LINUX and INITRD in case
+          ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
+          ;; separate partition.
+
+          ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
+          ;; initrd paths, to allow booting from a Btrfs subvolume.
+          #~(format port "menuentry ~s {
   ~a
   linux ~a ~a
   initrd ~a
 }~%"
-                   #$label
-                   #$(grub-root-search device linux)
-                   #$linux (string-join (list #$@arguments))
-                   #$initrd))
-          (let ((kernel (menu-entry-multiboot-kernel entry))
-                (arguments (menu-entry-multiboot-arguments entry))
-                (modules (menu-entry-multiboot-modules entry))
-                (root-index 1))            ; XXX EFI will need root-index 2
-        #~(format port "
+                    #$label
+                    #$(grub-root-search device linux)
+                    #$linux (string-join (list #$@arguments))
+                    #$initrd)))
+       (multiboot-kernel
+        (let ((kernel (menu-entry-multiboot-kernel entry))
+              (arguments (menu-entry-multiboot-arguments entry))
+              (modules (menu-entry-multiboot-modules entry))
+              (root-index 1))            ; XXX EFI will need root-index 2
+          #~(format port "
 menuentry ~s {
   multiboot ~a root=device:hd0s~a~a~a
+}~%"
+                    #$label
+                    #$kernel
+                    #$root-index (string-join (list #$@arguments) " " 'prefix)
+                    (string-join (map string-join '#$modules)
+                                 "\n  module " 'prefix))))
+       (chain-loader
+        #~(format port "
+menuentry ~s {
+  ~a
+  chainloader ~a
 }~%"
                   #$label
-                  #$kernel
-                  #$root-index (string-join (list #$@arguments) " " 'prefix)
-                  (string-join (map string-join '#$modules)
-                               "\n  module " 'prefix))))))
+                  #$(grub-root-search device chain-loader)
+                  #$chain-loader)))))
 
   (define (crypto-devices)
     (define (crypto-device->cryptomount dev)
-- 
2.37.2

[bug#57496] [PATCH v4 3/3] gnu: bootloader: Add a friendly error message of menu-entry.

[typ22]

From: tiantian <typ22@foxmail.com>

* gnu/bootloader.scm (report-menu-entry-error): New procedure.
(menu-entry->sexp): Add a call to `report-menu-entry-error'.

Co-Authored-By: Julien Lepiller <julien@lepiller.eu>
---
v3:
The error message like so:

guix system: error: invalid menu-entry: #<<menu-entry> label: "test" device: #<file-system-label "guix-root"> device-mount-point: #f linux: #f linux-arguments: () initrd: #f multiboot-kernel: #f multiboot-arguments: () multiboot-modules: () chain-loader: #f>
hint: Please chose only one of:

  1. direct boot by specifying fields `linux', `linux-arguments' and `linux-modules',

  2. multiboot by specifying fields `multiboot-kernel', `multiboot-arguments' and `multiboot-modules',

  3. chain-loader by specifying field `chain-loader'.

The code of `report-menu-entry-error' is quoted from Julien Lepiller.
Thanks the help from Julien Lepiller.

v4:
The checks of the lists are cancelled and the check of initrd is moved
to the first patch.

 gnu/bootloader.scm | 22 +++++++++++++++++++++-
 1 file changed, 21 insertions(+), 1 deletion(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 9fe6b65212..da65b9d5d5 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -34,6 +34,8 @@ (define-module (gnu bootloader)
   #:use-module (guix diagnostics)
   #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
   #:export (menu-entry
             menu-entry?
@@ -110,6 +112,23 @@ (define-record-type* <menu-entry>
   (chain-loader     menu-entry-chain-loader
                     (default #f)))         ; string, path of efi file
 
+(define (report-menu-entry-error menu-entry)
+  (raise
+   (condition
+    (&message
+     (message
+      (format #f (G_ "invalid menu-entry: ~a") menu-entry)))
+    (&fix-hint
+     (hint
+      (G_ "Please chose only one of:
+@enumerate
+@item direct boot by specifying fields @code{linux},
+@code{linux-arguments} and @code{linux-modules},
+@item multiboot by specifying fields @code{multiboot-kernel},
+@code{multiboot-arguments} and @code{multiboot-modules},
+@item chain-loader by specifying field @code{chain-loader}.
+@end enumerate"))))))
+
 (define (menu-entry->sexp entry)
   "Return ENTRY serialized as an sexp."
   (define (device->sexp device)
@@ -146,7 +165,8 @@ (define (menu-entry->sexp entry)
                   (label ,label)
                   (device ,(device->sexp device))
                   (device-mount-point ,mount-point)
-                  (chain-loader ,chain-loader)))))
+                  (chain-loader ,chain-loader)))
+    (_ (report-menu-entry-error entry))))
 
 (define (sexp->menu-entry sexp)
   "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
-- 
2.37.2

bug#57496: [PATCH v4 3/3] gnu: bootloader: Add a friendly error message of menu-entry.

[Julien Lepiller]

Pushed to master as 52d780ea2b0714d035a84e350b516ca2e2c19af1 to
32da9bbc91d365f514ae41528587905b21c41825, thanks!