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

[Julien Lepiller]

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)))))
>> 
>> >>
>> ;;;
>>-- 
>>2.37.2
>>
>>
>>
>>