Subject: [PATCH v5] Install guix system on Raspberry Pi

From: phodina <[email-masked]>
Date: Thu, 14 Apr 2022 12:23:20 +0000

Thanks Maxime,

sorry for silly mistake.

Here are the updated patches. The last changes are part of the 4th patch in the patch set.

After build I installed it to the SD card using following command:

sudo -E ./pre-inst-env guix system init gnu/system/examples/raspberry-pi-64.tmpl /mnt

However, I experience an issue when login into the system. I can get there using my SSH key, but it seems the passwd set-uid binary is missing from the profile:

$ ssh [email-masked]
You are required to change your password immediately (administrator enforced).
WARNING: Your password has expired.
passwd: no such file or directory

I understand that the password is not set and the account is accessed through SSH so it asks after login to change it. How come it's possible to change it? I tried to add shadow into the packages, but the error said, it's already part of the system, so my guess is that it's just missing in the PATH variable. Could it be due to the fact it's present in /run/setuid-programs?

----
Petr
From 7b9aa4a57404d39f2aed940aef2026667bfca34e Mon Sep 17 00:00:00 2001
From: Stefan <[email-masked]>
Date: Wed, 13 Apr 2022 21:02:07 +0200
Subject: [PATCH v5 1/8] gnu: bootloader: Rework chaining, add
 grub-efi-netboot-removable-bootloader.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* 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")
     …))
 …)
)

diff --git a/doc/guix.texi b/doc/guix.texi
index a865b2e2e4..4b35142e95 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35710,8 +35710,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
@@ -35737,9 +35738,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
@@ -35773,13 +35775,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 9cf5457873..797908e24a 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -259,26 +259,22 @@ (define (lookup-bootloader-by-name name)
             (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))
@@ -302,7 +298,7 @@ (define name-ends-with-/? (cut string-suffix? "/" <>))
             (define (name-is-store-entry? name)
               "Return #t if NAME is a direct store entry and nothing inside."
               (not (string-index (strip-store-file-name name) #\/)))
-            (let* ((collection (string-append #$output "/collection"))
+            (let* ((output #$output)
                    (files '#$files)
                    (directories (filter name-ends-with-/? files))
                    (names-from-directories
@@ -311,11 +307,11 @@ (define (name-is-store-entry? name)
                                 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)))
@@ -323,57 +319,63 @@ (define (name-is-store-entry? name)
                     #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 120cd55012..0ba6aa4dad 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -50,11 +50,12 @@ (define-module (gnu bootloader grub)
             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
 
@@ -348,7 +349,7 @@ (define (grub-root-search device file)
         ((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))
@@ -378,27 +379,27 @@ (define (menu-entry->gexp entry)
                 (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
 }~%"
@@ -435,9 +436,7 @@ (define (sugar)
   (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))))
@@ -463,8 +462,6 @@ (define locale-config
 
   (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))
@@ -515,6 +512,16 @@ (define builder
                  #: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")
+
 
 
 ;;;
@@ -608,42 +615,31 @@ (define install-grub-efi
                         "--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.
@@ -653,17 +649,18 @@ (define (install-grub-efi-netboot subdir)
 
 (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.
@@ -673,34 +670,78 @@ (define (install-grub-efi-netboot subdir)
 
 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")))))))))))
 
 
 
@@ -718,7 +759,7 @@ (define grub-bootloader
    (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
@@ -728,17 +769,29 @@ (define grub-minimal-bootloader
 
 (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 7ea6f5a647..6876ab17b9 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2020, 2021 Pierre Langlois <[email-masked]>
 ;;; Copyright © 2021 Vincent Legoll <[email-masked]>
 ;;; Copyright © 2021 Brice Waegeneire <[email-masked]>
+;;; Copyright © 2021 Stefan <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -66,13 +67,17 @@ (define-module (gnu packages bootloaders)
   #: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 @@ (define-public grub-hybrid
                   (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
-- 
2.34.0

From f6e01db0581ad7c291a20f5a8b15bd5925ba70af Mon Sep 17 00:00:00 2001
From: Stefan <[email-masked]>
Date: Wed, 13 Apr 2022 21:11:20 +0200
Subject: [PATCH v5 3/8] gnu: bootloader: Add U-Boot packages for Raspberry Pi
 models.

* 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.

diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 10f2dd5fad..84d65c94cd 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -748,17 +748,30 @@ (define-public u-boot-tools
 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))
@@ -1117,6 +1130,157 @@ (define-public u-boot-pinebook-pro-rk3399
        `(("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")
-- 
2.34.0

From 436b4544f526b96e3d60036016d131f13e439841 Mon Sep 17 00:00:00 2001
From: Stefan <[email-masked]>
Date: Wed, 13 Apr 2022 21:19:36 +0200
Subject: [PATCH v5 7/8] gnu: raspberry-pi: New function to make a package with
 device-tree files.

* 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.

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 @@ (define-module (gnu packages raspberry-pi)
   #: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 @@ (define-public (raspi-custom-txt content)
 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
-- 
2.34.0

From a235d7564715cca1cec774d9d515caf1bccb4856 Mon Sep 17 00:00:00 2001
From: Petr Hodina <[email-masked]>
Date: Wed, 13 Apr 2022 21:10:19 +0200
Subject: [PATCH v5 2/8] build: kconfig: Add new module to modify a defconfig
 file.

From: Stefan <[email-masked]>

* 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.

diff --git a/Makefile.am b/Makefile.am
index fecce7c6f7..7f69aacbd1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -223,6 +223,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 6876ab17b9..10f2dd5fad 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -16,6 +16,7 @@
 ;;; Copyright © 2021 Vincent Legoll <[email-masked]>
 ;;; Copyright © 2021 Brice Waegeneire <[email-masked]>
 ;;; Copyright © 2021 Stefan <[email-masked]>
+;;; Copyright © 2022 Petr Hodina <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -747,8 +748,9 @@ (define-public u-boot-tools
 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)))))
@@ -766,8 +768,11 @@ (define-public (make-u-boot-package board triplet)
       (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"
@@ -778,9 +783,18 @@ (define-public (make-u-boot-package board triplet)
          (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))
@@ -834,7 +848,11 @@ (define-public u-boot-malta
   (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")
@@ -843,25 +861,13 @@ (define-public u-boot-am335x-boneblack
 
 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
@@ -891,20 +897,10 @@ (define-public u-boot-pine64-lts
   (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"))
@@ -955,25 +951,17 @@ (define-public u-boot-mx6cuboxi
   (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 <[email-masked]>
+;;;
+;;; 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)))
-- 
2.34.0

From 56814914d86da8ef5b321e7827de86237b7accdc Mon Sep 17 00:00:00 2001
From: Petr Hodina <[email-masked]>
Date: Wed, 13 Apr 2022 21:18:37 +0200
Subject: [PATCH v5 4/8] gnu: linux: New function to modify the configuration
 of a Linux kernel.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

From: Stefan <[email-masked]>

* 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.

diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index a405837bb1..f802de9666 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -59,7 +59,8 @@
 ;;; Copyright © 2021 Josselin Poiret <[email-masked]>
 ;;; Copyright © 2021 Olivier Dion <[email-masked]>
 ;;; Copyright © 2021 Solene Rapenne <[email-masked]>
-;;; Copyright © 2021 Petr Hodina <[email-masked]>
+;;; Copyright © 2021, 2022 Petr Hodina <[email-masked]>
+;;; Copyright © 2021 Stefan <[email-masked]>
 ;;; Copyright © 2022 Artyom V. Poptsov <[email-masked]>
 
 ;;;
@@ -179,6 +180,7 @@ (define-module (gnu packages linux)
   #: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)
@@ -195,6 +197,21 @@ (define-public (system->linux-architecture arch)
           ((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
@@ -852,7 +869,7 @@ (define* (make-linux-libre* version gnu-revision source supported-systems
                  (lambda _
                    (substitute* (find-files "." "^Makefile(\\.include)?$")
                      (("/bin/pwd") "pwd"))))
-               (replace 'configure
+               (add-before 'configure 'set-environment
                  (lambda* (#:key inputs target #:allow-other-keys)
                    ;; Avoid introducing timestamps.
                    (setenv "KCONFIG_NOTIMESTAMP" "1")
@@ -877,8 +894,10 @@ (define* (make-linux-libre* version gnu-revision source supported-systems
 
                    (setenv "EXTRAVERSION"
                            #$(and extra-version
-                                  (string-append "-" extra-version)))
+                                  (string-append "-" extra-version)))))
 
+               (replace 'configure
+                 (lambda* (#:key inputs native-inputs #:allow-other-keys)
                    (let ((build  (assoc-ref %standard-phases 'build))
                          (config (assoc-ref inputs "kconfig")))
 
@@ -1210,6 +1229,110 @@ (define-public linux-libre-with-bpf
       (inputs (modify-inputs (package-inputs base-linux-libre)
                 (prepend cpio))))))
 
+
+;;;
+;;; 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"))))))))
+    (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))))
 
 
 ;;;
-- 
2.34.0

From 95da83f1159ab280b2313b816ce7841f5fbdb06f Mon Sep 17 00:00:00 2001
From: Stefan <[email-masked]>
Date: Wed, 13 Apr 2022 21:19:32 +0200
Subject: [PATCH v5 6/8] gnu: raspberry-pi: Add helpers for config.txt file
 generation.

* 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.

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 @@ (define-public raspi-arm64-chainloader
                #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
-- 
2.34.0

From 428de0cbfb9f03c14f88b9db5e56181ef759d7eb Mon Sep 17 00:00:00 2001
From: Stefan <[email-masked]>
Date: Wed, 13 Apr 2022 21:19:25 +0200
Subject: [PATCH v5 5/8] gnu: raspberry-pi: Add defconfig objects to build
 customized Linux kernels.

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.

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 <[email-masked]>
+;;; Copyright © 2021 Stefan <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,9 +26,10 @@ (define-module (gnu packages raspberry-pi)
   #: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 @@ (define-public raspi-arm64-chainloader
                (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"))
-- 
2.34.0

From 7e13ab0bb33e0f90b094ad4e2759e6e8bc1e8e9c Mon Sep 17 00:00:00 2001
From: Stefan <[email-masked]>
Date: Wed, 13 Apr 2022 21:19:41 +0200
Subject: [PATCH v5 8/8] gnu: raspberry-pi: Add a bootloader-chain for the
 Raspberry Pi and os examples.

* 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.

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 @@ (define-public (make-raspi-bcm28-dtbs 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..c006a287fb
--- /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)
+                (targets '("/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 (list (swap-space (target "/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..6b0178c861
--- /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)
+                (targets '("/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 (list (swap-space (target "/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
-- 
2.34.0