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 4LYLK+cOp19rQAAA0tVLHw (envelope-from ) for ; Sat, 07 Nov 2020 21:17:27 +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 MBnMJucOp18OSwAAbx9fmQ (envelope-from ) for ; Sat, 07 Nov 2020 21:17:27 +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 3372D9403C9 for ; Sat, 7 Nov 2020 21:17:27 +0000 (UTC) Received: from localhost ([::1]:44316 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1kbVaQ-0004ft-1M for larch@yhetil.org; Sat, 07 Nov 2020 16:17:26 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:41766) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1kbVa2-0004fg-RD for guix-patches@gnu.org; Sat, 07 Nov 2020 16:17:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:47791) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1kbVa2-0002p1-Hj for guix-patches@gnu.org; Sat, 07 Nov 2020 16:17:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1kbVa2-0000oQ-Dz for guix-patches@gnu.org; Sat, 07 Nov 2020 16:17:02 -0500 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: Sat, 07 Nov 2020 21:17: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 , 41066@debbugs.gnu.org Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Mathieu Othacehe Received: via spool by 41066-submit@debbugs.gnu.org id=B41066.16047837713060 (code B ref 41066); Sat, 07 Nov 2020 21:17:02 +0000 Received: (at 41066) by debbugs.gnu.org; 7 Nov 2020 21:16:11 +0000 Received: from localhost ([127.0.0.1]:59337 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kbVZC-0000nI-IQ for submit@debbugs.gnu.org; Sat, 07 Nov 2020 16:16:10 -0500 Received: from mx009.vodafonemail.xion.oxcs.net ([153.92.174.39]:6392) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1kbVZB-0000n6-4D for 41066@debbugs.gnu.org; Sat, 07 Nov 2020 16:16:09 -0500 Received: from vsmx002.vodafonemail.xion.oxcs.net (unknown [192.168.75.192]) by mta-6-out.mta.xion.oxcs.net (Postfix) with ESMTP id A5B566045B0; Sat, 7 Nov 2020 21:16:03 +0000 (UTC) Received: from macbook-pro.kuh-wiese.my-router.de (unknown [2.206.141.249]) by mta-6-out.mta.xion.oxcs.net (Postfix) with ESMTPA id AAE05604047; Sat, 7 Nov 2020 21:15:54 +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: <406E80FD-A5E2-4DB5-AC9C-809B1285F775@vodafonemail.de> Date: Sat, 7 Nov 2020 22:15:53 +0100 Content-Transfer-Encoding: quoted-printable Message-Id: 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> <0DCDD4B0-DC4B-4870-B018-D771C509F9E5@vodafonemail.de> <20201102164224.6f745693@scratchpost.org> <87a6vzbuh8.fsf@gmail.com> <87lffihkq0.fsf@gnu.org> <871rhaiy5b.fsf@gmail.com> <406E80FD-A5E2-4DB5-AC9C-809B1285F775@vodafonemail.de> X-Mailer: Apple Mail (2.3124) X-VADE-STATUS: LEGIT X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -3.3 (---) 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: ns3122888.ip-94-23-21.eu 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: bcuVUnWIJT0y * 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 #:hooks my-special-bootloader-profile-manipulator #:installer (install-grub-efi-netboot "efi/boot") #:copy-files? #t) (target "/boot")))) =E2=80=A6) --- 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 @@ =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,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=3D> (stat bootloader-target #f) stat:type) + 'directory) + (copy-recursively (string-append bootloader = "/collection") + bootloader-target + #:follow-symlinks? #t + #:log (%make-void-port "w")))))))))) --=20 2.26.0