From eaa1c6db1e5a8a059f499c904861d8270194faf6 Mon Sep 17 00:00:00 2001
From: Reza Alizadeh Majd <r.majd@pantherx.org>
Date: Fri, 5 Aug 2022 20:00:42 +0430
Subject: [PATCH] bootloader: extlinux: support for optional FDTDIR

There are situations that u-boot doesn't have to load from the device tree.
some provide the device tree using a vendor bootloader (like what raspberry-pi
does) or with an external bootloader that chainloads the u-boot (what Asahi
does for m1n1 bootloader).

Unfortunately we couldn't find any reliable document to enforce u-boot to pass
the device tree via `extlinux.conf`, however during our tests, we found that
removing the `FDTDIR` line from the `extlinux.conf` tend us to do so.

There is also no reliable way to guess if u-boot bootloader should load device
tree or not on a specific hardware. in addition, there are hardware that can
be booted with both firmware device tree on some kernels and with special
device tree on other (modified) kernels.

the following changes provided to define an optional parameter in <bootloader>
record, called <device-tree-support?>  which by default is set to #t to keep
the current behavior unchanged. if this paramter is set to #f, the FDTDIR line
will be discarded from the <extlinux.conf> and u-boot doesn't load the device
tree automatically.

* gnu/bootloader.scm (<bootloader>)[device-tree-support?]: new field.
* gnu/bootloader/extlinux.scm (extlinux-configuration-file): add FDTDIR line
based on bootloader <device-tree-support?> field of <bootloader>.
* gnu/tests/bootloader.scm: add tests for FDTDIR modification.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add gnu/tests/bootloader.scm
---
 gnu/bootloader.scm          |   6 +-
 gnu/bootloader/extlinux.scm |  13 +++-
 gnu/local.mk                |   2 +
 gnu/tests/bootloader.scm    | 119 ++++++++++++++++++++++++++++++++++++
 4 files changed, 137 insertions(+), 3 deletions(-)
 create mode 100644 gnu/tests/bootloader.scm

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 9cf5457873..3793cc981f 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,6 +55,7 @@ (define-module (gnu bootloader)
             bootloader-disk-image-installer
             bootloader-configuration-file
             bootloader-configuration-file-generator
+            bootloader-device-tree-support?
 
             bootloader-configuration
             bootloader-configuration?
@@ -173,7 +175,9 @@ (define-record-type* <bootloader>
   (disk-image-installer            bootloader-disk-image-installer
                                    (default #f))
   (configuration-file              bootloader-configuration-file)
-  (configuration-file-generator    bootloader-configuration-file-generator))
+  (configuration-file-generator    bootloader-configuration-file-generator)
+  (device-tree-support?            bootloader-device-tree-support?
+                                   (default #t)))
 
 
 ;;;
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index 6b5ff298e7..f3d69c0cc0 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -38,6 +39,10 @@ (define* (extlinux-configuration-file config entries
   (define all-entries
     (append entries (bootloader-configuration-menu-entries config)))
 
+  (define with-fdtdir?
+    (let ((bootloader (bootloader-configuration-bootloader config)))
+      (bootloader-device-tree-support? bootloader)))
+
   (define (menu-entry->gexp entry)
     (let ((label (menu-entry-label entry))
           (kernel (menu-entry-linux entry))
@@ -46,12 +51,16 @@ (define (menu-entry->gexp entry)
       #~(format port "LABEL ~a
   MENU LABEL ~a
   KERNEL ~a
-  FDTDIR ~a/lib/dtbs
+  ~a
   INITRD ~a
   APPEND ~a
 ~%"
                 #$label #$label
-                #$kernel (dirname #$kernel) #$initrd
+                #$kernel
+                (if #$with-fdtdir?
+                    (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
+                    "")
+                #$initrd
                 (string-join (list #$@kernel-arguments)))))
 
   (define builder
diff --git a/gnu/local.mk b/gnu/local.mk
index 88100416d5..b430c664ea 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -51,6 +51,7 @@
 # Copyright © 2022 Remco van 't Veer <remco@remworks.net>
 # Copyright © 2022 Artyom V. Poptsov <poptsov.artyom@gmail.com>
 # Copyright © 2022 John Kehayias <john.kehayias@protonmail.com>
+# Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
 #
 # This file is part of GNU Guix.
 #
@@ -736,6 +737,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests.scm					\
   %D%/tests/audio.scm				\
   %D%/tests/base.scm				\
+  %D%/tests/bootloader.scm				\
   %D%/tests/ci.scm				\
   %D%/tests/cups.scm				\
   %D%/tests/databases.scm			\
diff --git a/gnu/tests/bootloader.scm b/gnu/tests/bootloader.scm
new file mode 100644
index 0000000000..0c3bffa58d
--- /dev/null
+++ b/gnu/tests/bootloader.scm
@@ -0,0 +1,119 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;;
+;;; 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 (gnu tests bootloader)
+  #:use-module (gnu)
+  #:use-module (gnu bootloader u-boot)
+  #:use-module (gnu system vm)
+  #:use-module (gnu tests)
+  #:use-module (guix scripts system reconfigure)
+  #:export (%test-uboot-with-fdtdir
+            %test-uboot-without-fdtdir))
+
+
+(define %u-boot-with-fdtdir-bootloader
+  (bootloader
+   (inherit u-boot-bootloader)))
+
+
+(define %u-boot-without-fdtdir-bootloader
+  (bootloader
+   (inherit u-boot-bootloader)
+   (device-tree-support? #f)))
+
+
+(define (u-boot-os with-fdtdir?)
+  (operating-system
+    (inherit %simple-os)
+    (bootloader (bootloader-configuration
+                 (bootloader (if with-fdtdir?
+                                 %u-boot-with-fdtdir-bootloader
+                                 %u-boot-without-fdtdir-bootloader))))))
+
+
+(define* (run-uboot-fdtdir-test name #:key (with-fdtdir? #t))
+  "Run u-boot-bootloader installation with/without FDTDIR record for
+extlinux.conf"
+
+  (define os
+    (marionette-operating-system
+     (u-boot-os with-fdtdir?)))
+
+  (define vm (virtual-machine
+              (operating-system os)
+              (volatile? #f)))
+
+  (define (test script)
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin #$name)
+
+          (test-assert "bootloader installed"
+            (marionette-eval
+             '(primitive-load #$script)
+             marionette))
+
+          (test-assert "extlinux.conf file created"
+            (marionette-eval
+             '(file-exists? "/boot/extlinux/extlinux.conf")
+             marionette))
+
+          (let ((content (wait-for-file "/boot/extlinux/extlinux.conf" marionette
+                                        #:read 'get-string-all
+                                        #:timeout 30)))
+            (if #$with-fdtdir?
+                (test-assert "FDTDIR exists"
+                  (string-contains content "FDTDIR"))
+                (test-assert "FDTDIR removed"
+                  (not (string-contains content "FDTDIR")))))
+
+          (test-end #$name))))
+
+  (let* ((bootcfg (operating-system-bootcfg os '()))
+         (bootloader ((compose bootloader-configuration-bootloader
+                               operating-system-bootloader) os))
+         (bootcfg-file (bootloader-configuration-file bootloader)))
+    (gexp->derivation "uboot"
+      (test (install-bootloader-program #f #f #f bootcfg bootcfg-file
+                                        '(#f) "/")))))
+
+
+(define %test-uboot-with-fdtdir
+  (system-test
+   (name "uboot-with-fdtdir")
+   (description "test uboot installation with fdtdir")
+   (value
+    (run-uboot-fdtdir-test "uboot-with-fdtdir"
+                           #:with-fdtdir? #t))))
+
+
+(define %test-uboot-without-fdtdir
+  (system-test
+   (name "uboot-without-fdtdir")
+   (description "test uboot installation without fdtdir")
+   (value
+    (run-uboot-fdtdir-test "uboot-without-fdtdir"
+                           #:with-fdtdir? #f))))
-- 
2.37.1

