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

[bug#57496] [PATCH v3 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 v2 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 v3 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): Modify the pattern and add `else' to call
`report-menu-entry-error'.

Co-Authored-By: Julien Lepiller <julien@lepiller.eu>
---
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.

 gnu/bootloader.scm | 44 +++++++++++++++++++++++++++++++++++++++-----
 1 file changed, 39 insertions(+), 5 deletions(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 9e8b545d10..d4fe460570 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)
@@ -119,9 +138,21 @@ (define (menu-entry->sexp entry)
       ((? file-system-label? label)
        `(label ,(file-system-label->string label)))
       (_ device)))
+  (define (set-field? field)
+    "If the field is the default value, return #f."
+    (and field                  ; not default value #f
+         (not (null? field))))  ; not default value '()
   (match entry
+    ;; Modify the pattern to achieve more strict matching and prevent
+    ;; wrong matching, which ensures the output of error information
+    ;; when menu-entry is wrong.
+
+    ;; The linux-arguments is optional and the test code for boot-parameters
+    ;; does not set it, so don't check it here.
     (($ <menu-entry> label device mount-point
-                     (? identity linux) linux-arguments initrd
+                     (? set-field? linux)
+                     linux-arguments
+                     (? set-field? initrd)
                      #f () () #f)
      `(menu-entry (version 0)
                   (label ,label)
@@ -131,8 +162,10 @@ (define (menu-entry->sexp entry)
                   (linux-arguments ,linux-arguments)
                   (initrd ,initrd)))
     (($ <menu-entry> label device mount-point #f () #f
-                     (? identity multiboot-kernel) multiboot-arguments
-                     multiboot-modules #f)
+                     (? set-field? multiboot-kernel)
+                     (? set-field? multiboot-arguments)
+                     (? set-field? multiboot-modules)
+                     #f)
      `(menu-entry (version 0)
                   (label ,label)
                   (device ,(device->sexp device))
@@ -141,12 +174,13 @@ (define (menu-entry->sexp entry)
                   (multiboot-arguments ,multiboot-arguments)
                   (multiboot-modules ,multiboot-modules)))
     (($ <menu-entry> label device mount-point #f () #f #f () ()
-                     (? identity chain-loader))
+                     (? set-field? chain-loader))
      `(menu-entry (version 0)
                   (label ,label)
                   (device ,(device->sexp device))
                   (device-mount-point ,mount-point)
-                  (chain-loader ,chain-loader)))))
+                  (chain-loader ,chain-loader)))
+    (else (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 v3 3/3] gnu: bootloader: Add a friendly error message of menu-entry.

[Julien Lepiller]

Hi tiantian,

I think the first two patches are good now, so let me focus on this one
:)

Le Sun,  4 Sep 2022 22:04:31 +0800,
typ22@foxmail.com a écrit :

> From: tiantian <typ22@foxmail.com>
> 
> +  (define (set-field? field)
> +    "If the field is the default value, return #f."
> +    (and field                  ; not default value #f
> +         (not (null? field))))  ; not default value '()

I don't think this set-field? is necessary. In the following, I don't
think you need the null? case at all because I think all the lists may
be empty without triggering an error. You don't necessarily want to
load modules or have arguments on the linux command line.

In any case, it should be called field-set? instead :)

>    (match entry
> +    ;; Modify the pattern to achieve more strict matching and prevent
> +    ;; wrong matching, which ensures the output of error information
> +    ;; when menu-entry is wrong.
> +
> +    ;; The linux-arguments is optional and the test code for
> boot-parameters
> +    ;; does not set it, so don't check it here.
>      (($ <menu-entry> label device mount-point
> -                     (? identity linux) linux-arguments initrd
> +                     (? set-field? linux)
> +                     linux-arguments
> +                     (? set-field? initrd)

The could still be identity

>                       #f () () #f)
>       `(menu-entry (version 0)
>                    (label ,label)
> @@ -131,8 +162,10 @@ (define (menu-entry->sexp entry)
>                    (linux-arguments ,linux-arguments)
>                    (initrd ,initrd)))
>      (($ <menu-entry> label device mount-point #f () #f
> -                     (? identity multiboot-kernel)
> multiboot-arguments
> -                     multiboot-modules #f)
> +                     (? set-field? multiboot-kernel)
> +                     (? set-field? multiboot-arguments)
> +                     (? set-field? multiboot-modules)

Some users might want to not use any modules or arguments I think, so
these fields should not be mandatory. For multiboot-kernel, identity is
enough.

> +                     #f)
>       `(menu-entry (version 0)
>                    (label ,label)
>                    (device ,(device->sexp device))
> @@ -141,12 +174,13 @@ (define (menu-entry->sexp entry)
>                    (multiboot-arguments ,multiboot-arguments)
>                    (multiboot-modules ,multiboot-modules)))
>      (($ <menu-entry> label device mount-point #f () #f #f () ()
> -                     (? identity chain-loader))
> +                     (? set-field? chain-loader))

Same here, identity is fine.

>       `(menu-entry (version 0)
>                    (label ,label)
>                    (device ,(device->sexp device))
>                    (device-mount-point ,mount-point)
> -                  (chain-loader ,chain-loader)))))
> +                  (chain-loader ,chain-loader)))
> +    (else (report-menu-entry-error entry))))

Since this is a match, it is more common to use:

(_ (report-menu-entry-error entry))

Also, it feels weird to patch the code you modified in a previous patch
of the same series. If you're not happy with the code you wrote in a
previous patch, you need to change it in the previous patch, not in a
new one :)

>  
>  (define (sexp->menu-entry sexp)
>    "Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a
> <menu-entry>

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

[tiantian]

Julien Lepiller <julien@lepiller.eu> writes:

> Hi tiantian,
>
> I think the first two patches are good now, so let me focus on this one
> :)
>
> Le Sun,  4 Sep 2022 22:04:31 +0800,
> typ22@foxmail.com a écrit :
>
>> From: tiantian <typ22@foxmail.com>
>> 
>> +  (define (set-field? field)
>> +    "If the field is the default value, return #f."
>> +    (and field                  ; not default value #f
>> +         (not (null? field))))  ; not default value '()
>
> I don't think this set-field? is necessary. In the following, I don't
> think you need the null? case at all because I think all the lists may
> be empty without triggering an error. You don't necessarily want to
> load modules or have arguments on the linux command line.
>
> In any case, it should be called field-set? instead :)
>

My English is not good. To be honest, I tried set-value?, value-set?,
default-value?, not-default-value?, field-set? and set-field?. Finally,
I select the 'set-field?'. But it seems that I didn't choose well.

But it doesn't matter. The procedure is no longer needed.

>>    (match entry
>> +    ;; Modify the pattern to achieve more strict matching and prevent
>> +    ;; wrong matching, which ensures the output of error information
>> +    ;; when menu-entry is wrong.
>> +
>> +    ;; The linux-arguments is optional and the test code for
>> boot-parameters
>> +    ;; does not set it, so don't check it here.
>>      (($ <menu-entry> label device mount-point
>> -                     (? identity linux) linux-arguments initrd
>> +                     (? set-field? linux)
>> +                     linux-arguments
>> +                     (? set-field? initrd)
>
> The could still be identity
>
>>                       #f () () #f)
>>       `(menu-entry (version 0)
>>                    (label ,label)
>> @@ -131,8 +162,10 @@ (define (menu-entry->sexp entry)
>>                    (linux-arguments ,linux-arguments)
>>                    (initrd ,initrd)))
>>      (($ <menu-entry> label device mount-point #f () #f
>> -                     (? identity multiboot-kernel)
>> multiboot-arguments
>> -                     multiboot-modules #f)
>> +                     (? set-field? multiboot-kernel)
>> +                     (? set-field? multiboot-arguments)
>> +                     (? set-field? multiboot-modules)
>
> Some users might want to not use any modules or arguments I think, so
> these fields should not be mandatory. For multiboot-kernel, identity is
> enough.
>
>> +                     #f)
>>       `(menu-entry (version 0)
>>                    (label ,label)
>>                    (device ,(device->sexp device))
>> @@ -141,12 +174,13 @@ (define (menu-entry->sexp entry)
>>                    (multiboot-arguments ,multiboot-arguments)
>>                    (multiboot-modules ,multiboot-modules)))
>>      (($ <menu-entry> label device mount-point #f () #f #f () ()
>> -                     (? identity chain-loader))
>> +                     (? set-field? chain-loader))
>
> Same here, identity is fine.
>

I don't know multiboot very well, so I don't know if multiboot-arguments
and multiboot-modules are necessary. Then I check them. It turns out that
they are not necessary. I will not check them.

I will change to use identify. Honestly, It's much easier for me to
use only `identify'. :)

>>       `(menu-entry (version 0)
>>                    (label ,label)
>>                    (device ,(device->sexp device))
>>                    (device-mount-point ,mount-point)
>> -                  (chain-loader ,chain-loader)))))
>> +                  (chain-loader ,chain-loader)))
>> +    (else (report-menu-entry-error entry))))
>
> Since this is a match, it is more common to use:
>
> (_ (report-menu-entry-error entry))
>

Thank you for reminding me. I will correct it.

> Also, it feels weird to patch the code you modified in a previous patch
> of the same series. If you're not happy with the code you wrote in a
> previous patch, you need to change it in the previous patch, not in a
> new one :)
>

As I understood earlier, these changes about matching are related to the
error reporting information, so I put these modifications in this
submission. My knowledge of contribution is still too little.

I will pay attention to it later. Thank you for reminding me.

Thanks,
tiantian