modules/ryan-bootloader/uki.scm
1e1225d607e196e8bc0e020dce23589f16339427
· 5.4 KB · 115 lines
raw
| 1 | (define-module (ryan-bootloader uki) |
| 2 | #:use-module (gnu bootloader) |
| 3 | #:use-module (ryan-packages bootloaders) |
| 4 | #:use-module (gnu packages bootloaders) |
| 5 | #:use-module (gnu packages efi) |
| 6 | #:use-module (gnu packages linux) |
| 7 | #:use-module (guix gexp) |
| 8 | #:use-module (guix modules) |
| 9 | #:use-module (srfi srfi-1) |
| 10 | #:export (uefi-uki-bootloader uefi-uki-signed-bootloader)) |
| 11 | |
| 12 | ;; config generator makes script creating uki images |
| 13 | ;; install runs script |
| 14 | ;; install device is path to uefi dir |
| 15 | (define vendor "Guix") |
| 16 | (define script-loc "/boot/install-uki.scm") |
| 17 | |
| 18 | (define* (uefi-uki-configuration-file #:optional cert privkey) |
| 19 | (lambda* (config entries #:key (old-entries '()) #:allow-other-keys) |
| 20 | |
| 21 | (define (menu-entry->args e) |
| 22 | (let* ((boot (bootloader-configuration-bootloader config)) |
| 23 | (stub (bootloader-package boot))) |
| 24 | #~(list "--os-release" #$(menu-entry-label e) |
| 25 | "--linux" #$(menu-entry-linux e) "--initrd" #$(menu-entry-initrd e) |
| 26 | "--cmdline" (string-join (list #$@(menu-entry-linux-arguments e))) |
| 27 | "--stub" #$(file-append stub "/libexec/" (systemd-stub-name)) |
| 28 | #$@(if cert #~("--secureboot-certificate" #$cert) #~()) |
| 29 | #$@(if privkey #~("--secureboot-private-key" #$privkey) #~())))) |
| 30 | |
| 31 | (define (enum-filenames . args) ; same args as iota |
| 32 | (map (lambda (n) (string-append (number->string n) ".efi")) |
| 33 | (apply iota (map length args)))) |
| 34 | |
| 35 | (program-file "install-uki" |
| 36 | (with-imported-modules (source-module-closure '((guix build syscalls) |
| 37 | (guix build utils))) |
| 38 | #~(let* ((target (cadr (command-line))) |
| 39 | (vendir (string-append target "/EFI/" #$vendor)) |
| 40 | (schema (string-append vendir "/boot.mgr")) |
| 41 | (findmnt #$(file-append util-linux "/bin/findmnt")) |
| 42 | (efibootmgr #$(file-append efibootmgr "/sbin/efibootmgr"))) |
| 43 | (use-modules (guix build syscalls) (guix build utils) |
| 44 | (ice-9 popen) (ice-9 textual-ports)) |
| 45 | |
| 46 | (define (out name) (string-append vendir "/" name)) |
| 47 | (define disk |
| 48 | (call-with-port |
| 49 | (open-pipe* OPEN_READ findmnt "-fnro" "SOURCE" "-T" target) |
| 50 | (lambda (port) (get-line port)))) ; only 1 line: the device |
| 51 | (define part |
| 52 | (substring disk (- (string-length disk) 1))) |
| 53 | |
| 54 | ;; delete all boot entries and files we control |
| 55 | (when (file-exists? schema) |
| 56 | (call-with-input-file schema |
| 57 | (lambda (port) |
| 58 | (for-each (lambda (l) |
| 59 | (unless (string-null? l) |
| 60 | (system* efibootmgr "-B" "-L" l "-q"))) |
| 61 | (string-split (get-string-all port) #\lf))))) |
| 62 | (when (directory-exists? vendir) (delete-file-recursively vendir)) |
| 63 | (mkdir-p vendir) |
| 64 | |
| 65 | (define (install port boot? oos) |
| 66 | (lambda (args label name) |
| 67 | (let ((minbytes (* 2 (stat:size (stat #$script-loc))))) |
| 68 | (put-string port label) |
| 69 | (put-char port #\lf) |
| 70 | (force-output port) ; make sure space is alloc'd |
| 71 | (apply invoke #$(file-append ukify "/bin/ukify") |
| 72 | "build" "-o" (out name) args) |
| 73 | ;; make sure we have enough space for next install-uki.scm |
| 74 | (when (and oos (< (free-disk-space vendir) minbytes)) (oos)) |
| 75 | (invoke efibootmgr (if boot? "-c" "-C") "-L" label "--disk" disk "--part" part |
| 76 | "--loader" (string-append "\\EFI\\" #$vendor "\\" name) "-q")))) |
| 77 | |
| 78 | (call-with-output-file schema |
| 79 | (lambda (port) ; prioritize latest UKIs in limited ESP space |
| 80 | (for-each (install port #t #f) |
| 81 | (list #$@(map-in-order menu-entry->args entries)) |
| 82 | (list #$@(map-in-order menu-entry-label entries)) |
| 83 | (list #$@(enum-filenames entries))) |
| 84 | (for-each ; old-entries can fail (out of space) we don't care |
| 85 | (lambda (args label name) |
| 86 | (define (cleanup . _) ; do exit early if out of space tho |
| 87 | (when (file-exists? (out name)) (delete-file (out name))) |
| 88 | (exit)) |
| 89 | (with-exception-handler cleanup |
| 90 | (lambda _ ((install port #f cleanup) args label name)))) |
| 91 | (list #$@(map-in-order menu-entry->args old-entries)) |
| 92 | (list #$@(map-in-order menu-entry-label old-entries)) |
| 93 | (list #$@(enum-filenames old-entries entries)))))))))) |
| 94 | |
| 95 | (define install-uefi-uki |
| 96 | #~(lambda (bootloader target mount-point) |
| 97 | (invoke (string-append mount-point #$script-loc) |
| 98 | (string-append mount-point target)))) |
| 99 | |
| 100 | (define* (make-uefi-uki-bootloader #:optional cert privkey) |
| 101 | (bootloader |
| 102 | (name 'uefi-uki) |
| 103 | (package systemd-stub) |
| 104 | (installer install-uefi-uki) |
| 105 | (disk-image-installer #f) |
| 106 | (configuration-file script-loc) |
| 107 | (configuration-file-generator (uefi-uki-configuration-file cert privkey)))) |
| 108 | |
| 109 | ;; IMPORTANT NOTE: if bootloader install fails, do not turn off your computer! until |
| 110 | ;; install succeeds, your system is unbootable. |
| 111 | (define uefi-uki-bootloader (make-uefi-uki-bootloader)) |
| 112 | ;; use ukify genkey to generate cert and privkey. DO NOT include in store. |
| 113 | (define (uefi-uki-signed-bootloader cert privkey) |
| 114 | (make-uefi-uki-bootloader cert privkey)) |
| 115 |