[bug#41066] [PATCH] gnu: grub: Support for chain loading.

[bug#41066] [PATCH] gnu: grub: Support for chain loading.

[Stefan]

* gnu/bootloaders/grub.scm (grub-efi-net-bootloader-chain): New efi bootloader
for chaining with other bootloaders.
* guix/packages.scm (package-collection): New function to build a union of
packages with a collection of certain files.

This allows to chain grub-efi mainly for single-board-computers with e.g.
U-Boot, device-tree files, plain configuration files, etc. like this:

(operating-system
 (bootloader
   (grub-efi-net-bootloader-chain
     (list u-boot
           firmware)
     '("libexec/u-boot.bin"
       "firmware/")
     (list (plain-file "config.txt"
                       "kernel=u-boot.bin"))
     #:target "/boot-tftp"
     #:efi-subdir "efi/boot")
   (target "/boot-tftp"))
  ...)
---
gnu/bootloader/grub.scm |  36 +++++++++++++
guix/packages.scm       | 114 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 150 insertions(+)

diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 9ca4f016f6..67736724a7 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -22,6 +22,7 @@
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu bootloader grub)
+  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module ((guix utils) #:select (%current-system %current-target-system))
  #:use-module (guix gexp)
@@ -54,6 +55,7 @@
            grub-bootloader
            grub-efi-bootloader
            grub-efi-net-bootloader
+            grub-efi-net-bootloader-chain
            grub-mkrescue-bootloader

            grub-configuration))
@@ -525,6 +527,40 @@ TARGET for the system whose root is mounted at MOUNT-POINT."
     (installer (install-grub-efi-net efi-subdir))
     (configuration-file (string-append target "/" efi-subdir "/grub.cfg")))))

+(define* (grub-efi-net-bootloader-chain bootloader-packages
+                                        bootloader-package-contents
+                                        #:optional (files '())
+                                        #:key
+                                        (target #f)
+                                        (efi-subdir #f))
+  "Defines a (grub-efi-net-bootloader) with ADDITIONAL-BOOTLOADER-FILES from
+ADDITIONAL-BOOTLOADER-PACKAGES and ADDITIONAL-FILES, all collected as a
+(package-collection), whose files inside the \"collection\" folder get
+copied into TARGET along with the the bootloader installation in EFI-SUBDIR."
+  (let* ((base-bootloader (grub-efi-net-bootloader #:target target
+                                                   #:efi-subdir efi-subdir))
+         (base-installer (bootloader-installer base-bootloader))
+         (packages (package-collection
+                    (cons (bootloader-package base-bootloader)
+                          bootloader-packages)
+                    bootloader-package-contents
+                    files)))
+    (bootloader
+     (inherit base-bootloader)
+     (package packages)
+     (installer
+      #~(lambda (bootloader target mount-point)
+          (#$base-installer bootloader target mount-point)
+          (copy-recursively
+           (string-append bootloader "/collection")
+           (string-join (delete ""
+                                (string-split
+                                 (string-append mount-point "/" target)
+                                 #\/))
+                        "/"
+                        'prefix)
+           #:follow-symlinks? #t))))))
+
(define* grub-mkrescue-bootloader
  (bootloader
   (inherit grub-efi-bootloader)
diff --git a/guix/packages.scm b/guix/packages.scm
index 2fa4fd05d7..987c3b80ac 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -32,6 +32,7 @@
  #:use-module (guix derivations)
  #:use-module (guix memoization)
  #:use-module (guix build-system)
+  #:use-module (guix build-system trivial)
  #:use-module (guix search-paths)
  #:use-module (guix sets)
  #:use-module (ice-9 match)
@@ -114,6 +115,7 @@
            package-with-patches
            package-with-extra-patches
            package/inherit
+            package-collection

            transitive-input-references

@@ -944,6 +946,118 @@ OVERRIDES."
      overrides ...
      (replacement (and=> (package-replacement p) loop)))))

+(define* (package-collection packages package-contents #:optional (files '()))
+  "Defines a package union from PACKAGES and additional FILES.  Its output
+\":out\" has a \"collection\" directory with links to selected PACKAGE-CONTENTS
+and FILES. The output \":collection\" of the package links to that directory."
+  (let ((package-names (map (lambda (package)
+                              (package-name package))
+                            packages))
+        (link-machine '(lambda (file directory targetname)
+                         (symlink file
+                                  (string-append directory
+                                                 "/"
+                                                 (targetname file))))))
+    (package
+     (name (string-join (append '("package-collection") package-names) "-"))
+     ;; We copy the version of the first package.
+     (version (package-version (first packages)))
+     ;; FILES are expected to be a list of gexps like 'plain-file'. As gexps
+     ;; can't (yet) be used in the arguments of a package we convert FILES into
+     ;; the source of this package.
+     (source (computed-file
+              "computed-files"
+              (with-imported-modules
+               '((guix build utils))
+               #~(begin
+                   (use-modules (guix build utils))
+                   (define (targetname file)
+                     ;; A plain-file inside the store has a name like
+                     ;; gnu/store/9x6y7j75qy9z6iv21byrbyj4yy8hb490-config.txt.
+                     ;; We take its basename and drop the hash from it.
+                     ;; Therefore it expects the first '-' at index 32.
+                     ;; Otherwise the basename of file is returned
+                     (let ((name (basename file)))
+                       (if (and (> (string-length name) 33)
+                                (= (string-index name #\- 0 33) 32))
+                           (substring name 33)
+                           (name))))
+                   (mkdir-p #$output)
+                   (for-each (lambda (file)
+                               (#$link-machine file #$output targetname))
+                             '#$files)))))
+     (build-system trivial-build-system)
+     (arguments
+      `(#:modules
+        ((guix build union)
+         (guix build utils))
+        #:builder
+        (begin
+          (use-modules (guix build union)
+                       (guix build utils)
+                       (ice-9 ftw)
+                       (ice-9 match)
+                       (srfi srfi-1))
+          ;; Make a union of all packages as :out.
+          (match %build-inputs
+            (((names . directories) ...)
+             (union-build %output directories)))
+          (let* ((directory-content
+                  ;; Creates a list of absolute path names inside DIR.
+                  (lambda (dir)
+                    (map (lambda (name)
+                           (string-append dir name))
+                         (scandir dir (lambda (name)
+                                        (not (member name '("." ".."))))))))
+                 (select-names
+                  ;; Select names ending with (filter) or without "/" (remove)
+                  (lambda (select names)
+                    (select (lambda (name)
+                              (string=? (string-take-right name 1) "/"))
+                      names)))
+                 (content
+                  ;; The selected package content as a list of absolute paths.
+                  (map (lambda (name)
+                         (string-append %output "/" name))
+                       ',package-contents))
+                 (directory-names
+                  (append (select-names filter content)
+                          (list (string-append
+                                 (assoc-ref %build-inputs "source")
+                                 "/"))))
+                 (names-from-directories
+                  (fold (lambda (directory previous)
+                          (append (directory-content directory) previous))
+                        '()
+                        directory-names))
+                 (names-from-content (select-names remove content))
+                 (names (append names-from-directories names-from-content))
+                 (collection-directory (string-append %output "/collection"))
+                 (collection (assoc-ref %outputs "collection")))
+            ;; Collect links to package-contents and file.
+            (mkdir-p collection-directory)
+            (for-each (lambda (name)
+                        (,link-machine name collection-directory basename))
+                      names)
+            (symlink collection-directory collection)))))
+     (inputs (fold-right
+              (lambda (package previous)
+                (cons (list (package-name package) package) previous))
+              '()
+              packages))
+     (outputs '("out" "collection"))
+     (synopsis "Package union with a collection of package contents and files")
+     (description
+      (string-append "A package collection is useful when bootloaders need to "
+                     "be chained and the bootloader-installer needs to install "
+                     "selected parts of them.  This collection includes: "
+                     (string-join package-names ", ") "."))
+     (license
+      (append (map (lambda (package)
+                     (package-license package))
+                   packages)))
+     (home-page ""))))
+
^L
;;;
;;; Package derivations.
-- 
2.26.0

[bug#41066] [PATCH] gnu: grub: Support for chain loading.

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 884 bytes --]

I guess it is possible to do it like that--and maybe we even should.

But a collection of packages and accompanying setup is called a profile.

Maybe you'd rather want a bootloader profile instead of a bootloader
package-of-packages.

We do the same for kernel modules--it just creates a profile of all the
kernel module packages using the procedure "profile-derivation" and then
uses a profile hook to configure the whole thing.

See also operating-system-directory-base-entries in gnu/system.scm for
how this is done with kernel modules (the profile-derivation call).

You could do something similar with multiple bootloaders that are chained
together that make some kind of useful whole.

A profile hook could then make sure that this collection of bootloaders
actually makes sense and then chain them together in the right order,
if any.

What do you think?

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#41066] [PATCH] gnu: grub: Support for chain loading.

[Stefan]

Hi Danny!

> Am 24.05.2020 um 13:13 schrieb Danny Milosavljevic <dannym@scratchpost.org>:
> 
> I guess it is possible to do it like that--and maybe we even should.
> 
> But a collection of packages and accompanying setup is called a profile.

Good point.

> Maybe you'd rather want a bootloader profile instead of a bootloader
> package-of-packages.
> 
> We do the same for kernel modules--it just creates a profile of all the
> kernel module packages using the procedure "profile-derivation" and then
> uses a profile hook to configure the whole thing.
> 
> See also operating-system-directory-base-entries in gnu/system.scm for
> how this is done with kernel modules (the profile-derivation call).
> 
> You could do something similar with multiple bootloaders that are chained
> together that make some kind of useful whole.
> 
> A profile hook could then make sure that this collection of bootloaders
> actually makes sense and then chain them together in the right order,
> if any.
> 
> What do you think?

I’m still a bloody newbie. This sounds like a huge rework, probably too huge for me.

The biggest trouble from my point of view is that the bootloader installer functions only get a <bootloader> argument, which internally only has a <package> field. Then this <package> would need to be replaced by some kind of <profile>.

My current solution provides a different package with the proper collection of files to copy for the installer. That was quite easy – well, beside the problem to tear in a plain-file, for which I needed the trick with the source field.


Bye

Stefan

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

[Stefan]

* gnu/bootloader.scm (bootloader-profile): New internal function to build a
profile from packages and files with a collection of contents to install.
(bootloader-chain): New function to chain a bootloader with contents of
additional bootloader or other packages and additional files like configuration
files or device-trees.

This allows to chain GRUB with U-Boot, device-tree-files, plain configuration
files, etc. mainly for single-board-computers like this:

(operating-system
  (bootloader
    (bootloader-configurationa
      (bootloader
        (bootloader-chain grub-efi-netboot-bootloader
                          (list u-boot-my-scb
                                firmware)
                          '("libexec/u-boot.bin"
                            "firmware/")
                          (list (plain-file "config.txt"
                                            "kernel=u-boot.bin"))
                          #:installer (install-grub-efi-netboot "efi/boot"))
        (target "/boot"))))
  …)
---
 gnu/bootloader.scm | 143 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 142 insertions(+), 1 deletion(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 2eebb8e9d9..e9d80bf45a 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -22,6 +22,8 @@
 
 (define-module (gnu bootloader)
   #:use-module (guix discovery)
+  #:use-module (guix gexp)
+  #:use-module (guix profiles)
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
@@ -66,7 +68,9 @@
             bootloader-configuration-additional-configuration
 
             %bootloaders
-            lookup-bootloader-by-name))
+            lookup-bootloader-by-name
+
+            bootloader-chain))
 
 ^L
 ;;;
@@ -227,3 +231,140 @@ record."
               (eq? name (bootloader-name bootloader)))
             (force %bootloaders))
       (leave (G_ "~a: no such bootloader~%") name)))
+
+(define (bootloader-profile packages package-contents files)
+  "Creates a profile with PACKAGES and additional FILES.  The new profile will
+contain a directory collection/ with links to selected PACKAGE-CONTENTS and
+FILES.  This collection is meant to be used by the bootloader installer.
+
+PACKAGE-CONTENTS is a list of file or directory names relative to the PACKAGES,
+which will be 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.
+
+FILES is a list of file like objects produced by functions like plain-file,
+local-file, etc., which will be symlinked into the collection/ directory, too."
+  (define (bootloader-collection manifest)
+    (define build
+        (with-imported-modules '((guix build utils)
+                                 (ice-9 ftw)
+                                 (srfi srfi-1))
+          #~(begin
+            (use-modules ((guix build utils) #:select (mkdir-p))
+                         ((ice-9 ftw) #:select (scandir))
+                         ((srfi srfi-1) #:select (append-map remove)))
+            (define (symlink-to file directory transform-name)
+              "Creates a symlink with transformed name to FILE in DIRECTORY."
+              (when (file-exists? file)
+                    (symlink file
+                             (string-append
+                              directory "/"
+                              (transform-name (basename file))))))
+            (define (remove-hash basename)
+              "Returns the basename of a store entry without the hash."
+              ;; A plain-file inside the store has a name like
+              ;; gnu/store/9x6y7j75qy9z6iv21byrbyj4yy8hb490-config.txt.
+              ;; From its basename we drop the hash.
+              ;; Therefore we expects the first '-' at index 32.
+              ;; Otherwise the basename itself is returned.
+              (if (and (> (string-length basename) 33)
+                       (= (string-index basename #\- 0 33) 32))
+                  (substring basename 33)
+                  (basename)))
+            (define (directory-content directory)
+              "Creates a list of absolute path names inside DIRECTORY."
+              (map (lambda (name)
+                     (string-append directory name))
+                   (sort (or (scandir directory
+                                      (lambda (name)
+                                        (not (member name '("." "..")))))
+                             '())
+                         string<?)))
+            (define (select-names select names)
+              "Set SELECT to 'filter' or 'remove' names ending with '/'."
+              (select (lambda (name)
+                        (string-suffix? "/" name))
+                      names))
+            (define (filter-names-without-slash names)
+              (select-names remove names))
+            (define (filter-names-with-slash names)
+              (select-names filter names))
+            (let* ((collection (string-append #$output "/collection"))
+                   (packages '#$(map (lambda (entry)
+                                       (manifest-entry-item entry))
+                                     (manifest-entries manifest)))
+                   (contents (append-map
+                               (lambda (name)
+                                 (map (lambda (package)
+                                        (string-append package "/" name))
+                                      packages))
+                               '#$package-contents))
+                   (directories (filter-names-with-slash contents))
+                   (names-from-directories
+                    (append-map (lambda (directory)
+                                  (directory-content directory))
+                                directories))
+                   (names (append names-from-directories
+                                  (filter-names-without-slash contents))))
+              (mkdir-p collection)
+              (for-each (lambda (name)
+                          (symlink-to name collection identity))
+                        names)
+              (for-each (lambda (file)
+                          (symlink-to file collection remove-hash))
+                        '#$files))
+            #t)))
+
+    (gexp->derivation "bootloader-collection"
+                      build
+                      #:local-build? #t
+                      #:substitutable? #f
+                      #:properties
+                      `((type . profile-hook)
+                        (hook . bootloader-collection))))
+
+  (profile (content (packages->manifest packages))
+           (name "bootloader-profile")
+           (hooks (list bootloader-collection))
+           (locales? #f)
+           (allow-collisions? #f)
+           (relative-symlinks? #f)))
+
+(define* (bootloader-chain final-bootloader
+                           bootloader-packages
+                           bootloader-package-contents
+                           #:optional (files '())
+                           #:key installer)
+  "Defines a bootloader chain with the FINAL-BOOTLOADER as the final bootloader
+and certain directories and files given in the BOOTLOADER-PACKAGE-CONTENTS list
+relative to list of BOOTLOADER-PACKAGES and additional FILES.
+
+Along with the installation of the FINAL-BOOTLOADER these additional FILES and
+BOOTLOADER-PACKAGE-CONTENTS will be copied into the bootloader target directory.
+
+If a directory name in BOOTLOADER-PACKAGE-CONTENTS ends with '/', then the
+directory content instead of the directory itself will be copied.
+
+FILES is a list of file like objects produced by functions like plain-file,
+local-file, etc.
+
+If the INSTALLER argument is used, then this will be used as the bootloader
+installer.  Otherwise the intaller of the FINAL-BOOTLOADER will be used."
+  (let* ((final-installer (or installer
+                              (bootloader-installer final-bootloader)))
+         (profile (bootloader-profile
+                   (cons (bootloader-package final-bootloader)
+                         bootloader-packages)
+                   bootloader-package-contents
+                   files)))
+    (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")))))))
-- 
2.26.0

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

[Stefan]

A friendly ping …

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

[Stefan]

Hi!

Recently the documentation got enhanced and I realised that there is already the function strip-store-file-name which I kind of reimplemented. So I did a small rework and also added a check to verify that all package-content got collected.


Bye

Stefan

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

[Stefan]

* gnu/bootloader.scm (bootloader-profile): New internal function to build a
profile from packages and files with a collection of contents to install.
(bootloader-chain): New function to chain a bootloader with contents of
additional bootloader or other packages and additional files like configuration
files or device-trees.

This allows to chain GRUB with U-Boot, device-tree-files, plain configuration
files, etc. mainly for single-board-computers like this:

(operating-system
  (bootloader
    (bootloader-configurationa
      (bootloader
        (bootloader-chain grub-efi-netboot-bootloader
                          (list u-boot-my-scb
                                firmware)
                          '("libexec/u-boot.bin"
                            "firmware/")
                          (list (plain-file "config.txt"
                                            "kernel=u-boot.bin"))
                          #:installer (install-grub-efi-netboot "efi/boot"))
        (target "/boot"))))
  …)
---
 gnu/bootloader.scm | 143 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 142 insertions(+), 1 deletion(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 2eebb8e9d9..745618f204 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -22,6 +22,8 @@
 
 (define-module (gnu bootloader)
   #:use-module (guix discovery)
+  #:use-module (guix gexp)
+  #:use-module (guix profiles)
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
@@ -66,7 +68,9 @@
             bootloader-configuration-additional-configuration
 
             %bootloaders
-            lookup-bootloader-by-name))
+            lookup-bootloader-by-name
+
+            bootloader-chain))
 
 ^L
 ;;;
@@ -227,3 +231,140 @@ record."
               (eq? name (bootloader-name bootloader)))
             (force %bootloaders))
       (leave (G_ "~a: no such bootloader~%") name)))
+
+(define (bootloader-profile packages package-contents files)
+  "Creates a profile with PACKAGES and additional FILES.  The new profile will
+contain a directory collection/ with links to selected PACKAGE-CONTENTS and
+FILES.  This collection is meant to be used by the bootloader installer.
+
+PACKAGE-CONTENTS is a list of file or directory names relative to the PACKAGES,
+which will be 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.
+
+FILES is a list of file like objects produced by functions like plain-file,
+local-file, etc., which will be symlinked into the collection/ directory, too."
+  (define (bootloader-collection manifest)
+    (define build
+        (with-imported-modules '((guix build utils)
+                                 (ice-9 ftw)
+                                 (srfi srfi-1))
+          #~(begin
+            (use-modules ((guix build utils)
+                          #:select (mkdir-p strip-store-file-name))
+                         ((ice-9 ftw)
+                          #:select (scandir))
+                         ((srfi srfi-1)
+                          #:select (append-map every remove)))
+            (define (symlink-to file directory transform)
+              "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
+              (when (file-exists? file)
+                    (symlink file
+                             (string-append directory "/" (transform file)))))
+            (define (directory-content directory)
+              "Creates a list of absolute path names inside DIRECTORY."
+              (map (lambda (name)
+                     (string-append directory name))
+                   (sort (or (scandir directory
+                                      (lambda (name)
+                                        (not (member name '("." "..")))))
+                             '())
+                         string<?)))
+            (define (select-names select names)
+              "Set SELECT to 'filter' or 'remove' names ending with '/'."
+              (select (lambda (name)
+                        (string-suffix? "/" name))
+                      names))
+            (define (filter-names-without-slash names)
+              (select-names remove names))
+            (define (filter-names-with-slash names)
+              (select-names filter names))
+            (let* ((collection (string-append #$output "/collection"))
+                   (packages '#$(map (lambda (entry)
+                                       (manifest-entry-item entry))
+                                     (manifest-entries manifest)))
+                   ;; As the profile content will only be collected after this
+                   ;; hook function was executed, the CONTENTS varibale will
+                   ;; contain all permutations of elements from PACKAGES and
+                   ;; PACKAGE-CONTENTS.
+                   (contents (append-map
+                               (lambda (name)
+                                 (map (lambda (package)
+                                        (string-append package "/" name))
+                                      packages))
+                               '#$package-contents))
+                   (directories (filter-names-with-slash contents))
+                   (names-from-directories
+                    (append-map (lambda (directory)
+                                  (directory-content directory))
+                                directories))
+                   (names (append names-from-directories
+                                  (filter-names-without-slash contents))))
+              (mkdir-p collection)
+              (for-each (lambda (name)
+                          (symlink-to name collection basename))
+                        names)
+              (for-each (lambda (file)
+                          (symlink-to file collection strip-store-file-name))
+                        '#$files)
+              ;; Ensure that all elements of PACKEGE-CONTENTS got collected.
+              (if (every (lambda (content)
+                           (file-exists? (string-append collection "/"
+                                         (basename content))))
+                         '#$package-contents)
+                  #t
+                  #f)))))
+
+    (gexp->derivation "bootloader-collection"
+                      build
+                      #:local-build? #t
+                      #:substitutable? #f
+                      #:properties
+                      `((type . profile-hook)
+                        (hook . bootloader-collection))))
+
+  (profile (content (packages->manifest packages))
+           (name "bootloader-profile")
+           (hooks (list bootloader-collection))
+           (locales? #f)
+           (allow-collisions? #f)
+           (relative-symlinks? #f)))
+
+(define* (bootloader-chain final-bootloader
+                           bootloader-packages
+                           bootloader-package-contents
+                           #:optional (files '())
+                           #:key installer)
+  "Defines a bootloader chain with the FINAL-BOOTLOADER as the final bootloader
+and certain directories and files given in the BOOTLOADER-PACKAGE-CONTENTS list
+relative to list of BOOTLOADER-PACKAGES and additional FILES.
+
+Along with the installation of the FINAL-BOOTLOADER these additional FILES and
+BOOTLOADER-PACKAGE-CONTENTS will be copied into the bootloader target directory.
+
+If a directory name in BOOTLOADER-PACKAGE-CONTENTS ends with '/', then the
+directory content instead of the directory itself will be copied.
+
+FILES is a list of file like objects produced by functions like plain-file,
+local-file, etc.
+
+If the INSTALLER argument is used, then this will be used as the bootloader
+installer.  Otherwise the intaller of the FINAL-BOOTLOADER will be used."
+  (let* ((final-installer (or installer
+                              (bootloader-installer final-bootloader)))
+         (profile (bootloader-profile
+                   (cons (bootloader-package final-bootloader)
+                         bootloader-packages)
+                   bootloader-package-contents
+                   files)))
+    (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")))))))
-- 
2.26.0

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

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 6999 bytes --]

Hi Stefan,

this looks very good in general.

I have only a few doubts--mostly concerning the end-user API "bootloader-chain":

On Sun, 18 Oct 2020 13:21:28 +0200
Stefan <stefan-guix@vodafonemail.de> wrote:

>         (bootloader-chain grub-efi-netboot-bootloader
>                           (list u-boot-my-scb
>                                 firmware)
>                           '("libexec/u-boot.bin"
>                             "firmware/")
>                           (list (plain-file "config.txt"
>                                             "kernel=u-boot.bin"))
>                           #:installer (install-grub-efi-netboot "efi/boot"))

I would prefer if it was possible to do the following:

 (bootloader-chain (list firmware (plain-file "config.txt" "kernel=u-boot.bin") u-boot-my-scb) grub-efi-netboot-bootloader)

(I would put the main bootloader last because the user probably thinks of the
list of bootloaders in the order they are loaded at boot)

[maybe even

 (bootloader-chain (list u-boot-my-scb firmware (plain-file "config.txt" "kernel=u-boot.bin") grub-efi-netboot-bootloader))

-- with documentation that the order of the entries matters.  But maybe that
would be too magical--since only the last entry in that list would have their
installer called, and the actual guix generations also only go into the last
one's configuration.  But maybe that would be OK anyway]

Also, I don't like the ad hoc derivation subset selection mechanism you have.

I understand that it can be nice to be able to select a subset in general, but:

* Usually we make a special package, inherit from the original package, and then
just make it put the files we want into the derivation output directory.
The user would put "u-boot-my-scb-minimal" instead of "u-boot-my-scb" in
that case, and then only get the subset.

* In this special case of chaining bootloaders, I think that the profile hook
can take care of deleting all the unnecessary files, and of all the other weird
complications (installing FILES, moving stuff around etc--maybe even generating
or updating that config.txt one day).
One of the reasons I suggested using a profile in the first place is that
now the profile hook can do all the dirty work, even long term.

* If that isn't possible either, it would be nicer to have a helper
procedure that allows you to select a subset of the files that
are in the derivation of a package, and not have this subset selection mingled
into the innards of bootloader-chain.  (separation of concerns)
Maybe there could even be a package transformation to do that.

I know that there are probably good reasons why you did it like you did.

But still, I think a profile hook is exactly the right kind of tool to hide
the extra setup complexity that my API requires, and the API would be less
complicated to use and more stable (less likely to ever need to be changed).

What do you think?

Also, if it is difficult to collect bootloader packages into a profile
automatically (without extra user-supplied information) because of the subdir
"libexec" in u-boot derivations, then we can modify all the u-boot packages
(for good) to put u-boot into "$output/" instead of "$output/libexec".
I would prefer fixing things instead of having to put workarounds into user
configuration.  Please tell me if you want that--we can do that.

>                           #:installer (install-grub-efi-netboot "efi/boot"))

That should be automatic but overridable.
This seems to be the case already.  Nice!

> +(define (bootloader-profile packages package-contents files)

If using my suggested bootloader-chain API, this would just get PACKAGES,
not PACKAGE-CONTENTS and FILES (FILES would be mixed into the PACKAGES list--which
thus should be renamed to ITEMS or something).

> +  (define (bootloader-collection manifest)
> +    (define build
> +        (with-imported-modules '((guix build utils)
> +                                 (ice-9 ftw)
> +                                 (srfi srfi-1))
> +          #~(begin
> +            (use-modules ((guix build utils)
> +                          #:select (mkdir-p strip-store-file-name))
> +                         ((ice-9 ftw)
> +                          #:select (scandir))
> +                         ((srfi srfi-1)
> +                          #:select (append-map every remove)))
> +            (define (symlink-to file directory transform)
> +              "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
> +              (when (file-exists? file)
> +                    (symlink file
> +                             (string-append directory "/" (transform file)))))
> +            (define (directory-content directory)
> +              "Creates a list of absolute path names inside DIRECTORY."
> +              (map (lambda (name)
> +                     (string-append directory name))
> +                   (sort (or (scandir directory
> +                                      (lambda (name)
> +                                        (not (member name '("." "..")))))
> +                             '())
> +                         string<?)))
> +            (define (select-names select names)
> +              "Set SELECT to 'filter' or 'remove' names ending with '/'."
> +              (select (lambda (name)
> +                        (string-suffix? "/" name))
> +                      names))
> +            (define (filter-names-without-slash names)
> +              (select-names remove names))
> +            (define (filter-names-with-slash names)
> +              (select-names filter names))

I would prefer these to be in another procedure that can be used to transform
any package (or profile?) like this.  @Ludo: What do you think?

[...]
> +    (gexp->derivation "bootloader-collection"
> +                      build
> +                      #:local-build? #t
> +                      #:substitutable? #f
> +                      #:properties
> +                      `((type . profile-hook)
> +                        (hook . bootloader-collection))))
> +
> +  (profile (content (packages->manifest packages))
> +           (name "bootloader-profile")
> +           (hooks (list bootloader-collection))
> +           (locales? #f)
> +           (allow-collisions? #f)
> +           (relative-symlinks? #f)))
> +
> +(define* (bootloader-chain
[...]

> +    (bootloader
> +     (inherit final-bootloader)
> +     (package profile)

I like that.  Smart way to reuse existing code.

> +     (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")))))))

Thanks!

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

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

[Ludovic Courtès]

Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> On Sun, 18 Oct 2020 13:21:28 +0200
> Stefan <stefan-guix@vodafonemail.de> wrote:
>
>>         (bootloader-chain grub-efi-netboot-bootloader
>>                           (list u-boot-my-scb
>>                                 firmware)
>>                           '("libexec/u-boot.bin"
>>                             "firmware/")
>>                           (list (plain-file "config.txt"
>>                                             "kernel=u-boot.bin"))
>>                           #:installer (install-grub-efi-netboot "efi/boot"))

In the example above, I think that you could merge the 2nd and 3rd
arguments by using ‘file-append’:

  (bootloader-chain grub-efi-netboot-bootloader
                    (list (file-append u-boot "/libexec/u-boot.bin")
                          (file-append firmware "/firmware")))

No?

I think we should look at how to simplify this interface.  Intuitively,
I would expect the ‘bootloader-chain’ to take a list of <bootloader>
records and return a <bootloader> record.

Is this something that can be achieved?  If not, what are the extra
constraints that need to be taken into account?

>> +(define (bootloader-profile packages package-contents files)
>
> If using my suggested bootloader-chain API, this would just get PACKAGES,
> not PACKAGE-CONTENTS and FILES (FILES would be mixed into the PACKAGES list--which
> thus should be renamed to ITEMS or something).

Yes, if it’s about building a profile, you could just use a <profile>
object.  Would that work here?

>> +  (define (bootloader-collection manifest)
>> +    (define build
>> +        (with-imported-modules '((guix build utils)
>> +                                 (ice-9 ftw)
>> +                                 (srfi srfi-1))
>> +          #~(begin
>> +            (use-modules ((guix build utils)
>> +                          #:select (mkdir-p strip-store-file-name))
>> +                         ((ice-9 ftw)
>> +                          #:select (scandir))
>> +                         ((srfi srfi-1)
>> +                          #:select (append-map every remove)))
>> +            (define (symlink-to file directory transform)
>> +              "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
>> +              (when (file-exists? file)
>> +                    (symlink file
>> +                             (string-append directory "/" (transform file)))))
>> +            (define (directory-content directory)
>> +              "Creates a list of absolute path names inside DIRECTORY."
>> +              (map (lambda (name)
>> +                     (string-append directory name))
>> +                   (sort (or (scandir directory
>> +                                      (lambda (name)
>> +                                        (not (member name '("." "..")))))
>> +                             '())
>> +                         string<?)))
>> +            (define (select-names select names)
>> +              "Set SELECT to 'filter' or 'remove' names ending with '/'."
>> +              (select (lambda (name)
>> +                        (string-suffix? "/" name))
>> +                      names))
>> +            (define (filter-names-without-slash names)
>> +              (select-names remove names))
>> +            (define (filter-names-with-slash names)
>> +              (select-names filter names))
>
> I would prefer these to be in another procedure that can be used to transform
> any package (or profile?) like this.  @Ludo: What do you think?

From a quick look at the patch, I don’t fully understand yet what’s
going on.

Stylistically, I’d suggest a few things to make the code more consistent
with the rest of the code base, and thus hopefully easier to grasp for
the rest of us:

  1. Don’t sort the result of ‘scandir’, it’s already sorted.

  2. Remove ‘select-names’ as it requires people to read more code to
     understand that we’re just filtering/removing.   Instead, declare:

       (define absolute-file-name? (cut string-suffix? "/" <>))

     and write:

       (filter absolute-file-name? names)
       (remote absolute-file-name? names)

HTH!

Ludo’.

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

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 3076 bytes --]

Hi,

On Fri, 23 Oct 2020 14:48:36 +0200
Ludovic Courtès <ludo@gnu.org> wrote:

>   (bootloader-chain grub-efi-netboot-bootloader
>                     (list (file-append u-boot "/libexec/u-boot.bin")
>                           (file-append firmware "/firmware")))

Ohhh!  That's right.  That's much better.  Can a profile be created with those
in it?  Especially because of the profile hook...

> I think we should look at how to simplify this interface.  Intuitively,
> I would expect the ‘bootloader-chain’ to take a list of <bootloader>
> records and return a <bootloader> record.
> Is this something that can be achieved?  If not, what are the extra
> constraints that need to be taken into account?

That is not easily possible, and is also logically not what happens anyway.

The use case of this entire patchset is when one (for some reason) can't boot
the final bootloader directly, then one uses some chain of bootloaders to
get the final bootloader to boot.

That especially means that all the bootloaders before the final bootloader
WILL NOT GET THE GUIX GENERATIONS MENU.

It is also pretty uncommon/impossible to use each usual bootloader installer
in order to install all the bootloaders one after another.  Just think of
what would happen if multiple x86_64 bootloaders all tried to install
themselves into the first sector of the drive.  That's not gonna work
correctly.

What actually happens is that there's some kind of payload area in the first
bootloader where you can put the second bootloader, and some kind of payload
area in the second bootloader where you can put the third bootloader... and so
on.  Except for the final bootloader, which has the Linux kernel in the payload
area (as far as the final bootloader is concerned, it can do everything as if
it was the first and only thing that was loaded at boot so far).

That means the final bootloader can use the normal config files and generally
proceed like all our standalone bootloaders do.  None of the previous bootloaders
in the chain can do that, generally.

>bootloader-profile

> Yes, if it’s about building a profile, you could just use a <profile>
> object.  Would that work here?

Huh?  Isn't he doing that already?

That's what that procedure does.  Or am I misunderstanding?

> >From a quick look at the patch, I don’t fully understand yet what’s  
> going on.

I suggested to Stefan to use a profile with a profile hook in order to
configure all those bootloaders of a bootloader chain correctly.  That's
what he does here.

Usually, Guix bootloader *packages* have a lot of junk that (1) you wouldn't
want on a esp partition (wastes space) and also stuff that would be duplicates
with other bootloaders (COPYING etc).  Therefore, it's nice to be able to
filter what files of those packages get used.  I think your suggestion in the
beginning is the best one.  (file-append u-boot "/libexec/u-boot.bin") indeed!
The profile hook can then use whatever methods to configure all those
bootloaders correctly.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

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

[Ludovic Courtès]

Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> On Fri, 23 Oct 2020 14:48:36 +0200
> Ludovic Courtès <ludo@gnu.org> wrote:
>
>>   (bootloader-chain grub-efi-netboot-bootloader
>>                     (list (file-append u-boot "/libexec/u-boot.bin")
>>                           (file-append firmware "/firmware")))
>
> Ohhh!  That's right.  That's much better.  Can a profile be created with those
> in it?  Especially because of the profile hook...

Yes, there’s first-class <profile> objects that one can use in gexps:

  (profile (content (manifest (entries …))))

>> I think we should look at how to simplify this interface.  Intuitively,
>> I would expect the ‘bootloader-chain’ to take a list of <bootloader>
>> records and return a <bootloader> record.
>> Is this something that can be achieved?  If not, what are the extra
>> constraints that need to be taken into account?
>
> That is not easily possible, and is also logically not what happens anyway.
>
> The use case of this entire patchset is when one (for some reason) can't boot
> the final bootloader directly, then one uses some chain of bootloaders to
> get the final bootloader to boot.
>
> That especially means that all the bootloaders before the final bootloader
> WILL NOT GET THE GUIX GENERATIONS MENU.
>
> It is also pretty uncommon/impossible to use each usual bootloader installer
> in order to install all the bootloaders one after another.  Just think of
> what would happen if multiple x86_64 bootloaders all tried to install
> themselves into the first sector of the drive.  That's not gonna work
> correctly.
>
> What actually happens is that there's some kind of payload area in the first
> bootloader where you can put the second bootloader, and some kind of payload
> area in the second bootloader where you can put the third bootloader... and so
> on.  Except for the final bootloader, which has the Linux kernel in the payload
> area (as far as the final bootloader is concerned, it can do everything as if
> it was the first and only thing that was loaded at boot so far).
>
> That means the final bootloader can use the normal config files and generally
> proceed like all our standalone bootloaders do.  None of the previous bootloaders
> in the chain can do that, generally.

Sorry, I don’t see why this prevents an API that more closely matches
the idea of a chain of bootloaders (but perhaps I’d just need to spend
more time studying this.)

I guess my advice is: design an interface that’s as close as possible to
the concepts at hand.  If implementation details constrain what can be
done, that’s OK, but it should be clear in that case why we end up with
an interface that’s not as simple as one could expect.

>>bootloader-profile
>
>> Yes, if it’s about building a profile, you could just use a <profile>
>> object.  Would that work here?
>
> Huh?  Isn't he doing that already?
>
> That's what that procedure does.  Or am I misunderstanding?

It’s not using code from (guix profiles) IIRC.

>> >From a quick look at the patch, I don’t fully understand yet what’s  
>> going on.
>
> I suggested to Stefan to use a profile with a profile hook in order to
> configure all those bootloaders of a bootloader chain correctly.  That's
> what he does here.
>
> Usually, Guix bootloader *packages* have a lot of junk that (1) you wouldn't
> want on a esp partition (wastes space) and also stuff that would be duplicates
> with other bootloaders (COPYING etc).  Therefore, it's nice to be able to
> filter what files of those packages get used.  I think your suggestion in the
> beginning is the best one.  (file-append u-boot "/libexec/u-boot.bin") indeed!
> The profile hook can then use whatever methods to configure all those
> bootloaders correctly.

Alrighty!

Thanks,
Ludo’.

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

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 2637 bytes --]

Hi Ludo,

On Sat, 24 Oct 2020 18:22:48 +0200
Ludovic Courtès <ludo@gnu.org> wrote:

> >>   (bootloader-chain grub-efi-netboot-bootloader
> >>                     (list (file-append u-boot "/libexec/u-boot.bin")
> >>                           (file-append firmware "/firmware")))  
> >
> > Ohhh!  That's right.  That's much better.  Can a profile be created with those
> > in it?  Especially because of the profile hook...  
> 
> Yes, there’s first-class <profile> objects that one can use in gexps:
> 
>   (profile (content (manifest (entries …))))

Nice!

I haven't used those before, so no idea whether it would be better here.

> Sorry, I don’t see why this prevents an API that more closely matches
> the idea of a chain of bootloaders (but perhaps I’d just need to spend
> more time studying this.)

It doesn't prevent that API--but this narrow use case here doesn't need it.

And I do not intend to implement the general use case--we all decided against
general chainloading and then introduced full support for bootloaders other
than grub (which then do not chainload grub--they totally could have!).

But this use case with lots of bootloaders on an ESP partition (or Raspberry Pi
equivalent) is easy enough.  Maybe we should change the name of the main
procedure to be less general, though.  "chain-esp-bootloaders" ?

If you could check it out more, that would help.  I think how the patch is
now is fine for the narrow use case: chainloading the normal guix bootloader
using other bootloaders (or whatever else!  Maybe a turtle is loading the final
guix bootloader--who knows ;) ).

The code here can only chain bootloaders in the ESP partition (actually, the
Raspberry Pi equivalent of the latter).

> >>bootloader-profile  
> >  
> >> Yes, if it’s about building a profile, you could just use a <profile>
> >> object.  Would that work here?  
> >
> > Huh?  Isn't he doing that already?
> >
> > That's what that procedure does.  Or am I misunderstanding?  
> 
> It’s not using code from (guix profiles) IIRC.

From the patch:

>+(define (bootloader-profile packages package-contents files)
>[...]
>+  (profile (content (packages->manifest packages))
>+           (name "bootloader-profile")
>+           (hooks (list bootloader-collection))
>+           (locales? #f)
>+           (allow-collisions? #f)
>+           (relative-symlinks? #f)))

Maybe I don't understand what you mean... but that "profile" is from
(guix profiles).

In any case, maybe we should just call it "esp-bootloader-chain" or
maybe just "raspberry-pi-bootloader-chain".

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

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

[Stefan]

Hi Danny and Ludo!

I tried to consider your comments and modified the code as far as I could grasp the suggestions. Thanks!

Now the API looks like this:

(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
          #:hook my-special-bootloader-profile-manipulator
          #:installer (install-grub-efi-netboot "efi/boot"))

The suggestion to use file-append simplified a lot, also for the implementation of the bootloader-collection profile hook. I also added an optional hook function to do customised manipulations of the profile before invoking the installer.

Regarding this kind of chain-loading: The ARM world seems to consolidate onto an UEFI firmware, supporting either device-trees or ACPI. There are two main options for an UEFI firmware to chose from: TianoCore/EDK II and U-Boot.

Some platforms come with an EEPROM or NAND storage to install e.g. U-Boot with embedded device-tree information as an UEFI firmware. From a distribution’s point of view this can make using GRUB-EFI the default choice. And it becomes arguable if the distribution is responsible to install/update this firmware, if you compare to a BIOS.

Other platforms just boot from some FAT partition requiring some blobs and don’t offer an UEFI firmware. But copying e.g. U-Boot and some more files onto this FAT partition makes them appear like a system with an UEFI firmware, giving a kind of compatibility to the future.


Bye

Stefan

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

[Stefan]

* gnu/bootloader.scm (bootloader-profile): New internal function to build a
profile from a package and a collection of files to install.
(bootloader-chain): New function to chain a bootloader with a collection of
additional files like other bootloaders, configuration files or device-trees.

This allows to chain GRUB with U-Boot, device-tree-files, plain configuration
files, etc. mainly for single-board-computers like this:

(operating-system
  (bootloader
    (bootloader-configuration
      (bootloader
        (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
          #:hook my-special-bootloader-profile-manipulator
          #:installer (install-grub-efi-netboot "efi/boot"))
        (target "/boot"))))
…)
---
 gnu/bootloader.scm | 125 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 124 insertions(+), 1 deletion(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 2eebb8e9d9..b319e1f92f 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -22,6 +22,8 @@
 
 (define-module (gnu bootloader)
   #:use-module (guix discovery)
+  #:use-module (guix gexp)
+  #:use-module (guix profiles)
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
@@ -66,7 +68,9 @@
             bootloader-configuration-additional-configuration
 
             %bootloaders
-            lookup-bootloader-by-name))
+            lookup-bootloader-by-name
+
+            bootloader-chain))
 
 ^L
 ;;;
@@ -227,3 +231,122 @@ record."
               (eq? name (bootloader-name bootloader)))
             (force %bootloaders))
       (leave (G_ "~a: no such bootloader~%") name)))
+
+(define (bootloader-profile files bootloader-package hook)
+  "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 '/',
+then the directory content instead of the directory itself will be symlinked
+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."
+  (define (bootloader-collection manifest)
+    (define build
+        (with-imported-modules '((guix build utils)
+                                 (ice-9 ftw)
+                                 (srfi srfi-1)
+                                 (srfi srfi-26))
+          #~(begin
+            (use-modules ((guix build utils)
+                          #:select (mkdir-p strip-store-file-name))
+                         ((ice-9 ftw)
+                          #:select (scandir))
+                         ((srfi srfi-1)
+                          #:select (append-map every remove))
+                         ((srfi srfi-26)
+                          #:select (cut)))
+            (define (symlink-to file directory transform)
+              "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
+              (symlink file (string-append directory "/" (transform file))))
+            (define (directory-content directory)
+              "Creates a list of absolute path names inside DIRECTORY."
+              (map (lambda (name)
+                     (string-append directory name))
+                   (or (scandir directory (lambda (name)
+                                            (not (member name '("." "..")))))
+                       '())))
+            (define name-ends-with-/? (cut string-suffix? "/" <>))
+            (define (name-is-store-entry? name)
+              "Return #t if NAME is a direct store entry and nothing inside."
+              (not (string-index (strip-store-file-name name) #\/)))
+            (let* ((collection (string-append #$output "/collection"))
+                   (files '#$files)
+                   (directories (filter name-ends-with-/? files))
+                   (names-from-directories
+                    (append-map (lambda (directory)
+                                  (directory-content directory))
+                                directories))
+                   (names (append names-from-directories
+                                  (remove name-ends-with-/? files))))
+              (mkdir-p collection)
+              (if (every file-exists? names)
+                  (begin
+                    (for-each (lambda (name)
+                               (symlink-to name collection
+                                            (if (name-is-store-entry? name)
+                                                strip-store-file-name
+                                                basename)))
+                              names)
+                    #t)
+                  #f)))))
+
+    (gexp->derivation "bootloader-collection"
+                      build
+                      #:local-build? #t
+                      #:substitutable? #f
+                      #:properties
+                      `((type . profile-hook)
+                        (hook . bootloader-collection))))
+
+  (profile (content (packages->manifest (list bootloader-package)))
+           (name "bootloader-profile")
+           (hooks (append (list bootloader-collection)
+                          (or hook '())))
+           (locales? #f)
+           (allow-collisions? #f)
+           (relative-symlinks? #f)))
+
+(define* (bootloader-chain files
+                           final-bootloader
+                           #:key
+                           hook
+                           installer)
+  "Defines 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,
+local-file, etc., or package contents produced with file-append.  They will be
+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.
+
+The PROFILE-HOOK function can be used to further modify the bootloader profile.
+
+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.
+
+Independent of the INSTALLER argument, all files in the mentioned collection/
+directory of the bootloader profile will be copied into the bootloader target
+directory after the actual bootloader installer has been called."
+  (let* ((final-installer (or installer
+                              (bootloader-installer final-bootloader)))
+         (profile (bootloader-profile files
+                                      (bootloader-package final-bootloader)
+                                      hook)))
+    (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")))))))
-- 
2.26.0

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

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 3175 bytes --]

Hi Mathieu,

I've tried to test Stefan's patch on guix master with this configuration:

(use-modules (gnu))
(use-service-modules networking ssh)
(use-package-modules screen ssh bootloaders)

(operating-system
  (host-name "komputilo")
  (timezone "Europe/Berlin")
  (locale "en_US.utf8")
  (bootloader (bootloader-configuration
                (bootloader
                 (efi-bootloader-chain
                  (list ;(file-append firmware "/boot/")
                        (plain-file "config.txt"
                                    "kernel=u-boot.bin")
                        (file-append u-boot-a20-olinuxino-micro
                                     "/libexec/u-boot.bin"))
                  grub-efi-netboot-bootloader
                  ;#:hook my-special-bootloader-profile-manipulator
                  #:installer (install-grub-efi-netboot "efi/boot")))
                (target "/boot")))
  (file-systems (cons (file-system
                        (device (file-system-label "my-root"))
                        (mount-point "/")
                        (type "ext4"))
                      %base-file-systems))
  (users (cons (user-account
                (name "alice")
                (comment "Bob's sister")
                (group "users")
                (supplementary-groups '("wheel"
                                        "audio" "video")))
               %base-user-accounts))
  (packages (cons screen %base-packages))
  (services (append (list (service dhcp-client-service-type)
                          (service openssh-service-type
                                   (openssh-configuration
                                    (openssh openssh-sans-x)
                                    (port-number 2222))))
                    %base-services)))

and this command:

$ ./pre-inst-env guix system disk-image -t raw raspberry-os.scm

And I get this error:

################################################## ]^MESC[Kregistering 296 items  [######################################################]^MESC[Kregistering 296 items
Backtrace:
           5 (primitive-load "/gnu/store/br73py6l6w1x2p0ankqq9d8il4f…")
In ice-9/eval.scm:
    619:8  4 (_ #(#<directory (guile-user) 7ffff5bb7f00> #<proced…> …))
In ./gnu/build/image.scm:
    208:4  3 (initialize-root-partition "tmp-root" #:bootcfg _ # _ # …)
In ice-9/eval.scm:
    619:8  2 (_ #(#(#<directory (guile-user) 7ffff5bb7f00>) "/gnu…" …))
   293:34  1 (_ #(#(#<directory (guile-user) 7ffff5bb7f00>) "/gnu…" …))
In unknown file:
           0 (string-append "tmp-root" #f "/")

ERROR: In procedure string-append:
In procedure string-append: Wrong type (expecting string): #f
environment variable `PATH' set to `/gnu/store/swwd2i26pqx1jyfg81lrnrw1hq7adn05-e2fsprogs-1.45.6/bin:/gnu/store/swwd2i26pqx1jyfg81lrnrw1hq7adn05-e2fsprogs-1.45.6/sbin:/gnu/store/ppv9hd6mznmf1p4gagnrwzdivfhvc48z-fakeroot-1.25.3/bin:/gnu/store/nqynh6b3jhjh6wiq47jr4l6arckfw9j8-dosfstools-4.1/sbin:/gnu/store/zms4y35fpbpz5mr8qcb7ky8sqqnq61kh-mtools-4.0.25/bin'
installing bootloader...
[fails]

Before I search for it, would you know why it is?

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

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

[Mathieu Othacehe]

Hello Danny,

> $ ./pre-inst-env guix system disk-image -t raw raspberry-os.scm

The image types are not yet properly documented. However, the "raw"
image type corresponds to a raw image built for the current
architecture.

Using something like:

--8<---------------cut here---------------start------------->8---
./pre-inst-env guix system disk-image -t arm32-raw raspberry-os.scm
--8<---------------cut here---------------end--------------->8---

should cross-compile an image targeting an ARM32 architecture (since
commit c0458011).

Thanks,

Mathieu

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

[Ludovic Courtès]

Hi,

Mathieu Othacehe <m.othacehe@gmail.com> skribis:

>> $ ./pre-inst-env guix system disk-image -t raw raspberry-os.scm
>
> The image types are not yet properly documented. However, the "raw"
> image type corresponds to a raw image built for the current
> architecture.
>
> Using something like:
>
> ./pre-inst-env guix system disk-image -t arm32-raw raspberry-os.scm
>
> should cross-compile an image targeting an ARM32 architecture (since
> commit c0458011).

Ah so ‘-s’ and ‘--target’ are overridden by the image type?

Ludo’.

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

[Mathieu Othacehe]

Hey,

> Ah so ‘-s’ and ‘--target’ are overridden by the image type?

If a "target" is set in the "image" definition then yes it overrides
"--target", otherwise "--target" is honored.

This is handled by the following snippet:

--8<---------------cut here---------------start------------->8---
(let* ((base-image (os->image os #:type image-type))
       (base-target (image-target base-image)))
  (lower-object
   (system-image
    (image
     (inherit (if label
                  (image-with-label base-image label)
                  base-image))
     (target (or base-target target))
     (size image-size)
     (operating-system os))))))
--8<---------------cut here---------------end--------------->8---

There's no particular heuristic for "--system".

Mathieu

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

[Stefan]

Hi!

I did some more improvements to my previous patch.

Before copying files, it makes sense to check if the bootloader target is actually a directory. Also there is the convention for bootloader installer to check e.g. /mnt/boot/efi for existence and to prefer it over /boot/efi.

If someone implements an own installer procedure, then that installer gets the bootloader profile passed and may handle the files collection already, in which case copying them afterwards into the target directory is not wanted any more. So I added a #:copy-files? option to prevent copying files, but defaulting to #t.

For the generation of a profile a list of hooks is expected. I changed the #:hook option to be a #:hooks option and allow a single procedure and a list of procedures.


Schüss

Stefan

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

[Stefan]

* gnu/bootloader.scm (bootloader-profile): New internal function to build a
profile from a package and a collection of files to install.
(bootloader-chain): New function to chain a bootloader with a collection of
additional files like other bootloaders, configuration files or device-trees.

This allows to chain GRUB with U-Boot, device-tree-files, plain configuration
files, etc. mainly for single-board-computers like this:

(operating-system
  (bootloader
    (bootloader-configuration
      (bootloader
        (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 (install-grub-efi-netboot "efi/boot")
          #:copy-files? #t)
        (target "/boot"))))
…)
---
 gnu/bootloader.scm | 139 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 138 insertions(+), 1 deletion(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 2eebb8e9d9..fe51c90743 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -22,6 +22,8 @@
 
 (define-module (gnu bootloader)
   #:use-module (guix discovery)
+  #:use-module (guix gexp)
+  #:use-module (guix profiles)
   #:use-module (guix records)
   #:use-module (guix ui)
   #:use-module (srfi srfi-1)
@@ -66,7 +68,9 @@
             bootloader-configuration-additional-configuration
 
             %bootloaders
-            lookup-bootloader-by-name))
+            lookup-bootloader-by-name
+
+            bootloader-chain))
 
 ^L
 ;;;
@@ -227,3 +231,136 @@ record."
               (eq? name (bootloader-name bootloader)))
             (force %bootloaders))
       (leave (G_ "~a: no such bootloader~%") name)))
+
+(define (bootloader-profile files bootloader-package hooks)
+  "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 '/',
+then the directory content instead of the directory itself will be symlinked
+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.
+
+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))
+          #~(begin
+            (use-modules ((guix build utils)
+                          #:select (mkdir-p strip-store-file-name))
+                         ((ice-9 ftw)
+                          #:select (scandir))
+                         ((srfi srfi-1)
+                          #:select (append-map every remove))
+                         ((srfi srfi-26)
+                          #:select (cut)))
+            (define (symlink-to file directory transform)
+              "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
+              (symlink file (string-append directory "/" (transform file))))
+            (define (directory-content directory)
+              "Creates a list of absolute path names inside DIRECTORY."
+              (map (lambda (name)
+                     (string-append directory name))
+                   (or (scandir directory (lambda (name)
+                                            (not (member name '("." "..")))))
+                       '())))
+            (define name-ends-with-/? (cut string-suffix? "/" <>))
+            (define (name-is-store-entry? name)
+              "Return #t if NAME is a direct store entry and nothing inside."
+              (not (string-index (strip-store-file-name name) #\/)))
+            (let* ((collection (string-append #$output "/collection"))
+                   (files '#$files)
+                   (directories (filter name-ends-with-/? files))
+                   (names-from-directories
+                    (append-map (lambda (directory)
+                                  (directory-content directory))
+                                directories))
+                   (names (append names-from-directories
+                                  (remove name-ends-with-/? files))))
+              (mkdir-p collection)
+              (if (every file-exists? names)
+                  (begin
+                    (for-each (lambda (name)
+                               (symlink-to name collection
+                                            (if (name-is-store-entry? name)
+                                                strip-store-file-name
+                                                basename)))
+                              names)
+                    #t)
+                  #f)))))
+
+    (gexp->derivation "bootloader-collection"
+                      build
+                      #:local-build? #t
+                      #:substitutable? #f
+                      #:properties
+                      `((type . profile-hook)
+                        (hook . bootloader-collection))))
+
+  (profile (content (packages->manifest (list bootloader-package)))
+           (name "bootloader-profile")
+           (hooks (append (list bootloader-collection) hooks))
+           (locales? #f)
+           (allow-collisions? #f)
+           (relative-symlinks? #f)))
+
+(define* (bootloader-chain files
+                           final-bootloader
+                           #:key
+                           (hooks '())
+                           installer
+                           (copy-files? #t))
+  "Defines 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,
+local-file, etc., or package contents produced with file-append.  They will be
+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.
+
+The functions 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 COPY-FILES? is #t and the bootloader target is a directory, then all files in
+the mentioned collection/ directory of the bootloader profile will be copied
+into the bootloader target directory after the bootloader installer has been
+called.  Otherwise the /collection content is left for use by the INSTALLER."
+  (let* ((final-installer (or installer
+                              (bootloader-installer final-bootloader)))
+         (profile (bootloader-profile files
+                                      (bootloader-package final-bootloader)
+                                      (if (list? hooks)
+                                          hooks
+                                          (list hooks)))))
+    (bootloader
+     (inherit final-bootloader)
+     (package profile)
+     (installer
+      #~(lambda (bootloader target mount-point)
+        (#$final-installer bootloader target mount-point)
+        (when #$copy-files?
+          (let* ((mount-point/target (string-append mount-point target))
+                   ;; When installing Guix, it's common to mount TARGET below
+                   ;; MOUNT-POINT rather than below the root directory.
+                   (bootloader-target (if (file-exists? mount-point/target)
+                                          mount-point/target
+                                          target)))
+            (when (eq? (and=> (stat bootloader-target #f) stat:type)
+                      'directory)
+              (copy-recursively (string-append bootloader "/collection")
+                                bootloader-target
+                                #:follow-symlinks? #t
+                                #:log (%make-void-port "w"))))))))))
-- 
2.26.0

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

[Ludovic Courtès]

Hi,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

>> Sorry, I don’t see why this prevents an API that more closely matches
>> the idea of a chain of bootloaders (but perhaps I’d just need to spend
>> more time studying this.)
>
> It doesn't prevent that API--but this narrow use case here doesn't need it.
>
> And I do not intend to implement the general use case--we all decided against
> general chainloading and then introduced full support for bootloaders other
> than grub (which then do not chainload grub--they totally could have!).
>
> But this use case with lots of bootloaders on an ESP partition (or Raspberry Pi
> equivalent) is easy enough.  Maybe we should change the name of the main
> procedure to be less general, though.  "chain-esp-bootloaders" ?
>
> If you could check it out more, that would help.  I think how the patch is
> now is fine for the narrow use case: chainloading the normal guix bootloader
> using other bootloaders (or whatever else!  Maybe a turtle is loading the final
> guix bootloader--who knows ;) ).
>
> The code here can only chain bootloaders in the ESP partition (actually, the
> Raspberry Pi equivalent of the latter).

Oh got it, I thought it was about bootloader chaining “in general”,
apologies for the confusion!

> From the patch:
>
>>+(define (bootloader-profile packages package-contents files)
>>[...]
>>+  (profile (content (packages->manifest packages))
>>+           (name "bootloader-profile")
>>+           (hooks (list bootloader-collection))
>>+           (locales? #f)
>>+           (allow-collisions? #f)
>>+           (relative-symlinks? #f)))
>
> Maybe I don't understand what you mean... but that "profile" is from
> (guix profiles).

Oops, you’re right; my bad!

> In any case, maybe we should just call it "esp-bootloader-chain" or
> maybe just "raspberry-pi-bootloader-chain".

Yes, maybe that’d be clearer (perhaps the former, unless there’s
something really RPi-specific).

Thanks,
Ludo’.

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

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 133 bytes --]

Pushed to guix master as commit 74eeb11daee906cb012f10b6bb3afd254f9ea5c2,
after renaming bootloader-chain to efi-bootloader-chain.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

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

[Stefan]

Hi Danny!

> Pushed to guix master as commit 74eeb11daee906cb012f10b6bb3afd254f9ea5c2,
> after renaming bootloader-chain to efi-bootloader-chain.

You missed my last patch-set, unfortunately. Is it possible to push that as well?

https://lists.gnu.org/archive/html/guix-patches/2020-11/msg00212.html
https://lists.gnu.org/archive/html/guix-patches/2020-11/msg00213.html


Bye

Stefan

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

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 3877 bytes --]

Hi Stefan,

oops.

I've reviewed and pushed the first part (s;HOOK;HOOKS;) now as guix master
commit ede4117f7f18e118003f2599f5c8e985dfbdf9a5.

But I'm not sure whether the COPY-FILES? thing is a nice API (and I mean not just
the flag).

I would prefer if the user would just change the INSTALLER in the case he wants
to not use the profile (which is kinda weird?!) or pack it or whatever.

In case the user wanted to index the profile content, the user would use a HOOK
to do that.

It really depends on what exactly efi-bootloader-chain is being presented as.

Is it a profile ?  Then it shouldn't have weird flags like
that--if possible--and instead use the standard methods.

For example you could do instead (I cut&pasted to show the idea--untested!):

(define* (efi-bootloader-chain files
                               final-bootloader
                               #:key
                               (hooks '())
                               installer)

  (let* ((final-installer (or installer
                              (lambda (bootloader target mount-point)
                                ((bootloader-installer bootloader) bootloader target mount-point)
            (let* ((mount-point/target (string-append mount-point target))
                     ;; When installing Guix, it's common to mount TARGET below
                     ;; MOUNT-POINT rather than below the root directory.
                     (bootloader-target (if (file-exists? mount-point/target)
                                            mount-point/target
                                            target)))
              (when (eq? (and=> (stat bootloader-target #f) stat:type)
                        'directory)
                (copy-recursively (string-append bootloader "/collection")
                                  bootloader-target
                                  #:follow-symlinks? #t
                                  #:log (%make-void-port "w")))))))))))))
         (profile (efi-bootloader-profile files
                                          (bootloader-package final-bootloader)
                                          (if (list? hooks)
                                              hooks
                                              (list hooks)))))
    (bootloader
     (inherit final-bootloader)
     (package profile)
     (installer
      #~(lambda (bootloader target mount-point)
          (#$final-installer bootloader target mount-point))))

This way the weird flag COPY-FILES? is gone with no loss of functionality to
the customizer.  It's possible for the customizer to read the bootloader
package (profile), so it's still possible to copy stuff if it's required
(pass a custom INSTALLER which does the copying and also some custom
installation).

I have a few questions:

(1) Why is there a $output/collection subdirectory?  Is there something
else than that in the profile output?  
If there are no good reasons to do it like that, I'd just put the
profile into $output directly instead--it's easier to understand, and also it's
how other profiles are being used.

(2) The COPY-FILES? flag is kinda weird.
I would prefer if INSTALLER just defaulted to a procedure that: does copy
files, and then calls the final bootloader installer.
If the user doesn't want it then the user could still pass a INSTALLER
that doesn't (for example the user could pass #:installer
(bootloader-installer final-bootloader)).

(3) Why isn't the final bootloader installed last?  I would have expected
it to be installed last so that if it does packing of the profile contents
in order to quickly find it at boot, it would have to have all the files
of the profiles already, no?

Could you explain what this is for in your use case?  I don't yet understand
the reason for this complexity.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

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

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1218 bytes --]

Also, please keep in mind Ludo's suggestion of using the first class profiles
of G-Expressions.  I'm not sure it's applicable in this case (!)--but still, it
would be nice, for a future version of raspberry efi netboot or of similar
things, to be able to do this, right from config.scm:

  (operating-system
    (bootloader
      (bootloader-configuration
        (bootloader ; field in bootloader-configuration
          (bootloader ; bootloader record constructor
            (inherit grub-efi-netboot-bootloader) ; so we have the installer
            (package ; override bootloader's package
             (profile ; create a profile
              (content
               (list (file-append firmware "/boot/")
                     (file-append u-boot-my-scb "/libexec/u-boot.bin")
                     (plain-file "config.txt"
                                 "kernel=u-boot.bin")
                     (bootloader-package grub-efi-netboot-bootloader))))) ; and put the package we've overridden back into the profile
            (target "/boot"))))

This way, maybe the procedures efi-bootloader-chain and
efi-bootloader-profile would be superfluous.

Note: I haven't used this myself yet. 

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

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

[Stefan]

Hi Danny!

> I've reviewed and pushed the first part (s;HOOK;HOOKS;) now as guix master
> commit ede4117f7f18e118003f2599f5c8e985dfbdf9a5.

OK, thanks.

> Could you explain what this is for in your use case?  I don't yet understand
> the reason for this complexity.

Sure.

> (1) Why is there a $output/collection subdirectory?  Is there something
> else than that in the profile output?  

The profile contains first of all the GRUB package with all its tools and files. This profile is the ‘package’ argument to the GRUB installer. Having the profile hook create the collection folder eases the task for an installer. The simple idea is to copy all the additional files along with the installed GRUB bootloader into /boot. Without the collection/ the installer would require the list of files as well and reimplement the same functionality as already inside the hook, to copy the files into the /boot/ folder.

For example the profile contains at least these folders from the grub package, plus the collection/:

/gnu/store/…-bootloader-profile/collection
/gnu/store/…-bootloader-profile/etc
/gnu/store/…-bootloader-profile/share
/gnu/store/…-bootloader-profile/lib
/gnu/store/…-bootloader-profile/bin
/gnu/store/…-bootloader-profile/sbin

But the /boot/ folder finally contains something like this, with most of it being content from the collection/, where the GRUB files get installed belaw /boot/efi/:

/boot/bcm2710-rpi-3-b.dtb
/boot/bootcode.bin
/boot/bootloader.txt
/boot/config.txt
/boot/custom.txt
/boot/efi/
/boot/fixup.dat
/boot/gnu/
/boot/grub/
/boot/overlays/
/boot/u-boot.bin

Actually one could say that the profile hook is a kind of ‘pre-installer’ for everything not related to GRUB, able to prepare everything, but unable to write into the /boot folder.

> If there are no good reasons to do it like that, I'd just put the
> profile into $output directly instead--it's easier to understand, and also it's
> how other profiles are being used.

Not having the collection folder would mean that the installer would need to assume much more about the result of the profile hook, to copy the right files to /boot.

> (2) The COPY-FILES? flag is kinda weird.
> I would prefer if INSTALLER just defaulted to a procedure that: does copy
> files, and then calls the final bootloader installer.
> If the user doesn't want it then the user could still pass a INSTALLER
> that doesn't (for example the user could pass #:installer
> (bootloader-installer final-bootloader)).

Agreed. Another possibility would be to remove the collection folder within a hook.

> I would prefer if the user would just change the INSTALLER in the case he wants
> to not use the profile (which is kinda weird?!) or pack it or whatever.

OK, I see, in case of a custom installer we can skip the copying completely. That makes sense. 

> (3) Why isn't the final bootloader installed last?  I would have expected
> it to be installed last so that if it does packing of the profile contents
> in order to quickly find it at boot, it would have to have all the files
> of the profiles already, no?

I thought about the order as well. My conclusion was that a file from the collection should be able to overwrite a file installed from final-bootloader, for example to install own device-tree files.

What do think?


Bye

Stefan

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

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 3402 bytes --]

Hi Stefan,

On Tue, 17 Nov 2020 21:27:42 +0100
Stefan <stefan-guix@vodafonemail.de> wrote:

> For example the profile contains at least these folders from the grub package, plus the collection/:
> 
> /gnu/store/…-bootloader-profile/collection
> /gnu/store/…-bootloader-profile/etc
> /gnu/store/…-bootloader-profile/share
> /gnu/store/…-bootloader-profile/lib
> /gnu/store/…-bootloader-profile/bin
> /gnu/store/…-bootloader-profile/sbin

Ohhh, that's right.  It actually contains the grub installer--which it got from
the grub-efi derivation.  The actual boot EFI file is not in the grub-efi
derivation.

I wonder if it is possible (one day!) to have a package that actually contains
the EFI boot file that the grub installer generated.  That would be a lot
nicer--though I'm not sure whether that stuff depends on the system and thus
cannot be "pre-generated".

> But the /boot/ folder finally contains something like this, with most of it being content from the collection/, where the GRUB files get installed belaw /boot/efi/:
> 
> /boot/bcm2710-rpi-3-b.dtb
> /boot/bootcode.bin
> /boot/bootloader.txt
> /boot/config.txt
> /boot/custom.txt
> /boot/efi/
> /boot/fixup.dat
> /boot/gnu/
> /boot/grub/
> /boot/overlays/
> /boot/u-boot.bin
> 
> Actually one could say that the profile hook is a kind of ‘pre-installer’ for everything not related to GRUB, able to prepare everything, but unable to write into the /boot folder.
> 
> > If there are no good reasons to do it like that, I'd just put the
> > profile into $output directly instead--it's easier to understand, and also it's
> > how other profiles are being used.  
> 
> Not having the collection folder would mean that the installer would need to assume much more about the result of the profile hook, to copy the right files to /boot.

I agree.  Let's leave it inside subdir "collection".

> > (2) The COPY-FILES? flag is kinda weird.
> > I would prefer if INSTALLER just defaulted to a procedure that: does copy
> > files, and then calls the final bootloader installer.
> > If the user doesn't want it then the user could still pass a INSTALLER
> > that doesn't (for example the user could pass #:installer
> > (bootloader-installer final-bootloader)).  
> 
> Agreed.

> Another possibility would be to remove the collection folder within a hook.

I don't like that that much because it's mutating too much and thus
composability goes down.

> > I would prefer if the user would just change the INSTALLER in the case he wants
> > to not use the profile (which is kinda weird?!) or pack it or whatever.  
> 
> OK, I see, in case of a custom installer we can skip the copying completely. That makes sense. 

Could you send an updated patch that does it like that?  Or do you rather want
the old variant ?

> > (3) Why isn't the final bootloader installed last?  I would have expected
> > it to be installed last so that if it does packing of the profile contents
> > in order to quickly find it at boot, it would have to have all the files
> > of the profiles already, no?  
> 
> I thought about the order as well. My conclusion was that a file from the collection should be able to overwrite a file installed from final-bootloader, for example to install own device-tree files.

Yeah, that makes sense--if a little unusual (thus should be documented).

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

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

[Stefan]

Hi Danny!

> Could you send an updated patch that does it like that?

Sure, it’ll just need a little while.


Bye

Stefan

[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

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

[Stefan]

Hi!

A friendly ping. :-)

https://issues.guix.gnu.org/41066#29


Bye

Stefan

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

[Danny Milosavljevic]

[-- Attachment #1: Type: text/plain, Size: 1959 bytes --]

Hi Stefan,

thanks!

Like mentioned in recent e-mails on the mailing list by Mark Weaver (in general,
not to you), please seperate cosmetic patches from non-cosmetic patches.

This is mostly so users can see which commits change what and why without
having to read through unrelated stuff.

Your latest patch does:

(1) Export chain-bootloader-installer.  I totally agree with Ludo's earlier
comment in that this is not the right abstraction for GENERAL bootloader
chaining (which would be a LOT more difficult/impossible to do).

Regardless, since we want to use this for efi-bootloader-chain, that should be
called "efi-chain-bootloader-installer" instead.

I'm not sure whether "efi-bootloader-chain-installer" would be better (use
whatever you think is best)--in any case, please do not make it seem like
this function is in any way generic, which it is absolutely not.

It only works if there is a special partition which contains the bootloader,
which is not a given (and was pretty uncommon until a few years ago--a
bootloader on a FILESYSTEM?  What? :) ).

(2) efi-bootloader-profile cosmetic comment and import cleanup.  Also, some
more cosmetic comment cleanup in some other procedure.  Please use extra
patch(es).

(3) Definition of procedure chain-bootloader-installer.  This procedure does
not fail if the conditions are weird (collection is not a directory,
bootloader-target is not a directory).  If there is no good reason for that,
please use (error "...") to make it fail instead of silently continuing.
If there are good reasons, nevermind.

Since this is merely moving the existing procedure, please, if you do
these changes I suggest, do those in an extra commit (so the moving commit
is clearing only moving the procedure, not changing it).

(4) gnu/bootloader/grub.scm font installer doesn't use symlinks anymore.
Fine, but maybe also make an extra patch for that.  Please use your judgement.

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

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

[Stefan]

Hi Danny!

> (1) Export chain-bootloader-installer.  I totally agree with Ludo's earlier
> comment in that this is not the right abstraction for GENERAL bootloader
> chaining (which would be a LOT more difficult/impossible to do).

> I'm not sure whether "efi-bootloader-chain-installer" would be better (use
> whatever you think is best)--in any case, please do not make it seem like
> this function is in any way generic, which it is absolutely not.

Done, I chose chain-efi-bootloader-installer.

> (2) efi-bootloader-profile cosmetic comment and import cleanup.  Also, some
> more cosmetic comment cleanup in some other procedure.  Please use extra
> patch(es).

Undone.

> (3) Definition of procedure chain-bootloader-installer.  This procedure does
> not fail if the conditions are weird (collection is not a directory,
> bootloader-target is not a directory).  If there is no good reason for that,
> please use (error "...") to make it fail instead of silently continuing.
> If there are good reasons, nevermind.

Done.

> Since this is merely moving the existing procedure, please, if you do
> these changes I suggest, do those in an extra commit (so the moving commit
> is clearing only moving the procedure, not changing it).

No, it’s not strictly moving. Its pulling functionality out of efi-bootloader-chain into the new function chain-efi-bootloader-installer, which I put on top. Putting it below doesn’t make the diff prettier.

> (4) gnu/bootloader/grub.scm font installer doesn't use symlinks anymore.
> Fine, but maybe also make an extra patch for that.  Please use your judgement.

Done.


Bye

Stefan

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

[Stefan]

* gnu/bootloader.scm (chain-efi-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-efi-bootloader-installer) if the #:installer
argument is false.

The new chain-efi-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-efi-bootloader-installer (install-grub-efi-netboot "efi/boot")))
        (target "/boot"))))
---
 gnu/bootloader.scm | 54 ++++++++++++++++++++++++++++++++++++----------
 1 file changed, 43 insertions(+), 11 deletions(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 6d7352ddd2..ce62d315ef 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -70,6 +70,7 @@
             %bootloaders
             lookup-bootloader-by-name
 
+            chain-efi-bootloader-installer
             efi-bootloader-chain))
 
 ^L
@@ -311,6 +312,38 @@ HOOKS lists additional hook functions to modify the profile."
            (allow-collisions? #f)
            (relative-symlinks? #f)))
 
+(define (chain-efi-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-efi-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")))
+        (if (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"))
+            (error "expecting two directories for bootloader installation"
+                   collection bootloader-target)))))
+
 (define* (efi-bootloader-chain files
                                final-bootloader
                                #:key
@@ -330,10 +363,16 @@ 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-efi-bootloader-installer (bootloader-installer FINAL-BOOTLOADER))
+
+will be used to install the bootloader."
   (let* ((final-installer (or installer
-                              (bootloader-installer final-bootloader)))
+                              (chain-efi-bootloader-installer
+                               (bootloader-installer final-bootloader))))
          (profile (efi-bootloader-profile files
                                           (bootloader-package final-bootloader)
                                           (if (list? hooks)
@@ -342,11 +381,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))))
-- 
2.29.2

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

[Stefan]

Hi!

A friendly ping! :-)


Bye

Stefan

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

[Stefan]

Hi!

I’m working on a different improvement, which will make the still outstanding patch in this ticket obsolete. So this is done.


Bye

Stefan