GNU bug report logs - #41066
[PATCH] gnu: grub: Support for chain loading.

Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.

Package: guix-patches; Reported by: Stefan <stefan-guix@HIDDEN>; Keywords: patch; merged with #41068; dated Sun, 3 May 2020 23:35:02 UTC; Maintainer for guix-patches is guix-patches@HIDDEN.
Merged 41066 41068. Request was from Tobias Geerinckx-Rice <me@HIDDEN> to control <at> debbugs.gnu.org. Full text available.

Message received at submit <at> debbugs.gnu.org:


Received: (at submit) by debbugs.gnu.org; 3 May 2020 23:34:38 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun May 03 19:34:38 2020
Received: from localhost ([127.0.0.1]:58466 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
	id 1jVO86-0001Kv-2Y
	for submit <at> 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 <stefan-guix@HIDDEN>) id 1jVO83-0001Kn-HC
 for submit <at> 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 <stefan-guix@HIDDEN>)
 id 1jVO83-0000kI-8U
 for guix-patches@HIDDEN; 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 <stefan-guix@HIDDEN>)
 id 1jVO81-0005EA-FZ
 for guix-patches@HIDDEN; 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 <guix-patches@HIDDEN>; 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 <guix-patches@HIDDEN>; Sun,  3 May 2020 23:34:25 +0000 (UTC)
From: Stefan <stefan-guix@HIDDEN>
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: quoted-printable
Subject: [PATCH] gnu: grub: Support for chain loading.
Message-Id: <7A4ABEA8-4500-4D55-BCCE-BFB37FB06B2C@HIDDEN>
Date: Mon, 4 May 2020 01:34:24 +0200
To: guix-patches@HIDDEN
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@HIDDEN;
 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-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, 
 <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -2.3 (--)

* 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 <http://www.gnu.org/licenses/>.

(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=




Acknowledgement sent to Stefan <stefan-guix@HIDDEN>:
New bug report received and forwarded. Copy sent to guix-patches@HIDDEN. Full text available.
Report forwarded to guix-patches@HIDDEN:
bug#41066; Package guix-patches. Full text available.
Please note: This is a static page, with minimal formatting, updated once a day.
Click here to see this page with the latest information and nicer formatting.
Last modified: Mon, 4 May 2020 00:00:02 UTC

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997 nCipher Corporation Ltd, 1994-97 Ian Jackson.