From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id 2RsZOmavlV88fwAA0tVLHw (envelope-from ) for ; Sun, 25 Oct 2020 17:01:26 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0 with LMTPS id QBuNNWavlV8dWAAA1q6Kng (envelope-from ) for ; Sun, 25 Oct 2020 17:01:26 +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 1DD66940148 for ; Sun, 25 Oct 2020 17:01:26 +0000 (UTC) Received: from localhost ([::1]:41464 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kWjOW-0005M0-UI for larch@yhetil.org; Sun, 25 Oct 2020 13:01:25 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:34976) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kWjNC-0005KS-IC for guix-patches@gnu.org; Sun, 25 Oct 2020 13:00:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:54221) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kWjNC-0005kj-22 for guix-patches@gnu.org; Sun, 25 Oct 2020 13:00:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kWjNC-0007DR-1J for guix-patches@gnu.org; Sun, 25 Oct 2020 13:00: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, 25 Oct 2020 17:00:01 +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 , Ludovic =?UTF-8?Q?Court=C3=A8s?= , 41066@debbugs.gnu.org Received: via spool by 41066-submit@debbugs.gnu.org id=B41066.160364517527676 (code B ref 41066); Sun, 25 Oct 2020 17:00:01 +0000 Received: (at 41066) by debbugs.gnu.org; 25 Oct 2020 16:59:35 +0000 Received: from localhost ([127.0.0.1]:37534 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kWjMk-0007CK-SE for submit@debbugs.gnu.org; Sun, 25 Oct 2020 12:59:35 -0400 Received: from vsmx012.vodafonemail.xion.oxcs.net ([153.92.174.90]:16036) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kWjMi-0007C4-Lm for 41066@debbugs.gnu.org; Sun, 25 Oct 2020 12:59:33 -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 C3A90F353B4; Sun, 25 Oct 2020 16:59:26 +0000 (UTC) Received: from macbook-pro.kuh-wiese.my-router.de (unknown [2.202.77.30]) by mta-8-out.mta.xion.oxcs.net (Postfix) with ESMTPA id 4002019AE56; Sun, 25 Oct 2020 16:59:20 +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: <4FACB9F5-2A1E-45B5-A53F-42F0E098CEAA@vodafonemail.de> Date: Sun, 25 Oct 2020 17:59:19 +0100 Content-Transfer-Encoding: quoted-printable Message-Id: <0DCDD4B0-DC4B-4870-B018-D771C509F9E5@vodafonemail.de> References: <7A4ABEA8-4500-4D55-BCCE-BFB37FB06B2C@vodafonemail.de> <20200524131316.4c6e8a50@scratchpost.org> <3197004D-0131-4781-99FD-60EBE434E794@vodafonemail.de> <023CBBED-35CD-4AD3-97C4-0DE0B7623B9A@vodafonemail.de> <6E5ECFBA-57F4-485F-9403-1D04CF82062D@vodafonemail.de> <4D71A75A-5722-457C-A5CE-98CE51A53450@vodafonemail.de> <975EC414-6A81-444B-9BB0-AE303C6A9511@vodafonemail.de> <20201022194630.597302a2@scratchpost.org> <87eelpp0pn.fsf@gnu.org> <20201024033051.00720ac1@scratchpost.org> <87a6wbiofb.fsf@gnu.org> <20201025023345.73d515d2@scratchpost.org> <4FACB9F5-2A1E-45B5-A53F-42F0E098CEAA@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.51 X-TUID: HcDuFWhh1Jxm * 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=3Du-boot.bin")) grub-efi-netboot-bootloader #:hook my-special-bootloader-profile-manipulator #:installer (install-grub-efi-netboot "efi/boot")) (target "/boot")))) =E2=80=A6) --- 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 @@ =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,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"))))))) --=20 2.26.0