From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id UNBYLCz5eV8xSgAA0tVLHw (envelope-from ) for ; Sun, 04 Oct 2020 16:32:44 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id mVIXKCz5eV/DYQAAbx9fmQ (envelope-from ) for ; Sun, 04 Oct 2020 16:32:44 +0000 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 1CC3C9401BE for ; Sun, 4 Oct 2020 16:32:44 +0000 (UTC) Received: from localhost ([::1]:37830 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kP6wD-0002oT-HT for larch@yhetil.org; Sun, 04 Oct 2020 12:32:41 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:60356) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kP6va-0002o7-Hg for guix-patches@gnu.org; Sun, 04 Oct 2020 12:32:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:35085) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kP6va-0006DI-8d for guix-patches@gnu.org; Sun, 04 Oct 2020 12:32:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kP6va-00044C-4f for guix-patches@gnu.org; Sun, 04 Oct 2020 12:32:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41066] [PATCH] gnu: bootloader: Support for chain loading. Resent-From: Stefan Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 04 Oct 2020 16:32:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41066 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Danny Milosavljevic Cc: 41066@debbugs.gnu.org Received: via spool by 41066-submit@debbugs.gnu.org id=B41066.160182909815603 (code B ref 41066); Sun, 04 Oct 2020 16:32:02 +0000 Received: (at 41066) by debbugs.gnu.org; 4 Oct 2020 16:31:38 +0000 Received: from localhost ([127.0.0.1]:46631 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kP6vB-00043a-Mg for submit@debbugs.gnu.org; Sun, 04 Oct 2020 12:31:38 -0400 Received: from vsmx012.vodafonemail.xion.oxcs.net ([153.92.174.90]:48183) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kP6v9-00043L-7Y for 41066@debbugs.gnu.org; Sun, 04 Oct 2020 12:31:36 -0400 Received: from vsmx004.vodafonemail.xion.oxcs.net (unknown [192.168.75.198]) by mta-8-out.mta.xion.oxcs.net (Postfix) with ESMTP id 8F0B2F362E0; Sun, 4 Oct 2020 16:31:28 +0000 (UTC) Received: from macbook-pro.kuh-wiese.my-router.de (unknown [88.70.113.39]) by mta-8-out.mta.xion.oxcs.net (Postfix) with ESMTPA id 1C51A19B4A8; Sun, 4 Oct 2020 16:31:23 +0000 (UTC) Content-Type: text/plain; charset=utf-8 Mime-Version: 1.0 (Mac OS X Mail 9.3 \(3124\)) From: Stefan In-Reply-To: <3197004D-0131-4781-99FD-60EBE434E794@vodafonemail.de> Date: Sun, 4 Oct 2020 18:31:22 +0200 Content-Transfer-Encoding: quoted-printable Message-Id: <023CBBED-35CD-4AD3-97C4-0DE0B7623B9A@vodafonemail.de> References: <7A4ABEA8-4500-4D55-BCCE-BFB37FB06B2C@vodafonemail.de> <20200524131316.4c6e8a50@scratchpost.org> <3197004D-0131-4781-99FD-60EBE434E794@vodafonemail.de> X-Mailer: Apple Mail (2.3124) X-VADE-STATUS: LEGIT X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -1.7 (-) X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: "Guix-patches" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Spam-Score: 0.99 X-TUID: BByvWwUQHKH8 * 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=3Du-boot.bin")) #:installer (install-grub-efi-netboot = "efi/boot")) (target "/boot")))) =E2=80=A6) --- 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 @@ =20 (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 =20 %bootloaders - lookup-bootloader-by-name)) + lookup-bootloader-by-name + + bootloader-chain)) =20 ^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. + ;; =46rom 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) + (=3D (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 '("." = ".."))))) + '()) + stringderivation "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"))))))) --=20 2.26.0