Rosenthal/modules/rosenthal/bootloader/limine.scm
Hilton Chain 11d821da23
bootloader: limine: Remove use of false-if-exception.
There already exists an exception handler.

* modules/rosenthal/bootloader/limine.scm (limine-configuration-file): Remove
use of false-if-exception.
2026-03-03 15:39:02 +08:00

128 lines
5.1 KiB
Scheme
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Copyright © 2026 Hilton Chain <hako@ultrarare.space>
(define-module (rosenthal bootloader limine)
;; Guile builtins
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
;; Utilities
#:use-module (guix gexp)
#:use-module (guix modules)
#:use-module (guix utils)
;; Guix System - bootloaders
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (rosenthal bootloader uki)
;; Guix packages
#:use-module (rosenthal packages bootloaders)
#:export (limine-efi-removable-bootloader))
(define script-path "/boot/install-limine.scm")
(define* (limine-configuration-file config entries
#:key (old-entries '()) #:allow-other-keys)
(define limine
(file-append
(bootloader-package (bootloader-configuration-bootloader config))
(format #f "/share/limine/BOOT~a.EFI"
(cond
((target-x86-32?) "IA32")
((target-x86-64?) "X64")
((target-aarch64?) "AA64")
((target-riscv64?) "RISCV64")))))
(define menu-entries
(cons (first entries)
old-entries))
(define labels
(map-in-order menu-entry-label menu-entries))
(define ukify-args
(map-in-order menu-entry->ukify-args menu-entries))
(program-file "install-limine"
(with-imported-modules
(source-module-closure
'((guix build syscalls)
(guix build utils)))
#~(begin
(use-modules (ice-9 match)
(srfi srfi-1)
(guix build syscalls)
(guix build utils))
(let* ((args (command-line))
(directory (second args))
(limine-directory (in-vicinity directory "EFI/BOOT"))
(guix-directory (in-vicinity directory "EFI/Guix")))
(for-each mkdir-p (list limine-directory guix-directory))
(install-file #$limine limine-directory)
(call-with-output-file (in-vicinity limine-directory "limine.conf.tmp")
(lambda (port)
(let* ((ukify #$(file-append ukify "/bin/ukify"))
(script-path (first args))
(minbytes (* 2 (stat:size (stat script-path))))
(current-label (first '#$labels))
(current-args (first (list #$@ukify-args)))
(old-labels (cdr '#$labels))
(old-args (cdr (list #$@ukify-args))))
(format port "timeout: 5~%")
(with-directory-excursion guix-directory
(for-each delete-file (find-files "." "^OLD-[0-9]+\\.EFI$"))
(apply invoke ukify "build" "--output" "CURRENT.EFI"
current-args)
(format port "
/~a
protocol: efi
path: boot():/EFI/Guix/CURRENT.EFI~%"
current-label)
(unless (null? old-labels)
(format port "~%/GNU system, old configurations...~%"))
(let loop ((count 1)
(labels old-labels)
(args old-args))
(let* ((image-name (format #f "OLD-~a.EFI" count)))
(unless (null? labels)
(with-exception-handler
(lambda _
(false-if-exception (delete-file image-name))
(exit))
(lambda ()
(when (< (free-disk-space ".") minbytes)
(raise-exception 'insuffcient-disk-space))
(apply invoke/quiet
ukify "build" "--output" image-name
(first args))
(format port "~
//~a
protocol: efi
path: boot():/EFI/Guix/OLD-~a.EFI~%"
(first labels)
count)))
(loop (1+ count)
(cdr labels)
(cdr args)))))))))
(rename-file (in-vicinity limine-directory "limine.conf.tmp")
(in-vicinity limine-directory "limine.conf")))))))
(define install-limine-efi
#~(lambda (bootloader target mount-point)
(invoke (string-append mount-point #$script-path)
(string-append mount-point target))))
;; Limine + UKI
;; NOTE: configuration-file here is actually an activation script to be invoked by
;; installer.
;; XXX: Not expected by reinstall-bootloader so rolling-back and switching
;; generation won't work.
(define limine-efi-removable-bootloader
(bootloader
;; NOTE: Don't change the name. Generation switching code only knows
;; bootloaders defined in (gnu bootloader grub).
(name 'grub-efi-removable-bootloader)
(package limine)
(installer install-limine-efi)
(disk-image-installer #f)
(configuration-file script-path)
(configuration-file-generator limine-configuration-file)))