[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#41066] [PATCH] gnu: bootloader: Support for chain loading.
From: |
Stefan |
Subject: |
[bug#41066] [PATCH] gnu: bootloader: Support for chain loading. |
Date: |
Sun, 4 Oct 2020 18:31:22 +0200 |
* 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 <=
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Stefan, 2020/10/10
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Stefan, 2020/10/18
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Stefan, 2020/10/18
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Danny Milosavljevic, 2020/10/22
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Ludovic Courtès, 2020/10/23
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Danny Milosavljevic, 2020/10/23
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Ludovic Courtès, 2020/10/24
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Danny Milosavljevic, 2020/10/24
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Stefan, 2020/10/25
- [bug#41066] [PATCH] gnu: bootloader: Support for chain loading., Stefan, 2020/10/25