mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
Move <boot-parameters> record to a separate file.
Required to avoid a missing dependency error on build-side. * gnu/system.scm (<boot-parameters>): Move this record, and... (system-linux-image-file-name, %boot-parameters-version, bootable-kernel-arguments, ensure-not-/dev, read-boot-parameters, read-boot-parameters-file, boot-parameters->menu-entry): ...these procedures, to... * gnu/system/boot.scm: ...this new file. * gnu/machine/ssh.scm, gnu/system.scm, guix/scripts/system.scm, tests/boot-parameters.scm: Use new module above. * gnu/local.mk (GNU_SYSTEM_MODULES): Add new module above. * gnu/machine/ssh.scm (machine-boot-parameters): Don't private-import bootable-kernel-arguments. Change-Id: I50cca8d2187879cd351b8e9332e1e114ca5096ae
This commit is contained in:
Felix Lechner
parent
8db7a8f1e2
commit
b452d525d6
GPG key ID:
81B0E222A3E2308E
6 changed files with 340 additions and 289 deletions
|
|
@ -763,6 +763,7 @@ GNU_SYSTEM_MODULES = \
|
||||||
\
|
\
|
||||||
%D%/system.scm \
|
%D%/system.scm \
|
||||||
%D%/system/accounts.scm \
|
%D%/system/accounts.scm \
|
||||||
|
%D%/system/boot.scm \
|
||||||
%D%/system/file-systems.scm \
|
%D%/system/file-systems.scm \
|
||||||
%D%/system/hurd.scm \
|
%D%/system/hurd.scm \
|
||||||
%D%/system/image.scm \
|
%D%/system/image.scm \
|
||||||
|
|
|
||||||
|
|
@ -23,6 +23,7 @@ (define-module (gnu machine ssh)
|
||||||
#:use-module (gnu machine)
|
#:use-module (gnu machine)
|
||||||
#:autoload (gnu packages gnupg) (guile-gcrypt)
|
#:autoload (gnu packages gnupg) (guile-gcrypt)
|
||||||
#:use-module (gnu system)
|
#:use-module (gnu system)
|
||||||
|
#:use-module (gnu system boot)
|
||||||
#:use-module (gnu system file-systems)
|
#:use-module (gnu system file-systems)
|
||||||
#:use-module (gnu system uuid)
|
#:use-module (gnu system uuid)
|
||||||
#:use-module ((gnu services) #:select (sexp->system-provenance))
|
#:use-module ((gnu services) #:select (sexp->system-provenance))
|
||||||
|
|
@ -419,9 +420,6 @@ (define not-config?
|
||||||
(define (machine-boot-parameters machine)
|
(define (machine-boot-parameters machine)
|
||||||
"Monadic procedure returning a list of 'boot-parameters' for the generations
|
"Monadic procedure returning a list of 'boot-parameters' for the generations
|
||||||
of MACHINE's system profile, ordered from most recent to oldest."
|
of MACHINE's system profile, ordered from most recent to oldest."
|
||||||
(define bootable-kernel-arguments
|
|
||||||
(@@ (gnu system) bootable-kernel-arguments))
|
|
||||||
|
|
||||||
(define remote-exp
|
(define remote-exp
|
||||||
(with-extensions (list guile-gcrypt)
|
(with-extensions (list guile-gcrypt)
|
||||||
(with-imported-modules `(((guix config) => ,(make-config.scm))
|
(with-imported-modules `(((guix config) => ,(make-config.scm))
|
||||||
|
|
|
||||||
287
gnu/system.scm
287
gnu/system.scm
|
|
@ -72,6 +72,7 @@ (define-module (gnu system)
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
#:use-module (gnu services base)
|
#:use-module (gnu services base)
|
||||||
#:use-module (gnu bootloader)
|
#:use-module (gnu bootloader)
|
||||||
|
#:use-module (gnu system boot)
|
||||||
#:use-module (gnu system shadow)
|
#:use-module (gnu system shadow)
|
||||||
#:use-module (gnu system nss)
|
#:use-module (gnu system nss)
|
||||||
#:use-module (gnu system locale)
|
#:use-module (gnu system locale)
|
||||||
|
|
@ -147,33 +148,11 @@ (define-module (gnu system)
|
||||||
operating-system-boot-script
|
operating-system-boot-script
|
||||||
operating-system-uuid
|
operating-system-uuid
|
||||||
|
|
||||||
system-linux-image-file-name
|
|
||||||
operating-system-with-gc-roots
|
operating-system-with-gc-roots
|
||||||
operating-system-with-provenance
|
operating-system-with-provenance
|
||||||
|
|
||||||
hurd-default-essential-services
|
hurd-default-essential-services
|
||||||
|
|
||||||
boot-parameters
|
|
||||||
boot-parameters?
|
|
||||||
boot-parameters-label
|
|
||||||
boot-parameters-root-device
|
|
||||||
boot-parameters-bootloader-name
|
|
||||||
boot-parameters-bootloader-menu-entries
|
|
||||||
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
|
|
||||||
boot-parameters->menu-entry
|
|
||||||
|
|
||||||
local-host-aliases ;deprecated
|
local-host-aliases ;deprecated
|
||||||
%root-account
|
%root-account
|
||||||
%default-privileged-programs
|
%default-privileged-programs
|
||||||
|
|
@ -195,29 +174,6 @@ (define-module (gnu system)
|
||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
(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")))))
|
|
||||||
|
|
||||||
;; System-wide configuration.
|
|
||||||
|
|
||||||
(define-with-syntax-properties (warn-hosts-file-field-deprecation
|
(define-with-syntax-properties (warn-hosts-file-field-deprecation
|
||||||
(value properties))
|
(value properties))
|
||||||
(when value
|
(when value
|
||||||
|
|
@ -361,236 +317,6 @@ (define* (operating-system-kernel-arguments
|
||||||
(append (bootable-kernel-arguments os root-device version)
|
(append (bootable-kernel-arguments os root-device version)
|
||||||
(operating-system-user-kernel-arguments os)))
|
(operating-system-user-kernel-arguments os)))
|
||||||
|
|
||||||
|
|
||||||
;;;
|
|
||||||
;;; 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)
|
|
||||||
(bootloader-menu-entries ;list of <menu-entry>
|
|
||||||
boot-parameters-bootloader-menu-entries)
|
|
||||||
(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 (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))
|
|
||||||
|
|
||||||
(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)
|
|
||||||
(#f 'grub))) ; for compatibility reasons.
|
|
||||||
|
|
||||||
(bootloader-menu-entries
|
|
||||||
(match (assq 'bootloader-menu-entries rest)
|
|
||||||
((_ entries) (map sexp->menu-entry entries))
|
|
||||||
(#f '())))
|
|
||||||
|
|
||||||
;; 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 (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))
|
|
||||||
(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)
|
|
||||||
'())))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -731,17 +457,6 @@ (define (filter-deps swap)
|
||||||
(map (compose swap-service filter-deps)
|
(map (compose swap-service filter-deps)
|
||||||
(operating-system-swap-devices os)))
|
(operating-system-swap-devices os)))
|
||||||
|
|
||||||
(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")))
|
|
||||||
|
|
||||||
(define (operating-system-kernel-file os)
|
(define (operating-system-kernel-file os)
|
||||||
"Return an object representing the absolute file name of the kernel image of
|
"Return an object representing the absolute file name of the kernel image of
|
||||||
OS."
|
OS."
|
||||||
|
|
|
||||||
335
gnu/system/boot.scm
Normal file
335
gnu/system/boot.scm
Normal file
|
|
@ -0,0 +1,335 @@
|
||||||
|
;;; 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>
|
||||||
|
;;;
|
||||||
|
;;; 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-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-bootloader-menu-entries
|
||||||
|
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-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>
|
||||||
|
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)
|
||||||
|
(bootloader-menu-entries ;list of <menu-entry>
|
||||||
|
boot-parameters-bootloader-menu-entries)
|
||||||
|
(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)
|
||||||
|
(#f 'grub))) ; for compatibility reasons.
|
||||||
|
|
||||||
|
(bootloader-menu-entries
|
||||||
|
(match (assq 'bootloader-menu-entries rest)
|
||||||
|
((_ entries) (map sexp->menu-entry entries))
|
||||||
|
(#f '())))
|
||||||
|
|
||||||
|
;; 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 (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))
|
||||||
|
(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
|
||||||
|
|
@ -70,6 +70,7 @@ (define-module (guix scripts system)
|
||||||
#:use-module (gnu image)
|
#:use-module (gnu image)
|
||||||
#:use-module (gnu system)
|
#:use-module (gnu system)
|
||||||
#:use-module (gnu bootloader)
|
#:use-module (gnu bootloader)
|
||||||
|
#:use-module (gnu system boot)
|
||||||
#:use-module (gnu system file-systems)
|
#:use-module (gnu system file-systems)
|
||||||
#:use-module (gnu system image)
|
#:use-module (gnu system image)
|
||||||
#:use-module (gnu system mapped-devices)
|
#:use-module (gnu system mapped-devices)
|
||||||
|
|
|
||||||
|
|
@ -27,6 +27,7 @@ (define-module (test-boot-parameters)
|
||||||
#:use-module (gnu bootloader)
|
#:use-module (gnu bootloader)
|
||||||
#:use-module (gnu bootloader grub)
|
#:use-module (gnu bootloader grub)
|
||||||
#:use-module (gnu system)
|
#:use-module (gnu system)
|
||||||
|
#:use-module (gnu system boot)
|
||||||
#:use-module (gnu system file-systems)
|
#:use-module (gnu system file-systems)
|
||||||
#:use-module (gnu system uuid)
|
#:use-module (gnu system uuid)
|
||||||
#:use-module ((guix diagnostics) #:select (formatted-message?))
|
#:use-module ((guix diagnostics) #:select (formatted-message?))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue