[bug#41066] [PATCH] gnu: bootloader: Improve support for chain loading.

[Stefan]

* gnu/bootloader.scm (chain-bootloader-installer): New function to call its
final-installer argument before copying files from the collection directory
of a bootloader profile to the bootloader target directory, preferring a target
of /mnt/boot/efi over /boot/efi, and only copying if source and destination
directories exist.
* (efi-bootloader-chain): Using (chain-bootloader-installer) if the #:installer
argument is false.
* (bootloader-collection manifest): Removed unneeded imported modules.
* gnu/bootloader/grub.scm (font-file): Using (canonicalize-path), as symlinks
from a bootloader profile do not work on a tftp server when network booting.

The new chain-bootloader-installer allows a customization of installers like
(install-grub-efi-netboot):

(operating-system
  (bootloader
    (bootloader-configuration
      (bootloader
        (efi-bootloader-chain
          (list (file-append firmware "/boot/")
                (file-append u-boot-my-scb "/libexec/u-boot.bin")
                (plain-file "config.txt"
                            "kernel=u-boot.bin"))
          grub-efi-netboot-bootloader
          #:hooks my-special-bootloader-profile-manipulator
          #:installer
           (chain-bootloader-installer (install-grub-efi-netboot "efi/boot")))
        (target "/boot"))))
---
 gnu/bootloader.scm      | 70 ++++++++++++++++++++++++++++-------------
 gnu/bootloader/grub.scm | 15 +++++++--
 2 files changed, 61 insertions(+), 24 deletions(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 6d7352ddd2..491a839a65 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -70,6 +70,7 @@
             %bootloaders
             lookup-bootloader-by-name
 
+            chain-bootloader-installer
             efi-bootloader-chain))
 
 ^L
@@ -233,14 +234,14 @@ record."
       (leave (G_ "~a: no such bootloader~%") name)))
 
 (define (efi-bootloader-profile files bootloader-package hooks)
-  "Creates a profile with BOOTLOADER-PACKAGE and a directory collection/ with
+  "Creates a profile with BOOTLOADER-PACKAGE and a directory collection with
 links to additional FILES from the store.  This collection is meant to be used
 by the bootloader installer.
 
 FILES is a list of file or directory names from the store, which will be
-symlinked into the collection/ directory.  If a directory name ends with '/',
+symlinked into the collection directory.  If a directory name ends with '/',
 then the directory content instead of the directory itself will be symlinked
-into the collection/ directory.
+into the collection directory.
 
 FILES may contain file like objects produced by functions like plain-file,
 local-file, etc., or package contents produced with file-append.
@@ -248,10 +249,7 @@ local-file, etc., or package contents produced with 
file-append.
 HOOKS lists additional hook functions to modify the profile."
   (define (bootloader-collection manifest)
     (define build
-        (with-imported-modules '((guix build utils)
-                                 (ice-9 ftw)
-                                 (srfi srfi-1)
-                                 (srfi srfi-26))
+        (with-imported-modules '((guix build utils))
           #~(begin
             (use-modules ((guix build utils)
                           #:select (mkdir-p strip-store-file-name))
@@ -311,6 +309,37 @@ HOOKS lists additional hook functions to modify the 
profile."
            (allow-collisions? #f)
            (relative-symlinks? #f)))
 
+(define (chain-bootloader-installer final-installer)
+  "Define a new bootloader installer gexp, which will invoke FINAL-INSTALLER
+before it will copy the content from a collection directory of its 'bootloader'
+argument into the directory of its 'target' argument.
+
+This order is by intention to allow overwriting bootloader files like
+device-trees with own files provided in that collection directory.
+
+The generated bootloader function will usually be used in this way:
+
+  (efi-bootloader-chain … #:installer (chain-bootloader-installer …))"
+
+  #~(lambda (bootloader target mount-point)
+      (#$final-installer bootloader target mount-point)
+      (let* ((mount-point/target (string-append mount-point target))
+             ;; When installing Guix, it is common to mount TARGET below
+             ;; MOUNT-POINT rather than the root directory.
+             (bootloader-target (if (file-exists? mount-point/target)
+                                    mount-point/target
+                                    target))
+             (collection (string-append bootloader "/collection")))
+        (when (and (eq? (and=> (stat collection #f) stat:type)
+                        'directory)
+                   (eq? (and=> (stat bootloader-target #f) stat:type)
+                        'directory))
+          ;; Now copy the content of the collection directory.
+          (copy-recursively collection bootloader-target
+                            #:follow-symlinks? #t
+                            #:log (%make-void-port "w"))))))
+
+
 (define* (efi-bootloader-chain files
                                final-bootloader
                                #:key
@@ -319,21 +348,27 @@ HOOKS lists additional hook functions to modify the 
profile."
   "Define a bootloader chain with FINAL-BOOTLOADER as the final bootloader and
 certain directories and files from the store given in the list of FILES.
 
-FILES may contain file like objects produced by functions like plain-file,
+FILES may contain file like objects produced by procedures like plain-file,
 local-file, etc., or package contents produced with file-append.  They will be
-collected inside a directory collection/ inside a generated bootloader profile,
+collected inside a directory collection inside a generated bootloader profile,
 which will be passed to the INSTALLER.
 
 If a directory name in FILES ends with '/', then the directory content instead
-of the directory itself will be symlinked into the collection/ directory.
+of the directory itself will be symlinked into the collection directory.
 
 The procedures in the HOOKS list can be used to further modify the bootloader
 profile.  It is possible to pass a single function instead of a list.
 
-If the INSTALLER argument is used, then this function will be called to install
-the bootloader.  Otherwise the installer of the FINAL-BOOTLOADER will be 
called."
+If the INSTALLER argument is used, then this procedure will be called to 
install
+the bootloader and handle the files inside the collection directory of the
+profile.  Otherwise the generated procedure from
+
+  (chain-bootloader-installer (bootloader-installer FINAL-BOOTLOADER))
+
+will be used to install the bootloader."
   (let* ((final-installer (or installer
-                              (bootloader-installer final-bootloader)))
+                              (chain-bootloader-installer
+                               (bootloader-installer final-bootloader))))
          (profile (efi-bootloader-profile files
                                           (bootloader-package final-bootloader)
                                           (if (list? hooks)
@@ -342,11 +377,4 @@ the bootloader.  Otherwise the installer of the 
FINAL-BOOTLOADER will be called.
     (bootloader
      (inherit final-bootloader)
      (package profile)
-     (installer
-      #~(lambda (bootloader target mount-point)
-          (#$final-installer bootloader target mount-point)
-          (copy-recursively
-           (string-append bootloader "/collection")
-           (string-append mount-point target)
-           #:follow-symlinks? #t
-           #:log (%make-void-port "w")))))))
+     (installer final-installer))))
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index af7b7561ff..3177452dfb 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -191,9 +191,18 @@ fi~%"
   (define font-file
     (let* ((bootloader (bootloader-configuration-bootloader config))
            (grub (bootloader-package bootloader)))
-      (normalize-file (file-append grub "/share/grub/unicode.pf2")
-                      store-mount-point
-                      store-directory-prefix)))
+      ;; The bootloader-package may be a profile with only symlinks.
+      ;; If network booting, then a symlink to the font may not work on the
+      ;; server side.  Therefore we canonicalize the file name of the font.
+      ;; TODO:  The font gets installed by (install-grub-efi-netboot) and
+      ;; (install-grub-efi).  The installed font could be referred to as
+      ;; "unicode".  But it is currently unclear if (install-grub-disk-image)
+      ;; and (install-grub) both install the font as well.
+      ;; Actually this should be preferred.
+      #~(canonicalize-path
+         #+(normalize-file (file-append grub "/share/grub/unicode.pf2")
+                           store-mount-point
+                           store-directory-prefix))))
 
   (define image
     (normalize-file (grub-background-image config)
-- 
2.29.2