mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-06 23:16:13 -05:00
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
This commit is contained in:
Lilah Tascheter
parent
f171385ab4
commit
a0a99c446b
GPG key ID:
81B0E222A3E2308E
2 changed files with 74 additions and 77 deletions
|
|
@ -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."
|
||||
|
||||
;;;
|
||||
;;; 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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue