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

[Julien Lepiller <julien@lepiller.eu>]

Le 31 août 2022 09:18:44 GMT+02:00, Julien Lepiller <julien@lepiller.eu> a écrit :
>Hi tiantian!
>
>Thanks for the patches. It's a bit hard to follow since I'm not at a computer, but here are some preliminary remarks.
>
>First, thanks for documenting the change in the manual, it's not something even I think about all the time ^^'. We'll have to rework the English a bit but it's understandable :)
>
>I'm wondering why there are two patches? The first patch below seems documented but the second patch does not have a changelog text. Shouldn't they be merged? They seem to be for the same thing.

Nevesmind, I don't know how I missed it, there is a changelog for that patch. I still think it could be merged with the first. Or any reason to keep it separate?

>
>From what I understand, specifying chainloader with at least linux or linux-multiboot will lead to chainloader being silently dropped. Maybe we should have an error message instead?
>
>I'm not too familiar with chainloading. Is using grub partition names like (hd0,gpt1) the only way? We try to discourage using these names as they can easily vary between reboots and your system unbootable.
>
>Otherwise, it looks fine at first glance, but untested :)
>
>Le 31 août 2022 07:27:48 GMT+02:00, typ22@foxmail.com a écrit :
>>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.
>>---
>> doc/guix.texi      | 15 +++++++++++++++
>> gnu/bootloader.scm | 40 ++++++++++++++++++++++++++++++++++------
>> 2 files changed, 49 insertions(+), 6 deletions(-)
>>
>>diff --git a/doc/guix.texi b/doc/guix.texi
>>index 957b9a668e..69dcd9e7b9 100644
>>--- a/doc/guix.texi
>>+++ b/doc/guix.texi
>>@@ -37536,6 +37536,21 @@ Bootloader Configuration
>>              @dots{}))
>> @end lisp
>> 
>>+@item @code{chain-loader} (default: @code{#f})
>>+A string that any accepted by @code{chainloader}. If there are items
>>+other than @code{label} and @code{device}, it will have no effect.
>>+
>>+@lisp
>>+(bootloader
>>+  (bootloader-configuration
>>+  ;; @dots{}
>>+    (menu-entries
>>+      (list
>>+        (menu-entry
>>+          (label "GNU/Linux")
>>+          (chain-loader "(hd0,gpt1)/EFI/GNULinux/grubx64.efi"))))))
>>+@end lisp
>>+
>> @end table
>> @end deftp
>> 
>>diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
>>index 77c05e8946..41f690a4dc 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,11 @@ (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 +121,15 @@ (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
>>-                     ())
>>+    ;; Fields of <menu-entry> in the patterns is incomplete,
>>+    ;; resulting in menu-entry with chain-loader incorrectly
>>+    ;; matching the first.
>>+    ;; To keep pattern is short and keep matching order,
>>+    ;; judge an important field in each pattern.
>>+    ;; Such as kernel.
>>+    (($ <menu-entry> label device mount-point
>>+                     (? identity linux) linux-arguments initrd
>>+                     #f ())
>>      `(menu-entry (version 0)
>>                   (label ,label)
>>                   (device ,(device->sexp device))
>>@@ -127,14 +138,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)
>>      `(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 +190,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)))))
>> 
>> \f>>
>> ;;;
>>-- 
>>2.37.2
>>
>>
>>
>>