Subject: Re: [bug#31416] [PATCH 3/4] bootloader: Add make-u-boot-bootloader.

From: Danny Milosavljevic <[email-masked]>
Date: Sun, 17 Jun 2018 02:28:55 +0200

Hi Ludo,

On Fri, 15 Jun 2018 09:12:31 +0200
[email-masked] (Ludovic Courtès) wrote:

> Apologies for dropping the ball!

No problem, no need to hurry!

I've researched a little in the mean time and found out that other projects
DO have automated u-boot installation, for example:

https://github.com/buildroot/buildroot/blob/master/board/olimex/a20_olinuxino/genimage.cfg

So we could leave this stuff mostly to them - although it would mean
we'd only support boards they support.

It would make us lose support for these for now:

* qemu_arm_vexpress
* qemu_mips64el_malta
* banana-pi-m2-ultra
* nintendo-nes-classic-edition
* novena
* cubieboard
* puma-rk3399

So we'd have to upstream support for those[1] - and also have a fallback in the
mean time maybe.

A very minimal WIP patch for that is attached.

What it does is install a "genimage.cfg" which describes how to install u-boot for
the current board into the derivation of u-boot.

Do we want to proceed like that?

Should I move load-u-boot-config into a new guix/build/u-boot.scm ? Or how
do I get it into the build side without rebuilding the world?

[1] I added banana-pi-m2-ultra in my local buildroot checkout by creating 3 short
text files, so it's not that bad.
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 52b38dd1a..4213830cd 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -110,7 +110,7 @@
 (define u-boot-beaglebone-black-bootloader
   (bootloader
    (inherit u-boot-bootloader)
-   (package u-boot-beagle-bone-black)
+   (package u-boot-beaglebone)
    (installer install-beaglebone-black-u-boot)))
 
 (define u-boot-allwinner-bootloader
@@ -136,17 +136,17 @@
 (define u-boot-a20-olinuxino-lime-bootloader
   (bootloader
    (inherit u-boot-allwinner-bootloader)
-   (package u-boot-a20-olinuxino-lime)))
+   (package u-boot-olimex-a20-olinuxino-lime)))
 
 (define u-boot-a20-olinuxino-lime2-bootloader
   (bootloader
    (inherit u-boot-allwinner-bootloader)
-   (package u-boot-a20-olinuxino-lime2)))
+   (package u-boot-olimex-a20-olinuxino-lime2)))
 
 (define u-boot-a20-olinuxino-micro-bootloader
   (bootloader
    (inherit u-boot-allwinner-bootloader)
-   (package u-boot-a20-olinuxino-micro)))
+   (package u-boot-olimex-a20-olinuxino-micro)))
 
 (define u-boot-banana-pi-m2-ultra-bootloader
   (bootloader
@@ -156,7 +156,7 @@
 (define u-boot-mx6cuboxi-bootloader
   (bootloader
    (inherit u-boot-imx-bootloader)
-   (package u-boot-mx6cuboxi)))
+   (package u-boot-mx6cubox)))
 
 (define u-boot-wandboard-bootloader
   (bootloader
@@ -171,7 +171,7 @@
 (define u-boot-pine64-plus-bootloader
   (bootloader
    (inherit u-boot-allwinner64-bootloader)
-   (package u-boot-pine64-plus)))
+   (package u-boot-pine64)))
 
 (define u-boot-puma-rk3399-bootloader
   (bootloader
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index eb1e433ba..080515e79 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -456,6 +456,26 @@ def test_ctrl_c"))
 also initializes the boards (RAM etc).  This package provides its
 board-independent tools.")))
 
+(define-public buildroot-minimal
+  (package
+    (name "buildroot-minimal")
+    (version "2018.05")
+    (source (origin
+              (method url-fetch)
+              (uri
+               (string-append
+                "https://github.com/buildroot/buildroot/archive/"
+                version ".tar.gz"))
+              (file-name (string-append name "-" version ".tar.gz"))
+              (sha256
+               (base32
+                "002y07c1q3bx2f37ywq0qaj2f4wfn09dia09khnp7sy6ajz3k7p3"))))
+    (build-system gnu-build-system)
+    (synopsis "Generate embedded Linux system images")
+    (description "@code{buildroot} generates embedded Linux system images.")
+    (home-page "https://github.com/buildroot/buildroot")
+    (license license:gpl2+)))
+
 (define-public (make-u-boot-package board triplet)
   "Returns a u-boot package for BOARD cross-compiled for TRIPLET."
   (let ((same-arch? (if (string-prefix? (%current-system)
@@ -472,9 +492,12 @@ board-independent tools.")))
              `(("cross-gcc" ,(cross-gcc triplet #:xgcc gcc-7))
                ("cross-binutils" ,(cross-binutils triplet)))
              `(("gcc-7" ,gcc-7)))
+         ("buildroot" ,(package-source buildroot-minimal))
          ,@(package-native-inputs u-boot)))
       (arguments
-       `(#:modules ((ice-9 ftw) (guix build utils) (guix build gnu-build-system))
+       `(#:modules
+         ((ice-9 ftw) (ice-9 rdelim) (ice-9 regex) (guix build utils)
+          (guix build gnu-build-system))
          #:test-target "test"
          #:make-flags
          (list "HOSTCC=gcc"
@@ -483,16 +506,86 @@ board-independent tools.")))
                    '()))
          #:phases
          (modify-phases %standard-phases
+           (add-after 'unpack 'unpack-buildroot
+             (lambda* (#:key inputs outputs #:allow-other-keys)
+               (invoke "tar" "xf" (assoc-ref inputs "buildroot"))
+               ((@ (ice-9 match) match) (filter (lambda (name) (string-prefix? "buildroot" name)) (scandir "."))
+                ((name) (symlink name "buildroot")))
+               #t))
            (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))
-                     (zero? (apply system* "make" `(,@make-flags ,config-name)))
+             (lambda* (#:key  outputs make-flags #:allow-other-keys)
+;; FIXME move out.
+(define (load-u-boot-config port)
+  "Read the u-boot configuration from PORT and return an alist with the
+entries."
+  (let loop ((line (read-line port)))
+    (if (eof-object? line)
+        '()
+        (let ((match (string-match "^([A-Za-z][^=]*)=(.*)$" line)))
+          (if match
+              (cons (cons (match:substring match 1)
+                          (match:substring match 2))
+                    (loop (read-line port)))
+              (loop (read-line port)))))))
+
+               (let* ((buildroot-config-basename
+                       (string-append ,board "_defconfig"))
+                      (buildroot-config-dirname "buildroot/")
+                      (buildroot-config-name
+                       (string-append buildroot-config-dirname "configs/"
+                                      buildroot-config-basename))
+                      (buildroot-config
+                       (if (file-exists? buildroot-config-name)
+                           (call-with-input-file buildroot-config-name load-u-boot-config)
+                           #f)))
+                 (if buildroot-config
+                     (let* ((cfg (lambda (name)
+                                   (assoc-ref buildroot-config name)))
+                            (u-boot-config-match
+                             (and=> (or (cfg "BR2_TARGET_UBOOT_BOARD_DEFCONFIG")
+                                        (cfg "BR2_TARGET_UBOOT_BOARDNAME"))
+                                    (lambda (x)
+                                      (string-match "^\"(.*)\"$" x))))
+                            (u-boot-config-name
+                             (and u-boot-config-match
+                                  (match:substring u-boot-config-match 1)))
+                            (BR2_ROOTFS_POST_IMAGE_SCRIPT
+                             (cfg "BR2_ROOTFS_POST_IMAGE_SCRIPT"))
+                            (BR2_ROOTFS_POST_SCRIPT_ARGS
+                             (cfg "BR2_ROOTFS_POST_SCRIPT_ARGS"))
+                            (genimage-config-name
+                             (cond
+                              ;; Prefer genimage.sh parameters.
+                              ((and BR2_ROOTFS_POST_IMAGE_SCRIPT
+                                    (string=? BR2_ROOTFS_POST_IMAGE_SCRIPT
+                                              "\"support/scripts/genimage.sh\"")
+                                    BR2_ROOTFS_POST_SCRIPT_ARGS)
+                               (and=> (string-match "^\"-c (.*)\"$" BR2_ROOTFS_POST_SCRIPT_ARGS)
+                                      (lambda (match) (match:substring match 1))))
+                              ;; Fall back to the script directory.
+                              (BR2_ROOTFS_POST_IMAGE_SCRIPT
+                               (and=> (string-match "^\"(.*)/[^/]*\"$" BR2_ROOTFS_POST_IMAGE_SCRIPT)
+                                       (lambda (match) (string-append (match:substring match 1)
+                                                                  "/genimage.cfg"))))
+                              ;; Fall back to no "genimage.cfg".
+                              (else
+                               #f))))
+                         (if genimage-config-name
+                           (let ((x (string-append buildroot-config-dirname
+                                                   genimage-config-name)))
+                             (if (file-exists? x)
+                                 (copy-file x "genimage.cfg"))))
+                       (if (not u-boot-config-name)
+                           (error "Cannot build U-Boot for this system."))
+                       (apply invoke "make"
+                              `(,@make-flags
+                                ,(string-append u-boot-config-name
+                                                "_defconfig"))))
                      (begin
                        (display "Invalid board name. Valid board names are:"
                                 (current-error-port))
                        (let ((suffix-len (string-length "_defconfig"))
-                             (entries (scandir "configs")))
+                             (entries (scandir (dirname buildroot-config-name))))
                          (for-each (lambda (file-name)
                                      (when (string-suffix? "_defconfig" file-name)
                                        (format (current-error-port)
@@ -500,7 +593,8 @@ board-independent tools.")))
                                                (string-drop-right file-name
                                                                   suffix-len))))
                                    (sort entries string-ci<)))
-                       #f)))))
+                       (error "Invalid board name ~s."
+                              buildroot-config-basename))))))
            (replace 'install
              (lambda* (#:key outputs #:allow-other-keys)
                (let* ((out (assoc-ref outputs "out"))
@@ -512,6 +606,9 @@ board-independent tools.")))
                  (install-file ".config" libexec)
                  ;; Useful for "qemu -kernel".
                  (install-file "u-boot" libexec)
+                 (if (file-exists? "genimage.cfg")
+                     (install-file "genimage.cfg" libexec))
+
                  (for-each
                   (lambda (file)
                     (let ((target-file (string-append libexec "/" file)))
@@ -519,17 +616,17 @@ board-independent tools.")))
                       (copy-file file target-file)))
                   uboot-files))))))))))
 
-(define-public u-boot-vexpress
-  (make-u-boot-package "vexpress_ca9x4" "arm-linux-gnueabihf"))
+(define-public u-boot-qemu-arm-vexpress
+  (make-u-boot-package "qemu_arm_vexpress" "arm-linux-gnueabihf"))
 
-(define-public u-boot-malta
-  (make-u-boot-package "malta" "mips64el-linux-gnuabi64"))
+(define-public u-boot-qemu-mips64el-malta
+  (make-u-boot-package "qemu_mips64el_malta" "mips64el-linux-gnuabi64"))
 
-(define-public u-boot-beagle-bone-black
-  (make-u-boot-package "am335x_boneblack" "arm-linux-gnueabihf"))
+(define-public u-boot-beaglebone
+  (make-u-boot-package "beaglebone" "arm-linux-gnueabihf"))
 
-(define-public u-boot-pine64-plus
-  (let ((base (make-u-boot-package "pine64_plus" "aarch64-linux-gnu")))
+(define-public u-boot-pine64
+  (let ((base (make-u-boot-package "pine64" "aarch64-linux-gnu")))
     (package
       (inherit base)
       (arguments
@@ -550,33 +647,38 @@ board-independent tools.")))
        `(("firmware" ,arm-trusted-firmware-pine64-plus)
          ,@(package-native-inputs base))))))
 
+;; MISSING
 (define-public u-boot-banana-pi-m2-ultra
   (make-u-boot-package "Bananapi_M2_Ultra" "arm-linux-gnueabihf"))
 
-(define-public u-boot-a20-olinuxino-lime
-  (make-u-boot-package "A20-OLinuXino-Lime" "arm-linux-gnueabihf"))
+(define-public u-boot-olimex-a20-olinuxino-lime
+  (make-u-boot-package "olimex_a20_olinuxino_lime" "arm-linux-gnueabihf"))
 
-(define-public u-boot-a20-olinuxino-lime2
-  (make-u-boot-package "A20-OLinuXino-Lime2" "arm-linux-gnueabihf"))
+(define-public u-boot-olimex-a20-olinuxino-lime2
+  (make-u-boot-package "olimex_a20_olinuxino_lime2" "arm-linux-gnueabihf"))
 
-(define-public u-boot-a20-olinuxino-micro
-  (make-u-boot-package "A20-OLinuXino_MICRO" "arm-linux-gnueabihf"))
+(define-public u-boot-olimex-a20-olinuxino-micro
+  (make-u-boot-package "olimex_a20_olinuxino_micro" "arm-linux-gnueabihf"))
 
+;; MISSING
 (define-public u-boot-nintendo-nes-classic-edition
   (make-u-boot-package "Nintendo_NES_Classic_Edition" "arm-linux-gnueabihf"))
 
 (define-public u-boot-wandboard
   (make-u-boot-package "wandboard" "arm-linux-gnueabihf"))
 
-(define-public u-boot-mx6cuboxi
-  (make-u-boot-package "mx6cuboxi" "arm-linux-gnueabihf"))
+(define-public u-boot-mx6cubox
+  (make-u-boot-package "mx6cubox" "arm-linux-gnueabihf"))
 
+;; MISSING
 (define-public u-boot-novena
   (make-u-boot-package "novena" "arm-linux-gnueabihf"))
 
+;; MISSING
 (define-public u-boot-cubieboard
   (make-u-boot-package "Cubieboard" "arm-linux-gnueabihf"))
 
+;; MISSING
 (define-public u-boot-puma-rk3399
   (let ((base (make-u-boot-package "puma-rk3399" "aarch64-linux-gnu")))
     (package