;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013-2022 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2015, 2016 Alex Kost ;;; Copyright © 2016 Chris Marusich ;;; Copyright © 2017 Mathieu Othacehe ;;; Copyright © 2019 Meiyo Peng ;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas ;;; Copyright © 2020 Danny Milosavljevic ;;; Copyright © 2020, 2021 Brice Waegeneire ;;; Copyright © 2020 Florian Pelz ;;; Copyright © 2020, 2022 Maxim Cournoyer ;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen ;;; Copyright © 2020, 2022 Efraim Flashner ;;; Copyright © 2021 Maxime Devos ;;; Copyright © 2021 raid5atemyhomework ;;; Copyright © 2023 Bruno Victal ;;; Copyright © 2023 Felix Lechner ;;; ;;; 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 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 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 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 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 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) (#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 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 make-boot-alternative boot-alternative? (generation boot-alternative-generation) (system-path boot-alternative-system-path) (epoch boot-alternative-epoch) (parameters boot-alternative-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* ((numbered (lambda (number) (string-append "#" (number->string number)))) (count (and=> generation numbered)) (timestamp (and=> epoch epoch->date-string)) (extras (filter identity (list count timestamp))) (helpful (if (null? extras) "" (string-append "(" (string-join extras ", ") ")")))) (string-join (list text helpful)))) (define (boot-parameters->menu-entry conf) "Return a instance given CONF, a 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)) (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 (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