mirror of
https://codeberg.org/hako/Rosenthal.git
synced 2026-03-04 17:04:21 +00:00
There already exists an exception handler. * modules/rosenthal/bootloader/limine.scm (limine-configuration-file): Remove use of false-if-exception.
128 lines
5.1 KiB
Scheme
128 lines
5.1 KiB
Scheme
;;; 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)))
|