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 ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2022 Reza Alizadeh Majd +;;; Copyright © 2024 Lilah Tascheter ;;; ;;; 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 - object, and where the store is available at STORE-FS, a - object. OLD-ENTRIES is taken to be a list of menu entries -corresponding to old generations of the system." + +;;; +;;; Config procedures. +;;; - (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)) - (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))))) + #$label #$label #$linux + #$(if device-tree-support? fdt "") + #$(normalize-file entry initrd) + (string-join (list #$@linux-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 + (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))))))))) - ;;; -;;; 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)))) + (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-mbr - (install-extlinux "mbr.bin")) - -(define install-extlinux-gpt - (install-extlinux "gptmbr.bin")) - ;;; ;;; 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))) + (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-bootloader-gpt +(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