mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
a0a99c446b
* 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
129 lines
4.7 KiB
Scheme
129 lines
4.7 KiB
Scheme
;;; 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>
|
||
;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
|
||
;;;
|
||
;;; 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 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 (install-extlinux-config ; for u-boot
|
||
extlinux-bootloader
|
||
extlinux-gpt-bootloader
|
||
extlinux-bootloader-gpt))
|
||
|
||
|
||
;;;
|
||
;;; Config procedures.
|
||
;;;
|
||
|
||
(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 #$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~%" ; Timeout is expressed in tenths of a second.
|
||
#$(if (> timeout 0) 1 0) #$(* 10 timeout))
|
||
#$@(map menu-entry->gexp entries)))))))))
|
||
|
||
|
||
;;;
|
||
;;; Install procedure.
|
||
;;;
|
||
|
||
(define (install-extlinux mbr)
|
||
(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)))))
|
||
|
||
|
||
|
||
;;;
|
||
;;; Bootloader definitions.
|
||
;;;
|
||
|
||
(define extlinux-bootloader
|
||
(bootloader
|
||
(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 "gptmbr.bin"))))
|
||
|
||
(define-deprecated/alias extlinux-bootloader-gpt extlinux-gpt-bootloader)
|