[bug#59619] [PATCH] grub-configfile tested successfully

["S.Karrmann" <S.Karrmann@web.de>]

Dear all,

I tested my patch and generated a vm with configfile in its GRUB boot menu,
cf. ~system-config.scm~ in my last post.

I needed ~make clean-go ; make make-go~ to get consistent compiled guile
code. The guile manual suggested ~--fresh-auto-compile~, but for this I
must call guile directly AFAICS. Some tool for guile-autocompile would be
nice for such developments.

I hope, this patch makes it into the master branch. It helps to test install
Guix in parallel to another OS. So more people can test it and will fall in
love with Guix, hopefully.

Kind regards,
Dr. Stefan Karrmann

---
 doc/guix.texi             | 39 +++++++++++++++++++++++++++++----------
 gnu/bootloader.scm        | 29 +++++++++++++++++++++++++----
 gnu/bootloader/grub.scm   | 11 +++++++++++
 tests/boot-parameters.scm | 11 +++++++++++
 4 files changed, 76 insertions(+), 14 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2b1ad77ba5..45f9ed23ed 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -112,6 +112,7 @@ Copyright @copyright{} 2022 John Kehayias@*
 Copyright @copyright{} 2022 Ivan Vilata-i-Balaguer@*
 Copyright @copyright{} 2023 Giacomo Leidi@*
 Copyright @copyright{} 2022 Antero Mejr@*
+Copyright @copyright{} 2023 Dr. Stefan Karrmann@*

 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -6159,7 +6160,7 @@ Transformation Options}) so it should be lossless.

 @item --profile=@var{profile}
 @itemx -p @var{profile}
-Create an environment containing the packages installed in @var{profile}.
+Create an environment containing the packages installed in @var{profile}.
 Use @command{guix package} (@pxref{Invoking guix package}) to create
 and manage profiles.

@@ -6605,7 +6606,7 @@ interpreted as packages that will be added to the environment directly.

 @item --profile=@var{profile}
 @itemx -p @var{profile}
-Create an environment containing the packages installed in @var{profile}.
+Create an environment containing the packages installed in @var{profile}.
 Use @command{guix package} (@pxref{Invoking guix package}) to create
 and manage profiles.

@@ -12564,7 +12565,7 @@ candidates, and even to test their impact on packages that depend on
 them:

 @example
-guix build elogind --with-source=@dots{}/shepherd-0.9.0rc1.tar.gz
+guix build elogind --with-source=@dots{}/shepherd-0.9.0rc1.tar.gz
 @end example

 @dots{} or to build from a checkout in a pristine environment:
@@ -23482,7 +23483,7 @@ created for.
 Restricts all controllers to the specified transport. @code{'dual} means both
 BR/EDR and LE are enabled (if supported by the hardware).

-Possible values are:
+Possible values are:

 @itemize @bullet
 @item
@@ -38666,6 +38667,24 @@ The list of commands for loading Multiboot modules.  For example:
              @dots{}))
 @end lisp

+@item @code{config-file} (default: @code{#f})
+A string that can be accepted by @code{grub}'s @code{configfile}
+directive. This has no effect if either @code{linux} or
+@code{multiboot-kernel} fields are specified. The following is an
+example of switching to a different GNU/GRUB menu.
+
+@lisp
+(bootloader
+ (bootloader-configuration
+  ;; @dots{}
+  (menu-entries
+   (list
+    (menu-entry
+     (label "GNU/Linux")
+     (device (uuid "5cbb9a70-a3c8-4384-a085-9e6896058343"))
+     (config-file "/boot/grub/grub.cfg"))))))
+@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
@@ -40553,7 +40572,7 @@ A clause can have one of the following forms:
 (@var{field-name}
  (@var{type} @var{default-value})
  @var{documentation})
-
+
 (@var{field-name}
  (@var{type} @var{default-value})
  @var{documentation}
@@ -40602,7 +40621,7 @@ A simple serializer procedure could look like this:
 (define (serialize-boolean field-name value)
   (let ((value (if value "true" "false")))
     #~(string-append #$field-name #$value)))
-@end lisp
+@end lisp

 In some cases multiple different configuration records might be defined
 in the same file, but their serializers for the same type might have to
@@ -40620,7 +40639,7 @@ manually specify a custom @var{serializer} for every field.

 (define (bar-serialize-string field-name value)
   @dots{})
-
+
 (define-configuration foo-configuration
   (label
    (string)
@@ -40652,7 +40671,7 @@ macro which is a shorthand of this.
   (field
    (string "test")
    "Some documentation."))
-@end lisp
+@end lisp
 @end deffn

 @deffn {Scheme Syntax} define-maybe @var{type}
@@ -43153,7 +43172,7 @@ down in its dependency graph.  As it turns out, GLib does not have a
    from /gnu/store/@dots{}-glib-2.62.6/lib/libglib-2.0.so.0
 #1  0x00007ffff608a7d6 in gobject_init_ctor ()
    from /gnu/store/@dots{}-glib-2.62.6/lib/libgobject-2.0.so.0
-#2  0x00007ffff7fe275a in call_init (l=<optimized out>, argc=argc@@entry=1, argv=argv@@entry=0x7fffffffcfd8,
+#2  0x00007ffff7fe275a in call_init (l=<optimized out>, argc=argc@@entry=1, argv=argv@@entry=0x7fffffffcfd8,
     env=env@@entry=0x7fffffffcfe8) at dl-init.c:72
 #3  0x00007ffff7fe2866 in call_init (env=0x7fffffffcfe8, argv=0x7fffffffcfd8, argc=1, l=<optimized out>)
     at dl-init.c:118
@@ -43182,7 +43201,7 @@ Starting program: /gnu/store/@dots{}-profile/bin/sh -c exec\ inkscape
 #0  g_getenv (variable=variable@@entry=0x7ffff60c7a2e "GOBJECT_DEBUG") at ../glib-2.62.6/glib/genviron.c:252
 #1  0x00007ffff608a7d6 in gobject_init () at ../glib-2.62.6/gobject/gtype.c:4380
 #2  gobject_init_ctor () at ../glib-2.62.6/gobject/gtype.c:4493
-#3  0x00007ffff7fe275a in call_init (l=<optimized out>, argc=argc@@entry=3, argv=argv@@entry=0x7fffffffd088,
+#3  0x00007ffff7fe275a in call_init (l=<optimized out>, argc=argc@@entry=3, argv=argv@@entry=0x7fffffffd088,
     env=env@@entry=0x7fffffffd0a8) at dl-init.c:72
 @dots{}
 @end example
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 2c36d8c6cf..7c24fd2ebf 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 ;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2022 Dr. Stefan Karrmann <S.Karrmann@web.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -49,6 +50,7 @@
             menu-entry-multiboot-arguments
             menu-entry-multiboot-modules
             menu-entry-chain-loader
+            menu-entry-config-file

             menu-entry->sexp
             sexp->menu-entry
@@ -109,8 +111,10 @@
   (multiboot-modules menu-entry-multiboot-modules
                      (default '()))        ; list of multiboot commands, where
                                            ; a command is a list of <string>
+  (config-file      menu-entry-config-file
+                    (default #f))          ; string, path of grub.cfg file
   (chain-loader     menu-entry-chain-loader
-                    (default #f)))         ; string, path of efi file
+                    (default #f)))          ; string, path of efi file

 (define (report-menu-entry-error menu-entry)
   (raise
@@ -126,6 +130,7 @@
 @code{linux-arguments} and @code{linux-modules},
 @item multiboot by specifying fields @code{multiboot-kernel},
 @code{multiboot-arguments} and @code{multiboot-modules},
+@item config-file by specifying field @code{config-file}.
 @item chain-loader by specifying field @code{chain-loader}.
 @end enumerate"))))))

@@ -141,7 +146,7 @@
   (match entry
     (($ <menu-entry> label device mount-point
                      (? identity linux) linux-arguments (? identity initrd)
-                     #f () () #f)
+                     #f () () #f #f)
      `(menu-entry (version 0)
                   (label ,label)
                   (device ,(device->sexp device))
@@ -151,7 +156,7 @@
                   (initrd ,initrd)))
     (($ <menu-entry> label device mount-point #f () #f
                      (? identity multiboot-kernel) multiboot-arguments
-                     multiboot-modules #f)
+                     multiboot-modules #f #f)
      `(menu-entry (version 0)
                   (label ,label)
                   (device ,(device->sexp device))
@@ -159,13 +164,20 @@
                   (multiboot-kernel ,multiboot-kernel)
                   (multiboot-arguments ,multiboot-arguments)
                   (multiboot-modules ,multiboot-modules)))
-    (($ <menu-entry> label device mount-point #f () #f #f () ()
+    (($ <menu-entry> label device mount-point #f () #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)))
+    (($ <menu-entry> label device mount-point #f () #f #f () ()
+                     (? identity config-file) #f)
+     `(menu-entry (version 0)
+                  (label ,label)
+                  (device ,(device->sexp device))
+                  (device-mount-point ,mount-point)
+                  (config-file ,config-file)))
     (_ (report-menu-entry-error entry))))

 (define (sexp->menu-entry sexp)
@@ -204,6 +216,15 @@ record."
       (multiboot-kernel multiboot-kernel)
       (multiboot-arguments multiboot-arguments)
       (multiboot-modules multiboot-modules)))
+    (('menu-entry ('version 0)
+                  ('label label) ('device device)
+                  ('device-mount-point mount-point)
+                  ('config-file config-file) _ ...)
+     (menu-entry
+      (label label)
+      (device (sexp->device device))
+      (device-mount-point mount-point)
+      (config-file config-file)))
     (('menu-entry ('version 0)
                   ('label label) ('device device)
                   ('device-mount-point mount-point)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index ecd44e7f3c..7ed0d155d8 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
 ;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
+;;; Copyright © 2022 Dr. Stefan Karrmann <S.Karrmann@web.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -377,6 +378,7 @@ when booting a root file system on a Btrfs subvolume."
           (device (menu-entry-device entry))
           (device-mount-point (menu-entry-device-mount-point entry))
           (multiboot-kernel (menu-entry-multiboot-kernel entry))
+          (config-file (menu-entry-config-file entry))
           (chain-loader (menu-entry-chain-loader entry)))
       (cond
        (linux
@@ -417,6 +419,15 @@ menuentry ~s {
                     #$root-index (string-join (list #$@arguments) " " 'prefix)
                     (string-join (map string-join '#$modules)
                                  "\n  module " 'prefix))))
+       (config-file
+        #~(format port "
+menuentry ~s {
+  ~a
+  config-file ~a
+}~%"
+                  #$label
+                  #$(grub-root-search device config-file)
+                  #$config-file))
        (chain-loader
         #~(format port "
 menuentry ~s {
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 03a1d01aff..f2d1453b2c 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
 ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
+;;; Copyright © 2022 Dr. Stefan Karrmann <S.Karrmann@web.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -318,6 +319,12 @@
    (linux "/boot/bzImage")
    (initrd "/boot/initrd.cpio.gz")))

+(define %config-file-menu-entry
+  (menu-entry
+   (label "test-config-file")
+   (device (uuid "6d5b13d4-6092-46d0-8be4-073dc07413cc"))
+   (config-file "/boot/grub/grub.cfg")))
+
 (test-equal "menu-entry roundtrip, uuid"
   %uuid-menu-entry
   (sexp->menu-entry (menu-entry->sexp %uuid-menu-entry)))
@@ -326,4 +333,8 @@
   %file-system-label-menu-entry
   (sexp->menu-entry (menu-entry->sexp %file-system-label-menu-entry)))

+(test-equal "menu-entry roundtrip, config-file"
+  %config-file-menu-entry
+  (sexp->menu-entry (menu-entry->sexp %config-file-menu-entry)))
+
 (test-end "boot-parameters")
--
2.30.2