[bug#72457] [PATCH v6 09/12] gnu: bootloader: Add Raspberry Pi bootloader.

[Herman Rimm via Guix-patches via <guix-patches@gnu.org>]

From: Lilah Tascheter <lilah@lunabee.space>

Less adding and more making it an actual bootloader rather than some
weirdly specified packages.  The GRUB EFI bootloader can be recreated by
combining a Raspberry Pi bootloader with grub-efi.

* gnu/bootloader.scm (efi-bootloader-profile, efi-bootloader-chain):
Delete procedures.
* gnu/bootloader/u-boot.scm (rpi-config, install-rpi,
make-u-boot-rpi-bootloader): New procedures.
(u-boot-rpi-2-bootloader, u-boot-rpi-3-bootloader,
u-boot-rpi-4-bootloader, u-boot-rpi-bootloader): New variables.
* gnu/packages/bootloaders.scm (make-u-boot-bin-package): Delete
procedure.
(%u-boot-rpi-efi-description, %u-boot-rpi-efi-description-32-bit,
u-boot-rpi-2-efi, u-boot-rpi-3-32b-efi, u-boot-rpi-4-32b-efi,
u-boot-rpi-arm64-efi, u-boot-rpi-2-bin, u-boot-rpi-3_32b-bin,
u-boot-rpi-4_32b-bin, u-boot-rpi-arm64-bin, u-boot-rpi-2-efi-bin,
u-boot-rpi-3-32b-efi-bin, u-boot-rpi-4-32b-efi-bin,
u-boot-rpi-arm64-efi-bin): Delete variables.
* gnu/packages/raspberry-pi.scm (grub-efi-bootloader-chain-raspi-64):
Delete procedure.
* gnu/system/examples/raspberry-pi-64-nfs-root.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64.tmpl (bootloader): Use new target
system.

Change-Id: I5139a0b00ec89189e8e7c84e06a7a3b7240259cd
---
 gnu/bootloader.scm                            | 124 +-----------------
 gnu/bootloader/u-boot.scm                     |  70 ++++++++++
 gnu/packages/bootloaders.scm                  |  94 +------------
 gnu/packages/raspberry-pi.scm                 |  18 ---
 .../examples/raspberry-pi-64-nfs-root.tmpl    |  23 ++--
 gnu/system/examples/raspberry-pi-64.tmpl      |  18 +--
 6 files changed, 102 insertions(+), 245 deletions(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 14066e11f9..5e4578add0 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -118,8 +118,7 @@ (define-module (gnu bootloader)
 
             %efi-supported-systems
             efi-arch
-            install-efi
-            efi-bootloader-chain))
+            install-efi))
 
 \f
 ;;;
@@ -733,124 +732,3 @@ (define (install-efi bootloader-config plan)
         (('vendir => (vendir :path) (loader :devpath) (disk :device))
          #~(install-efi #+(file-append (lazy-efibootmgr) "/sbin/efibootmgr")
                         #$vendir #$loader #$disk #$plan))))))
-
-(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 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 procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-HOOKS lists additional hook functions to modify the profile."
-  (define* (efi-bootloader-profile-hook manifest #:optional system)
-    (define build
-        (with-imported-modules '((guix build utils))
-          #~(begin
-            (use-modules ((guix build utils)
-                          #:select (mkdir-p strip-store-file-name))
-                         ((ice-9 ftw)
-                          #:select (scandir))
-                         ((srfi srfi-1)
-                          #:select (append-map every remove))
-                         ((srfi srfi-26)
-                          #:select (cut)))
-            (define (symlink-to file directory transform)
-              "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
-              (symlink file (string-append directory "/" (transform file))))
-            (define (directory-content directory)
-              "Creates a list of absolute path names inside DIRECTORY."
-              (map (lambda (name)
-                     (string-append directory name))
-                   (or (scandir directory (lambda (name)
-                                            (not (member name '("." "..")))))
-                       '())))
-            (define name-ends-with-/? (cut string-suffix? "/" <>))
-            (define (name-is-store-entry? name)
-              "Return #t if NAME is a direct store entry and nothing inside."
-              (not (string-index (strip-store-file-name name) #\/)))
-            (let* ((files '#$files)
-                   (directories (filter name-ends-with-/? files))
-                   (names-from-directories
-                    (append-map (lambda (directory)
-                                  (directory-content directory))
-                                directories))
-                   (names (append names-from-directories
-                                  (remove name-ends-with-/? files))))
-              (mkdir-p #$output)
-              (if (every file-exists? names)
-                  (begin
-                    (for-each (lambda (name)
-                               (symlink-to name #$output
-                                            (if (name-is-store-entry? name)
-                                                strip-store-file-name
-                                                basename)))
-                              names)
-                    #t)
-                  #f)))))
-
-    (gexp->derivation "efi-bootloader-profile"
-                      build
-                      #:system system
-                      #:local-build? #t
-                      #:substitutable? #f
-                      #:properties
-                      `((type . profile-hook)
-                        (hook . efi-bootloader-profile-hook))))
-
-  (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 final-bootloader
-                               #:key
-                               (packages '())
-                               (files '())
-                               (hooks '())
-                               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.
-
-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 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 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/u-boot.scm b/gnu/bootloader/u-boot.scm
index 2d351c9dc2..264138249b 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -28,7 +28,10 @@ (define-module (gnu bootloader u-boot)
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader extlinux)
   #:use-module (gnu packages bootloaders)
+  #:use-module (gnu packages raspberry-pi)
+  #:use-module (gnu system boot)
   #:use-module (guix gexp)
+  #:use-module (guix utils)
   #:export (u-boot-a20-olinuxino-lime-bootloader
             u-boot-a20-olinuxino-lime2-bootloader
             u-boot-a20-olinuxino-micro-bootloader
@@ -49,6 +52,10 @@ (define-module (gnu bootloader u-boot)
             u-boot-puma-rk3399-bootloader
             u-boot-rock64-rk3328-bootloader
             u-boot-rockpro64-rk3399-bootloader
+            u-boot-rpi-2-bootloader
+            u-boot-rpi-3-bootloader
+            u-boot-rpi-4-bootloader
+            u-boot-rpi-bootloader
             u-boot-sifive-unmatched-bootloader
             u-boot-qemu-riscv64-bootloader
             u-boot-starfive-visionfive2-bootloader
@@ -231,3 +238,66 @@ (define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
 
 (define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
   u-boot-qemu-riscv64 "u-boot.bin")
+
+\f
+;;;
+;;; Raspberry Pi bootloader definitions.
+;;;
+
+(define (rpi-config 64bit?)
+  "Raspberry Pi config.txt which includes a user-specified custom.txt."
+  (plain-file "config.txt"
+    (string-join
+      (list (string-append "arm_64bit=" (if 64bit? "1" "0"))
+            "enable_uart=1"
+            "kernel=u-boot.bin"
+            "include custom.txt")
+      #\newline
+      'suffix)))
+
+(define (install-rpi u-boot-32 u-boot-64)
+  "Install the U-Boot from U-BOOT-64 for a 64-bit target, if available.
+Otherwise install using U-BOOT-32."
+  (lambda* (#:key bootloader-config #:allow-other-keys . args)
+    (with-targets (bootloader-configuration-targets bootloader-config)
+      ('install (apply install-extlinux-config args))
+      (('firmware => (firmware :path))
+       (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+              (64bit? (and (not 32?) (target-64bit?) u-boot-64)))
+         #~(with-directory-excursion #$firmware
+             (atomic-copy #$(file-append (if 64bit? u-boot-64 u-boot-32)
+                                         "/libexec/u-boot.bin")
+                          "u-boot.bin")
+             (atomic-copy #$(rpi-config 64bit?) "config.txt")))))))
+
+(define* (make-u-boot-rpi-bootloader #:key u-boot-32 u-boot-64)
+  "Make a Raspberry Pi bootloader using either U-BOOT-32 or U-BOOT-64."
+  (bootloader (name 'u-boot)
+              (default-targets
+                (list (bootloader-target (type 'install)
+                                         (offset 'firmware)
+                                         (path "extlinux"))
+                      (bootloader-target (type 'firmware)
+                                         (offset 'root)
+                                         (path "boot"))))
+              (installer (install-rpi u-boot-32 u-boot-64))))
+
+;; These neither install firmware nor device-tree files for the Raspberry Pi.
+;; They just assume them to be existing in 'install in the same way that some
+;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
+;; They can be used with either extlinux or as UEFI firmware, alongside
+;; e.g. GRUB.
+(define u-boot-rpi-2-bootloader
+  (make-u-boot-rpi-bootloader #:u-boot-32 u-boot-rpi-2))
+
+(define u-boot-rpi-3-bootloader
+  (make-u-boot-rpi-bootloader #:u-boot-32 u-boot-rpi-3-32b
+                              #:u-boot-64 u-boot-rpi-arm64))
+
+(define u-boot-rpi-4-bootloader
+  (make-u-boot-rpi-bootloader #:u-boot-32 u-boot-rpi-4-32b
+                              #:u-boot-64 u-boot-rpi-arm64))
+
+;; Usable for any 64-bit Raspberry Pi.
+(define u-boot-rpi-bootloader
+  (make-u-boot-rpi-bootloader #:u-boot-64 u-boot-rpi-arm64))
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 00b502aaee..e08f471a97 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -1451,40 +1451,8 @@ (define-public u-boot-pinebook-pro-rk3399
        (modify-inputs (package-inputs base)
          (append arm-trusted-firmware-rk3399))))))
 
-(define*-public (make-u-boot-bin-package u-boot-package
-                                         #:key
-                                         (u-boot-bin "u-boot.bin"))
-  "Return a package with a single U-BOOT-BIN file from the U-BOOT-PACKAGE.
-The package name will be that of the U-BOOT package suffixed with \"-bin\"."
-  (package
-    (name (string-append (package-name u-boot-package) "-bin"))
-    (version (package-version u-boot-package))
-    (source #f)
-    (build-system trivial-build-system)
-    (arguments
-     (list
-      #:builder
-      (with-imported-modules '((guix build utils))
-        #~(begin
-            (use-modules (guix build utils))
-            (mkdir #$output)
-            (symlink (search-input-file %build-inputs
-                                        (string-append "libexec/" #$u-boot-bin))
-                     (string-append #$output "/" #$u-boot-bin))))))
-    (inputs (list u-boot-package))
-    (home-page (package-home-page u-boot-package))
-    (synopsis (package-synopsis u-boot-package))
-    (description (string-append
-                  (package-description u-boot-package)
-                  "\n\n"
-                  (format #f
-                          "This package only contains the file ~a."
-                          u-boot-bin)))
-    (license (package-license u-boot-package))))
-
-(define-public %u-boot-rpi-efi-configs
-  '("CONFIG_OF_EMBED"
-    "CONFIG_OF_BOARD=y"))
+;; get dtbs from firmware to support dtoverlays
+(define-public %u-boot-rpi-configs '("CONFIG_OF_EMBED" "CONFIG_OF_BOARD=y"))
 
 (define %u-boot-rpi-description-32-bit
   "This is a 32-bit build of U-Boot.")
@@ -1493,76 +1461,26 @@ (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-2
   (make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
+                       #:configs %u-boot-rpi-configs
                        #:append-description %u-boot-rpi-description-32-bit))
 
 (define-public u-boot-rpi-3-32b
   (make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
+                       #:configs %u-boot-rpi-configs
                        #:append-description %u-boot-rpi-description-32-bit))
 
 (define-public u-boot-rpi-4-32b
   (make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
+                       #:configs %u-boot-rpi-configs
                        #:append-description %u-boot-rpi-description-32-bit))
 
 (define-public u-boot-rpi-arm64
   (make-u-boot-package "rpi_arm64" "aarch64-linux-gnu"
+                       #:configs %u-boot-rpi-configs
                        #:append-description %u-boot-rpi-description-64-bit))
 
-(define-public u-boot-rpi-2-efi
-  (make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
-                       #:name-suffix "-efi"
-                       #:configs %u-boot-rpi-efi-configs
-                       #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-3-32b-efi
-  (make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
-                       #:name-suffix "-efi"
-                       #:configs %u-boot-rpi-efi-configs
-                       #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-4-32b-efi
-  (make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
-                       #:name-suffix "-efi"
-                       #:configs %u-boot-rpi-efi-configs
-                       #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-arm64-efi
-  (make-u-boot-package "rpi_arm64""aarch64-linux-gnu"
-                       #:name-suffix "-efi"
-                       #:configs %u-boot-rpi-efi-configs
-                       #:append-description (string-append
-                                             %u-boot-rpi-efi-description "  "
-                                             %u-boot-rpi-description-64-bit)))
-
-(define-public u-boot-rpi-2-bin (make-u-boot-bin-package u-boot-rpi-2))
-
-(define-public u-boot-rpi-3_32b-bin (make-u-boot-bin-package u-boot-rpi-3-32b))
-
-(define-public u-boot-rpi-4_32b-bin (make-u-boot-bin-package u-boot-rpi-4-32b))
-
-(define-public u-boot-rpi-arm64-bin (make-u-boot-bin-package u-boot-rpi-arm64))
-
-(define-public u-boot-rpi-2-efi-bin (make-u-boot-bin-package u-boot-rpi-2-efi))
-
-(define-public u-boot-rpi-3-32b-efi-bin
-  (make-u-boot-bin-package u-boot-rpi-3-32b-efi))
-
-(define-public u-boot-rpi-4-32b-efi-bin
-  (make-u-boot-bin-package u-boot-rpi-4-32b-efi))
-
-(define-public u-boot-rpi-arm64-efi-bin
-  (make-u-boot-bin-package u-boot-rpi-arm64-efi))
-
 (define u-boot-ts-mx6
   ;; There is no release; use the latest commit of the
   ;; 'imx_v2015.04_3.14.52_1.1.0_ga' branch.
diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index 216c74cb9c..88dbc2cf6b 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -19,8 +19,6 @@
 ;;; 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)
@@ -329,22 +327,6 @@ (define (make-raspi-bcm28-dtbs linux)
      (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 a custom bootloader-chain with firmware and device-tree
-  ;; packages or files.
-  (efi-bootloader-chain grub-efi-netboot-removable-bootloader
-                        #:packages (list u-boot-rpi-arm64-efi-bin)
-                        #: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
index 1baca02491..85476854f3 100644
--- a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
+++ b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
@@ -25,14 +25,21 @@
   (operating-system
     (host-name "raspberrypi-guix")
     (timezone "Europe/Berlin")
-    (bootloader (bootloader-configuration
-                 (bootloader grub-efi-bootloader-chain-raspi-64)
-                 (targets (list "/boot/efi"))
-                 (theme (grub-theme
-                         (resolution '(1920 . 1080))
-                         (image (file-append
-                                 %artwork-repository
-                                 "/grub/GuixSD-fully-black-16-9.svg"))))))
+    (bootloader (list (bootloader-configuration
+                        (bootloader u-boot-rpi-bootloader)
+                        (targets (list (bootloader-target
+                                         (type 'install)
+                                         (path "/boot/efi")))))
+                      (bootloader-configuration
+                        (bootloader grub-efi-bootloader)
+                        (targets (list (bootloader-target
+                                         (type 'esp)
+                                         (path "/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 (customize-linux #:linux linux-libre-arm64-generic
                              #:extra-version "arm64-generic-netboot"
diff --git a/gnu/system/examples/raspberry-pi-64.tmpl b/gnu/system/examples/raspberry-pi-64.tmpl
index 414d8ac7a5..d5b90b9705 100644
--- a/gnu/system/examples/raspberry-pi-64.tmpl
+++ b/gnu/system/examples/raspberry-pi-64.tmpl
@@ -24,14 +24,16 @@
   (operating-system
     (host-name "raspberrypi-guix")
     (timezone "Europe/Berlin")
-    (bootloader (bootloader-configuration
-                 (bootloader grub-efi-bootloader-chain-raspi-64)
-                 (targets (list "/boot/efi"))
-                 (theme (grub-theme
-                         (resolution '(1920 . 1080))
-                         (image (file-append
-                                 %artwork-repository
-                                 "/grub/GuixSD-fully-black-16-9.svg"))))))
+    (bootloader (list (bootloader-configuration
+                        (bootloader u-boot-rpi-bootloader)
+                        (targets (list (bootloader-target
+                                         (type 'install)
+                                         (path "/boot/efi"))))
+                        (theme
+                          (grub-theme
+                            (resolution '(1920 . 1080))
+                            (image (file-append %artwork-repository
+                                     "/grub/GuixSD-fully-black-16-9.svg")))))))
     (kernel (customize-linux #:linux linux-libre-arm64-generic
                              ;; It is possible to use a specific defconfig
                              ;; file, for example the "bcmrpi3_defconfig" with
-- 
2.45.2