gnu: bootloader: extlinux: Rewrite completely.

* 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

@@ -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,32 +22,34 @@
 (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))
+;;; Config procedures.
-                                      (old-entries '())
+;;;
+
+(define* (install-extlinux-config #:key bootloader-config
+                                        current-boot-alternative
+                                        old-boot-alternatives
                                   #:allow-other-keys)
-  "Return the U-Boot configuration file corresponding to CONFIG, a
+  "Installer for the extlinux configuration file, meant to be shared by
-<u-boot-configuration> object, and where the store is available at STORE-FS, a
+all bootloaders that use the format to specify boot options."
-<file-system> object.  OLD-ENTRIES is taken to be a list of menu entries
+  (match-bootloader-configuration
-corresponding to old generations of the system."
+    bootloader-config
-
+    (targets menu-entries device-tree-support? timeout)
-  (define all-entries
-    (append entries (bootloader-configuration-menu-entries config)))
-
-  (define with-fdtdir?
-    (bootloader-configuration-device-tree-support? config))
-
     (define (menu-entry->gexp entry)
-    (let ((label (menu-entry-label entry))
+      (match-menu-entry entry (label linux linux-arguments initrd)
-          (kernel (menu-entry-linux entry))
+        (let* ((linux (normalize-file entry linux))
-          (kernel-arguments (menu-entry-linux-arguments entry))
+               (fdt #~(string-append "FDTDIR " (dirname #$linux) "/lib/dtbs")))
-          (initrd (menu-entry-initrd entry)))
           #~(format port "LABEL ~a
   MENU LABEL ~a
   KERNEL ~a
@@ -54,66 +57,53 @@ (define (menu-entry->gexp entry)
   INITRD ~a
   APPEND ~a
 ~%"
-                #$label #$label
+                    #$label #$label #$linux
-                #$kernel
+                    #$(if device-tree-support? fdt "")
-                (if #$with-fdtdir?
+                    #$(normalize-file entry initrd)
-                    (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
+                    (string-join (list #$@linux-arguments))))))
-                    "")
-                #$initrd
-                (string-join (list #$@kernel-arguments)))))
 
-  (define builder
+    (let ((entries (cons (boot-alternative->menu-entry
-    #~(call-with-output-file #$output
+                           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)
-          (let ((timeout #$(bootloader-configuration-timeout config)))
+                 (format port "\
-            (format port "# This file was generated from your Guix configuration.  Any changes
+# 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~%"
+TIMEOUT ~a~%" ; Timeout is expressed in tenths of a second.
-                    (if (> timeout 0) 1 0)
+                         #$(if (> timeout 0) 1 0) #$(* 10 timeout))
-                    ;; timeout is expressed in 1/10s of seconds.
+                 #$@(map menu-entry->gexp entries)))))))))
-                    (* 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)))
-
 
 
-
 ;;;
-;;; Install procedures.
+;;; Install procedure.
 ;;;
 
 (define (install-extlinux mbr)
-  #~(lambda (bootloader device mount-point)
+  (lambda* (#:key bootloader-config #:allow-other-keys . args)
-      (let ((extlinux (string-append bootloader "/sbin/extlinux"))
+    (with-targets (bootloader-configuration-targets bootloader-config)
-            (install-dir (string-append mount-point "/boot/extlinux"))
+      (('extlinux => (path :path))
-            (syslinux-dir (string-append bootloader "/share/syslinux")))
+       #~(begin
-        (for-each (lambda (file)
+           #$(apply install-extlinux-config args)
-                    (install-file file install-dir))
+           (copy-recursively #$(file-append syslinux "/share/syslinux") #$path)
-                  (find-files syslinux-dir "\\.c32$"))
+           (invoke/quiet #+(file-append syslinux "/sbin/extlinux")
-        (invoke/quiet extlinux "--install" install-dir)
+                         "--install" #$path)))
-        (write-file-on-device (string-append syslinux-dir "/" #$mbr)
+      (('disk => (disk :device))
-                              440 device 0))))
+       #~(write-file-on-device #$(file-append syslinux "/share/syslinux/" mbr)
+                               440 #$disk 0)))))
 
-(define install-extlinux-mbr
-  (install-extlinux "mbr.bin"))
-
-(define install-extlinux-gpt
-  (install-extlinux "gptmbr.bin"))
 
 
-
 ;;;
 ;;; Bootloader definitions.
 ;;;
@@ -121,12 +111,19 @@ (define install-extlinux-gpt
 (define extlinux-bootloader
   (bootloader
     (name 'extlinux)
-   (package syslinux)
+    (default-targets (list (bootloader-target
-   (installer install-extlinux-mbr)
+                             (type 'install)
-   (configuration-file "/boot/extlinux/extlinux.conf")
+                             (offset 'root)
-   (configuration-file-generator extlinux-configuration-file)))
+                             (path "boot"))
+                           (bootloader-target
+                             (type 'extlinux)
+                             (offset 'install)
+                             (path "extlinux"))))
+    (installer (install-extlinux "mbr.bin"))))
 
-(define extlinux-bootloader-gpt
+(define extlinux-gpt-bootloader
   (bootloader
     (inherit extlinux-bootloader)
-   (installer install-extlinux-gpt)))
+    (installer (install-extlinux "gptmbr.bin"))))
+
+(define-deprecated/alias extlinux-bootloader-gpt extlinux-gpt-bootloader)

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