unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Stefan <stefan-guix@vodafonemail.de>
To: 48314@debbugs.gnu.org
Cc: Danny Milosavljevic <dannym@scratchpost.org>
Subject: [bug#48314] Patches to install guix system on Raspberry Pi
Date: Sun, 31 Oct 2021 23:07:09 +0100	[thread overview]
Message-ID: <AFD31F40-6691-4B53-ACA9-7F821D139124@vodafonemail.de> (raw)
In-Reply-To: <BDB9E76C-37FF-4033-81C1-9D5F0AA575F2@vodafonemail.de>

[-- Attachment #1: Type: text/plain, Size: 199 bytes --]

Hi!

I did a rebase of the patch series to avoid bit-rotting. One patch got obsolete meanwhile.

This series applies on GIT commit 1a80b8909a521b91d30649a011b0257d0fadc18c.


Bye

Stefan


[-- Attachment #2: 01-gnu-bootloader-rework-chaining --]
[-- Type: application/octet-stream, Size: 37426 bytes --]

gnu: bootloader: Rework chaining, add grub-efi-netboot-removable-bootloader.

From: Stefan <stefan-guix@vodafonemail.de>

* doc/guix.texi (Bootloader Configuration): Describe the new
‘grub-efi-netboot-removable-bootloader’.  Mention used sub-directories and
that the UEFI Boot Manager is not modified.  Advice to disable write-access
over TFTP.
* gnu/bootloader.scm (efi-bootloader-profile): Allow a list of packages and
collect everything directly in the profile, avoiding a separate collection
directory.  Renamed the profile from "bootloader-profile" to
"efi-bootloader-profile".
[bootloader-collection]: Renamed to …
[efi-bootloader-profile-hook]: … this and removed unused modules and the
creation of the now unneeded collection directory.
(efi-bootloader-chain): Added packages and disk-image-installer arguments.
Removed handling of the collection directory, now only calling the given
installer procedure.
* gnu/bootloader/grub.scm (make-grub-efi-netboot-installer): New helper.
(make-grub-configuration): New helper based on (grub-configuration-file).
Adding grub argument, fixed indentation, removend code to get grub.
(grub-configuration-file): Now using (make-grub-configuration).
(grub-efi-configuration-file): New function using (make-grub-configuration).
Instead of getting the grub-efi package from the bootloader-configuration
this function refers to the grub-efi package directly.
(grub-cfg): New variable to replace "/boot/grub/grub.cfg".
(install-grub-efi-netboot): Removed, the functionality got moved.
(make-grub-efi-netboot-installer): New helper function to return a customized
installer for a certain efi-sub-directory.  The installer basically copies
a pre-installed efi-bootloader-profile, and adds needed symlinks for booting
over network, or – on an ESP – an intermediate grub-cfg to load the final
grub-cfg file.
(grub-bootloader): Now using the grub-cfg variable.
(grub-efi-bootloader): Now using the grub-cfg variable.  Removed inheritance,
giving complete set of fields.
(make-grub-efi-netboot-bootloader): New helper function.
(grub-efi-netboot-bootloader): Now using the helper.
(grub-efi-netboot-removable-bootloader): New bootloader using the helper.
It uses the efi-sub-directory "efi/boot" for removable media.
* gnu/packages/bootloaders.scm (make-grub-efi-netboot): New function to return
a grub-efi package pre-installed via grub-mknetdir, customized for an
efi-sub-directory and able to boot via network and local storage.

The rework allows to use an (efi-bootloader-chain) like this, which is able
to boot over network or local storage, depending on the symlink-support at
the bootloader-target:

(operating-system
 (bootloader
   (bootloader-configuration
     (bootloader
       (efi-bootloader-chain
         grub-efi-netboot-removable-bootloader
         #:packages (list my-firmware-package
                          my-u-boot-package)
         #:files (list (plain-file "config.txt"
                                   "kernel=u-boot.bin"))
         #:hooks my-special-bootloader-profile-manipulator))
     (target "/booti/efi")
     …))
 …)
)
---
 doc/guix.texi                |   24 +++-
 gnu/bootloader.scm           |  104 +++++++++---------
 gnu/bootloader/grub.scm      |  241 ++++++++++++++++++++++++++----------------
 gnu/packages/bootloaders.scm |   90 ++++++++++++++++
 4 files changed, 308 insertions(+), 151 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ea1973f02c..1dad33cfae 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -33853,8 +33853,9 @@ The type of a bootloader configuration declaration.
 @cindex BIOS, bootloader
 The bootloader to use, as a @code{bootloader} object.  For now
 @code{grub-bootloader}, @code{grub-efi-bootloader},
-@code{grub-efi-netboot-bootloader}, @code{extlinux-bootloader} and
-@code{u-boot-bootloader} are supported.
+@code{grub-efi-netboot-bootloader},
+@code{grub-efi-netboot-removable-bootloader},
+@code{extlinux-bootloader} and @code{u-boot-bootloader} are supported.
 
 @cindex ARM, bootloaders
 @cindex AArch64, bootloaders
@@ -33880,9 +33881,10 @@ build a diskless Guix system.
 
 The installation of the @code{grub-efi-netboot-bootloader} generates the
 content of the TFTP root directory at @code{targets} (@pxref{Bootloader
-Configuration, @code{targets}}), to be served by a TFTP server.  You may
-want to mount your TFTP server directories onto the @code{targets} to
-move the required files to the TFTP server automatically.
+Configuration, @code{targets}}) below the sub-directory @file{efi/Guix}, to be
+served by a TFTP server.  You may want to mount your TFTP server directories
+onto the @code{targets} to move the required files to the TFTP server
+automatically during installation.
 
 If you plan to use an NFS root file system as well (actually if you mount the
 store from an NFS share), then the TFTP server needs to serve the file
@@ -33916,13 +33918,23 @@ directory to your @code{targets}.
 It is important to note that symlinks pointing outside the TFTP root directory
 may need to be allowed in the configuration of your TFTP server.  Further the
 store link exposes the whole store through TFTP@.  Both points need to be
-considered carefully for security aspects.
+considered carefully for security aspects.  It is advised to disable any TFTP
+write access!
+
+Please note, that this bootloader will not modify the ‘UEFI Boot Manager’ of
+the system.
 
 Beside the @code{grub-efi-netboot-bootloader}, the already mentioned TFTP and
 NFS servers, you also need a properly configured DHCP server to make the booting
 over netboot possible.  For all this we can currently only recommend you to look
 for instructions about @acronym{PXE, Preboot eXecution Environment}.
 
+@vindex grub-efi-netboot-removable-bootloader
+@code{grub-efi-netboot-removable-bootloader} is identical to
+@code{grub-efi-netboot-bootloader} with the exception that the sub-directory
+@file{efi/boot} will be used instead of @file{efi/Guix} to comply to the UEFI
+specification for removable media.
+
 @item @code{targets}
 This is a list of strings denoting the targets onto which to install the
 bootloader.
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index d1c72c0c85..cddb8daf93 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -261,26 +261,22 @@ instead~%")))
             (force %bootloaders))
       (leave (G_ "~a: no such bootloader~%") name)))
 
-(define (efi-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.
+(define (efi-bootloader-profile packages files hooks)
+  "Creates a profile from the lists of PACKAGES and FILES from the store.
+This profile 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.
+symlinked into the profile.  If a directory name ends with '/', then the
+directory content instead of the directory itself will be symlinked into the
+profile.
 
-FILES may contain file like objects produced by functions like plain-file,
+FILES may contain file like objects produced by procedures 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 (efi-bootloader-profile-hook manifest)
     (define build
-        (with-imported-modules '((guix build utils)
-                                 (ice-9 ftw)
-                                 (srfi srfi-1)
-                                 (srfi srfi-26))
+        (with-imported-modules '((guix build utils))
           #~(begin
             (use-modules ((guix build utils)
                           #:select (mkdir-p strip-store-file-name))
@@ -304,7 +300,7 @@ HOOKS lists additional hook functions to modify the profile."
             (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"))
+            (let* ((output #$output)
                    (files '#$files)
                    (directories (filter name-ends-with-/? files))
                    (names-from-directories
@@ -313,11 +309,11 @@ HOOKS lists additional hook functions to modify the profile."
                                 directories))
                    (names (append names-from-directories
                                   (remove name-ends-with-/? files))))
-              (mkdir-p collection)
+              (mkdir-p output)
               (if (every file-exists? names)
                   (begin
                     (for-each (lambda (name)
-                               (symlink-to name collection
+                               (symlink-to name output
                                             (if (name-is-store-entry? name)
                                                 strip-store-file-name
                                                 basename)))
@@ -325,57 +321,63 @@ HOOKS lists additional hook functions to modify the profile."
                     #t)
                   #f)))))
 
-    (gexp->derivation "bootloader-collection"
+    (gexp->derivation "efi-bootloader-profile"
                       build
                       #:local-build? #t
                       #:substitutable? #f
                       #:properties
                       `((type . profile-hook)
-                        (hook . bootloader-collection))))
+                        (hook . efi-bootloader-profile-hook))))
 
-  (profile (content (packages->manifest (list bootloader-package)))
-           (name "bootloader-profile")
-           (hooks (append (list bootloader-collection) hooks))
+  (profile (content (packages->manifest packages))
+           (name "efi-bootloader-profile")
+           (hooks (cons efi-bootloader-profile-hook hooks))
            (locales? #f)
            (allow-collisions? #f)
            (relative-symlinks? #f)))
 
-(define* (efi-bootloader-chain files
-                               final-bootloader
+(define* (efi-bootloader-chain final-bootloader
                                #:key
+                               (packages '())
+                               (files '())
                                (hooks '())
-                               installer)
-  "Define a bootloader chain with FINAL-BOOTLOADER as the final bootloader and
-certain directories and files from the store given in the list of FILES.
+                               installer
+                               disk-image-installer)
+  "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES,
+and optional 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.
+The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
+in an efi-bootloader-profile, which will be passed to the INSTALLER.
+
+FILES may contain file like objects produced by procedures like plain-file,
+local-file, etc., or package contents produced with file-append.
 
 If a directory name in FILES ends with '/', then the directory content instead
-of the directory itself will be symlinked into the collection/ directory.
+of the directory itself will be symlinked into the efi-bootloader-profile.
 
 The procedures 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."
-  (let* ((final-installer (or installer
-                              (bootloader-installer final-bootloader)))
-         (profile (efi-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)
-          (copy-recursively
-           (string-append bootloader "/collection")
-           (string-append mount-point target)
-           #:follow-symlinks? #t
-           #:log (%make-void-port "w")))))))
+If the INSTALLER argument is used, then this gexp procedure will be called to
+install the efi-bootloader-profile.  Otherwise the installer of the
+FINAL-BOOTLOADER will be called.
+
+If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
+to install the efi-bootloader-profile into a disk-image.  Otherwise the
+disk-image-installer of the FINAL-BOOTLOADER will be called."
+  (bootloader
+    (inherit final-bootloader)
+    (name "efi-bootloader-chain")
+    (package
+     (efi-bootloader-profile (cons (bootloader-package final-bootloader)
+                                   packages)
+                             files
+                             (if (list? hooks)
+                                 hooks
+                                 (list hooks))))
+    (installer
+     (or installer
+         (bootloader-installer final-bootloader)))
+    (disk-image-installer
+     (or disk-image-installer
+         (bootloader-disk-image-installer final-bootloader)))))
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index d8e888ff40..2235363c6d 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -50,11 +50,12 @@
             grub-theme-color-highlight
             grub-theme-gfxmode
 
-            install-grub-efi-netboot
+            make-grub-efi-netboot-installer
 
             grub-bootloader
             grub-efi-bootloader
             grub-efi-netboot-bootloader
+            grub-efi-netboot-removable-bootloader
             grub-mkrescue-bootloader
             grub-minimal-bootloader
 
@@ -346,7 +347,7 @@ code."
         ((or #f (? string?))
          #~(format #f "search --file --set ~a" #$file)))))
 
-(define* (grub-configuration-file config entries
+(define* (make-grub-configuration grub config entries
                                   #:key
                                   (locale #f)
                                   (system (%current-system))
@@ -376,27 +377,27 @@ when booting a root file system on a Btrfs subvolume."
                 (initrd (normalize-file (menu-entry-initrd entry)
                                         device-mount-point
                                         store-directory-prefix)))
-         ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
-         ;; Use the right file names for LINUX and INITRD in case
-         ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
-         ;; separate partition.
-
-         ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
-         ;; initrd paths, to allow booting from a Btrfs subvolume.
-         #~(format port "menuentry ~s {
+            ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
+            ;; Use the right file names for LINUX and INITRD in case
+            ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
+            ;; separate partition.
+
+            ;; When BTRFS-SUBVOLUME-FILE-NAME is defined, prepend it the linux and
+            ;; initrd paths, to allow booting from a Btrfs subvolume.
+            #~(format port "menuentry ~s {
   ~a
   linux ~a ~a
   initrd ~a
 }~%"
-                   #$label
-                   #$(grub-root-search device linux)
-                   #$linux (string-join (list #$@arguments))
-                   #$initrd))
+                      #$label
+                      #$(grub-root-search device linux)
+                      #$linux (string-join (list #$@arguments))
+                      #$initrd))
           (let ((kernel (menu-entry-multiboot-kernel entry))
                 (arguments (menu-entry-multiboot-arguments entry))
                 (modules (menu-entry-multiboot-modules entry))
                 (root-index 1))            ; XXX EFI will need root-index 2
-        #~(format port "
+            #~(format port "
 menuentry ~s {
   multiboot ~a root=device:hd0s~a~a~a
 }~%"
@@ -434,9 +435,7 @@ menuentry ~s {
   (define locale-config
     (let* ((entry (first all-entries))
            (device (menu-entry-device entry))
-           (mount-point (menu-entry-device-mount-point entry))
-           (bootloader (bootloader-configuration-bootloader config))
-           (grub (bootloader-package bootloader)))
+           (mount-point (menu-entry-device-mount-point entry)))
       #~(let ((locale #$(and locale
                              (locale-definition-source
                               (locale-name->definition locale))))
@@ -462,8 +461,6 @@ set lang=~a~%"
 
   (define keyboard-layout-config
     (let* ((layout (bootloader-configuration-keyboard-layout config))
-           (grub   (bootloader-package
-                    (bootloader-configuration-bootloader config)))
            (keymap* (and layout
                          (keyboard-layout-file layout #:grub grub)))
            (entry (first all-entries))
@@ -514,6 +511,16 @@ fi~%"))))
                  #:options '(#:local-build? #t
                              #:substitutable? #f)))
 
+(define (grub-configuration-file config . args)
+  (let* ((bootloader (bootloader-configuration-bootloader config))
+         (grub (bootloader-package bootloader)))
+    (apply make-grub-configuration grub config args)))
+
+(define (grub-efi-configuration-file . args)
+  (apply make-grub-configuration grub-efi args))
+
+(define grub-cfg "/boot/grub/grub.cfg")
+
 \f
 
 ;;;
@@ -607,42 +614,31 @@ fi~%"))))
                         "--bootloader-id=Guix"
                         "--efi-directory" target-esp)))))
 
-(define (install-grub-efi-netboot subdir)
-  "Define a grub-efi-netboot bootloader installer for installation in SUBDIR,
-which is usually efi/Guix or efi/boot."
-  (let* ((system (string-split (nix-system->gnu-triplet
-                                (or (%current-target-system)
-                                    (%current-system)))
-                               #\-))
-         (arch (first system))
-         (boot-efi-link (match system
-                          ;; These are the supportend systems and the names
-                          ;; defined by the UEFI standard for removable media.
-                          (("i686" _ ...)        "/bootia32.efi")
-                          (("x86_64" _ ...)      "/bootx64.efi")
-                          (("arm" _ ...)         "/bootarm.efi")
-                          (("aarch64" _ ...)     "/bootaa64.efi")
-                          (("riscv" _ ...)       "/bootriscv32.efi")
-                          (("riscv64" _ ...)     "/bootriscv64.efi")
-                          ;; Other systems are not supported, although defined.
-                          ;; (("riscv128" _ ...) "/bootriscv128.efi")
-                          ;; (("ia64" _ ...)     "/bootia64.efi")
-                          ((_ ...)               #f)))
-         (core-efi (string-append
-                    ;; This is the arch dependent file name of GRUB, e.g.
-                    ;; i368-efi/core.efi or arm64-efi/core.efi.
-                    (match arch
-                      ("i686"    "i386")
-                      ("aarch64" "arm64")
-                      ("riscv"   "riscv32")
-                      (_         arch))
-                    "-efi/core.efi")))
-    (with-imported-modules
-     '((guix build union))
-     #~(lambda (bootloader target mount-point)
-         "Install the BOOTLOADER, which must be the package grub, as e.g.
-bootx64.efi or bootaa64.efi into SUBDIR, which is usually efi/Guix or efi/boot,
-below the directory TARGET for the system whose root is mounted at MOUNT-POINT.
+(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
+  "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
+its files in SUBDIR and its configuration file in GRUB-CFG.
+
+As a grub-efi-netboot package is already preinstalled by 'grub-mknetdir', the
+installer basically copies all files from the bootloader-package (or profile)
+into the bootloader-target directory.
+
+Additionally for network booting over TFTP, two relative symlinks to the store
+and to the GRUB-CFG file are necessary.  Due to this a TFTP root directory must
+not be located on a FAT file-system.
+
+If the bootloader-target does not support symlinks, then it is assumed to be a
+kind of EFI System Partition (ESP).  In this case an intermediate configuration
+file is created with the help of GRUB-EFI to load the GRUB-CFG.
+
+The installer is usable for any efi-bootloader-chain, which prepares the
+bootloader-profile in a way ready for copying.
+
+The installer does not manipulate the system's 'UEFI Boot Manager'."
+  (with-imported-modules '((guix build union))
+    #~(lambda (bootloader target mount-point)
+        "Copy the BOOTLOADER, which must be a preinstalled grub-efi-netboot
+package with a SUBDIR like efi/boot or efi/Guix, below the directory
+TARGET for the system whose root is mounted at MOUNT-POINT.
 
 MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
 or '/' for other 'guix system' commands.
@@ -652,17 +648,18 @@ bootloader-configuration in:
 
 (operating-system
  (bootloader (bootloader-configuration
-              (targets '(\"/boot\"))
+              (targets '(\"/boot/efi\"))
               …))
  …)
 
 TARGET is required to be an absolute directory name, usually mounted via NFS,
 and finally needs to be provided by a TFTP server as the TFTP root directory.
 
+Usually the installer will be used to prepare network booting over TFTP.  Then
 GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
 load more files from the store like tftp://server/gnu/store/…-linux…/Image.
 
-To make this possible two symlinks will be created. The first symlink points
+To make this possible two symlinks will be created.  The first symlink points
 relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
 MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
 MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.
@@ -672,34 +669,78 @@ paths on the TFTP server side are unknown.
 
 It is also important to note that both symlinks will point outside the TFTP root
 directory and that the TARGET/%store-prefix symlink makes the whole store
-accessible via TFTP. Possibly the TFTP server must be configured
-to allow accesses outside its TFTP root directory. This may need to be
-considered for security aspects."
-         (use-modules ((guix build union) #:select (symlink-relative)))
-         (let* ((net-dir (string-append mount-point target "/"))
-                (sub-dir (string-append net-dir #$subdir "/"))
-                (store (string-append mount-point (%store-prefix)))
-                (store-link (string-append net-dir (%store-prefix)))
-                (grub-cfg (string-append mount-point "/boot/grub/grub.cfg"))
-                (grub-cfg-link (string-append sub-dir (basename grub-cfg)))
-                (boot-efi-link (string-append sub-dir #$boot-efi-link)))
-           ;; Prepare the symlink to the store.
-           (mkdir-p (dirname store-link))
-           (false-if-exception (delete-file store-link))
-           (symlink-relative store store-link)
-           ;; Prepare the symlink to the grub.cfg, which points into the store.
-           (mkdir-p (dirname grub-cfg-link))
-           (false-if-exception (delete-file grub-cfg-link))
-           (symlink-relative grub-cfg grub-cfg-link)
-           ;; Install GRUB, which refers to the grub.cfg, with support for
-           ;; encrypted partitions,
-           (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-           (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
-                         (string-append "--net-directory=" net-dir)
-                         (string-append "--subdir=" #$subdir))
-           ;; Prepare the bootloader symlink, which points to core.efi of GRUB.
-           (false-if-exception (delete-file boot-efi-link))
-           (symlink #$core-efi boot-efi-link))))))
+accessible via TFTP.  Possibly the TFTP server must be configured to allow
+accesses outside its TFTP root directory.  This all may need to be considered
+for security aspects.  It is advised to disable any TFTP write access!
+
+The installer can also be used to prepare booting from local storages, if the
+underlying file-system, like FAT on an EFI System Partition (ESP), does not
+support symlinks.  In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
+created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file.  A
+symlink to the store is not needed in this case."
+        ;; In context of a disk image creation TARGET will be #f and an
+        ;; installer is expected to do necessary installations on MOUNT-POINT,
+        ;; which will become the root file system.
+        ;; If TARGET is #f, this installer has nothing to do, as it only cares
+        ;; about the EFI System Partition (ESP).
+        (when target
+          (use-modules ((guix build union) #:select (symlink-relative))
+                       (ice-9 popen)
+                       (ice-9 rdelim))
+          (let* ((mount-point/target (string-append mount-point target "/"))
+                 ;; When installing Guix, it is common to mount TARGET below
+                 ;; MOUNT-POINT rather than the root directory.
+                 (bootloader-target (if (file-exists? mount-point/target)
+                                        mount-point/target
+                                        target))
+                 (store (string-append mount-point (%store-prefix)))
+                 (store-link (string-append bootloader-target (%store-prefix)))
+                 (grub-cfg (string-append mount-point #$grub-cfg))
+                 (grub-cfg-link (string-append bootloader-target
+                                               #$subdir "/"
+                                               (basename grub-cfg))))
+            ;; Copy the bootloader into the bootloader-target directory.
+            ;; Should we beforehand recursively delete any existing file?
+            (copy-recursively bootloader bootloader-target
+                              #:follow-symlinks? #t
+                              #:log (%make-void-port "w"))
+            ;; For TFTP we need to install additional relative symlinks.
+            ;; If we install on an EFI System Partition (ESP) or some other FAT
+            ;; file-system, then symlinks cannot be created and are not needed.
+            ;; Therefore we ignore exceptions when trying.
+            ;; Prepare the symlink to the grub.cfg.
+            (mkdir-p (dirname grub-cfg-link))
+            (false-if-exception (delete-file grub-cfg-link))
+            (if (unspecified?
+                (false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
+              ;; Symlinks are supported.
+              (begin
+                ;; Prepare the symlink to the store.
+                (mkdir-p (dirname store-link))
+                (false-if-exception (delete-file store-link))
+                (symlink-relative store store-link))
+              ;; Creating symlinks does not seem to be supported.
+              ;; Probably an ESP is used.
+              ;; Instead we can script to search and load the actual grub.cfg.
+              (let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
+                     (port
+                       (open-pipe* OPEN_READ probe "--target=fs_uuid" grub-cfg))
+                     (search-root
+                       (match (read-line port)
+                         ((? eof-object?)
+                           ;; There is no UUID available. As a fallback search
+                           ;; everywhere for the grub.cfg.
+                           (string-append "search --file --set " #$grub-cfg))
+                         (fs-uuid
+                           ;; The UUID to load the grub.cfg from is known.
+                           (string-append "search --fs-uuid --set " fs-uuid))))
+                     (load-grub-cfg (string-append "configfile " #$grub-cfg)))
+                (close-pipe port)
+                (with-output-to-file grub-cfg-link
+                  (lambda ()
+                    (display (string-join (list search-root
+                                                load-grub-cfg)
+                                          "\n")))))))))))
 
 \f
 
@@ -717,7 +758,7 @@ considered for security aspects."
    (package grub)
    (installer install-grub)
    (disk-image-installer install-grub-disk-image)
-   (configuration-file "/boot/grub/grub.cfg")
+   (configuration-file grub-cfg)
    (configuration-file-generator grub-configuration-file)))
 
 (define grub-minimal-bootloader
@@ -727,17 +768,29 @@ considered for security aspects."
 
 (define grub-efi-bootloader
   (bootloader
-   (inherit grub-bootloader)
+   (name 'grub-efi)
+   (package grub-efi)
    (installer install-grub-efi)
    (disk-image-installer #f)
-   (name 'grub-efi)
-   (package grub-efi)))
+   (configuration-file grub-cfg)
+   (configuration-file-generator grub-configuration-file)))
 
-(define grub-efi-netboot-bootloader
+(define (make-grub-efi-netboot-bootloader name subdir)
   (bootloader
-   (inherit grub-efi-bootloader)
-   (name 'grub-efi-netboot-bootloader)
-   (installer (install-grub-efi-netboot "efi/Guix"))))
+   (name name)
+   (package (make-grub-efi-netboot (symbol->string name) subdir))
+   (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
+   (disk-image-installer #f)
+   (configuration-file grub-cfg)
+   (configuration-file-generator grub-efi-configuration-file)))
+
+(define grub-efi-netboot-bootloader
+  (make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
+                                    "efi/Guix"))
+
+(define grub-efi-netboot-removable-bootloader
+  (make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
+                                    "efi/boot"))
 
 (define grub-mkrescue-bootloader
   (bootloader
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 706ddf0207..601912011b 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2020, 2021 Pierre Langlois <pierre.langlois@gmx.com>
 ;;; Copyright © 2021 Vincent Legoll <vincent.legoll@gmail.com>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 Stefan <stefan-guix@vodafonemail.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -66,13 +67,17 @@
   #:use-module (gnu packages virtualization)
   #:use-module (gnu packages xorg)
   #:use-module (guix build-system gnu)
+  #:use-module (guix build-system trivial)
   #:use-module (guix download)
+  #:use-module (guix gexp)
   #:use-module (guix git-download)
   #:use-module ((guix licenses) #:prefix license:)
   #:use-module (guix packages)
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 optargs)
   #:use-module (ice-9 regex))
 
 (define unifont
@@ -366,6 +371,91 @@ menu to select one of the installed operating systems.")
                   (scandir input-dir))
                  #t)))))))))
 
+(define-public (make-grub-efi-netboot name subdir)
+  "Make a grub-efi-netboot package named NAME, which will be able to boot over
+network via TFTP by accessing its files in the SUBDIR of a TFTP root directory.
+This package is also able to boot from local storage devices.
+
+A bootloader-installer basically needs to copy the package content into the
+bootloader-target directory, which will usually be the TFTP root, as
+'grub-mknetdir' will be invoked already during the package creation.
+
+Alternatively the bootloader-target directory can be a mounted EFI System
+Partition (ESP), or a similar partition with a FAT file system, for booting
+from local storage devices.
+
+The name of the GRUB EFI binary will conform to the UEFI specification for
+removable media.  Depending on the system it will be e.g. bootx64.efi or
+bootaa64.efi below SUBDIR.
+
+The SUBDIR argument needs to be set to \"efi/boot\" to create a package which
+conforms to the UEFI specification for removable media.
+
+The SUBDIR argument defaults to \"efi/Guix\", as it is also the case for
+'grub-efi-bootloader'."
+  (package
+    (name name)
+    (version (package-version grub-efi))
+    ;; Source is not needed, but it cannot be omitted.
+    (source #f)
+    (build-system trivial-build-system)
+    (arguments
+     (let* ((system (string-split (nix-system->gnu-triplet
+                                  (or (%current-target-system)
+                                      (%current-system)))
+                                  #\-))
+            (arch (first system))
+            (boot-efi
+             (match system
+               ;; These are the supportend systems and the names defined by
+               ;; the UEFI standard for removable media.
+               (("i686" _ ...)        "/bootia32.efi")
+               (("x86_64" _ ...)      "/bootx64.efi")
+               (("arm" _ ...)         "/bootarm.efi")
+               (("aarch64" _ ...)     "/bootaa64.efi")
+               (("riscv" _ ...)       "/bootriscv32.efi")
+               (("riscv64" _ ...)     "/bootriscv64.efi")
+               ;; Other systems are not supported, although defined.
+               ;; (("riscv128" _ ...) "/bootriscv128.efi")
+               ;; (("ia64" _ ...)     "/bootia64.efi")
+               ((_ ...)               #f)))
+            (core-efi (string-append
+                       ;; This is the arch dependent file name of GRUB, e.g.
+                       ;; i368-efi/core.efi or arm64-efi/core.efi.
+                       (match arch
+                         ("i686"    "i386")
+                         ("aarch64" "arm64")
+                         ("riscv"   "riscv32")
+                         (_         arch))
+                       "-efi/core.efi")))
+       `(#:modules ((guix build utils))
+         #:builder
+         (begin
+           (use-modules (guix build utils))
+           (let* ((bootloader (assoc-ref %build-inputs "grub-efi"))
+                  (net-dir (assoc-ref %outputs "out"))
+                  (sub-dir (string-append net-dir "/" ,subdir "/"))
+                  (boot-efi (string-append sub-dir ,boot-efi))
+                  (core-efi (string-append sub-dir ,core-efi)))
+             ;; Install GRUB, which refers to the grub.cfg, with support for
+             ;; encrypted partitions,
+             (setenv "GRUB_ENABLE_CRYPTODISK" "y")
+             (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
+                           (string-append "--net-directory=" net-dir)
+                           (string-append "--subdir=" ,subdir)
+                           ;; These modules must be preloaded to allow booting
+                           ;; from an ESP or a similar partition with a FAT
+                           ;; file system.
+                           (string-append "--modules=part_msdos part_gpt fat"))
+             ;; Move GRUB's core.efi to the removable media name.
+             (false-if-exception (delete-file boot-efi))
+             (rename-file core-efi boot-efi))))))
+    (inputs `(("grub-efi" ,grub-efi)))
+    (synopsis (package-synopsis grub-efi))
+    (description (package-description grub-efi))
+    (home-page (package-home-page grub-efi))
+    (license (package-license grub-efi))))
+
 (define-public syslinux
   (let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
     (package

[-- Attachment #3: 02-build-kconfig-add-new-module --]
[-- Type: application/octet-stream, Size: 15487 bytes --]

build: kconfig: Add new module to modify a defconfig file.

From: Stefan <stefan-guix@vodafonemail.de>

* guix/build/kconfig.scm (modify-defconfig): New file with a new function.
* gnu/packages/bootloaders.scm (make-u-boot-package,
make-u-boot-sunxi64-package): Adding new key arguments to pass and/or modify
a defconfig file.
(u-boot-am335x-boneblack, u-boot-pinebook, u-boot-novena): Simplify functions
by using the new key arguments of the former functions.
* Makefile.am: Adding guix/build/kconfig.scm to MODULES.
---
 Makefile.am                  |    1 
 gnu/packages/bootloaders.scm |   87 +++++++++++--------------
 guix/build/kconfig.scm       |  148 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 186 insertions(+), 50 deletions(-)
 create mode 100644 guix/build/kconfig.scm

diff --git a/Makefile.am b/Makefile.am
index d608b08899..06cceebf07 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -221,6 +221,7 @@ MODULES =					\
   guix/build/waf-build-system.scm		\
   guix/build/haskell-build-system.scm		\
   guix/build/julia-build-system.scm		\
+  guix/build/kconfig.scm                        \
   guix/build/linux-module-build-system.scm	\
   guix/build/store-copy.scm			\
   guix/build/json.scm				\
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 601912011b..3bc5600c7c 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -733,8 +733,9 @@ def test_ctrl_c"))
 also initializes the boards (RAM etc).  This package provides its
 board-independent tools.")))
 
-(define-public (make-u-boot-package board triplet)
-  "Returns a u-boot package for BOARD cross-compiled for TRIPLET."
+(define*-public (make-u-boot-package board triplet #:key defconfig configs)
+  "Returns a u-boot package for BOARD cross-compiled for TRIPLET with the
+optional DEFCONFIG file and optional configuration changes from CONFIGS."
   (let ((same-arch? (lambda ()
                       (string=? (%current-system)
                                 (gnu-triplet->nix-system triplet)))))
@@ -752,8 +753,11 @@ board-independent tools.")))
       (arguments
        `(#:modules ((ice-9 ftw)
                     (srfi srfi-1)
-                    (guix build utils)
-                    (guix build gnu-build-system))
+                    (guix build gnu-build-system)
+                    (guix build kconfig)
+                    (guix build utils))
+         #:imported-modules (,@%gnu-build-system-modules
+                             (guix build kconfig))
          #:test-target "test"
          #:make-flags
          (list "HOSTCC=gcc"
@@ -764,9 +768,18 @@ board-independent tools.")))
          (modify-phases %standard-phases
            (replace 'configure
              (lambda* (#:key outputs make-flags #:allow-other-keys)
-               (let ((config-name (string-append ,board "_defconfig")))
-                 (if (file-exists? (string-append "configs/" config-name))
-                     (apply invoke "make" `(,@make-flags ,config-name))
+               (let* ((config-name (string-append ,board "_defconfig"))
+                      (config-file (string-append "configs/" config-name))
+                      (defconfig ,defconfig)
+                      (configs ',configs))
+                 (when defconfig
+                   ;; Replace the board-specific defconfig with the given one.
+                   (copy-file defconfig config-file))
+                 (if (file-exists? config-file)
+                     (begin
+                       (when configs
+                         (modify-defconfig config-file configs))
+                       (apply invoke "make" `(,@make-flags ,config-name)))
                      (begin
                        (display "Invalid board name. Valid board names are:"
                                 (current-error-port))
@@ -820,7 +833,11 @@ board-independent tools.")))
   (make-u-boot-package "malta" "mips64el-linux-gnuabi64"))
 
 (define-public u-boot-am335x-boneblack
-  (let ((base (make-u-boot-package "am335x_evm" "arm-linux-gnueabihf")))
+  (let ((base (make-u-boot-package "am335x_evm" "arm-linux-gnueabihf"
+               ;; Patch out other device trees to build image small enough to
+               ;; fit within typical partitioning schemes where the first
+               ;; partition begins at sector 2048.
+               #:configs '("CONFIG_OF_LIST=\"am335x-evm am335x-boneblack\""))))
     (package
       (inherit base)
       (name "u-boot-am335x-boneblack")
@@ -829,25 +846,13 @@ also initializes the boards (RAM etc).
 
 This U-Boot is built for the BeagleBone Black, which was removed upstream,
 adjusted from the am335x_evm build with several device trees removed so that
-it fits within common partitioning schemes.")
-      (arguments
-       (substitute-keyword-arguments (package-arguments base)
-         ((#:phases phases)
-          `(modify-phases ,phases
-             (add-after 'unpack 'patch-defconfig
-               ;; Patch out other devicetrees to build image small enough to
-               ;; fit within typical partitioning schemes where the first
-               ;; partition begins at sector 2048.
-               (lambda _
-                 (substitute* "configs/am335x_evm_defconfig"
-                   (("CONFIG_OF_LIST=.*$") "CONFIG_OF_LIST=\"am335x-evm am335x-boneblack\"\n"))
-                 #t)))))))))
+it fits within common partitioning schemes."))))
 
 (define-public u-boot-am335x-evm
   (make-u-boot-package "am335x_evm" "arm-linux-gnueabihf"))
 
-(define-public (make-u-boot-sunxi64-package board triplet)
-  (let ((base (make-u-boot-package board triplet)))
+(define*-public (make-u-boot-sunxi64-package board triplet #:key defconfig configs)
+  (let ((base (make-u-boot-package board triplet #:defconfig defconfig #:configs configs)))
     (package
       (inherit base)
       (arguments
@@ -877,20 +882,10 @@ it fits within common partitioning schemes.")
   (make-u-boot-sunxi64-package "pine64-lts" "aarch64-linux-gnu"))
 
 (define-public u-boot-pinebook
-  (let ((base (make-u-boot-sunxi64-package "pinebook" "aarch64-linux-gnu")))
-    (package
-      (inherit base)
-      (arguments
-       (substitute-keyword-arguments (package-arguments base)
-         ((#:phases phases)
-          `(modify-phases ,phases
-             (add-after 'unpack 'patch-pinebook-config
-               ;; Fix regression with LCD video output introduced in 2020.01
-               ;; https://patchwork.ozlabs.org/patch/1225130/
-               (lambda _
-                 (substitute* "configs/pinebook_defconfig"
-                   (("CONFIG_VIDEO_BRIDGE_ANALOGIX_ANX6345=y") "CONFIG_VIDEO_BRIDGE_ANALOGIX_ANX6345=y\nCONFIG_VIDEO_BPP32=y"))
-                 #t)))))))))
+  (make-u-boot-sunxi64-package "pinebook" "aarch64-linux-gnu"
+   ;; Fix regression with LCD video output introduced in 2020.01
+   ;; https://patchwork.ozlabs.org/patch/1225130/
+   #:configs '("CONFIG_VIDEO_BPP32=y")))
 
 (define-public u-boot-bananapi-m2-ultra
   (make-u-boot-package "Bananapi_M2_Ultra" "arm-linux-gnueabihf"))
@@ -941,25 +936,17 @@ device while it's being turned on (and a while longer).")
   (make-u-boot-package "mx6cuboxi" "arm-linux-gnueabihf"))
 
 (define-public u-boot-novena
-  (let ((base (make-u-boot-package "novena" "arm-linux-gnueabihf")))
+  (let ((base (make-u-boot-package "novena" "arm-linux-gnueabihf"
+               ;; Patch configuration to disable loading u-boot.img from FAT
+               ;; partition, allowing it to be installed at a device offset.
+               #:configs '("CONFIG_SPL_FS_FAT="))))
     (package
       (inherit base)
       (description "U-Boot is a bootloader used mostly for ARM boards. It
 also initializes the boards (RAM etc).
 
 This U-Boot is built for Novena.  Be advised that this version, contrary
-to Novena upstream, does not load u-boot.img from the first partition.")
-      (arguments
-       (substitute-keyword-arguments (package-arguments base)
-         ((#:phases phases)
-          `(modify-phases ,phases
-             (add-after 'unpack 'patch-novena-defconfig
-               ;; Patch configuration to disable loading u-boot.img from FAT partition,
-               ;; allowing it to be installed at a device offset.
-               (lambda _
-                 (substitute* "configs/novena_defconfig"
-                   (("CONFIG_SPL_FS_FAT=y") "# CONFIG_SPL_FS_FAT is not set"))
-                 #t)))))))))
+to Novena upstream, does not load u-boot.img from the first partition."))))
 
 (define-public u-boot-cubieboard
   (make-u-boot-package "Cubieboard" "arm-linux-gnueabihf"))
diff --git a/guix/build/kconfig.scm b/guix/build/kconfig.scm
new file mode 100644
index 0000000000..09ddf59dd0
--- /dev/null
+++ b/guix/build/kconfig.scm
@@ -0,0 +1,148 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build kconfig)
+  #:use-module  (ice-9 rdelim)
+  #:use-module  (ice-9 regex)
+  #:use-module  (srfi srfi-1)
+  #:use-module  (srfi srfi-26)
+  #:export (modify-defconfig))
+
+;; Commentary:
+;;
+;; Builder-side code to modify configurations for the Kconfig build system as
+;; used by Linux and U-Boot.
+;;
+;; Code:
+
+(define (modify-defconfig defconfig configs)
+  "This function can modify a given DEFCONFIG file by adding, changing or
+removing the list of strings in CONFIGS.  This allows an easy customization of
+Kconfig based projects like the kernel Linux or the bootloader 'Das U-Boot'.
+
+These are examples for CONFIGS to add or change or remove
+configurations to/from DEFCONFIG:
+
+'(\"CONFIG_A=\\\"a\\\"\"
+  \"CONFIG_B=0\"
+  \"CONFIG_C=y\"
+  \"CONFIG_D=m\"
+  \"CONFIG_E=\"
+  \"CONFIG_F\"
+  \"# CONFIG_G is not set\")
+
+Instead of a list, CONFGIS can be a string with one configuration per line."
+  (define config-rx
+    (make-regexp
+     ;; (match:substring (string-match "=(.*)" "=") 1) returns "", but the
+     ;; pattern "=(.+)?" makes it return #f instead.  For a "CONFIG_A=" we like
+     ;; to get #f, which as a value emits "# … is not set".
+     "^(#[\\t ]*)?(CONFIG_[A-Z0-9_]+)([\\t ]*=[\\t ]*(.+)?|([\\t ]+is[\\t ]+not[\\t ]+set))?$"))
+
+  (define (config-string->pair config-string)
+    "Parse a config-string like \"CONFIG_EXAMPLE=y\" into a key-value pair.
+Spaces get trimmed.
+\"CONFIG_A=y\"            -> '(\"CONFIG_A\" . \"y\")
+\"CONFIG_B=\\\"\\\"\"         -> '(\"CONFIG_B\" . \"\\\"\\\"\")
+\"CONFIG_C=\"             -> '(\"CONFIG_C\" . #f)
+\"CONFIG_D\"              -> '(\"CONFIG_D\" . #f)
+\"# CONFIG_E is not set\" -> '(\"CONFIG_E\" . #f)
+\"# Anything else\"       -> '(\"# Anything else\" . \"\")"
+    (let ((match (regexp-exec config-rx (string-trim-both config-string))))
+      (if (not match)
+          ;; This is some unparsable config-string.
+          ;; We keep it as it is.
+          (cons config-string "")
+          (let* ((comment (match:substring match 1))
+                 (key (match:substring match 2))
+                 (unset (match:substring match 5))
+                 (value (and (not comment)
+                             (not unset)
+                             (match:substring match 4))))
+            (if (or (and comment (not unset))
+                    (and (not comment) unset))
+                ;; This is just some comment or strange line, which we keep as is.
+                (cons config-string "")
+                (cons key value))))))
+
+  (define (pair->config-string pair)
+    "Convert a PAIR back to a config-string."
+    (let* ((key (car pair))
+           (value (cdr pair)))
+      (if (string? value)
+          (if (string-null? value)
+              key
+              (string-append key "=" value))
+          (string-append "# " key " is not set"))))
+
+  (define (remove-pair pair blacklist)
+    "Turn a key-value PAIR into '("" . ""), if its key is listed in BLACKLIST."
+    (let* ((key (first pair)))
+      (if (member key blacklist)
+          '("" . "")
+          pair)))
+
+  (define (remove-config-string config-string blacklist)
+    "Remove the CONFIG-STRING, if its key is listed in BLACKLIST."
+    (pair->config-string (remove-pair (config-string->pair config-string)
+                                       blacklist)))
+
+  (define* (write-lines input #:key (line-modifier identity))
+    "Write all lines from the INPUT after applying the LINE-MODIFIER to the
+ current-output-port."
+    (let loop ((line (read-line input)))
+      (when (not (eof-object? line))
+        (display (line-modifier line))
+        (newline)
+        (loop (read-line input)))))
+
+  (let* ((modified-defconfig (string-append defconfig ".mod"))
+         ;; Split the configs into a list of single configuations.
+         ;; To minimize mistakes, we support a string and a list of strings,
+         ;; each with newlines to separate configurations.
+         (config-list (fold-right append '()
+                                  (map (lambda (s)
+                                         (string-split s #\newline))
+                                       (if (string? configs)
+                                           (list configs)
+                                           configs))))
+         ;; Generate key-value pairs from the config-list.
+         (pairs (map (lambda (config-string)
+                       (config-string->pair config-string))
+                     config-list))
+         ;; Generate a blacklist of config keys from pairs.
+         (blacklist (map (lambda (config-pair)
+                           (first config-pair))
+                         pairs))
+         (remove-config-string (cut remove-config-string <> blacklist)))
+    ;; Write to the modified-defconfig file first the content of the defconfig
+    ;; file with removed lines, and afterwards the configs.
+    (call-with-output-file modified-defconfig
+      (lambda (output)
+        (with-output-to-port output
+          (lambda ()
+            (call-with-input-file defconfig
+              (lambda (input)
+                (write-lines input #: line-modifier remove-config-string)))
+            (call-with-input-string
+              (string-join (map pair->config-string pairs) "\n")
+              (lambda (input)
+                (write-lines input)))))))
+    ;; Ensure the modified-defconfig file is used.
+    (delete-file defconfig)
+    (rename-file modified-defconfig defconfig)))

[-- Attachment #4: 03-gnu-bootloader-add-u-boot --]
[-- Type: application/octet-stream, Size: 8452 bytes --]

gnu: bootloader: Add U-Boot packages for Raspberry Pi models.

From: Stefan <stefan-guix@vodafonemail.de>

* gnu/packages/bootloader.scm (make-u-boot-package): Add keyword
parameters 'name' and 'description'.
(make-preinstalled-u-boot-package): New function to make minimal packages.
(%u-boot-rpi-efi-configs): New helper list with config strings.
(%u-boot-rpi-description-32-bit, %u-boot-rpi-description-64-bit,
%u-boot-rpi-efi-description, %u-boot-rpi-efi-description-32-bit): New helper
strings.
(u-boot-rpi-0-w, u-boot-rpi, u-boot-rpi-2, u-boot-rpi-3, u-boot-rpi-4,
u-boot-rpi-64, u-boot-rpi-0-w-efi, u-boot-rpi-efi, u-boot-rpi-2-efi,
u-boot-rpi-3-efi, u-boot-rpi-4-efi, u-boot-rpi-efi-64): New packages.
---
 gnu/packages/bootloaders.scm |  172 +++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 168 insertions(+), 4 deletions(-)

diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 3bc5600c7c..5121f3a6ea 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -733,17 +733,30 @@ def test_ctrl_c"))
 also initializes the boards (RAM etc).  This package provides its
 board-independent tools.")))
 
-(define*-public (make-u-boot-package board triplet #:key defconfig configs)
+(define*-public (make-u-boot-package board
+                                     triplet
+                                     #:key
+                                     defconfig
+                                     configs
+                                     name
+                                     description)
   "Returns a u-boot package for BOARD cross-compiled for TRIPLET with the
-optional DEFCONFIG file and optional configuration changes from CONFIGS."
+optional DEFCONFIG file and optional configuration changes from CONFIGS.
+Either NAME, if used, or otherwise BOARD will be part of the package name.
+DESCRIPTION will be appended to the package description."
   (let ((same-arch? (lambda ()
                       (string=? (%current-system)
                                 (gnu-triplet->nix-system triplet)))))
     (package
       (inherit u-boot)
       (name (string-append "u-boot-"
-                           (string-replace-substring (string-downcase board)
-                                                     "_" "-")))
+                           (string-replace-substring
+                            (string-downcase (or name board))
+                            "_" "-")))
+      (description (if description
+                       (string-append (package-description u-boot)
+                                      "\n" description)
+                       (package-description u-boot)))
       (native-inputs
        `(,@(if (not (same-arch?))
              `(("cross-gcc" ,(cross-gcc triplet))
@@ -1071,6 +1084,157 @@ to Novena upstream, does not load u-boot.img from the first partition."))))
        `(("firmware" ,arm-trusted-firmware-rk3399)
          ,@(package-native-inputs base))))))
 
+(define*-public (make-preinstalled-u-boot-package board
+                                                  triplet
+                                                  #:key
+                                                  defconfig
+                                                  configs
+                                                  name
+                                                  description
+                                                  (u-boot-file "u-boot.bin"))
+  "Returns a package with a single U-BOOT-FILE for BOARD cross-compiled for
+TRIPLET with the optional DEFCONFIG file and optional configuration changes
+from CONFIGS.  Either NAME, if used, or otherwise BOARD will be part of the
+package name.  DESCRIPTION will be appended to the package description."
+  (let* ((name-suffix "-complete")
+         (u-boot-package (make-u-boot-package board
+                                              triplet
+                                              #:defconfig defconfig
+                                              #:configs configs
+                                              #:name (string-append
+                                                      (or name board)
+                                                      name-suffix)
+                                              #:description description)))
+    (package
+      (name (string-drop-right (package-name u-boot-package)
+                               (string-length name-suffix)))
+      (version (package-version u-boot-package))
+      (source #f)
+      (build-system trivial-build-system)
+      (arguments
+       `(#:builder
+         (begin
+           (let ((out (assoc-ref %outputs "out")))
+             (mkdir out)
+             (symlink (string-append (assoc-ref %build-inputs "u-boot")
+                                   "/libexec/"
+                                   ,u-boot-file)
+                      (string-append out "/" ,u-boot-file))))))
+      (inputs `(("u-boot" ,u-boot-package)))
+      (home-page (package-home-page u-boot-package))
+      (synopsis (package-synopsis u-boot-package))
+      (description (package-description u-boot-package))
+      (license (package-license u-boot-package)))))
+
+(define-public %u-boot-rpi-efi-configs
+  '("CONFIG_OF_EMBED="
+    "CONFIG_OF_BOARD=y"
+    "CONFIG_BOOTDELAY=0"))
+
+(define %u-boot-rpi-description-32-bit
+  "This is a 32-bit build of U-Boot.")
+
+(define %u-boot-rpi-description-64-bit
+  "This is a common 64-bit build of U-Boot for all 64-bit capable Raspberry Pi
+variants.")
+
+(define %u-boot-rpi-efi-description
+  "It allows network booting and uses the device-tree from the firmware,
+allowing the usage of overlays.  It can act as an EFI firmware for the
+grub-efi-netboot-removable-bootloader.")
+
+(define %u-boot-rpi-efi-description-32-bit
+  (string-append %u-boot-rpi-efi-description "  "
+                 %u-boot-rpi-description-32-bit))
+
+(define-public u-boot-rpi-0-w
+  (make-preinstalled-u-boot-package
+   "rpi_0_w"
+   "arm-linux-gnueabihf"
+   #:description %u-boot-rpi-description-32-bit))
+
+(define-public u-boot-rpi
+  (make-preinstalled-u-boot-package
+   "rpi"
+   "arm-linux-gnueabihf"
+   #:description %u-boot-rpi-description-32-bit))
+
+(define-public u-boot-rpi-2
+  (make-preinstalled-u-boot-package
+   "rpi_2"
+   "arm-linux-gnueabihf"
+   #:description %u-boot-rpi-description-32-bit))
+
+(define-public u-boot-rpi-3
+  (make-preinstalled-u-boot-package
+   "rpi_3_32b"
+   "arm-linux-gnueabihf"
+   #:name "rpi-3"
+   #:description %u-boot-rpi-description-32-bit))
+
+(define-public u-boot-rpi-4
+  (make-preinstalled-u-boot-package
+   "rpi_4_32b"
+   "arm-linux-gnueabihf"
+   #:name "rpi-4"
+   #:description %u-boot-rpi-description-32-bit))
+
+(define-public u-boot-rpi-64
+  (make-preinstalled-u-boot-package
+   "rpi_arm64"
+   "aarch64-linux-gnu"
+   #:name "rpi-64"
+   #:description %u-boot-rpi-description-64-bit))
+
+(define-public u-boot-rpi-0-w-efi
+  (make-preinstalled-u-boot-package
+   "rpi_0_w"
+   "arm-linux-gnueabihf"
+   #:name "rpi-0-w-efi"
+   #:configs %u-boot-rpi-efi-configs
+   #:description %u-boot-rpi-efi-description-32-bit))
+
+(define-public u-boot-rpi-efi
+  (make-preinstalled-u-boot-package
+   "rpi"
+   "arm-linux-gnueabihf"
+   #:name "rpi-efi"
+   #:configs %u-boot-rpi-efi-configs
+   #:description %u-boot-rpi-efi-description-32-bit))
+
+(define-public u-boot-rpi-2-efi
+  (make-preinstalled-u-boot-package
+   "rpi_2"
+   "arm-linux-gnueabihf"
+   #:name "rpi-2-efi"
+   #:configs %u-boot-rpi-efi-configs
+   #:description %u-boot-rpi-efi-description-32-bit))
+
+(define-public u-boot-rpi-3-efi
+  (make-preinstalled-u-boot-package
+   "rpi_3_32b"
+   "arm-linux-gnueabihf"
+   #:name "rpi-3-efi"
+   #:configs %u-boot-rpi-efi-configs
+   #:description %u-boot-rpi-efi-description-32-bit))
+
+(define-public u-boot-rpi-4-efi
+  (make-preinstalled-u-boot-package
+   "rpi_4_32b"
+   "arm-linux-gnueabihf"
+   #:name "rpi-4-efi"
+   #:configs %u-boot-rpi-efi-configs
+   #:description %u-boot-rpi-efi-description-32-bit))
+
+(define-public u-boot-rpi-efi-64
+  (make-preinstalled-u-boot-package
+   "rpi_arm64"
+   "aarch64-linux-gnu"
+   #:name "rpi-efi-64"
+   #:configs %u-boot-rpi-efi-configs
+   #:description (string-append %u-boot-rpi-efi-description "  "
+                                %u-boot-rpi-description-64-bit)))
+
 (define-public vboot-utils
   (package
     (name "vboot-utils")

[-- Attachment #5: 04-gnu-linux-new-function-to --]
[-- Type: application/octet-stream, Size: 8577 bytes --]

gnu: linux: New function to modify the configuration of a Linux kernel.

From: Stefan <stefan-guix@vodafonemail.de>

* gnu/packages/linux.scm (system->linux-srcarch): New function to return the
relevent folder name below arch/ in the Linux source code.
(make-linux-libre*) ['set-environment]: Splitted this new phase out of and
adding it before …
['configure]: … to allow a replacement and reuse from (modify-linux).
(modify-linux): New function to make a customized Linux package inherited
from another Linux package, which will be build with an own defconfig or
configuration changes.
(make-defconfig): Function to get a defconfig from an uri.
---
 gnu/packages/linux.scm |  130 +++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 127 insertions(+), 3 deletions(-)

diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index f4c1867c5d..d8ff747d20 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -53,6 +53,7 @@
 ;;; Copyright © 2021 B. Wilson <elaexuotee@wilsonb.com>
 ;;; Copyright © 2021 Ivan Gankevich <i.gankevich@spbu.ru>
 ;;; Copyright © 2021 Olivier Dion <olivier.dion@polymtl.ca>
+;;; Copyright © 2021 Stefan <stefan-guix@vodafonemail.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -166,6 +167,7 @@
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 optargs)
   #:use-module (ice-9 regex))
 
 (define-public (system->linux-architecture arch)
@@ -182,6 +184,21 @@
           ((string-prefix? "riscv" arch) "riscv")
           (else arch))))
 
+(define-public (system->linux-srcarch arch)
+  "Return for a Guix system ARCH name the SRCARCH name, which is set in the
+toplevel Makefile of Linux and denotes the architecture specific directory name
+below arch/ in its source code.  Some few architectures share a common folder.
+It resembles the definition of SRCARCH based on ARCH in the Makefile and may
+be used to place a defconfig file in the proper path."
+  (let ((linux-arch (system->linux-architecture arch)))
+    (match linux-arch
+      ("i386"    "x86")
+      ("x86_64"  "x86")
+      ("sparc32" "sparc")
+      ("sparc64" "sparc")
+      ("sh64"    "sh")
+      (_         linux-arch))))
+
 (define-public (system->defconfig system)
   "Some systems (notably powerpc-linux) require a special target for kernel
 defconfig.  Return the appropriate make target if applicable, otherwise return
@@ -811,8 +828,8 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
              (substitute* (find-files "." "^Makefile(\\.include)?$")
                (("/bin/pwd") "pwd"))
              #t))
-         (replace 'configure
-           (lambda* (#:key inputs native-inputs target #:allow-other-keys)
+         (add-before 'configure 'set-environment
+           (lambda* (#:key target #:allow-other-keys)
              ;; Avoid introducing timestamps
              (setenv "KCONFIG_NOTIMESTAMP" "1")
              (setenv "KBUILD_BUILD_TIMESTAMP" (getenv "SOURCE_DATE_EPOCH"))
@@ -831,7 +848,9 @@ for ARCH and optionally VARIANT, or #f if there is no such configuration."
 
              (setenv "EXTRAVERSION" ,(and extra-version
                                           (string-append "-" extra-version)))
-
+             #t))
+         (replace 'configure
+           (lambda* (#:key inputs native-inputs #:allow-other-keys)
              (let ((build  (assoc-ref %standard-phases 'build))
                    (config (assoc-ref (or native-inputs inputs) "kconfig")))
 
@@ -1163,6 +1182,111 @@ It has been modified to remove all non-free binary blobs.")
       (inherit base-linux-libre)
       (inputs `(("cpio" ,cpio) ,@(package-inputs base-linux-libre))))))
 
+\f
+;;;
+;;; Linux kernel customization functions.
+;;;
+
+(define*-public (modify-linux #:key name
+                                    (linux linux-libre)
+                                    source
+                                    defconfig
+                                    (configs "")
+                                    extra-version)
+  "Make a Linux package NAME as a modification of another LINUX package.
+
+If NAME is not given, then it defaults to the same name as the LINUX package.
+
+Unless SOURCE is given the source of LINUX is used.
+
+A DEFCONFIG file to be used can be given as a package, as a file like object
+(file-append, local-file etc.), or as a string with the name of a defconfig file
+available in the Linux sources.  If DEFCONFIG is not given, then a defconfig
+file will be saved from the LINUX package configuration.
+
+Additional CONFIGS will be used to modify the given or saved defconfig, which
+will finally be used to build Linux.
+
+CONFIGS can be a list of strings, with one configuration per line.  The usual
+defconfig syntax has to be used, but there is a special extension to ease the
+removal of configurations.  Comment lines are supported as well.
+
+Here is an explaining usage example:
+
+  '(;; This string defines the version tail in 'uname -r'.
+    \"CONFIG_LOCALVERSION=\\\"-handcrafted\\\"
+    ;; This '# CONFIG_… is not set' syntax has to match exactly!
+    \"# CONFIG_BOOT_CONFIG is not set\"
+    \"CONFIG_NFS_SWAP=y\"
+    ;; This is a multiline configuration:
+    \"CONFIG_E1000=y
+# This is a comment, below follow two special removal extensions:
+CONFIG_CMDLINE_EXTEND
+CONFIG_CMDLINE_FORCE=\")
+
+A string of configurations instead of a list of configuration strings is also
+possible.
+
+EXTRA-VERSION can be a string overwriting the EXTRAVERSION setting of the LINUX
+package, after being prepended by a hyphen.  It will be visible in the output
+of 'uname -r' behind the Linux version numbers."
+  (package
+    (inherit linux)
+    (name (or name (package-name linux)))
+    (source (or source (package-source linux)))
+    (arguments
+     (substitute-keyword-arguments
+         (package-arguments linux)
+       ((#:imported-modules imported-modules %gnu-build-system-modules)
+        `((guix build kconfig) ,@imported-modules))
+       ((#:modules modules)
+        `((guix build kconfig) ,@modules))
+       ((#:phases phases)
+        `(modify-phases ,phases
+           (replace 'configure
+             (lambda* (#:key inputs #:allow-other-keys #:rest arguments)
+               (let* ((srcarch
+                       ,(system->linux-srcarch (or (%current-target-system)
+                                                   (%current-system))))
+                      (configs (string-append "arch/" srcarch "/configs/"))
+                      (guix_defconfig (string-append configs "guix_defconfig")))
+                 ,(cond
+                   ((not defconfig)
+                    `(begin
+                       ;; Call the original 'configure phase.
+                       (apply (assoc-ref ,phases 'configure) arguments)
+                       ;; Save a defconfig file.
+                       (invoke "make" "savedefconfig")
+                       ;; Move the saved defconfig to the proper location.
+                       (rename-file "defconfig"
+                                    guix_defconfig)))
+                   ((string? defconfig)
+                    ;; Use another existing defconfig from the Linux sources.
+                    `(rename-file (string-append configs ,defconfig)
+                                  guix_defconfig))
+                   (else
+                    ;; Copy the defconfig input to the proper location.
+                    '(copy-file (assoc-ref inputs "guix_defconfig")
+                                guix_defconfig)))
+                 (modify-defconfig guix_defconfig ',configs)
+                 ,@(if extra-version
+                       `((setenv "EXTRAVERSION"
+                                 ,(string-append "-" extra-version)))
+                       '())
+                 (invoke "make" "guix_defconfig"))
+               #t))))))
+    (native-inputs
+     (append (if (or (not defconfig)
+                     (string? defconfig))
+                 '()
+                 ;; The defconfig should be a package or file-like object.
+                 `(("guix_defconfig" ,defconfig)))
+             (package-native-inputs linux)))))
+
+(define-public (make-defconfig uri sha256-as-base32)
+  (origin (method url-fetch)
+          (uri uri)
+          (sha256 (base32 sha256-as-base32))))
 
 \f
 ;;;

[-- Attachment #6: 05-gnu-raspberry-pi-add-defconfig --]
[-- Type: application/octet-stream, Size: 3217 bytes --]

gnu: raspberry-pi: Add defconfig objects to build customized Linux kernels.

From: Stefan <stefan-guix@vodafonemail.de>

gnu/packages/raspberry-pi.scm (make-raspi-defconig): New function to make
downloaded defconfig objects from the Linux repository of the Raspberry Pi
Foundation.
(%bcm2709-defconfig, %bcm2710-defconfig, %bcm2711-defconfig,
%bcm2835-defconfig, %bcmrpi-defconfig, %bcm2711-defconfig-64,
%bcmrpi3-defconfig): New variables containing defconfig objects to build
Linux kernels customized for Raspberry Pi single board computers.
---
 gnu/packages/raspberry-pi.scm |   44 ++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 43 insertions(+), 1 deletion(-)

diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index bb38b8b218..a2ab300531 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2021 Stefan <stefan-guix@vodafonemail.de>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,9 +26,10 @@
   #:use-module (gnu packages commencement)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages documentation)
+  #:use-module (gnu packages embedded)
   #:use-module (gnu packages file)
   #:use-module (gnu packages gcc)
-  #:use-module (gnu packages embedded)
+  #:use-module (gnu packages linux)
   #:use-module (guix build-system gnu)
   #:use-module (guix download)
   #:use-module (guix git-download)
@@ -235,3 +237,43 @@ Raspberry Pi.  Note: It does not work on Raspberry Pi 1.")
                (install-file "arm64.bin" libexec)
                #t))))))))
     (supported-systems '("aarch64-linux"))))
+
+(define (make-raspi-defconfig arch defconfig sha256-as-base32)
+  "Make for the architecture ARCH a file-like object from the DEFCONFIG file
+with the hash SHA256-AS-BASE32.  This object can be used as the #:defconfig
+argument of the function (modify-linux)."
+  (make-defconfig
+   (string-append
+    "https://raw.githubusercontent.com/raspberrypi/linux/raspberrypi-kernel_1.20210430-1/arch/"
+    arch "/configs/" defconfig)
+   sha256-as-base32))
+
+(define-public %bcm2709-defconfig
+  (make-raspi-defconfig
+   "arm" "bcm2709_defconfig"
+   "0yvrmid2jakl929d1mv00gidnqbf91ffhj61c9gl75f7km48811c"))
+
+(define-public %bcm2711-defconfig
+  (make-raspi-defconfig
+   "arm" "bcm2711_defconfig"
+   "19hb6nwna7sk3b4rn5yjfhldrs3c1lv24q08w4gpa4xzh1byv7jj"))
+
+(define-public %bcm2835-defconfig
+  (make-raspi-defconfig
+   "arm" "bcm2835_defconfig"
+   "17dmvabqvxwqn6lgv1x8rfh2wqf1r2xmm10nkdnrgwkmgv8bh2d5"))
+
+(define-public %bcmrpi-defconfig
+  (make-raspi-defconfig
+   "arm" "bcmrpi_defconfig"
+   "0lcmr6nxdd53m3k8hqb5k6c5b7vbdgmfvcliqyl95snp45rxjjkw"))
+
+(define-public %bcm2711-defconfig-64
+  (make-raspi-defconfig
+   "arm64" "bcm2711_defconfig"
+   "0xf38nczwinr0j8vhsn8nd8h4ysjn77xphg7xnssz04gclb7fndr"))
+
+(define-public %bcmrpi3-defconfig
+  (make-raspi-defconfig
+   "arm64" "bcmrpi3_defconfig"
+   "01k098snd7kbmhz68j93mj2fwp39c56g9r8rgaw17js5r0w0zbhy"))

[-- Attachment #7: 06-gnu-raspberry-pi-add-helpers --]
[-- Type: application/octet-stream, Size: 3018 bytes --]

gnu: raspberry-pi: Add helpers for config.txt file generation.

From: Stefan <stefan-guix@vodafonemail.de>

* gnu/packages/raspberry-pi.scm (raspi-config-file, raspi-custom-txt):
New functions.
(%raspi-config-txt, %raspi-bcm27-dtb-txt, %raspi-bcm28-dtb-txt
%raspi-u-boot-bootloader-txt): New variables.
---
 gnu/packages/raspberry-pi.scm |   53 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)

diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index a2ab300531..0707516f72 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -238,6 +238,59 @@ Raspberry Pi.  Note: It does not work on Raspberry Pi 1.")
                #t))))))))
     (supported-systems '("aarch64-linux"))))
 
+(define-public (raspi-config-file name content)
+  "Make a configuration file like config.txt for the Raspberry Pi firmware.
+CONTENT can be a list of strings, which are concatenated with a newline
+character.  Alternatively CONTENT can be a string with the full file content."
+  (plain-file
+   name
+   (if (list? content)
+       (string-join content "\n" 'suffix)
+       content)))
+
+(define-public %raspi-config-txt
+  ;; A config.txt file to start the ARM cores up in 64-bit mode if necessary
+  ;; and to include a dtb.txt, bootloader.txt, and a custom.txt, each with
+  ;; separated configurations for the Raspberry Pi firmware.
+  (raspi-config-file
+   "config.txt"
+   `("# See https://www.raspberrypi.org/documentation/configuration/config-txt/README.md for details."
+     ""
+     ,(string-append "arm_64bit=" (if (target-aarch64?) "1" "0"))
+     "include dtb.txt"
+     "include bootloader.txt"
+     "include custom.txt")))
+
+(define-public %raspi-bcm27-dtb-txt
+  ;; A dtb.txt file to be included by the config.txt to ensure that the
+  ;; downstream device tree files bcm27*.dtb will be used.
+  (raspi-config-file
+   "dtb.txt"
+   "upstream_kernel=0"))
+
+(define-public %raspi-bcm28-dtb-txt
+  ;; A dtb.txt file to be included by the config.txt to ensure that the
+  ;; upstream device tree files bcm28*.dtb will be used.
+  ;; This also implies the use of the dtoverlay=upstream.
+  (raspi-config-file
+   "dtb.txt"
+   "upstream_kernel=1"))
+
+(define-public %raspi-u-boot-bootloader-txt
+  ;; A bootloader.txt file to be included by the config.txt to load the
+  ;; U-Boot bootloader.
+  (raspi-config-file
+   "bootloader.txt"
+   '("dtoverlay=upstream"
+     "enable_uart=1"
+     "kernel=u-boot.bin")))
+
+(define-public (raspi-custom-txt content)
+  "Make a custom.txt file for the Raspberry Pi firmware.
+CONTENT can be a list of strings, which are concatenated with a newline
+character.  Alternatively CONTENT can be a string with the full file content."
+  (raspi-config-file "custom.txt" content))
+
 (define (make-raspi-defconfig arch defconfig sha256-as-base32)
   "Make for the architecture ARCH a file-like object from the DEFCONFIG file
 with the hash SHA256-AS-BASE32.  This object can be used as the #:defconfig

[-- Attachment #8: 07-gnu-raspberry-pi-new-function --]
[-- Type: application/octet-stream, Size: 2078 bytes --]

gnu: raspberry-pi: New function to make a package with device-tree files.

From: Stefan <stefan-guix@vodafonemail.de>

* gnu/packages/raspberry-pi.scm (make-raspi-bcm28-dtbs): New function to make
a package with device-tree files for Raspberry Pi models from the kernel given
as argument.
---
 gnu/packages/raspberry-pi.scm |   21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index 0707516f72..d808f61ac2 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -30,6 +30,7 @@
   #:use-module (gnu packages file)
   #:use-module (gnu packages gcc)
   #:use-module (gnu packages linux)
+  #:use-module (guix build-system copy)
   #:use-module (guix build-system gnu)
   #:use-module (guix download)
   #:use-module (guix git-download)
@@ -291,6 +292,26 @@ CONTENT can be a list of strings, which are concatenated with a newline
 character.  Alternatively CONTENT can be a string with the full file content."
   (raspi-config-file "custom.txt" content))
 
+(define-public (make-raspi-bcm28-dtbs linux)
+  "Make a package with the device-tree files for Raspberry Pi models from the
+kernel LINUX."
+  (package
+    (inherit linux)
+    (name "raspi-bcm28-dtbs")
+    (source #f)
+    (build-system copy-build-system)
+    (arguments
+     `(#:phases (modify-phases %standard-phases (delete 'unpack))
+       #:install-plan
+       (list (list (string-append (assoc-ref %build-inputs "linux")
+                                  "/lib/dtbs/broadcom/")
+                   "." #:include-regexp '("/bcm....-rpi.*\\.dtb")))))
+    (inputs `(("linux" ,linux)))
+    (synopsis "Device-tree files for a Raspberry Pi")
+    (description
+     (simple-format #f "The device-tree files for Raspberry Pi models from ~a."
+             (package-name linux)))))
+
 (define (make-raspi-defconfig arch defconfig sha256-as-base32)
   "Make for the architecture ARCH a file-like object from the DEFCONFIG file
 with the hash SHA256-AS-BASE32.  This object can be used as the #:defconfig

[-- Attachment #9: 08-gnu-raspberry-pi-add-a --]
[-- Type: application/octet-stream, Size: 9951 bytes --]

gnu: raspberry-pi: Add a bootloader-chain for the Raspberry Pi and os examples.

From: Stefan <stefan-guix@vodafonemail.de>

* gnu/packages/raspberry-pi.scm (grub-efi-bootloader-chain-raspi-64): New
bootloader variable, capable to boot a Raspberry Pi over network or from a
local storage.
* gnu/system/examples/raspberry-pi-64.tmpl: New operating-system example.
* gnu/system/examples/raspberry-pi-64-nfs-root.tmpl: New operating-system
example for booting over network.
---
 gnu/packages/raspberry-pi.scm                     |   19 +++++
 gnu/system/examples/raspberry-pi-64-nfs-root.tmpl |   73 ++++++++++++++++++++
 gnu/system/examples/raspberry-pi-64.tmpl          |   77 +++++++++++++++++++++
 3 files changed, 169 insertions(+)
 create mode 100644 gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
 create mode 100644 gnu/system/examples/raspberry-pi-64.tmpl

diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index d808f61ac2..d52a4a72c5 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -18,11 +18,14 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu packages raspberry-pi)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu bootloader grub)
   #:use-module (gnu packages)
   #:use-module (gnu packages admin)
   #:use-module (gnu packages algebra)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages bootloaders)
   #:use-module (gnu packages commencement)
   #:use-module (gnu packages cross-base)
   #:use-module (gnu packages documentation)
@@ -312,6 +315,22 @@ kernel LINUX."
      (simple-format #f "The device-tree files for Raspberry Pi models from ~a."
              (package-name linux)))))
 
+(define-public grub-efi-bootloader-chain-raspi-64
+  ;; A bootloader capable to boot a Raspberry Pi over network via TFTP or from
+  ;; a local storage like a micro SD card.
+  ;; It neither installs firmware nor device-tree files for the Raspberry Pi.
+  ;; It just assumes them to be existing in boot/efi in the same way that some
+  ;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
+  ;; It creates firmware configuration files and a bootloader-chain with U-Boot
+  ;; to provide an EFI API for the final GRUB bootloader.
+  ;; It also serves as a blue-print to create an own bootloader-chain with
+  ;; firmwre and device-tree packages or files.
+  (efi-bootloader-chain grub-efi-netboot-removable-bootloader
+                        #:packages (list u-boot-rpi-efi-64)
+                        #:files (list %raspi-config-txt
+                                      %raspi-bcm27-dtb-txt
+                                      %raspi-u-boot-bootloader-txt)))
+
 (define (make-raspi-defconfig arch defconfig sha256-as-base32)
   "Make for the architecture ARCH a file-like object from the DEFCONFIG file
 with the hash SHA256-AS-BASE32.  This object can be used as the #:defconfig
diff --git a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
new file mode 100644
index 0000000000..a1e41e3399
--- /dev/null
+++ b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
@@ -0,0 +1,73 @@
+;; This is an operating-system configuration template of a
+;; 64-bit minimal system for a Raspberry Pi with an NFS root file-system.
+
+;; It neither installs firmware nor device-tree files for the Raspberry Pi.
+;; It just assumes them to be existing in boot/efi in the same way that some
+;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
+
+;; It expects the boot/efi directory to be served via TFTP and the root
+;; file-system to be served via NFS. See the grub-efi-netboot-bootloader
+;; description in the manual for more details.
+
+(use-modules (gnu)
+             (gnu artwork)
+             (gnu system nss))
+(use-service-modules admin
+                     avahi
+                     networking
+                     ssh)
+(use-package-modules certs
+                     linux
+                     raspberry-pi
+                     ssh)
+
+(define %my-public-key
+  (local-file (string-append (getenv "HOME") "/.ssh/id_ecdsa.pub")))
+
+(define-public raspberry-pi-64-nfs-root
+  (operating-system
+   (host-name "raspberrypi-guix")
+   (timezone "Europe/Berlin")
+   (bootloader (bootloader-configuration
+                (bootloader grub-efi-bootloader-chain-raspi-64)
+                (target "/boot/efi")
+                (theme (grub-theme (resolution '(1920 . 1080))
+                       (image (file-append
+                               %artwork-repository
+                               "/grub/GuixSD-fully-black-16-9.svg"))))))
+   (kernel-arguments '("ip=dhcp"))
+   (kernel (modify-linux #:linux linux-libre-arm64-generic
+                         #:extra-version "arm64-generic-netboot"
+                         #:configs '("CONFIG_NFS_SWAP=y"
+                                     "CONFIG_USB_USBNET=y"
+                                     "CONFIG_USB_LAN78XX=y"
+                                     "CONFIG_USB_NET_SMSC95XX=y")))
+   (initrd-modules '())
+   (file-systems (cons* (file-system
+                         (mount-point "/")
+                         (type "nfs")
+                         (device ":/export/raspberrypi/guix")
+                         (options "addr=10.20.30.40,vers=4.1"))
+                        %base-file-systems))
+   (swap-devices '("/run/swapfile"))
+   (users (cons* (user-account
+                  (name "pi")
+                  (group "users")
+                  (supplementary-groups '("wheel" "netdev" "audio" "video"))
+                  (home-directory "/home/pi"))
+                 %base-user-accounts))
+   (packages (cons* nss-certs
+                    openssh
+                    %base-packages))
+   (services (cons* (service avahi-service-type)
+                    (service dhcp-client-service-type)
+                    (service ntp-service-type)
+                    (service openssh-service-type
+                             (openssh-configuration
+                              (x11-forwarding? #t)
+                              (authorized-keys
+                              `(("pi" ,%my-public-key)))))
+                    %base-services))
+   (name-service-switch %mdns-host-lookup-nss)))
+
+raspberry-pi-64-nfs-root
diff --git a/gnu/system/examples/raspberry-pi-64.tmpl b/gnu/system/examples/raspberry-pi-64.tmpl
new file mode 100644
index 0000000000..7e18f00d86
--- /dev/null
+++ b/gnu/system/examples/raspberry-pi-64.tmpl
@@ -0,0 +1,77 @@
+;; This is an operating-system configuration template of a
+;; 64-bit minimal system for a Raspberry Pi with local storage.
+
+;; It neither installs firmware nor device-tree files for the Raspberry Pi.
+;; It just assumes them to be existing in boot/efi in the same way that some
+;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
+
+;; It expects the boot-partition to be mounted as boot/efi in the same way
+;; as it is usually expeted on PCs with UEFI firmware.
+
+(use-modules (gnu)
+             (gnu artwork)
+             (gnu system nss))
+(use-service-modules admin
+                     avahi
+                     networking
+                     ssh)
+(use-package-modules certs
+                     linux
+                     raspberry-pi
+                     ssh)
+
+(define %my-public-key
+  (local-file (string-append (getenv "HOME") "/.ssh/id_ecdsa.pub")))
+
+(define-public raspberry-pi-64
+  (operating-system
+   (host-name "raspberrypi-guix")
+   (timezone "Europe/Berlin")
+   (bootloader (bootloader-configuration
+                (bootloader grub-efi-bootloader-chain-raspi-64)
+                (target "/boot/efi")
+                (theme (grub-theme (resolution '(1920 . 1080))
+                       (image (file-append
+                               %artwork-repository
+                               "/grub/GuixSD-fully-black-16-9.svg"))))))
+   (kernel (modify-linux #:linux linux-libre-arm64-generic
+                         #| It is possible to use a specific defconfig file,
+                            for example the "bcmrpi3_defconfig" with the
+                            variable shown below.  Unfortunately the kernel
+                            build from the linux-libre sources with this
+                            defconfig file does not boot.
+                            #:extra-version "gnu-bcmrpi3"
+                            #:defconfig %bcmrpi3-defconfig
+                         |#))
+   (initrd-modules '())
+   (file-systems (cons* (file-system
+                         (mount-point "/")
+                         (type "ext4")
+                         (device (file-system-label "Guix")))
+                        (file-system
+                         (mount-point "/boot/efi")
+                         (type "vfat")
+                         (device (file-system-label "EFI")))
+                        %base-file-systems))
+   (swap-devices '("/run/swapfile"))
+   (users (cons* (user-account
+                  (name "pi")
+                  (group "users")
+                  (supplementary-groups '("wheel" "netdev" "audio" "video"))
+                  (home-directory "/home/pi"))
+                 %base-user-accounts))
+   (packages (cons* nss-certs
+                    openssh
+                    %base-packages))
+   (services (cons* (service avahi-service-type)
+                    (service dhcp-client-service-type)
+                    (service ntp-service-type)
+                    (service openssh-service-type
+                             (openssh-configuration
+                              (x11-forwarding? #t)
+                              (authorized-keys
+                              `(("pi" ,%my-public-key)))))
+                    %base-services))
+   (name-service-switch %mdns-host-lookup-nss)))
+
+raspberry-pi-64

  reply	other threads:[~2021-10-31 22:08 UTC|newest]

Thread overview: 74+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-05-09 15:32 [bug#48314] Patches to install guix system on Raspberry Pi Stefan
2021-05-16 12:46 ` Stefan
2021-06-19 18:11   ` Danny Milosavljevic
2021-06-19 18:13   ` Danny Milosavljevic
2021-06-19 19:10     ` Stefan
2021-06-19 19:04   ` Danny Milosavljevic
2021-06-19 19:18     ` Stefan
2021-06-19 19:10   ` Danny Milosavljevic
2021-06-19 20:21     ` Stefan
2021-07-28 18:58       ` Stefan
2021-10-31 22:07         ` Stefan [this message]
2021-11-13 18:05           ` Vagrant Cascadian
2021-11-13 18:51             ` Vagrant Cascadian
2022-07-17 16:47             ` Stefan via Guix-patches via
2021-11-13 18:23           ` Vagrant Cascadian
2022-07-17 16:47             ` Stefan via Guix-patches via
2021-11-13 20:21           ` Vagrant Cascadian
2022-07-17 16:47             ` Stefan via Guix-patches via
2022-07-17 17:21               ` Vagrant Cascadian
2022-07-17 18:04                 ` Stefan via Guix-patches via
2021-11-17 14:00 ` [bug#48314] Install " phodina via Guix-patches via
2022-04-14  7:38 ` [bug#48314] [PATCH v3] " phodina via Guix-patches via
2022-04-14  8:17   ` phodina via Guix-patches via
2022-04-14  8:32   ` Maxime Devos
2022-04-14  9:25     ` [bug#48314] [PATCH v4] " phodina via Guix-patches via
2022-04-14 11:00       ` Maxime Devos
2022-04-14 12:23         ` [bug#48314] [PATCH v5] " phodina via Guix-patches via
2022-04-14 13:03           ` phodina via Guix-patches via
2022-04-14 13:57             ` Maxime Devos
2022-04-14 14:00           ` Maxime Devos
2022-04-14 14:06   ` [bug#48314] [PATCH v3] " Maxime Devos
2022-04-14 15:53     ` phodina via Guix-patches via
2022-04-14 17:33       ` Maxime Devos
2022-04-15 17:17       ` Ludovic Courtès
2022-04-16  8:53         ` phodina via Guix-patches via
2022-04-18 21:00           ` Ludovic Courtès
2022-04-21 10:52             ` phodina via Guix-patches via
2022-04-21 19:32               ` Stefan
2022-04-14 15:56   ` Vagrant Cascadian
2022-04-28  2:57     ` Vagrant Cascadian
2022-04-28  6:05       ` Stefan
2022-04-28 15:25         ` Vagrant Cascadian
2022-07-02  6:40           ` phodina via Guix-patches via
2022-07-17 16:48             ` Stefan via Guix-patches via
2022-07-17 16:48             ` Stefan via Guix-patches via
2022-07-18 19:23               ` phodina via Guix-patches via
2022-07-19  6:55                 ` Stefan via Guix-patches via
2022-07-19  7:35                   ` phodina via Guix-patches via
2022-07-20  6:13                     ` Stefan via Guix-patches via
2022-07-20  7:16                       ` phodina via Guix-patches via
2022-07-20 19:42                         ` Stefan via Guix-patches via
2022-08-12 14:27                           ` phodina via Guix-patches via
2022-08-13 10:48                             ` Stefan via Guix-patches via
2022-08-14  9:59                               ` phodina via Guix-patches via
2022-08-14 11:35                                 ` Stefan via Guix-patches via
2022-09-01 23:55                                   ` Stefan via Guix-patches via
2022-09-02  5:49                                     ` phodina via Guix-patches via
2022-09-04 18:41                                       ` Stefan via Guix-patches via
2022-09-22 16:18                                         ` [bug#48314] [PATCH v5] " Stefan via Guix-patches via
2022-10-05 13:02                                           ` Ludovic Courtès
2022-10-08 16:22                                           ` Vagrant Cascadian
2022-10-09 13:41                                             ` Stefan via Guix-patches via
2022-10-30 12:39                                               ` phodina via Guix-patches via
2022-10-30 17:08                                                 ` Stefan via Guix-patches via
2022-10-30 17:31                                                   ` Stefan via Guix-patches via
2022-12-01 14:25                                           ` [bug#48314] [PATCH] " Maxim Cournoyer
2022-12-01 15:32                                           ` Maxim Cournoyer
2022-12-01 16:22                                           ` Maxim Cournoyer
2022-12-01 18:01                                           ` Maxim Cournoyer
2022-12-01 19:33                                           ` bug#48314: " Maxim Cournoyer
2022-12-03  5:53                                             ` [bug#48314] " Vagrant Cascadian
2022-12-04  6:28                                               ` Maxim Cournoyer
2022-10-30 17:32 ` [bug#48314] [PATCH v5] " Stefan via Guix-patches via
2022-10-30 17:33 ` Stefan via Guix-patches via

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=AFD31F40-6691-4B53-ACA9-7F821D139124@vodafonemail.de \
    --to=stefan-guix@vodafonemail.de \
    --cc=48314@debbugs.gnu.org \
    --cc=dannym@scratchpost.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).