gnu/build/bootloader.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
   3 ;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 (define-module (gnu build bootloader)
  21   #:use-module (guix build utils)
  22   #:use-module (guix utils)
  23   #:use-module (ice-9 binary-ports)
  24   #:use-module (ice-9 format)
  25   #:use-module (rnrs io ports)
  26   #:use-module (rnrs io simple)
  27   #:export (write-file-on-device
  28             install-efi-loader))
  29
  30 \f
  31 ;;;
  32 ;;; Writing utils.
  33 ;;;
  34
  35 (define (write-file-on-device file size device offset)
  36   "Write SIZE bytes from FILE to DEVICE starting at OFFSET."
  37   (call-with-input-file file
  38     (lambda (input)
  39       (let ((bv (get-bytevector-n input size)))
  40         (call-with-port
  41          ;; Do not use "call-with-output-file" that would truncate the file.
  42          (open-file-output-port device
  43                                 (file-options no-truncate no-fail)
  44                                 (buffer-mode block)
  45                                 ;; Use the binary-friendly ISO-8859-1
  46                                 ;; encoding.
  47                                 (make-transcoder (latin-1-codec)))
  48          (lambda (output)
  49            (seek output offset SEEK_SET)
  50            (put-bytevector output bv)))))))
  51
  52 \f
  53 ;;;
  54 ;;; EFI bootloader.
  55 ;;;
  56
  57 (define (install-efi grub grub-config esp)
  58   "Write a self-contained GRUB EFI loader to the mounted ESP using GRUB-CONFIG."
  59   (let* ((system %host-type)
  60          ;; Hard code the output location to a well-known path recognized by
  61          ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
  62          ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
  63          (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
  64          (efi-directory (string-append esp "/EFI/BOOT"))
  65          ;; Map grub target names to boot file names.
  66          (efi-targets (cond ((string-prefix? "x86_64" system)
  67                              '("x86_64-efi" . "BOOTX64.EFI"))
  68                             ((string-prefix? "i686" system)
  69                              '("i386-efi" . "BOOTIA32.EFI"))
  70                             ((string-prefix? "armhf" system)
  71                              '("arm-efi" . "BOOTARM.EFI"))
  72                             ((string-prefix? "aarch64" system)
  73                              '("arm64-efi" . "BOOTAA64.EFI")))))
  74     ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
  75     (setenv "TMPDIR" esp)
  76
  77     (mkdir-p efi-directory)
  78     (invoke grub-mkstandalone "-O" (car efi-targets)
  79             "-o" (string-append efi-directory "/"
  80                                 (cdr efi-targets))
  81             ;; Graft the configuration file onto the image.
  82             (string-append "boot/grub/grub.cfg=" grub-config))))
  83
  84 (define (install-efi-loader grub-efi esp)
  85   "Install in ESP directory the given GRUB-EFI bootloader.  Configure it to
  86 load the Grub bootloader located in the 'Guix_image' root partition."
  87   (let ((grub-config "grub.cfg"))
  88     (call-with-output-file grub-config
  89       (lambda (port)
  90         ;; Create a tiny configuration file telling the embedded grub where to
  91         ;; load the real thing.  XXX This is quite fragile, and can prevent
  92         ;; the image from booting when there's more than one volume with this
  93         ;; label present.  Reproducible almost-UUIDs could reduce the risk
  94         ;; (not eliminate it).
  95         (format port
  96                 "insmod part_msdos~@
  97                search --set=root --label Guix_image~@
  98                configfile /boot/grub/grub.cfg~%")))
  99     (install-efi grub-efi grub-config esp)
 100     (delete-file grub-config)))