;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2019 Ludovic Courtès ;;; Copyright © 2022 Denis 'GNUtoo' Carikli ;;; Copyright © 2022 Timothy Sample ;;; Copyright © 2024 Lilah Tascheter ;;; ;;; 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 . (define-module (gnu build bootloader) #:autoload (guix build syscalls) (free-disk-space) #:use-module (guix build utils) #:use-module (guix diagnostics) #:use-module (guix i18n) #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 popen) #:use-module (ice-9 receive) #:use-module (ice-9 regex) #:use-module (rnrs io ports) #:use-module (rnrs io simple) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-35) #:export (atomic-copy in-temporary-directory write-file-on-device install-efi)) ;;; ;;; Writing utils. ;;; (define (atomic-copy from to) (let ((pivot (string-append to ".new"))) (copy-file from pivot) (rename-file pivot to))) (define-syntax-rule (in-temporary-directory blocks ...) "Run BLOCKS while chdir'd into a temporary directory." ;; Under POSIX.1-2008, mkdtemp must make the dir with 700 perms. (let* ((tmp (or (getenv "TMPDIR") "/tmp")) (dir (mkdtemp (string-append tmp "/guix-bootloader.XXXXXX"))) (cwd (getcwd))) (dynamic-wind (lambda () (chdir dir)) (lambda () blocks ...) (lambda () (chdir cwd) (delete-file-recursively dir))))) (define (write-file-on-device file size device offset) "Write SIZE bytes from FILE to DEVICE starting at OFFSET." (call-with-input-file file (lambda (input) (let ((bv (get-bytevector-n input size))) (call-with-port ;; Do not use "call-with-output-file" that would truncate the file. (open-file-output-port device (file-options no-truncate no-fail) (buffer-mode block) ;; Use the binary-friendly ISO-8859-1 ;; encoding. (make-transcoder (latin-1-codec))) (lambda (output) (seek output offset SEEK_SET) (put-bytevector output bv))))))) ;;; ;;; EFI bootloader. ;;; ;; XXX: Parsing efibootmgr output may be kinda jank. A better way may exist. (define (efi-bootnums efibootmgr) "Returns '(path . bootnum) pairs for each EFI boot entry. bootnum is a string, and path is backslash-deliminated and relative to the ESP." (let* ((pipe (open-pipe* OPEN_READ efibootmgr)) (text (get-string-all pipe)) (status (status:exit-val (close-pipe pipe))) (bootnum-pattern "^Boot([0-9a-fA-F]+).*[^A-Za-z]File\\(([^)]+)\\)$")) (unless (zero? status) (raise-exception (formatted-message (G_ "efibootmgr exited with error code ~a") status))) (fold-matches (make-regexp bootnum-pattern regexp/newline) text '() (lambda (match acc) (let* ((path (match:substring match 2)) (bootnum (match:substring match 1))) (cons (cons path bootnum) acc)))))) (define (install-efi efibootmgr vendir loader* disk plan) "See also install-efi in (gnu bootloader)." (let* ((loader (string-map (match-lambda (#\/ #\\) (x x)) loader*)) (bootnums (filter (compose (cut string-prefix? loader <>) car) (efi-bootnums efibootmgr))) (plan-files (map cadr plan))) (define (size file) (if (file-exists? file) (stat:size (stat file)) 0)) (define (vendirof file) (string-append vendir "/" file)) (define (loaderof file) (string-append loader "\\" file)) (define (delete-boot num file) (invoke efibootmgr "--quiet" "--bootnum" num "--delete-bootnum") (when (file-exists? file) (delete-file file))) (mkdir-p vendir) ;; Delete old entries first, to clear up space. (for-each (lambda (spec) ; '(path . bootnum) (let* ((s (substring (car spec) (string-length loader))) (file (substring s (if (string-prefix? "\\" s) 1 0)))) (unless (member file plan-files) (delete-boot (cdr spec) (vendirof file))))) bootnums) ;; New and updated entries. (in-temporary-directory (for-each (lambda (spec) (let* ((builder (car spec)) (name (cadr spec)) (dest (vendirof name)) (loadest (loaderof name)) (rest (reverse (cdr (member name plan-files))))) ;; Build to a temporary file so we can check its size. (builder name) ;; Disk space is usually limited on ESPs. ;; Try to clear space as we install new bootloaders. (if (while (> (- (size name) (size dest)) (free-disk-space vendir)) (let ((del (find (compose file-exists? vendirof) rest))) (if del (delete-file (vendirof del)) (break #t)))) (begin (and=> (assoc-ref bootnums loadest) (cut delete-boot <> dest)) (warning (G_ "ESP too small for bootloader ~a!~%") name)) ;; The ESP is too small for atomic copy. (begin (copy-file name dest) (unless (assoc loadest bootnums) (invoke efibootmgr "--quiet" "--create-only" "--label" (cddr spec) "--disk" disk "--loader" loadest)))) (delete-file name))) plan)) ;; Verify that at least the first entry was installed. (unless (file-exists? (vendirof (cadr (car plan)))) ;; Extremely fatal error so we use leave instead of raise. (leave (G_ "not enough space in ESP to install bootloader! SYSTEM WILL NOT BOOT UNLESS THIS IS FIXED!~%"))) ;; Some UEFI systems will refuse to acknowledge the existence of boot ;; entries unless they're in bootorder, so just shove everything in there. (invoke efibootmgr "--quiet" "--bootorder" ;; Recall efi-bootnums to get a fresh list with new installs. (let ((num (cute assoc-ref (efi-bootnums efibootmgr) <>))) ; cute is eager (string-join (filter-map (compose num loaderof) plan-files) ",")))))