[bug#72457] [PATCH v6 07/12] gnu: bootloader: extlinux: Rewrite completely.

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

From: Lilah Tascheter <lilah@lunabee.space>

* gnu/bootloader/extlinux.scm (install-extlinux-config): Add procedure.
(extlinux-configuration-file): Delete procedure.
(install-extlinux): Use install-extlinux-config.
(install-extlinux-mbr, install-extlinux-gpt): Delete variables.
(extlinux-bootloader): Update to new bootloader record.
(extlinux-gpt-bootloader): Update extlinux-bootloader-gpt to this.
(extlinux-bootloader-gpt): Deprecate variable.
* gnu/tests/install.scm (%minimal-extlinux-os)[bootloader]: Use proper
extlinux variable.

Change-Id: I3654d160f7306bb45a78b82ea6b249ff4281f739
---
 gnu/bootloader/extlinux.scm | 153 ++++++++++++++++++------------------
 gnu/tests/install.scm       |   2 +-
 2 files changed, 76 insertions(+), 79 deletions(-)

diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index d9b6d8bf8a..d2bf3f2cca 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 David Craven <david@craven.ch>
 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,112 +22,108 @@
 (define-module (gnu bootloader extlinux)
   #:use-module (gnu bootloader)
   #:use-module (gnu packages bootloaders)
+  #:use-module (gnu system boot)
   #:use-module (guix gexp)
+  #:use-module (guix deprecation)
+  #:use-module (guix records)
   #:use-module (guix utils)
-  #:export (extlinux-bootloader
+  #:export (install-extlinux-config ; for u-boot
+            extlinux-bootloader
+            extlinux-gpt-bootloader
             extlinux-bootloader-gpt))
 
-(define* (extlinux-configuration-file config entries
-                                      #:key
-                                      (system (%current-system))
-                                      (old-entries '())
-                                      #:allow-other-keys)
-  "Return the U-Boot configuration file corresponding to CONFIG, a
-<u-boot-configuration> object, and where the store is available at STORE-FS, a
-<file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
-corresponding to old generations of the system."
-
-  (define all-entries
-    (append entries (bootloader-configuration-menu-entries config)))
-
-  (define with-fdtdir?
-    (bootloader-configuration-device-tree-support? config))
+\f
+;;;
+;;; Config procedures.
+;;;
 
-  (define (menu-entry->gexp entry)
-    (let ((label (menu-entry-label entry))
-          (kernel (menu-entry-linux entry))
-          (kernel-arguments (menu-entry-linux-arguments entry))
-          (initrd (menu-entry-initrd entry)))
-      #~(format port "LABEL ~a
+(define* (install-extlinux-config #:key bootloader-config
+                                        current-boot-alternative
+                                        old-boot-alternatives
+                                  #:allow-other-keys)
+  "Installer for the extlinux configuration file, meant to be shared by
+all bootloaders that use the format to specify boot options."
+  (match-bootloader-configuration
+    bootloader-config
+    (targets menu-entries device-tree-support? timeout)
+    (define (menu-entry->gexp entry)
+      (match-menu-entry entry (label linux linux-arguments initrd)
+        (let* ((linux (normalize-file entry linux))
+               (fdt #~(string-append "FDTDIR " (dirname #$linux) "/lib/dtbs")))
+          #~(format port "LABEL ~a
   MENU LABEL ~a
   KERNEL ~a
   ~a
   INITRD ~a
   APPEND ~a
 ~%"
-                #$label #$label
-                #$kernel
-                (if #$with-fdtdir?
-                    (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
-                    "")
-                #$initrd
-                (string-join (list #$@kernel-arguments)))))
-
-  (define builder
-    #~(call-with-output-file #$output
-        (lambda (port)
-          (let ((timeout #$(bootloader-configuration-timeout config)))
-            (format port "# This file was generated from your Guix configuration.  Any changes
+                    #$label #$label #$linux
+                    #$(if device-tree-support? fdt "")
+                    #$(normalize-file entry initrd)
+                    (string-join (list #$@linux-arguments))))))
+
+    (let ((entries (cons (boot-alternative->menu-entry
+                           current-boot-alternative)
+                         (append menu-entries
+                                 (map boot-alternative->menu-entry
+                                      old-boot-alternatives)))))
+      (with-targets targets
+        (('extlinux => (path :path))
+         #~(begin
+             (mkdir-p #$path)
+             (call-with-output-file #$(string-append path
+                                                     "/extlinux.conf")
+               (lambda (port)
+                 (format port "\
+# This file was generated from your Guix configuration.  Any changes
 # will be lost upon reconfiguration.
 UI menu.c32
 MENU TITLE GNU Guix Boot Options
 PROMPT ~a
-TIMEOUT ~a~%"
-                    (if (> timeout 0) 1 0)
-                    ;; timeout is expressed in 1/10s of seconds.
-                    (* 10 timeout))
-            #$@(map menu-entry->gexp all-entries)
-
-            #$@(if (pair? old-entries)
-                   #~((format port "~%")
-                      #$@(map menu-entry->gexp old-entries)
-                      (format port "~%"))
-                   #~())))))
-
-  (computed-file "extlinux.conf" builder
-                 #:options '(#:local-build? #t
-                             #:substitutable? #f)))
-
+TIMEOUT ~a~%" ; Timeout is expressed in tenths of a second.
+                         #$(if (> timeout 0) 1 0) #$(* 10 timeout))
+                 #$@(map menu-entry->gexp entries)))))))))
 
 \f
-
 ;;;
-;;; Install procedures.
+;;; Install procedure.
 ;;;
 
 (define (install-extlinux mbr)
-  #~(lambda (bootloader device mount-point)
-      (let ((extlinux (string-append bootloader "/sbin/extlinux"))
-            (install-dir (string-append mount-point "/boot/extlinux"))
-            (syslinux-dir (string-append bootloader "/share/syslinux")))
-        (for-each (lambda (file)
-                    (install-file file install-dir))
-                  (find-files syslinux-dir "\\.c32$"))
-        (invoke/quiet extlinux "--install" install-dir)
-        (write-file-on-device (string-append syslinux-dir "/" #$mbr)
-                              440 device 0))))
-
-(define install-extlinux-mbr
-  (install-extlinux "mbr.bin"))
+  (lambda* (#:key bootloader-config #:allow-other-keys . args)
+    (with-targets (bootloader-configuration-targets bootloader-config)
+      (('extlinux => (path :path))
+       #~(begin
+           #$(apply install-extlinux-config args)
+           (copy-recursively #$(file-append syslinux "/share/syslinux") #$path)
+           (invoke/quiet #+(file-append syslinux "/sbin/extlinux")
+                         "--install" #$path)))
+      (('disk => (disk :device))
+       #~(write-file-on-device #$(file-append syslinux "/share/syslinux/" mbr)
+                               440 #$disk 0)))))
 
-(define install-extlinux-gpt
-  (install-extlinux "gptmbr.bin"))
 
 \f
-
 ;;;
 ;;; Bootloader definitions.
 ;;;
 
 (define extlinux-bootloader
   (bootloader
-   (name 'extlinux)
-   (package syslinux)
-   (installer install-extlinux-mbr)
-   (configuration-file "/boot/extlinux/extlinux.conf")
-   (configuration-file-generator extlinux-configuration-file)))
-
-(define extlinux-bootloader-gpt
+    (name 'extlinux)
+    (default-targets (list (bootloader-target
+                             (type 'install)
+                             (offset 'root)
+                             (path "boot"))
+                           (bootloader-target
+                             (type 'extlinux)
+                             (offset 'install)
+                             (path "extlinux"))))
+    (installer (install-extlinux "mbr.bin"))))
+
+(define extlinux-gpt-bootloader
   (bootloader
-   (inherit extlinux-bootloader)
-   (installer install-extlinux-gpt)))
+    (inherit extlinux-bootloader)
+    (installer (install-extlinux "gptmbr.bin"))))
+
+(define-deprecated/alias extlinux-bootloader-gpt extlinux-gpt-bootloader)
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..57b2a77414 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -140,7 +140,7 @@ (define-os-with-source (%minimal-extlinux-os
     (locale "en_US.UTF-8")
 
     (bootloader (bootloader-configuration
-                 (bootloader extlinux-bootloader-gpt)
+                 (bootloader extlinux-gpt-bootloader)
                  (targets (list "/dev/vdb"))))
     (kernel-arguments '("console=ttyS0"))
     (file-systems (cons (file-system
-- 
2.45.2