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 VvPEFCRVr16MCgAA0tVLHw (envelope-from ) for ; Sun, 03 May 2020 23:35:00 +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 UFbTDS9Vr14qKQAAbx9fmQ (envelope-from ) for ; Sun, 03 May 2020 23:35:11 +0000 Received: from lists.gnu.org (lists.gnu.org [IPv6:2001:470:142::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 069B3941A8A for ; Sun, 3 May 2020 23:35:09 +0000 (UTC) Received: from localhost ([::1]:35584 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jVO8b-0000oZ-5P for larch@yhetil.org; Sun, 03 May 2020 19:35:09 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:52928) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jVO8U-0000o9-Ss for guix-patches@gnu.org; Sun, 03 May 2020 19:35:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:46920) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jVO8U-0005JD-K6 for guix-patches@gnu.org; Sun, 03 May 2020 19:35:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jVO8U-0001Ld-Hp for guix-patches@gnu.org; Sun, 03 May 2020 19:35:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#41066] [PATCH] gnu: grub: Support for chain loading. Resent-From: Stefan Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 03 May 2020 23:35:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 41066 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 41066@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.15885488785146 (code B ref -1); Sun, 03 May 2020 23:35:02 +0000 Received: (at submit) by debbugs.gnu.org; 3 May 2020 23:34:38 +0000 Received: from localhost ([127.0.0.1]:58466 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jVO86-0001Kv-2Y for submit@debbugs.gnu.org; Sun, 03 May 2020 19:34:38 -0400 Received: from lists.gnu.org ([209.51.188.17]:40836) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jVO83-0001Kn-HC for submit@debbugs.gnu.org; Sun, 03 May 2020 19:34:36 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:52818) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jVO83-0000kI-8U for guix-patches@gnu.org; Sun, 03 May 2020 19:34:35 -0400 Received: from mx009.vodafonemail.xion.oxcs.net ([153.92.174.39]:57241) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jVO81-0005EA-FZ for guix-patches@gnu.org; Sun, 03 May 2020 19:34:34 -0400 Received: from vsmx002.vodafonemail.xion.oxcs.net (unknown [192.168.75.192]) by mta-6-out.mta.xion.oxcs.net (Postfix) with ESMTP id 87FFD604800 for ; Sun, 3 May 2020 23:34:27 +0000 (UTC) Received: from macbook-pro.kuh-wiese.my-router.de (unknown [88.70.113.211]) by mta-6-out.mta.xion.oxcs.net (Postfix) with ESMTPA id 47BA56047FF for ; Sun, 3 May 2020 23:34:25 +0000 (UTC) From: Stefan Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: quoted-printable Message-Id: <7A4ABEA8-4500-4D55-BCCE-BFB37FB06B2C@vodafonemail.de> Date: Mon, 4 May 2020 01:34:24 +0200 Mime-Version: 1.0 (Mac OS X Mail 9.3 \(3124\)) X-Mailer: Apple Mail (2.3124) X-VADE-STATUS: LEGIT X-VADE-SCORE: 0 X-VADE-REASON: gggruggvucftvghtrhhoucdtuddrgeduhedrjeefgddvvdcutefuodetggdotefrodftvfcurfhrohhfihhlvgemucevfgfuvffqoffgtfdpucggtfgfnhhsuhgsshgtrhhisggvnecuuegrihhlohhuthemuceftddtnecunecujfgurhephfgtgffukfffvfggofesthhqmhdthhdtvdenucfhrhhomhepufhtvghfrghnuceoshhtvghfrghnqdhguhhigiesvhhouggrfhhonhgvmhgrihhlrdguvgeqnecuggftrfgrthhtvghrnhepkefguefhvdfgledutddvueejuefhveeffeeufeekgfdtueelgedvfffgvdfghfetnecuffhomhgrihhnpehgnhhurdhorhhgnecukfhppeekkedrjedtrdduudefrddvuddunecuufhprghmffhomhgrihhnpehmhidqrhhouhhtvghrrdguvgenucevlhhushhtvghrufhiiigvpedtnecurfgrrhgrmhepmhhouggvpehsmhhtphhouhhtpdhhvghlohepmhgrtggsohhokhdqphhrohdrkhhuhhdqfihivghsvgdrmhihqdhrohhuthgvrhdruggvpdhinhgvthepkeekrdejtddruddufedrvdduuddpmhgrihhlfhhrohhmpehsthgvfhgrnhdqghhuihigsehvohgurghfohhnvghmrghilhdruggvpdhrtghpthhtohepghhuihigqdhprghttghhvghssehgnhhurdhorhhg Received-SPF: pass client-ip=153.92.174.39; envelope-from=stefan-guix@vodafonemail.de; helo=mx009.vodafonemail.xion.oxcs.net X-detected-operating-system: by eggs.gnu.org: First seen = 2020/05/03 19:34:27 X-ACL-Warn: Detected OS = Linux 2.2.x-3.x (no timestamps) [generic] [fuzzy] X-Spam_score_int: -41 X-Spam_score: -4.2 X-Spam_bar: ---- X-Spam_report: (-4.2 / 5.0 requ) BAYES_00=-1.9, RCVD_IN_DNSWL_MED=-2.3, SPF_PASS=-0.001, URIBL_BLOCKED=0.001 autolearn=_AUTOLEARN X-Spam_action: no action X-Spam-Score: -1.3 (-) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -2.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: scn0 X-Spam-Score: -0.51 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of guix-patches-bounces@gnu.org designates 2001:470:142::17 as permitted sender) smtp.mailfrom=guix-patches-bounces@gnu.org X-Scan-Result: default: False [-0.51 / 13.00]; RCVD_VIA_SMTP_AUTH(0.00)[]; GENERIC_REPUTATION(0.00)[-0.49376563481163]; DWL_DNSWL_FAIL(0.00)[2001:470:142::17:server fail]; R_SPF_ALLOW(-0.20)[+ip6:2001:470:142::/48:c]; MV_CASE(0.50)[]; TO_DN_NONE(0.00)[]; IP_REPUTATION_HAM(0.00)[asn: 22989(0.14), country: US(-0.00), ip: 2001:470:142::17(-0.49)]; MX_GOOD(-0.50)[cached: eggs.gnu.org]; MAILLIST(-0.20)[mailman]; FORGED_RECIPIENTS_MAILLIST(0.00)[]; RECEIVED_SPAMHAUS_PBL(0.00)[88.70.113.211:received]; RCVD_TLS_LAST(0.00)[]; MIME_TRACE(0.00)[0:+]; ASN(0.00)[asn:22989, ipnet:2001:470:142::/48, country:US]; R_DKIM_NA(0.00)[]; TAGGED_FROM(0.00)[larch=yhetil.org]; ARC_NA(0.00)[]; FROM_NEQ_ENVFROM(0.00)[stefan-guix@vodafonemail.de,guix-patches-bounces@gnu.org]; FROM_HAS_DN(0.00)[]; URIBL_BLOCKED(0.00)[gnu.org:url]; MID_RHS_MATCH_FROM(0.00)[]; MIME_GOOD(-0.10)[text/plain]; DMARC_NA(0.00)[vodafonemail.de]; HAS_LIST_UNSUB(-0.01)[]; RCPT_COUNT_ONE(0.00)[1]; DNSWL_BLOCKED(0.00)[2001:470:142::17:from]; RCVD_COUNT_SEVEN(0.00)[11]; FORGED_SENDER_MAILLIST(0.00)[] X-TUID: c3nJBaZCosoH * 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=3Du-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 . (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=3D> (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) + (=3D (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=3D? (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. --=20 2.26.0=