[bug#74109] [PATCH] gnu: bootloader: grub: Add procedure to share EFI installer code.

[bug#74109] [PATCH] gnu: bootloader: grub: Add procedure to share EFI installer code.

[Herman Rimm via Guix-patches via]

* gnu/bootloader/grub.scm (make-grub-efi-bootloader): Add procedure.
(install-grub-efi, install-grub-efi32): Remove variables.
(install-grub-efi-removable): Deprecate variable.

Change-Id: Ie10b506bb1088179d459ddafe3229fd730ac45aa
---
 gnu/bootloader/grub.scm | 82 ++++++++++++++---------------------------
 1 file changed, 27 insertions(+), 55 deletions(-)

diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..4933bdcff0 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -28,6 +28,7 @@
 
 (define-module (gnu bootloader grub)
   #:use-module (guix build union)
+  #:use-module (guix deprecation)
   #:use-module (guix records)
   #:use-module (guix store)
   #:use-module (guix utils)
@@ -54,6 +55,7 @@ (define-module (gnu bootloader grub)
             grub-theme-gfxmode
 
             install-grub-efi-removable
+            make-grub-efi-installer
             make-grub-efi-netboot-installer
 
             grub-bootloader
@@ -621,7 +623,16 @@ (define install-grub-disk-image
                 "-d" "."
                 image))))
 
-(define install-grub-efi
+(define* (make-grub-efi-installer #:key efi32? removable?)
+  "Return a G-expression of a procedure for installing GRUB on a UEFI
+system.  If EFI32? is #t, then a 32-bit target will be used.  If
+REMOVABLE? is #t, GRUB will be installed for Removable Media Boot."
+  (define extra-args
+    (list (and efi32?
+               #~(cond ((target-x86?) "--target=i386-efi")
+                       ((target-arm?) "--target=arm-efi")))
+          ;; This does not update UEFI boot entries, like --no-nvram.
+          (and removable? "--removable")))
   #~(lambda (bootloader efi-dir mount-point)
       ;; There is nothing useful to do when called in the context of a disk
       ;; image generation.
@@ -638,57 +649,10 @@ (define install-grub-efi
           ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
           ;; root partition.
           (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--bootloader-id=Guix"
-                        "--efi-directory" target-esp)))))
-
-(define install-grub-efi-removable
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
-      ;; NOTE: efi-dir comes from target list of booloader configuration
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--removable"
-                        ;; "--no-nvram"
-                        "--bootloader-id=Guix"
-                        "--efi-directory" target-esp)))))
-
-(define install-grub-efi32
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--bootloader-id=Guix"
-			(cond ((target-x86?) "--target=i386-efi")
-                              ((target-arm?) "--target=arm-efi"))
-                        "--efi-directory" target-esp)))))
+          (invoke/quiet grub-install "--bootloader-id=Guix"
+                        "--boot-directory" install-dir
+                        "--efi-directory" target-esp
+                        #$@(filter identity extra-args))))))
 
 (define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
   "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
@@ -849,7 +813,7 @@ (define grub-efi-bootloader
   (bootloader
    (name 'grub-efi)
    (package grub-efi)
-   (installer install-grub-efi)
+   (installer (make-grub-efi-installer))
    (disk-image-installer #f)
    (configuration-file grub-cfg)
    (configuration-file-generator grub-configuration-file)))
@@ -858,12 +822,12 @@ (define grub-efi-removable-bootloader
   (bootloader
    (inherit grub-efi-bootloader)
    (name 'grub-efi-removable-bootloader)
-   (installer install-grub-efi-removable)))
+   (installer (make-grub-efi-installer #:removable? #t))))
 
 (define grub-efi32-bootloader
   (bootloader
    (inherit grub-efi-bootloader)
-   (installer install-grub-efi32)
+   (installer (make-grub-efi-installer #:efi32? #t))
    (name 'grub-efi32)
    (package grub-efi32)))
 
@@ -909,4 +873,12 @@ (define-syntax grub-configuration
                   (bootloader grub-bootloader)
                   fields ...))))
 
+\f
+;;;
+;;; Deprecated bootloader and installer variables.
+;;;
+
+(define-deprecated/alias install-grub-efi-removable
+  (make-grub-efi-installer #:removable? #t))
+
 ;;; grub.scm ends here

base-commit: d6f775c30c6f47e174f6110d1089edc6315600e4
-- 
2.45.2

[bug#74109] [PATCH v2 0/2] Reduce duplicate bootloader installer code.

[Herman Rimm via Guix-patches via]

Hi,

For this revision, I added a similar procedure for U-Boot bootloaders
and updated my copyright notices.  I tested grub-efi-bootloader and
the removable variant, by building '%test-images' in (gnu tests image).

Cheers,
Herman

Herman Rimm (2):
  gnu: bootloader: grub: Add procedure to share EFI installer code.
  gnu: bootloader: u-boot: Add procedure to share installer code.

 gnu/bootloader/grub.scm   | 83 +++++++++++++--------------------------
 gnu/bootloader/u-boot.scm | 47 +++++++++++-----------
 2 files changed, 50 insertions(+), 80 deletions(-)


base-commit: 6e50b0c56a8cc767bd3acb26638f78c450bde718
-- 
2.45.2

[bug#74109] [PATCH v2 1/2] gnu: bootloader: grub: Add procedure to share EFI installer code.

[Herman Rimm via Guix-patches via]

* gnu/bootloader/grub.scm (make-grub-efi-bootloader): Add procedure.
(install-grub-efi, install-grub-efi32): Remove variables.
(install-grub-efi-removable): Deprecate variable.

Change-Id: Ie10b506bb1088179d459ddafe3229fd730ac45aa
---
 gnu/bootloader/grub.scm | 83 ++++++++++++++---------------------------
 1 file changed, 28 insertions(+), 55 deletions(-)

diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..f4a197567e 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
 ;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -28,6 +29,7 @@
 
 (define-module (gnu bootloader grub)
   #:use-module (guix build union)
+  #:use-module (guix deprecation)
   #:use-module (guix records)
   #:use-module (guix store)
   #:use-module (guix utils)
@@ -54,6 +56,7 @@ (define-module (gnu bootloader grub)
             grub-theme-gfxmode
 
             install-grub-efi-removable
+            make-grub-efi-installer
             make-grub-efi-netboot-installer
 
             grub-bootloader
@@ -621,7 +624,16 @@ (define install-grub-disk-image
                 "-d" "."
                 image))))
 
-(define install-grub-efi
+(define* (make-grub-efi-installer #:key efi32? removable?)
+  "Return a G-expression of a procedure for installing GRUB on a UEFI
+system.  If EFI32? is #t, then a 32-bit target will be used.  If
+REMOVABLE? is #t, GRUB will be installed for Removable Media Boot."
+  (define extra-args
+    (list (and efi32?
+               #~(cond ((target-x86?) "--target=i386-efi")
+                       ((target-arm?) "--target=arm-efi")))
+          ;; This does not update UEFI boot entries, like --no-nvram.
+          (and removable? "--removable")))
   #~(lambda (bootloader efi-dir mount-point)
       ;; There is nothing useful to do when called in the context of a disk
       ;; image generation.
@@ -638,57 +650,10 @@ (define install-grub-efi
           ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
           ;; root partition.
           (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--bootloader-id=Guix"
-                        "--efi-directory" target-esp)))))
-
-(define install-grub-efi-removable
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
-      ;; NOTE: efi-dir comes from target list of booloader configuration
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--removable"
-                        ;; "--no-nvram"
-                        "--bootloader-id=Guix"
-                        "--efi-directory" target-esp)))))
-
-(define install-grub-efi32
-  #~(lambda (bootloader efi-dir mount-point)
-      ;; There is nothing useful to do when called in the context of a disk
-      ;; image generation.
-      (when efi-dir
-        ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
-        ;; system whose root is mounted at MOUNT-POINT.
-        (let ((grub-install (string-append bootloader "/sbin/grub-install"))
-              (install-dir (string-append mount-point "/boot"))
-              ;; When installing Guix, it's common to mount EFI-DIR below
-              ;; MOUNT-POINT rather than /boot/efi on the live image.
-              (target-esp (if (file-exists? (string-append mount-point efi-dir))
-                              (string-append mount-point efi-dir)
-                              efi-dir)))
-          ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
-          ;; root partition.
-          (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-          (invoke/quiet grub-install "--boot-directory" install-dir
-                        "--bootloader-id=Guix"
-			(cond ((target-x86?) "--target=i386-efi")
-                              ((target-arm?) "--target=arm-efi"))
-                        "--efi-directory" target-esp)))))
+          (invoke/quiet grub-install "--bootloader-id=Guix"
+                        "--boot-directory" install-dir
+                        "--efi-directory" target-esp
+                        #$@(filter identity extra-args))))))
 
 (define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
   "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
@@ -849,7 +814,7 @@ (define grub-efi-bootloader
   (bootloader
    (name 'grub-efi)
    (package grub-efi)
-   (installer install-grub-efi)
+   (installer (make-grub-efi-installer))
    (disk-image-installer #f)
    (configuration-file grub-cfg)
    (configuration-file-generator grub-configuration-file)))
@@ -858,12 +823,12 @@ (define grub-efi-removable-bootloader
   (bootloader
    (inherit grub-efi-bootloader)
    (name 'grub-efi-removable-bootloader)
-   (installer install-grub-efi-removable)))
+   (installer (make-grub-efi-installer #:removable? #t))))
 
 (define grub-efi32-bootloader
   (bootloader
    (inherit grub-efi-bootloader)
-   (installer install-grub-efi32)
+   (installer (make-grub-efi-installer #:efi32? #t))
    (name 'grub-efi32)
    (package grub-efi32)))
 
@@ -909,4 +874,12 @@ (define-syntax grub-configuration
                   (bootloader grub-bootloader)
                   fields ...))))
 
+\f
+;;;
+;;; Deprecated bootloader and installer variables.
+;;;
+
+(define-deprecated/alias install-grub-efi-removable
+  (make-grub-efi-installer #:removable? #t))
+
 ;;; grub.scm ends here
-- 
2.45.2

[bug#74109] [PATCH v2 2/2] gnu: bootloader: u-boot: Add procedure to share installer code.

[Herman Rimm via Guix-patches via]

* gnu/bootloader/u-boot.scm (make-u-boot-installer): Add procedure.
(install-u-boot-ts7970-q-2g-1000mhz-c-u-boot,
install-qemu-riscv64-u-boot): Remove variables.
(install-starfive-visionfive2-uEnv.txt,
u-boot-ts7970-q-2g-1000mhz-c-bootloader,
u-boot-qemu-riscv64-bootloader): Use make-u-boot-installer.

Change-Id: I0b0b507925a7c8ca608f7307d442d9588862ae91
---
 gnu/bootloader/u-boot.scm | 47 ++++++++++++++++++---------------------
 1 file changed, 22 insertions(+), 25 deletions(-)

diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index c5437a7b63..5e149eaea0 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -5,7 +5,7 @@
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
-;;; Copyright © 2023 Herman Rimm <herman_rimm@protonmail.com>
+;;; Copyright © 2023-2024 Herman Rimm <herman@rimm.ee>
 ;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -28,6 +28,7 @@ (define-module (gnu bootloader u-boot)
   #:use-module (gnu bootloader)
   #:use-module (gnu packages bootloaders)
   #:use-module (guix gexp)
+  #:use-module (ice-9 match)
   #:export (u-boot-bootloader
             u-boot-a20-olinuxino-lime-bootloader
             u-boot-a20-olinuxino-lime2-bootloader
@@ -53,6 +54,18 @@ (define-module (gnu bootloader u-boot)
             u-boot-ts7970-q-2g-1000mhz-c-bootloader
             u-boot-wandboard-bootloader))
 
+(define (make-u-boot-installer file)
+  (let ((file
+          (match file
+            ((? string?)
+             (list #~(install-file (string-append bootloader #$file)
+                                   install-dir)))
+            ((? file-like?) (list #~(install-file #$file install-dir)))
+            (#f '()))))
+    #~(lambda (bootloader device mount-point)
+        (let ((install-dir (string-append mount-point "/boot")))
+          #$@file))))
+
 (define install-u-boot
   #~(lambda (bootloader root-index image)
       (if bootloader
@@ -145,12 +158,6 @@ (define install-rockpro64-rk3399-u-boot
 
 (define install-pinebook-pro-rk3399-u-boot install-rockpro64-rk3399-u-boot)
 
-(define install-u-boot-ts7970-q-2g-1000mhz-c-u-boot
-  #~(lambda (bootloader device mount-point)
-      (let ((u-boot.imx (string-append bootloader "/libexec/u-boot.imx"))
-            (install-dir (string-append mount-point "/boot")))
-        (install-file u-boot.imx install-dir))))
-
 (define install-sifive-unmatched-u-boot
   #~(lambda (bootloader root-index image)
       (let ((spl (string-append bootloader "/libexec/spl/u-boot-spl.bin"))
@@ -171,24 +178,14 @@ (define install-starfive-visionfive2-u-boot
                               image (* 2082 512)))))
 
 (define install-starfive-visionfive2-uEnv.txt
-  #~(lambda (bootloader device mount-point)
-      (mkdir-p (string-append mount-point "/boot"))
-      (call-with-output-file (string-append mount-point "/boot/uEnv.txt")
-        (lambda (port)
-          (format port
-                  ;; if board SPI use vender's u-boot, will find
-                  ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
-                  ;; that users will update this u-boot, so set it.
-                  "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%")))))
-
-(define install-qemu-riscv64-u-boot
-  #~(lambda (bootloader device mount-point)
-      (let ((u-boot.bin (string-append bootloader "/libexec/u-boot.bin"))
-            (install-dir (string-append mount-point "/boot")))
-        (install-file u-boot.bin install-dir))))
+  (make-u-boot-installer
+    ;; If the board SPI uses the vendor's U-Boot, it will find starfive/
+    ;; starfive_visionfive2.dtb.  We cannot guarantee that users will
+    ;; update this U-Boot, so set the FDT explicitly.
+    (plain-file "uEnv.txt"
+      "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%")))
 
 \f
-
 ;;;
 ;;; Bootloader definitions.
 ;;;
@@ -329,7 +326,7 @@ (define u-boot-ts7970-q-2g-1000mhz-c-bootloader
   (bootloader
    (inherit u-boot-bootloader)
    (package u-boot-ts7970-q-2g-1000mhz-c)
-   (installer install-u-boot-ts7970-q-2g-1000mhz-c-u-boot)
+   (installer (make-u-boot-installer "libexec/u-boot.imx"))
    (disk-image-installer #f)))
 
 (define u-boot-sifive-unmatched-bootloader
@@ -349,5 +346,5 @@ (define u-boot-qemu-riscv64-bootloader
   (bootloader
    (inherit u-boot-bootloader)
    (package u-boot-qemu-riscv64)
-   (installer install-qemu-riscv64-u-boot)
+   (installer (make-u-boot-installer "libexec/u-boot.bin"))
    (disk-image-installer #f)))
-- 
2.45.2