mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
689cca0c75
Sorry this is a massive commit. It's kinda impossible to split it without either completely breaking basic functionality or making a buggy shim layer that's written just to be immediately removed. But anyway, this is the real body of the bootloader subsystem update. One of my favorite new things possible with this is easy generation of disk images using arbitrary bootloaders, including ones that require one or more data/install partitions, such as p-boot or depthcharge! * gnu/build/image.scm (initialize-root-partition): Don't install bootloader here. (make-iso9660-image): Pull in grub.dir instead of a bootcfg. * gnu/build/install.scm (install-boot-config): Delete procedure. * gnu/machine/ssh.scm (deploy-managed-host, roll-back-managed-host): Use new bootloader system. (operating-system)[bootloader]: Use wrap-element sanitizer and support multiple bootloaders. (operating-system-bootcfg): Rename to... (operating-system-bootmeta): ...this. Rewrite to return relevant information instead of calling the config procedure directly. (operating-system-boot-parameters): Support multiple bootloaders. * gnu/system/boot.scm (read-boot-parameters): Support multiple bootloaders. * gnu/system/image.scm (root-partition-index): Delete procedure. (system-disk-image, system-iso9960-image): Support new bootloader system. (system-disk-image)[targets]: New subprocedure. * guix/scripts/system.scm (install, install-bootloader-from-provenance, perform-action): Support multiple bootloaders and work with new bootloader system instead of bootcfgs. (display-system-generation): Support multiple bootloaders. * guix/scripts/system/reconfigure.scm (install-bootloader-program): Rewrite to simply insert each bootloader's installer in the gexp directly, instead of copying bootcfgs. (install-bootloader): Work with new bootloader system. Just in case, add install-bootloader.scm to the gc roots too. Change-Id: I3654d160f7306bb45a78b82ea6b249ff4281f739
369 lines
15 KiB
Scheme
369 lines
15 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
|
;;; Copyright © 2013-2022 Ludovic Courtès <ludo@gnu.org>
|
|
;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
|
|
;;; Copyright © 2017 David Craven <david@craven.ch>
|
|
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
|
|
;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
|
|
;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
|
|
;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
|
|
;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
|
|
;;; Copyright © 2020 Janneke Nieuwenhuizen <jannek@gnu.org>
|
|
;;; Copyright © 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
|
|
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
|
|
;;; Copyright © 2024 Felix Lechner <felix.lechner@lease-up.com>
|
|
;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
|
|
;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
|
|
;;;
|
|
;;; 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 <http://www.gnu.org/licenses/>.
|
|
|
|
(define-module (gnu system boot)
|
|
#:use-module (guix gexp)
|
|
#:use-module (guix diagnostics)
|
|
#:use-module (guix i18n)
|
|
#:use-module (guix records)
|
|
#:use-module (guix store)
|
|
#:use-module (guix utils)
|
|
#:use-module (gnu bootloader)
|
|
#:use-module (gnu system file-systems)
|
|
#:use-module (gnu system uuid)
|
|
#:use-module (ice-9 format)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-19)
|
|
#:use-module (srfi srfi-34)
|
|
#:use-module (srfi srfi-35)
|
|
#:use-module (rnrs bytevectors)
|
|
#:export (boot-parameters
|
|
boot-parameters?
|
|
boot-parameters-label
|
|
boot-parameters-root-device
|
|
boot-parameters-bootloader-name
|
|
boot-parameters-store-crypto-devices
|
|
boot-parameters-store-device
|
|
boot-parameters-store-directory-prefix
|
|
boot-parameters-store-mount-point
|
|
boot-parameters-locale
|
|
boot-parameters-kernel
|
|
boot-parameters-kernel-arguments
|
|
boot-parameters-initrd
|
|
boot-parameters-multiboot-modules
|
|
boot-parameters-version
|
|
%boot-parameters-version
|
|
|
|
read-boot-parameters
|
|
read-boot-parameters-file
|
|
bootable-kernel-arguments
|
|
|
|
boot-alternative
|
|
boot-alternative?
|
|
boot-alternative-generation
|
|
boot-alternative-system-path
|
|
boot-alternative-epoch
|
|
boot-alternative-parameters
|
|
|
|
epoch->date-string
|
|
decorated-boot-label
|
|
boot-parameters->menu-entry
|
|
boot-alternative->menu-entry
|
|
|
|
ensure-not-/dev
|
|
system-linux-image-file-name))
|
|
|
|
;;;
|
|
;;; Boot parameters
|
|
;;;
|
|
|
|
;;; Version 1 was introduced early 2022 to mark the departure from long option
|
|
;;; names such as '--load' to the more conventional initrd option names like
|
|
;;; 'gnu.load'.
|
|
;;;
|
|
;;; When bumping the boot-parameters version, increment it by one (1).
|
|
(define %boot-parameters-version 1)
|
|
|
|
(define-record-type* <boot-parameters>
|
|
boot-parameters make-boot-parameters boot-parameters?
|
|
(label boot-parameters-label)
|
|
;; Because we will use the 'store-device' to create the GRUB search command,
|
|
;; the 'store-device' has slightly different semantics than 'root-device'.
|
|
;; The 'store-device' can be a file system uuid, a file system label, or #f,
|
|
;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
|
|
;; not understand that. The 'root-device', on the other hand, corresponds
|
|
;; exactly to the device field of the <file-system> object representing the
|
|
;; OS's root file system, so it might be a device file name like
|
|
;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
|
|
;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
|
|
;; contain "/storefs" if the store is located in that subvolume of a btrfs
|
|
;; partition.
|
|
(root-device boot-parameters-root-device)
|
|
(bootloader-name boot-parameters-bootloader-name)
|
|
(store-device boot-parameters-store-device)
|
|
(store-mount-point boot-parameters-store-mount-point)
|
|
(store-directory-prefix boot-parameters-store-directory-prefix)
|
|
(store-crypto-devices boot-parameters-store-crypto-devices
|
|
(default '()))
|
|
(locale boot-parameters-locale)
|
|
(kernel boot-parameters-kernel)
|
|
(kernel-arguments boot-parameters-kernel-arguments)
|
|
(initrd boot-parameters-initrd)
|
|
(multiboot-modules boot-parameters-multiboot-modules)
|
|
(version boot-parameters-version ;positive integer
|
|
(default %boot-parameters-version)))
|
|
|
|
(define (read-boot-parameters port)
|
|
"Read boot parameters from PORT and return the corresponding
|
|
<boot-parameters> object. Raise an error if the format is unrecognized."
|
|
(define device-sexp->device
|
|
(match-lambda
|
|
(('uuid (? symbol? type) (? bytevector? bv))
|
|
(bytevector->uuid bv type))
|
|
(('file-system-label (? string? label))
|
|
(file-system-label label))
|
|
((? bytevector? bv) ;old format
|
|
(bytevector->uuid bv 'dce))
|
|
((? string? device)
|
|
(if (string-contains device ":/")
|
|
device ; nfs-root
|
|
;; It used to be that we would not distinguish between labels and
|
|
;; device names. Try to infer the right thing here.
|
|
(if (string-prefix? "/" device)
|
|
device
|
|
(file-system-label device))))))
|
|
(define uuid-sexp->uuid
|
|
(match-lambda
|
|
(('uuid (? symbol? type) (? bytevector? bv))
|
|
(bytevector->uuid bv type))
|
|
(x
|
|
(warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
|
|
#f)))
|
|
|
|
;; New versions are not backward-compatible, so only accept past and current
|
|
;; versions, not future ones.
|
|
(define (version? n)
|
|
(member n (iota (1+ %boot-parameters-version))))
|
|
|
|
(match (read port)
|
|
(('boot-parameters ('version (? version? version))
|
|
('label label) ('root-device root)
|
|
('kernel kernel)
|
|
rest ...)
|
|
(boot-parameters
|
|
(version version)
|
|
(label label)
|
|
(root-device (device-sexp->device root))
|
|
|
|
(bootloader-name
|
|
(match (assq 'bootloader-name rest)
|
|
((_ (args ...)) args)
|
|
((_ args) (list args))
|
|
(#f 'grub))) ; for compatibility reasons.
|
|
|
|
;; In the past, we would store the directory name of linux instead of
|
|
;; the absolute file name of its image. Detect that and correct it.
|
|
(kernel (if (string=? kernel (direct-store-path kernel))
|
|
(string-append kernel "/"
|
|
(system-linux-image-file-name))
|
|
kernel))
|
|
|
|
(kernel-arguments
|
|
(match (assq 'kernel-arguments rest)
|
|
((_ args) args)
|
|
(#f '()))) ;the old format
|
|
|
|
(initrd
|
|
(match (assq 'initrd rest)
|
|
(('initrd ('string-append directory file)) ;the old format
|
|
(string-append directory file))
|
|
(('initrd (? string? file))
|
|
file)
|
|
(#f #f)))
|
|
|
|
(multiboot-modules
|
|
(match (assq 'multiboot-modules rest)
|
|
((_ args) args)
|
|
(#f '())))
|
|
|
|
(locale
|
|
(match (assq 'locale rest)
|
|
((_ locale) locale)
|
|
(#f #f)))
|
|
|
|
(store-device
|
|
;; Linux device names like "/dev/sda1" are not suitable GRUB device
|
|
;; identifiers, so we just filter them out.
|
|
(ensure-not-/dev
|
|
(match (assq 'store rest)
|
|
(('store ('device #f) _ ...)
|
|
root-device)
|
|
(('store ('device device) _ ...)
|
|
(device-sexp->device device))
|
|
(_ ;the old format
|
|
root-device))))
|
|
|
|
(store-directory-prefix
|
|
(match (assq 'store rest)
|
|
(('store . store-data)
|
|
(match (assq 'directory-prefix store-data)
|
|
(('directory-prefix prefix) prefix)
|
|
;; No directory-prefix found.
|
|
(_ #f)))
|
|
(_
|
|
;; No store found, old format.
|
|
#f)))
|
|
|
|
(store-crypto-devices
|
|
(match (assq 'store rest)
|
|
(('store . store-data)
|
|
(match (assq 'crypto-devices store-data)
|
|
(('crypto-devices (devices ...))
|
|
(map uuid-sexp->uuid devices))
|
|
(('crypto-devices dev)
|
|
(warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
|
|
dev (port-filename port))
|
|
'())
|
|
(_
|
|
;; No crypto-devices found.
|
|
'())))
|
|
(_
|
|
;; No store found, old format.
|
|
'())))
|
|
|
|
(store-mount-point
|
|
(match (assq 'store rest)
|
|
(('store ('device _) ('mount-point mount-point) _ ...)
|
|
mount-point)
|
|
(_ ;the old format
|
|
"/")))))
|
|
(x ;unsupported format
|
|
(raise
|
|
(make-compound-condition
|
|
(formatted-message
|
|
(G_ "unrecognized boot parameters at '~a'~%")
|
|
(port-filename port))
|
|
(condition
|
|
(&fix-hint (hint (format #f (G_ "This probably means that this version
|
|
of Guix is older than the one that created @file{~a}. To address this, you
|
|
need to update Guix:
|
|
|
|
@example
|
|
guix pull
|
|
@end example")
|
|
(port-filename port))))))))))
|
|
|
|
(define (read-boot-parameters-file system)
|
|
"Read boot parameters from SYSTEM's (system or generation) \"parameters\"
|
|
file and returns the corresponding <boot-parameters> object or #f if the
|
|
format is unrecognized.
|
|
The object has its kernel-arguments extended in order to make it bootable."
|
|
(let* ((file (string-append system "/parameters"))
|
|
(params (call-with-input-file file read-boot-parameters))
|
|
(root (boot-parameters-root-device params))
|
|
(version (boot-parameters-version params)))
|
|
(boot-parameters
|
|
(inherit params)
|
|
(kernel-arguments (append (bootable-kernel-arguments system root version)
|
|
(boot-parameters-kernel-arguments params))))))
|
|
|
|
(define* (bootable-kernel-arguments system root-device version)
|
|
"Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE.
|
|
VERSION is the target version of the boot-parameters record."
|
|
;; If the version is newer than 0, we use the new style initrd parameter
|
|
;; names, otherwise we use the legacy ones. This is to maintain backward
|
|
;; compatibility when producing bootloader configurations for older
|
|
;; generations.
|
|
(define version>0? (> version 0))
|
|
(let ((root (file-system-device->string root-device
|
|
#:uuid-type 'dce)))
|
|
(append
|
|
(if (string=? root "none")
|
|
'() ; Ignore the case where the root is "none" (typically tmpfs).
|
|
;; Note: Always use the DCE format because that's what
|
|
;; (gnu build linux-boot) expects for the 'root'
|
|
;; kernel command-line option.
|
|
(list (string-append (if version>0? "root=" "--root=") root)))
|
|
(list #~(string-append (if #$version>0? "gnu.system=" "--system=") #$system)
|
|
#~(string-append (if #$version>0? "gnu.load=" "--load=")
|
|
#$system "/boot")))))
|
|
|
|
(define-record-type* <boot-alternative>
|
|
boot-alternative make-boot-alternative boot-alternative?
|
|
(generation boot-alternative-generation)
|
|
(system-path boot-alternative-system-path)
|
|
(epoch boot-alternative-epoch)
|
|
(parameters boot-alternative-parameters)) ; <boot-parameters>
|
|
|
|
(define (epoch->date-string epoch)
|
|
"Return a string representing the date for EPOCH seconds."
|
|
(let ((time (make-time time-utc 0 epoch)))
|
|
(date->string (time-utc->date time)
|
|
"~Y-~m-~d ~H:~M")))
|
|
|
|
(define (decorated-boot-label text generation epoch)
|
|
"Return a string for a nice boot label that includes TEXT, a numbered
|
|
GENERATION, and a timestamp derived from EPOCH seconds."
|
|
(let ((count (and generation
|
|
(string-append "#" (number->string generation))))
|
|
(timestamp (and=> epoch epoch->date-string)))
|
|
(match (filter identity (list count timestamp))
|
|
(() text)
|
|
(extras (string-append text "(" (string-join extras ", ") ")")))))
|
|
|
|
(define (boot-parameters->menu-entry conf)
|
|
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
|
|
(let* ((kernel (boot-parameters-kernel conf))
|
|
(multiboot-modules (boot-parameters-multiboot-modules conf))
|
|
(multiboot? (pair? multiboot-modules)))
|
|
(menu-entry
|
|
(label (boot-parameters-label conf))
|
|
(device (boot-parameters-store-device conf))
|
|
(device-mount-point (boot-parameters-store-mount-point conf))
|
|
(device-subvol (boot-parameters-store-directory-prefix conf))
|
|
(linux (and (not multiboot?) kernel))
|
|
(linux-arguments (if (not multiboot?)
|
|
(boot-parameters-kernel-arguments conf)
|
|
'()))
|
|
(initrd (boot-parameters-initrd conf))
|
|
(multiboot-kernel (and multiboot? kernel))
|
|
(multiboot-arguments (if multiboot?
|
|
(boot-parameters-kernel-arguments conf)
|
|
'()))
|
|
(multiboot-modules (if multiboot?
|
|
(boot-parameters-multiboot-modules conf)
|
|
'())))))
|
|
|
|
(define boot-alternative->menu-entry
|
|
(compose boot-parameters->menu-entry boot-alternative-parameters))
|
|
|
|
(define (ensure-not-/dev device)
|
|
"If DEVICE starts with a slash, return #f. This is meant to filter out
|
|
Linux device names such as /dev/sda, and to preserve GRUB device names and
|
|
file system labels."
|
|
(if (and (string? device) (string-prefix? "/" device))
|
|
#f
|
|
device))
|
|
|
|
;; XXX: defined here instead of (gnu system) to prevent dependency loop
|
|
(define* (system-linux-image-file-name #:optional
|
|
(target (or (%current-target-system)
|
|
(%current-system))))
|
|
"Return the basename of the kernel image file for TARGET."
|
|
(cond
|
|
((string-prefix? "arm" target) "zImage")
|
|
((string-prefix? "mips" target) "vmlinuz")
|
|
((string-prefix? "aarch64" target) "Image")
|
|
((string-prefix? "riscv64" target) "Image")
|
|
(else "bzImage")))
|
|
|
|
;;; boot.scm ends here
|