180 lines
7.7 KiB
Scheme
180 lines
7.7 KiB
Scheme
|
;; Taken from https://paste.sr.ht/~hako/62bb15503290273e869520e12466718ebb82e000
|
|||
|
;; Based off various things related to https://issues.guix.gnu.org/68524
|
|||
|
|
|||
|
(define-module (ryan-components uki)
|
|||
|
#:use-module (gnu bootloader)
|
|||
|
#:use-module (gnu packages bootloaders)
|
|||
|
#:use-module (gnu packages linux)
|
|||
|
#:use-module (guix gexp)
|
|||
|
#:use-module (guix modules)
|
|||
|
#:export (uefi-uki-bootloader
|
|||
|
uefi-uki-signed-bootloader))
|
|||
|
|
|||
|
(define vendor "Guix")
|
|||
|
(define script-path "/boot/install-uki.scm")
|
|||
|
|
|||
|
(define* (uefi-uki-configuration-file #:optional cert privkey)
|
|||
|
(lambda* (config entries #:key (old-entries '()) #:allow-other-keys)
|
|||
|
|
|||
|
(define all-entries
|
|||
|
(append entries old-entries))
|
|||
|
|
|||
|
(define (menu-entry->ukify-args entry)
|
|||
|
(let* ((label (menu-entry-label entry))
|
|||
|
(linux (menu-entry-linux entry))
|
|||
|
(initrd (menu-entry-initrd entry))
|
|||
|
(arguments (menu-entry-linux-arguments entry))
|
|||
|
(boot (bootloader-configuration-bootloader config))
|
|||
|
(stub (bootloader-package boot)))
|
|||
|
#~(list "--os-release" #$label
|
|||
|
"--linux" #$linux
|
|||
|
"--initrd" #$initrd
|
|||
|
"--cmdline" (string-join (list #$@arguments))
|
|||
|
"--stub" #$(file-append stub "/libexec/" (systemd-stub-name))
|
|||
|
#$@(if cert #~("--secureboot-certificate" #$cert) '())
|
|||
|
#$@(if privkey #~("--secureboot-private-key" #$privkey) '()))))
|
|||
|
|
|||
|
(define (enumerate-uki-filenames entries)
|
|||
|
(map (lambda (n)
|
|||
|
(string-append (number->string n) ".efi"))
|
|||
|
(iota (length entries))))
|
|||
|
|
|||
|
(program-file
|
|||
|
"install-uki"
|
|||
|
(with-imported-modules (source-module-closure
|
|||
|
'((guix build syscalls)
|
|||
|
(guix build utils)
|
|||
|
(guix diagnostics)
|
|||
|
(guix i18n)))
|
|||
|
#~(begin
|
|||
|
(use-modules (guix build syscalls)
|
|||
|
(guix build utils)
|
|||
|
(guix diagnostics)
|
|||
|
(guix i18n)
|
|||
|
(ice-9 string-fun)
|
|||
|
(rnrs io ports)
|
|||
|
(srfi srfi-1))
|
|||
|
(let* ((target (second (command-line)))
|
|||
|
(vendor-directory (string-append target "/EFI/" #$vendor))
|
|||
|
(schema (string-append vendor-directory "/boot.mgr"))
|
|||
|
(efibootmgr #$(file-append efibootmgr "/sbin/efibootmgr"))
|
|||
|
(ukify #$(file-append ukify "/bin/ukify")))
|
|||
|
(define (uki-install-path name)
|
|||
|
(string-append vendor-directory "/" name))
|
|||
|
|
|||
|
(define (uki-efi-path name)
|
|||
|
(string-replace-substring
|
|||
|
(string-drop (uki-install-path name) (string-length target))
|
|||
|
"/"
|
|||
|
"\\"))
|
|||
|
|
|||
|
(define target/trimmed
|
|||
|
(let* ((not-slash (char-set-complement (char-set #\/)))
|
|||
|
(components (string-tokenize target not-slash)))
|
|||
|
(string-join components "/" 'prefix)))
|
|||
|
|
|||
|
(define disk
|
|||
|
(let ((target-mount
|
|||
|
(find (lambda (mount)
|
|||
|
(string=? (mount-point mount) target/trimmed))
|
|||
|
(mounts))))
|
|||
|
(if target-mount
|
|||
|
(mount-source target-mount)
|
|||
|
(leave (G_ "target '~a' not mounted!~%") target/trimmed))))
|
|||
|
|
|||
|
;; Delete all boot entries and files we control.
|
|||
|
(when (file-exists? schema)
|
|||
|
(call-with-input-file schema
|
|||
|
(lambda (port)
|
|||
|
(for-each (lambda (line)
|
|||
|
(unless (string-null? line)
|
|||
|
(false-if-exception
|
|||
|
(invoke/quiet
|
|||
|
efibootmgr
|
|||
|
"--delete-bootnum"
|
|||
|
"--label" line))))
|
|||
|
(string-split (get-string-all port) #\newline)))))
|
|||
|
(when (file-exists? vendor-directory)
|
|||
|
(delete-file-recursively vendor-directory))
|
|||
|
(mkdir-p vendor-directory)
|
|||
|
|
|||
|
(define (install-uki port)
|
|||
|
(lambda (args label name boot?)
|
|||
|
"Install NAME, an unified kernel image to be built with ARGS,
|
|||
|
to vendor-directory, add it to UEFI boot entries with LABEL, and append LABEL to
|
|||
|
PORT. If BOOT? is #t, also add the created boot entry to boot order."
|
|||
|
(define image
|
|||
|
(uki-install-path name))
|
|||
|
|
|||
|
(define (out-of-space-handler . _)
|
|||
|
(when (file-exists? image)
|
|||
|
(delete-file image))
|
|||
|
(unless (file-exists? (uki-install-path "0.efi"))
|
|||
|
(leave
|
|||
|
(G_ "no bootloader installed due to insuffcient space \
|
|||
|
either in '~a' or UEFI NVRAM. Please DO NOT turn off your computer until a \
|
|||
|
bootloader is properly installed.~%")
|
|||
|
target/trimmed))
|
|||
|
(exit))
|
|||
|
|
|||
|
(with-exception-handler out-of-space-handler
|
|||
|
(lambda ()
|
|||
|
(let ((minbytes (* 2 (stat:size (stat #$script-path)))))
|
|||
|
(apply invoke/quiet
|
|||
|
ukify
|
|||
|
"build"
|
|||
|
"--output" image
|
|||
|
args)
|
|||
|
;; Although ‘install-uki.scm’ may not reside on the EFI
|
|||
|
;; system partition, this test can still be utilized to
|
|||
|
;; ensure there's space left for writing to the schema
|
|||
|
;; file.
|
|||
|
(when (< (free-disk-space vendor-directory) minbytes)
|
|||
|
(raise-exception 'insuffcient-disk-space))
|
|||
|
;; Fails when no space left in NVRAM.
|
|||
|
(invoke/quiet efibootmgr
|
|||
|
(if boot? "--create" "--create-only")
|
|||
|
"--label" label
|
|||
|
"--disk" disk
|
|||
|
"--loader" (uki-efi-path name))
|
|||
|
;; This part is harder to discard, so put it to the last
|
|||
|
;; where all errors are handled.
|
|||
|
(put-string port label)
|
|||
|
(put-char port #\newline))))))
|
|||
|
|
|||
|
(call-with-output-file schema
|
|||
|
(lambda (port)
|
|||
|
(for-each
|
|||
|
(install-uki port)
|
|||
|
(list #$@(map-in-order menu-entry->ukify-args all-entries))
|
|||
|
'#$(map-in-order menu-entry-label all-entries)
|
|||
|
'#$(enumerate-uki-filenames all-entries)
|
|||
|
'#$(append
|
|||
|
(map (const #t) entries)
|
|||
|
(map (const #f) old-entries)))))))))))
|
|||
|
|
|||
|
(define install-uefi-uki
|
|||
|
#~(lambda (bootloader target mount-point)
|
|||
|
(invoke (string-append mount-point #$script-path)
|
|||
|
(string-append mount-point target))))
|
|||
|
|
|||
|
;; ‘configuration-file’ here is actually an activation script to be invoked by
|
|||
|
;; ‘installer’.
|
|||
|
;; FIXME: Not expected by ‘reinstall-bootloader’ in (guix scripts system).
|
|||
|
(define uefi-uki-bootloader
|
|||
|
(bootloader
|
|||
|
(name 'uefi-uki)
|
|||
|
(package systemd-stub)
|
|||
|
(installer install-uefi-uki)
|
|||
|
(disk-image-installer #f)
|
|||
|
(configuration-file script-path)
|
|||
|
(configuration-file-generator (uefi-uki-configuration-file))))
|
|||
|
|
|||
|
;; FIXME: Breaks ‘reinstall-bootloader’.
|
|||
|
;; ‘cert’ and ‘privkey’ are not provided to boot parameters.
|
|||
|
(define (uefi-uki-signed-bootloader cert privkey)
|
|||
|
(bootloader
|
|||
|
(inherit uefi-uki-bootloader)
|
|||
|
(name 'uefi-uki-signed)
|
|||
|
(configuration-file-generator (uefi-uki-configuration-file cert privkey))))
|