* [bug#72457] [PATCH 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
` (20 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Christopher Baines, Josselin Poiret,
Ludovic Court??s, Mathieu Othacehe, Simon Tournier,
Tobias Geerinckx-Rice
The current implementation is broken anyway. Multiple bootloaders share
a name (including both versions of extlinux) and
bootloader-configuration data is significant to bootloader installation.
It shouldn't be just faked.
Rely on the provenance service instead, which while not always present,
should be for the vast majority of systems.
* guix/scripts/system.scm (reinstall-bootloader): Rename to...
(install-bootloader-from-provenance): ...this, and rewrite to extract
bootloader-configuration data from system provenance.
(switch-to-system-generation, process-command): Use
install-bootloader-from-provenance.
Change-Id: I5713a43ad4f9f32a129d980db06d70de16b03f27
---
guix/scripts/system.scm | 75 ++++++++++++++---------------------------
1 file changed, 25 insertions(+), 50 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0f7d864e06..bb7b5d37bf 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -88,6 +88,7 @@ (define-module (guix scripts system)
#:use-module (srfi srfi-37)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
#:use-module (rnrs bytevectors)
#:export (guix-system
read-operating-system
@@ -377,60 +378,33 @@ (define (switch-to-system-generation store spec)
(activate (string-append generation "/activate")))
(if number
(begin
- (reinstall-bootloader store number)
+ (install-bootloader-from-provenance store number)
(switch-to-generation* %system-profile number)
(unless-file-not-found (primitive-load activate)))
(leave (G_ "cannot switch to system generation '~a'~%") spec))))
-(define* (system-bootloader-name #:optional (system %system-profile))
- "Return the bootloader name stored in SYSTEM's \"parameters\" file."
- (let ((params (unless-file-not-found
- (read-boot-parameters-file system))))
- (boot-parameters-bootloader-name params)))
-
-(define (reinstall-bootloader store number)
- "Re-install bootloader for existing system profile generation NUMBER.
-STORE is an open connection to the store."
+(define (install-bootloader-from-provenance store number)
+ "Re-install an old bootloader using provenance data for system profile
+generation NUMBER with store STORE."
(let* ((generation (generation-file-name %system-profile number))
- ;; Detect the bootloader used in %system-profile.
- (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
-
- ;; Use the detected bootloader with default configuration.
- ;; It will be enough to allow the system to boot.
- (bootloader-config (bootloader-configuration
- (bootloader bootloader)))
-
- ;; Make the specified system generation the default entry.
- (chosen-alternative (generation->boot-alternative
- %system-profile number))
- (params (boot-alternative-parameters chosen-alternative))
- (locale (boot-parameters-locale params))
- (store-crypto-devices (boot-parameters-store-crypto-devices params))
- (store-directory-prefix
- (boot-parameters-store-directory-prefix params))
- (old-generations
- (delv number (reverse (generation-numbers %system-profile))))
- (previous-boot-alternatives (profile->boot-alternatives
- %system-profile old-generations))
- (entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- previous-boot-alternatives))))
- (run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object
- ((bootloader-configuration-file-generator bootloader)
- bootloader-config entries
- #:locale locale
- #:store-crypto-devices store-crypto-devices
- #:store-directory-prefix store-directory-prefix
- #:old-entries old-entries)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))))
+ (os (receive (_ os) (system-provenance generation)
+ (and=> os read-operating-system)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (numbers (delv number (reverse (generation-numbers %system-profile))))
+ (old (profile->boot-alternatives %system-profile numbers)))
+ (if os
+ (run-with-store store
+ (mlet* %store-monad
+ ((bootcfg (lower-object (operating-system-bootcfg os old)))
+ (drvs -> (list bootcfg)))
+ (mbegin %store-monad
+ (built-derivations drvs)
+ ;; Only install bootloader configuration file.
+ (install-bootloader local-eval bootloader-config bootcfg
+ #:run-installer? #f))))
+ (leave (G_ "cannot rollback to provenanceless generation '~a'~%")
+ number))))
\f
;;;
@@ -1416,7 +1390,8 @@ (define (process-command command args opts)
(x (leave (G_ "wrong number of arguments~%"))))))
(with-store* store
(delete-matching-generations store %system-profile pattern)
- (reinstall-bootloader store (generation-number %system-profile)))))
+ (install-bootloader-from-provenance store
+ (generation-number %system-profile)))))
((switch-generation)
(let ((pattern (match args
((pattern) pattern)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 02/15] gnu: Add bootloader target infastructure.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
` (19 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Christopher Baines, Josselin Poiret,
Lilah Tascheter, Ludovic Court??s, Mathieu Othacehe,
Simon Tournier, Tobias Geerinckx-Rice
* gnu/bootloader.scm (bootloader-target): New record.
(&target-error): New condition.
(pathcat, get-target-of-type, parent-of, unfold-pathcat, target-base?,
type-major?, ensure, ensure-target-types, ensure-majors, gbegin):
New procedures.
(define-literal, with-targets, :path, :devpath, :device,
:fs, :label, :uuid): New macros.
(bootloader-modules): Prevent mutual imports.
* guix/ui.scm (call-with-error-handling)[target-error?]:
Handle target-errors.
Change-Id: I3f07c9096dd8b91c04449b6360b3b7d21640da14
---
gnu/bootloader.scm | 212 ++++++++++++++++++++++++++++++++++++++++++++-
guix/ui.scm | 8 ++
2 files changed, 217 insertions(+), 3 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index f32e90e79d..3ddc112cc6 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -31,10 +31,11 @@ (define-module (gnu bootloader)
#:use-module (guix profiles)
#:use-module (guix records)
#:use-module (guix deprecation)
- #:use-module ((guix ui) #:select (warn-about-load-error))
#:use-module (guix diagnostics)
#:use-module (guix i18n)
+ #:use-module (guix modules)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
@@ -63,6 +64,26 @@ (define-module (gnu bootloader)
bootloader-configuration-file
bootloader-configuration-file-generator
+ <bootloader-target>
+ bootloader-target
+ bootloader-target?
+ bootloader-target-type
+ bootloader-target-expected?
+ bootloader-target-path
+ bootloader-target-offset
+ bootloader-target-device
+ bootloader-target-file-system
+ bootloader-target-label
+ bootloader-target-uuid
+
+ target-error?
+ target-error-type
+ target-error-targets
+
+ gbegin
+ :path :devpath :device :fs :label :uuid
+ with-targets
+
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
@@ -236,6 +257,191 @@ (define-record-type* <bootloader>
(configuration-file bootloader-configuration-file)
(configuration-file-generator bootloader-configuration-file-generator))
+\f
+;;;
+;;; Bootloader target record.
+;;;
+
+;; <bootloader-target> represents different kinds of targets in a normalized form.
+
+(define-record-type* <bootloader-target>
+ bootloader-target make-bootloader-target bootloader-target?
+ (type bootloader-target-type) ; symbol
+ (expected? bootloader-target-expected? (default #f)) ; bool
+
+ (path bootloader-target-path (default #f)) ; string|#f
+ (offset bootloader-target-offset (thunked) ; symbol|#f
+ (default (and (bootloader-target-path this-record)
+ (not (eq? (bootloader-target-type this-record) 'root))
+ 'root)))
+ (device bootloader-target-device (default #f)) ; string|#f
+ (file-system bootloader-target-file-system (default #f)) ; string|#f
+ (label bootloader-target-label (default #f)) ; string|#f
+ (uuid bootloader-target-uuid (default #f))) ; uuid|#f
+
+(define-condition-type &target-error &error target-error?
+ (type target-error-type)
+ (targets target-error-targets))
+
+(define (pathcat p1 p2)
+ (string-append (string-trim-right p1 #\/) "/" (string-trim p2 #\/)))
+
+(define* (get-target-of-type type targets #:optional (require? #f))
+ "Finds a target in TARGETS of type TYPE, optionally providing an error when
+not found if REQUIRE? is provided."
+ (let* ((pred (lambda (target) (eq? type (bootloader-target-type target))))
+ (candidates (filter pred targets))
+ (ret (if (pair? candidates) (car candidates) #f)))
+ (if (and require? (not ret))
+ (raise (condition
+ (&message (message (G_ "required, but not provided")))
+ (&target-error (type type) (targets targets))))
+ ret)))
+
+(define (parent-of target targets)
+ (and=> (bootloader-target-offset target)
+ (cut get-target-of-type <> targets #t)))
+
+(define (unfold-pathcat target targets)
+ (let ((quit (lambda (t) (not (and=> t bootloader-target-path)))))
+ (reduce pathcat #f
+ (unfold quit bootloader-target-path (cut parent-of <> targets) target))))
+
+(define (target-base? t)
+ (or (not t) (match-record t <bootloader-target>
+ (expected? offset device label uuid)
+ (or device label uuid (not offset) expected?))))
+
+(define (type-major? target) (memq target '(root esp disk)))
+
+(define (ensure types targets end)
+ (let* ((used-in (cute unfold end identity (cut parent-of <> targets) <>))
+ (cons-in (lambda (t) (cons t (used-in t))))
+ (ensure (map (cut get-target-of-type <> targets #t) types)))
+ (filter ->bool (apply append (map cons-in ensure)))))
+
+(define* (ensure-target-types types targets #:optional (base? #f))
+ "Ensures all TYPES are provided in TARGETS. Returns #t iff every ensured
+target and its requirements are fully provided. Errors out when a required TYPE
+isn't provided. When BASE?, only ensure path requirements up to a device."
+ (not (any bootloader-target-expected?
+ (ensure types targets (if base? target-base? not)))))
+
+(define (ensure-majors types targets)
+ "Errors out when a required TYPE isn't provided, or when use of multiple major
+targets is detected."
+ (let* ((all (map bootloader-target-type (ensure types targets target-base?)))
+ (majors (delete-duplicates (filter type-major? all) eq?)))
+ (if (< (length majors) 2) #t
+ (raise (condition (&message (message (G_ "multiple major targets used")))
+ (&target-error (type majors) (targets targets)))))))
+
+
+
+(define (gbegin . gex)
+ "Sequence provided g-expressions."
+ (case (length gex) ((0) #f) ((1) (car gex)) (else #~(begin #$@gex))))
+
+;; syntax matching on free literals breaks easily, so bind them
+(define-syntax-rule (define-literal id) (define-syntax id (syntax-rules ())))
+(define-literal :path)
+(define-literal :devpath)
+(define-literal :device)
+(define-literal :fs)
+(define-literal :label)
+(define-literal :uuid)
+
+(define-syntax with-targets
+ (cut syntax-case <> ()
+ ((_ targets-expr block ...)
+ (let* ((genvars (compose generate-temporaries iota))
+ (targets (car (genvars 1)))
+
+ (path? (cut syntax-case <> (:path) ((_ :path) #t) (_ #f)))
+ (qualified? (cut syntax-case <> (=>)
+ ((_ => spec ...) (any path? #'(spec ...)))
+ (_ #f)))
+
+ (resolve
+ (lambda (in target base)
+ (with-syntax ((target target) (base base) (targets targets))
+ (syntax-case in
+ (:path :devpath :device :fs :label :uuid)
+ ((name _) (not (identifier? #'name))
+ #`(_ (syntax-error "binds must be to identifiers" #,in)))
+ ((name :device) #'(name (bootloader-target-device base)))
+ ((name :label) #'(name (bootloader-target-label base)))
+ ((name :uuid) #'(name (bootloader-target-uuid base)))
+ ((name :fs) #'(name (bootloader-target-file-system base)))
+ ((name :path) #'(name (unfold-pathcat target targets)))
+ ((name :devpath)
+ #'(name (pathcat "/" (bootloader-target-path target))))
+ (_ #`(_ (syntax-error "invalid binding spec" #,in)))))))
+ (binds
+ (lambda (spec)
+ (syntax-case spec (=>)
+ ((type => binds ...)
+ (with-syntax (((target base) (genvars 2)) (targets targets))
+ (append
+ #`((get (lambda (t) (get-target-of-type t targets #t)))
+ (target (get type))
+ (base (if (target-base? target) target
+ (get (bootloader-target-offset target)))))
+ (map (cut resolve <> #'target #'base) #'(binds ...)))))
+ (_ #f))))
+
+ (blocks
+ (cut syntax-case <> ()
+ ((spec ... expr)
+ (let* ((specs #'(spec ...))
+ (lets (apply append (filter-map binds specs)))
+ (type (cut syntax-case <> (=>)
+ ((t => _ ...) #'t) (t #'t))))
+ (receive (full part) (partition qualified? specs)
+ #`(and (ensure-majors (list #,@(map type specs)) #,targets)
+ (ensure-target-types (list #,@(map type part))
+ #,targets #t)
+ (ensure-target-types (list #,@(map type full))
+ #,targets #f)
+ (let* #,lets expr)))))
+ (bad #'(syntax-error "malformed block" bad)))))
+ "Using the list TARGETS, evaluate and sequence each BLOCK to produce a
+gexp. BLOCK is a set of SPECs followed by an EXPR (evaluating to a gexp). Each
+SPEC denotes a type of target to guard EXPR on their existance and
+full-qualification. This procedure is linear in regards to BLOCKs.
+
+SPEC may be of the following forms:
+@itemize
+@item 'TYPE Requires TYPE to be fully present or promised. Errors otherwise.
+@item ('TYPE => (VAR COMPONENT) ...): As type, but also binds variables. TYPE's
+ COMPONENT is bound to the variable VAR as described below.
+@end itemize
+
+Available COMPONENTs are:
+@itemize
+@item :path (fully-qualified)
+@item :devpath (relative from device)
+@item :device (auto-detected from uuid and label if not user-provided)
+@item :fs
+@item :label
+@item :uuid
+@end itemize
+
+Note that installers may be called multiple times with different targets being
+fully-qualified. To ensure that targets aren't installed multiple times, make sure
+that each BLOCK ensures at least one major target, either directly or indirectly.
+Corrolarily, at most one major target should be ensured per BLOCK, under the same
+conditions. Major targets originate from disk image handling, and are currently:
+@itemize
+@item disk
+@item root
+@item esp
+@end itemize"
+ #`(let ((#,targets targets-expr))
+ (apply gbegin (filter ->bool
+ (list #,@(map blocks #'(block ...))))))))
+ (bad #'(syntax-error "must provide targets" bad))))
+
\f
;;;
;;; Bootloader configuration record.
@@ -305,10 +511,10 @@ (define (bootloader-configuration-targets config)
(define (bootloader-modules)
"Return the list of bootloader modules."
+ ;; don't provide #:warn to prevent mutual imports
(all-modules (map (lambda (entry)
`(,entry . "gnu/bootloader"))
- %load-path)
- #:warn warn-about-load-error))
+ %load-path)))
(define %bootloaders
;; The list of publically-known bootloaders.
diff --git a/guix/ui.scm b/guix/ui.scm
index 9db6f6e9d7..1c9300c9eb 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -36,6 +36,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix ui)
+ #:use-module ((gnu bootloader)
+ #:select (target-error? target-error-type target-error-targets))
#:use-module (guix i18n)
#:use-module (guix colors)
#:use-module (guix diagnostics)
@@ -857,6 +859,12 @@ (define (call-with-error-handling thunk)
(invoke-error-stop-signal c)
(cons (invoke-error-program c)
(invoke-error-arguments c))))
+ ((target-error? c)
+ (leave (G_ "bootloader-target '~a'~@[: ~a~] ~
+ among the following targets:~%~{~y~}")
+ (target-error-type c)
+ (and (message-condition? c) (condition-message c))
+ (target-error-targets c)))
((formatted-message? c)
(apply report-error
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 03/15] guix: scripts: Remove unused code.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
` (18 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Christopher Baines, Josselin Poiret,
Ludovic Court??s, Mathieu Othacehe, Simon Tournier,
Tobias Geerinckx-Rice
* guix/scripts/system.scm (bootloader-installer-script): Delete.
Change-Id: Ic1e0a523c814e4f1bf44b2721f5658f00066b0ab
---
guix/scripts/system.scm | 22 ----------------------
1 file changed, 22 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bb7b5d37bf..344bb74151 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -731,28 +731,6 @@ (define (maybe-suggest-running-guix-pull)
(warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%"))
(warning (G_ "Failing to do that may downgrade your system!~%"))))
-(define (bootloader-installer-script installer
- bootloader device target)
- "Return a file calling INSTALLER gexp with given BOOTLOADER, DEVICE
-and TARGET arguments."
- (scheme-file "bootloader-installer"
- (with-imported-modules '((gnu build bootloader)
- (guix build utils))
- #~(begin
- (use-modules (gnu build bootloader)
- (guix build utils)
- (ice-9 binary-ports)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (guard (c ((message-condition? c) ;XXX: i18n
- (format (current-error-port) "error: ~a~%"
- (condition-message c))
- (exit 1)))
- (#$installer #$bootloader #$device #$target)
- (info (G_ "bootloader successfully installed on '~a'~%")
- #$device))))))
-
(define (local-eval exp)
"Evaluate EXP, a G-Expression, in-place."
(mlet* %store-monad ((lowered (lower-gexp exp))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 04/15] gnu: Core bootloader changes.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (2 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
` (17 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Christopher Baines, Efraim Flashner,
Josselin Poiret, Lilah Tascheter, Ludovic Court??s,
Mathieu Othacehe, Simon Tournier, Tobias Geerinckx-Rice,
Vagrant Cascadian
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/bootloader.scm (menu-entry): Add device-subvol field.
(menu-entry->sexp, sexp->menu-entry): Support device-subvol.
(normalize-file, warn-update-targets, target-overrides, normalize,
bootloader-configuration->gexp, bootloader-configurations->gexps,
efi-arch, install-efi):
New procedures.
(bootloader): Rewrite record.
(bootloader-configuration)[target]: Remove deprecated field.
[targets]: Include sanitizer and allow multiple bootloaders.
[terminal-outputs, terminal-inputs]: Don't assume grub.
[efi-removable?, 32bit?]: New fields.
(warn-target-field-deprecation): Delete deprecation warning.
(%bootloaders): Delete variable.
(bootloader-configuration-target, bootloader-configuration-targets,
lookup-bootloader-by-name, bootloader-modules, efi-bootloader-profile,
efi-bootloader-chain): Delete procedures.
* gnu/bootloader/depthcharge.scm, gnu/bootloader/extlinux.scm,
gnu/bootloader/grub.scm, gnu/bootloader/u-boot.scm: Rewrite entirely.
* gnu/build/bootloader.scm (parse-bootnums): New variable.
(atomic-copy, in-temporary-directory, efi-bootnums): New procedures.
(install-efi-loader): Delete procedure.
(install-efi): Rewrite to support installation of any efi bootloader.
* gnu/build/image.scm (initialize-efi32-partition: Deprecate.
(initialize-efi-partitition): Only create EFI directory.
(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/image.scm (partition)[target]: New field in order to support
dynamic provision of image partitions as bootloader targets.
* gnu/installer/parted.scm (bootloader-configuration),
gnu/machine/ssh.scm (deploy-managed-host) (roll-back-managed-host):
Use new bootloader system.
* gnu/packages/bootloaders.scm (make-grub-efi-netboot): Delete
procedure.
* gnu/packages/raspberry-pi.scm (grub-efi-bootloader-chain-raspi-64):
Delete procedure. Can be recreated with a raspberry pi bootloader
combined with grub-efi.
* gnu/system.scm (convert-bootloader-field): New procedure.
(operating-system)[bootloader]: Use above sanitizer and support
multiple bootloaders.
(operating-system-bootcfg): Rename to...
(operating-system-bootmeta): ...this. Rewrite to return relavent
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.
(boot-parameters->menu-entry): Support device-subvol.
(boot-alternative->menu-entry): New procedure.
* gnu/system/image.scm (root-partition, esp-partition): Use target field.
(esp32-partition, efi32-disk-partition, efi32-raw-image-type): Deprecate.
(root-partition-index): Delete procedure.
(system-disk-image, system-iso9960-image): Support new bootloader system.
(system-disk-image)[targets]: New subprocedure.
* gnu/system/images/hurd.scm (hurd-barebones-os)[bootloader],
gnu/system/images/novena.scm (novena-barebones-os)[bootloader],
gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
(orangepi-r1-plus-lts-rk3328-barebones-os)[bootloader],
gnu/system/images/pine64.scm (pine64-barebones-os)[bootloader],
gnu/system/images/pinebook-pro.scm
(pinebook-pro-barebones-os)[bootloader],
gnu/system/images/rock64.scm (rock64-barebones-os)[bootloader],
gnu/system/images/unmatched.scm (unmatched-barebones-os)[bootloader],
gnu/system/images/visionfive2.scm
(visionfive2-barebones-os)[bootloader]: Use new target format.
* gnu/system/images/wsl2.scm (dummy-bootloader): Delete variable.
(wsl-os)[bootloader]: Don't provide field.
* gnu/system/install.scm (installation-os)[bootloader]: Use new format.
(os-with-u-boot): Delete procedure.
(embedded-installation-os)[bootloader]: Use new format.
(beaglebone-black-installation-os, a20-olinuxino-lime-installation-os,
a20-olinuxino-lime2-emmc-installation-os,
a20-olinuxino-micro-installation-os, bananapi-m2-ultra-installation-os,
firefly-rk3399-installation-os, mx6cuboxi-installation-os,
novena-installation-os, nintendo-nes-classic-edition-installation-os,
orangepi-r1-plus-lts-rk3328-installation-os, pine64-plus-installation-os,
pinebook-installation-os, rock64-installation-os,
rockpro64-installation-os, rk3399-puma-installation-os,
wandboard-installation-os): Don't guess block device.
* gnu/system/vm.scm (virtualized-operating-system): Don't provide
bootloader.
* gnu/tests/install.scm (%minimal-extlinux-os)[bootloader]: Use proper
extlinux variable.
(%btrfs-raid10-root-os): Use multiple bootloaders.
* gnu/tests/reconfigure.scm (%test-install-bootloader): Delete variable.
(run-install-bootloader-test): Delete procedure.
* 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
---
gnu/bootloader.scm | 424 +++---
gnu/bootloader/depthcharge.scm | 153 +-
gnu/bootloader/extlinux.scm | 149 +-
gnu/bootloader/grub.scm | 1279 +++++++----------
gnu/bootloader/u-boot.scm | 439 ++----
gnu/build/bootloader.scm | 157 +-
gnu/build/image.scm | 40 +-
gnu/build/install.scm | 16 +-
gnu/image.scm | 3 +
gnu/installer/parted.scm | 12 +-
gnu/machine/ssh.scm | 71 +-
gnu/packages/bootloaders.scm | 86 --
gnu/packages/raspberry-pi.scm | 18 -
gnu/system.scm | 45 +-
gnu/system/boot.scm | 8 +-
gnu/system/image.scm | 162 ++-
gnu/system/images/hurd.scm | 4 +-
gnu/system/images/novena.scm | 3 +-
.../images/orangepi-r1-plus-lts-rk3328.scm | 3 +-
gnu/system/images/pine64.scm | 3 +-
gnu/system/images/pinebook-pro.scm | 3 +-
gnu/system/images/rock64.scm | 3 +-
gnu/system/images/unmatched.scm | 3 +-
gnu/system/images/visionfive2.scm | 3 +-
gnu/system/images/wsl2.scm | 14 +-
gnu/system/install.scm | 43 +-
gnu/system/vm.scm | 11 -
gnu/tests/install.scm | 10 +-
gnu/tests/reconfigure.scm | 86 +-
guix/scripts/system.scm | 88 +-
guix/scripts/system/reconfigure.scm | 159 +-
31 files changed, 1410 insertions(+), 2088 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 3ddc112cc6..2bb13437dc 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,45 +25,52 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader)
+ #:autoload (gnu build file-systems)
+ (read-partition-label read-partition-uuid
+ find-partition-by-label find-partition-by-uuid)
+ #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
- #:use-module (guix discovery)
- #:use-module (guix gexp)
- #:use-module (guix profiles)
- #:use-module (guix records)
+ #:autoload (guix build syscalls)
+ (mounts mount-source mount-point mount-type)
#:use-module (guix deprecation)
#:use-module (guix diagnostics)
+ #:use-module (guix gexp)
#:use-module (guix i18n)
#:use-module (guix modules)
+ #:use-module (guix profiles)
+ #:use-module (guix records)
+ #:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
- #:export (menu-entry
+ #:use-module (ice-9 receive)
+ #:export (<menu-entry>
+ menu-entry
menu-entry?
menu-entry-label
menu-entry-device
+ menu-entry-device-mount-point
+ menu-entry-device-subvol
menu-entry-linux
menu-entry-linux-arguments
menu-entry-initrd
- menu-entry-device-mount-point
menu-entry-multiboot-kernel
menu-entry-multiboot-arguments
menu-entry-multiboot-modules
menu-entry-chain-loader
+ normalize-file
menu-entry->sexp
sexp->menu-entry
bootloader
bootloader?
bootloader-name
- bootloader-package
+ bootloader-default-targets
bootloader-installer
- bootloader-disk-image-installer
- bootloader-configuration-file
- bootloader-configuration-file-generator
<bootloader-target>
bootloader-target
@@ -84,13 +92,15 @@ (define-module (gnu bootloader)
:path :devpath :device :fs :label :uuid
with-targets
+ <bootloader-configuration>
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
- bootloader-configuration-target ;deprecated
bootloader-configuration-targets
bootloader-configuration-menu-entries
bootloader-configuration-default-entry
+ bootloader-configuration-efi-removable?
+ bootloader-configuration-32bit?
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -101,10 +111,11 @@ (define-module (gnu bootloader)
bootloader-configuration-device-tree-support?
bootloader-configuration-extra-initrd
- %bootloaders
- lookup-bootloader-by-name
+ bootloader-configuration->gexp
+ bootloader-configurations->gexp
- efi-bootloader-chain))
+ efi-arch
+ install-efi))
\f
;;;
@@ -119,6 +130,8 @@ (define-record-type* <menu-entry>
(default #f))
(device-mount-point menu-entry-device-mount-point
(default #f))
+ (device-subvol menu-entry-device-subvol
+ (default #f))
(linux menu-entry-linux
(default #f))
(linux-arguments menu-entry-linux-arguments
@@ -135,6 +148,18 @@ (define-record-type* <menu-entry>
(chain-loader menu-entry-chain-loader
(default #f))) ; string, path of efi file
+(define (normalize-file entry val)
+ "Normalize a file VAL stored in a menu entry into one suitable for a
+bootloader. Realizes device-mount-point and device-subvol."
+ (match-record entry <menu-entry> (device-mount-point device-subvol)
+ #~(let* ((rel (lambda (s) (substring s (if (string-prefix? "/" s) 1 0))))
+ (file (rel #$val))
+ (subvol (and=> #$device-subvol rel))
+ (mount (and=> #$device-mount-point rel)))
+ (string-append (if subvol (string-append "/" subvol "/") "/")
+ (if (and mount (string-prefix? mount file))
+ (substring file (string-length mount)) file)))))
+
(define (report-menu-entry-error menu-entry)
(raise
(condition
@@ -162,7 +187,7 @@ (define (menu-entry->sexp entry)
`(label ,(file-system-label->string label)))
(_ device)))
(match entry
- (($ <menu-entry> label device mount-point
+ (($ <menu-entry> label device mount-point subvol
(? identity linux) linux-arguments (? identity initrd)
#f () () #f)
`(menu-entry (version 0)
@@ -171,8 +196,9 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(linux ,linux)
(linux-arguments ,linux-arguments)
- (initrd ,initrd)))
- (($ <menu-entry> label device mount-point #f () #f
+ (initrd ,initrd)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f
(? identity multiboot-kernel) multiboot-arguments
multiboot-modules #f)
`(menu-entry (version 0)
@@ -181,19 +207,23 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(multiboot-kernel ,multiboot-kernel)
(multiboot-arguments ,multiboot-arguments)
- (multiboot-modules ,multiboot-modules)))
- (($ <menu-entry> label device mount-point #f () #f #f () ()
+ (multiboot-modules ,multiboot-modules)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f #f () ()
(? identity chain-loader))
`(menu-entry (version 0)
(label ,label)
(device ,(device->sexp device))
(device-mount-point ,mount-point)
- (chain-loader ,chain-loader)))
+ (chain-loader ,chain-loader)
+ (device-subvol ,subvol)))
(_ (report-menu-entry-error entry))))
(define (sexp->menu-entry sexp)
"Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
record."
+ ;; XXX: rely on shadowing to support the match ors below
+ (define subvol #f)
(define (sexp->device device-sexp)
(match device-sexp
(('uuid type uuid-string)
@@ -206,35 +236,41 @@ (define (sexp->menu-entry sexp)
('label label) ('device device)
('device-mount-point mount-point)
('linux linux) ('linux-arguments linux-arguments)
- ('initrd initrd) _ ...)
+ ('initrd initrd)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(linux linux)
(linux-arguments linux-arguments)
(initrd initrd)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
+ ('device-mount-point mount-point) ('device-subvol subvol)
('multiboot-kernel multiboot-kernel)
('multiboot-arguments multiboot-arguments)
- ('multiboot-modules multiboot-modules) _ ...)
+ ('multiboot-modules multiboot-modules)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(multiboot-kernel multiboot-kernel)
(multiboot-arguments multiboot-arguments)
(multiboot-modules multiboot-modules)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
- ('chain-loader chain-loader) _ ...)
+ ('device-mount-point mount-point) ('device-subvol subvol)
+ ('chain-loader chain-loader)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(chain-loader chain-loader)))))
\f
@@ -247,15 +283,10 @@ (define (sexp->menu-entry sexp)
;; has to be described by this record.
(define-record-type* <bootloader>
- bootloader make-bootloader
- bootloader?
- (name bootloader-name)
- (package bootloader-package)
- (installer bootloader-installer)
- (disk-image-installer bootloader-disk-image-installer
- (default #f))
- (configuration-file bootloader-configuration-file)
- (configuration-file-generator bootloader-configuration-file-generator))
+ bootloader make-bootloader bootloader?
+ (name bootloader-name)
+ (default-targets bootloader-default-targets (default '()))
+ (installer bootloader-installer))
\f
;;;
@@ -450,28 +481,48 @@ (define-syntax with-targets
;; The <bootloader-configuration> record contains bootloader independant
;; configuration used to fill bootloader configuration file.
-(define-with-syntax-properties (warn-target-field-deprecation
- (value properties))
- (when value
- (warning (source-properties->location properties)
- (G_ "the 'target' field is deprecated, please use 'targets' \
-instead~%")))
- value)
+(define-with-syntax-properties (warn-update-targets (value properties))
+ (let ((loc (source-properties->location properties)))
+ (define update
+ (match-lambda
+ ((? bootloader-target? target) (cons #f target))
+ ((? string? s) (cons #t (if (string-prefix? "/dev" s)
+ (bootloader-target
+ (type 'disk)
+ (device s))
+ (bootloader-target
+ (type 'esp)
+ (offset 'root)
+ (path s)))))
+ (x (error loc (G_ "invalid target '~a'~%") x))))
+
+ (let* ((updated (map update (if (list? value) value (list value))))
+ (targets (map cdr updated))
+ (types (map bootloader-target-type targets)))
+ ;; XXX: should this be an error?
+ (when (any car updated)
+ (warning loc (G_ "the 'targets' field should now contain \
+<bootloader-target> records. inferring a best guess (this might break!)...~%")))
+ (when (not (eqv? (length types) (length (delete-duplicates types))))
+ (error loc (G_ "the 'targets' field may not contain duplicates~%")))
+ targets)))
(define-record-type* <bootloader-configuration>
bootloader-configuration make-bootloader-configuration
bootloader-configuration?
(bootloader
- bootloader-configuration-bootloader) ;<bootloader>
- (targets %bootloader-configuration-targets
- (default #f)) ;list of strings
- (target %bootloader-configuration-target ;deprecated
- (default #f)
- (sanitize warn-target-field-deprecation))
+ bootloader-configuration-bootloader) ;<bootloader>
+ (targets bootloader-configuration-targets
+ (default '()) ;list of strings
+ (sanitize warn-update-targets))
(menu-entries bootloader-configuration-menu-entries
(default '())) ;list of <menu-entry>
(default-entry bootloader-configuration-default-entry
(default 0)) ;integer
+ (efi-removable? bootloader-configuration-efi-removable?
+ (default #f)) ;bool
+ (32bit? bootloader-configuration-32bit?
+ (default #f)) ;bool
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
@@ -479,9 +530,9 @@ (define-record-type* <bootloader-configuration>
(theme bootloader-configuration-theme
(default #f)) ;bootloader-specific theme
(terminal-outputs bootloader-configuration-terminal-outputs
- (default '(gfxterm))) ;list of symbols
+ (default #f)) ;list of symbols | #f (default outs)
(terminal-inputs bootloader-configuration-terminal-inputs
- (default '())) ;list of symbols
+ (default #f)) ;list of symbols | #f (default ins)
(serial-unit bootloader-configuration-serial-unit
(default #f)) ;integer | #f
(serial-speed bootloader-configuration-serial-speed
@@ -491,164 +542,129 @@ (define-record-type* <bootloader-configuration>
(extra-initrd bootloader-configuration-extra-initrd
(default #f))) ;string | #f
-(define-deprecated (bootloader-configuration-target config)
- bootloader-configuration-targets
- (%bootloader-configuration-target config))
+\f
+;;;
+;;; Bootloader installation paths.
+;;;
-(define (bootloader-configuration-targets config)
- (or (%bootloader-configuration-targets config)
- ;; TODO: Remove after the deprecated 'target' field is removed.
- (list (%bootloader-configuration-target config))
- ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this
- ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f,
- ;; hence the default value of '(#f) rather than '().
- (list #f)))
+;; highest -> lowest priority
+(define (target-overrides . layers)
+ (let* ((types (fold append '()
+ (map (cute map bootloader-target-type <>) layers)))
+ (pred (lambda (type layer found)
+ (or found (get-target-of-type type layer))))
+ (find (lambda (type) (fold (cute pred type <> <>) #f layers))))
+ (filter ->bool (map find (delete-duplicates types)))))
+
+(define (normalize targets)
+ "Augments user-supplied targets with filesystem information at runtime,
+allowing users to specify a lot less information. Relatively minimal to prevent
+errors. Puts targets into a normal form, where all paths are fully specified up
+to a device offset."
+ (let* ((mass (lambda (m) `((,(mount-source m) . ,m) (,(mount-point m) . ,m))))
+ (amounts (delay (apply append (map mass (mounts)))))
+ (accessible=> (lambda (d f) (and d (access? d R_OK) (f d))))
+ (assoc-mnt (lambda (f) (lambda (v)
+ (and=> (assoc-ref (force amounts) v) f)))))
+
+ (define (scrape target)
+ (match-record target <bootloader-target>
+ (expected? path offset device label uuid file-system)
+ (if expected? target
+ (bootloader-target
+ (inherit target)
+ (device (or device (false-if-exception
+ (or (and=> uuid find-partition-by-uuid)
+ (and=> label find-partition-by-label)))
+ (and path ((assoc-mnt mount-source)
+ (unfold-pathcat target targets)))))
+ (label (or label (accessible=> device read-partition-label)))
+ (uuid (or uuid (accessible=> device read-partition-uuid)))
+ (file-system (or file-system (and=> device (assoc-mnt mount-type))))
+ (offset (and path offset))
+ (path (or path (and=> device (assoc-mnt mount-point))))))))
+
+ (define (arborify target targets)
+ (let* ((up (lambda (t) (and t (parent-of t targets))))
+ (proto (unfold target-base? identity up (up target) list))
+ (chain (reverse (cons target proto))))
+ (bootloader-target
+ (inherit target)
+ (offset (and=> (car chain) bootloader-target-type))
+ (path (reduce pathcat #f (map bootloader-target-path (cdr chain)))))))
+
+ (let ((mid (map scrape targets))) (map (cut arborify <> mid) mid))))
+
+(define* (bootloader-configuration->gexp bootloader-config args #:key
+ (root-offset "/") (overrides '()))
+ "Returns a gexp to install BOOTLOADER-CONFIG to its targets, passing ARGS
+to each installer alongside the additional #:bootloader-config keyword
+arguments. Target OVERRIDES are applied and all path targets have ROOT-OFFSET
+applied. The following keyword arguments are expected in ARGS:
+@enumerate
+@item current-boot-alternative
+@item old-boot-alternatives
+@item locale (from bootmeta)
+@item store-directory-prefix (from bootmeta)
+@item store-crypto-devices (from bootmeta)
+@end enumerate"
+ (let* ((bootloader (bootloader-configuration-bootloader bootloader-config))
+ (installer (bootloader-installer bootloader))
+ (auto-targets (list (bootloader-target
+ (type 'root)
+ (path root-offset)
+ (offset #f))))
+ (targets (target-overrides
+ overrides
+ (bootloader-configuration-targets bootloader-config)
+ auto-targets
+ (bootloader-default-targets bootloader)))
+ (conf (bootloader-configuration
+ (inherit bootloader-config)
+ (targets (normalize targets)))))
+ (apply installer #:bootloader-config conf args)))
+
+(define (bootloader-configurations->gexp bootloader-configs . rest)
+ (apply gbegin (filter-map (cut apply bootloader-configuration->gexp <> rest)
+ bootloader-configs)))
\f
;;;
-;;; Bootloaders.
+;;; EFI shit
;;;
-(define (bootloader-modules)
- "Return the list of bootloader modules."
- ;; don't provide #:warn to prevent mutual imports
- (all-modules (map (lambda (entry)
- `(,entry . "gnu/bootloader"))
- %load-path)))
-
-(define %bootloaders
- ;; The list of publically-known bootloaders.
- (delay (fold-module-public-variables (lambda (obj result)
- (if (bootloader? obj)
- (cons obj result)
- result))
- '()
- (bootloader-modules))))
-
-(define (lookup-bootloader-by-name name)
- "Return the bootloader called NAME."
- (or (find (lambda (bootloader)
- (eq? name (bootloader-name bootloader)))
- (force %bootloaders))
- (leave (G_ "~a: no such bootloader~%") name)))
-
-(define (efi-bootloader-profile packages files hooks)
- "Creates a profile from the lists of PACKAGES and FILES from the store.
-This profile is meant to be used by the bootloader-installer.
-
-FILES is a list of file or directory names from the store, which will be
-symlinked into the profile. If a directory name ends with '/', then the
-directory content instead of the directory itself will be symlinked into the
-profile.
-
-FILES may contain file like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-HOOKS lists additional hook functions to modify the profile."
- (define* (efi-bootloader-profile-hook manifest #:optional system)
- (define build
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules ((guix build utils)
- #:select (mkdir-p strip-store-file-name))
- ((ice-9 ftw)
- #:select (scandir))
- ((srfi srfi-1)
- #:select (append-map every remove))
- ((srfi srfi-26)
- #:select (cut)))
- (define (symlink-to file directory transform)
- "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
- (symlink file (string-append directory "/" (transform file))))
- (define (directory-content directory)
- "Creates a list of absolute path names inside DIRECTORY."
- (map (lambda (name)
- (string-append directory name))
- (or (scandir directory (lambda (name)
- (not (member name '("." "..")))))
- '())))
- (define name-ends-with-/? (cut string-suffix? "/" <>))
- (define (name-is-store-entry? name)
- "Return #t if NAME is a direct store entry and nothing inside."
- (not (string-index (strip-store-file-name name) #\/)))
- (let* ((files '#$files)
- (directories (filter name-ends-with-/? files))
- (names-from-directories
- (append-map (lambda (directory)
- (directory-content directory))
- directories))
- (names (append names-from-directories
- (remove name-ends-with-/? files))))
- (mkdir-p #$output)
- (if (every file-exists? names)
- (begin
- (for-each (lambda (name)
- (symlink-to name #$output
- (if (name-is-store-entry? name)
- strip-store-file-name
- basename)))
- names)
- #t)
- #f)))))
-
- (gexp->derivation "efi-bootloader-profile"
- build
- #:system system
- #:local-build? #t
- #:substitutable? #f
- #:properties
- `((type . profile-hook)
- (hook . efi-bootloader-profile-hook))))
-
- (profile (content (packages->manifest packages))
- (name "efi-bootloader-profile")
- (hooks (cons efi-bootloader-profile-hook hooks))
- (locales? #f)
- (allow-collisions? #f)
- (relative-symlinks? #f)))
-
-(define* (efi-bootloader-chain final-bootloader
- #:key
- (packages '())
- (files '())
- (hooks '())
- installer
- disk-image-installer)
- "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES,
-and optional directories and files from the store given in the list of FILES.
-
-The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
-in an efi-bootloader-profile, which will be passed to the INSTALLER.
-
-FILES may contain file-like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-If a directory name in FILES ends with '/', then the directory content instead
-of the directory itself will be symlinked into the efi-bootloader-profile.
-
-The procedures in the HOOKS list can be used to further modify the bootloader
-profile. It is possible to pass a single function instead of a list.
-
-If the INSTALLER argument is used, then this gexp procedure will be called to
-install the efi-bootloader-profile. Otherwise the installer of the
-FINAL-BOOTLOADER will be called.
-
-If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
-to install the efi-bootloader-profile into a disk image. Otherwise the
-disk-image-installer of the FINAL-BOOTLOADER will be called."
- (bootloader
- (inherit final-bootloader)
- (name "efi-bootloader-chain")
- (package
- (efi-bootloader-profile (cons (bootloader-package final-bootloader)
- packages)
- files
- (if (list? hooks)
- hooks
- (list hooks))))
- (installer
- (or installer
- (bootloader-installer final-bootloader)))
- (disk-image-installer
- (or disk-image-installer
- (bootloader-disk-image-installer final-bootloader)))))
+(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
+ (32? #f))
+ "Returns the UEFI architecture name for the current target, in lowercase."
+ (cond ((target-x86-32? target) "ia32")
+ ((target-x86-64? target) (if 32? "ia32" "x64"))
+ ((target-arm32? target) "arm")
+ ((target-aarch64? target) (if 32? "arm" "aa64"))
+ ((target-riscv64? target) (if 32? "riscv32" "riscv64"))
+ (else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
+ target)))))
+
+(define (install-efi bootloader-config plan)
+ "Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
+PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
+should be in boot order. If the user selects a removable bootloader, only the
+first entry in PLAN is used."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets efi-removable? 32bit?)
+ (if efi-removable?
+ ;; Hard code the output location to a well-known path recognized by
+ ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
+ ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
+ (with-targets targets
+ (('esp => (path :path))
+ #~(let ((boot #$(string-append path "/EFI/BOOT"))
+ (arch #$(string-upcase (efi-arch #:32? 32bit?)))
+ (builder (car (car #$plan))))
+ (mkdir-p boot)
+ ;; only realize first planspec
+ (builder (string-append boot "/BOOT" arch ".EFI")))))
+ ;; normal install when not doing a removable config
+ (with-targets targets
+ (('vendir => (vendir :path) (loader :devpath) (disk :device))
+ #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm
index 0a50374bd9..ad29f5d5e4 100644
--- a/gnu/bootloader/depthcharge.scm
+++ b/gnu/bootloader/depthcharge.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,92 +18,86 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader depthcharge)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:use-module (ice-9 match)
- #:export (depthcharge-bootloader))
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
+ #:export (depthcharge-veyron-speedy-bootloader
+ depthcharge-bootloader))
-(define (signed-kernel kernel kernel-arguments initrd)
- (define builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 binary-ports)
- (rnrs bytevectors))
- (set-path-environment-variable "PATH" '("bin") (list #$dtc))
+(define* (install-depthcharge arch dtb
+ #:key bootloader-config current-boot-alternative
+ #:allow-other-keys)
+ (when (not (null? (bootloader-configuration-menu-entries bootloader-config)))
+ (raise (formatted-message
+ (G_ "extra menu-entries are not supported for depthcharge!"))))
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ;; use 'part instead of 'disk, cause we write an image directly into a
+ ;; partition instead of the extra-partition disk space
+ (('part => (disk :device))
+ (match-record (boot-alternative->menu-entry current-boot-alternative)
+ <menu-entry> (linux linux-arguments initrd)
+ #~(begin
+ (use-modules (ice-9 binary-ports) (rnrs bytevectors))
+ (set-path-environment-variable "PATH" '("bin") (list #$dtc))
- ;; TODO: These files have to be writable, so we copy them.
- ;; This can probably be fixed by using a ".its" file, just
- ;; be careful not to break initrd loading.
- (copy-file #$kernel "zImage")
- (chmod "zImage" #o755)
- (copy-file (string-append (dirname #$kernel) "/lib/dtbs/"
- "rk3288-veyron-speedy.dtb")
- "rk3288-veyron-speedy.dtb")
- (chmod "rk3288-veyron-speedy.dtb" #o644)
- (copy-file #$initrd "initrd")
- (chmod "initrd" #o644)
+ ;; TODO: These files have to be writable, so we copy them.
+ ;; This can probably be fixed by using a ".its" file, just
+ ;; be careful not to break initrd loading.
+ (copy-file #$linux "zImage")
+ (chmod "zImage" #o755)
+ (copy-file (string-append (dirname #$linux) "/lib/dtbs/" #$dtb)
+ "dtb")
+ (chmod "dtb" #o644)
+ (copy-file #$initrd "initrd")
+ (chmod "initrd" #o644)
- (invoke (string-append #$u-boot-tools "/bin/mkimage")
- "-D" "-I dts -O dtb -p 2048"
- "-f" "auto"
- "-A" "arm"
- "-O" "linux"
- "-T" "kernel"
- "-C" "None"
- "-d" "zImage"
- "-a" "0"
- "-b" "rk3288-veyron-speedy.dtb"
- "-i" "initrd"
- "image.itb")
- (call-with-output-file "bootloader.bin"
- (lambda (port)
- (put-bytevector port (make-bytevector 512 0))))
- (with-output-to-file "kernel-arguments"
- (lambda ()
- (display (string-join (list #$@kernel-arguments)))))
- (invoke (string-append #$vboot-utils "/bin/vbutil_kernel")
- "--pack" #$output
- "--version" "1"
- "--vmlinuz" "image.itb"
- "--arch" "arm"
- "--keyblock" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel.keyblock")
- "--signprivate" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel_data_key.vbprivk")
- "--config" "kernel-arguments"
- "--bootloader" "bootloader.bin"))))
- (computed-file "vmlinux.kpart" builder))
+ (invoke #+(file-append u-boot-tools "/bin/mkimage")
+ "-D" "-I dts -O dtb -p 2048"
+ "-f" "auto" ; format
+ "-A" #$arch ; architecture
+ "-O" "linux" ; os
+ "-T" "kernel" ; image type
+ "-C" "None" ; compression
+ "-d" "zImage" ; image data
+ "-a" "0" ; load address (hex)
+ "-b" "dtb" ; dtb for device
+ "-i" "initrd" ; initrd
+ "image.itb")
+ (call-with-output-file "bootloader.bin"
+ (lambda (port)
+ (put-bytevector port (make-bytevector 512 0))))
+ (call-with-output-file "kernel-arguments"
+ (lambda (port)
+ (display (string-join (list #$@linux-arguments)) port)))
+ (invoke #+(file-append vboot-utils "/bin/vbutil_kernel")
+ "--version" "1"
+ "--vmlinuz" "image.itb"
+ "--arch" #$arch
+ "--keyblock"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel.keyblock")
+ "--signprivate"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel_data_key.vbprivk")
+ "--config" "kernel-arguments"
+ "--pack" "vmlinux.kpart")
+ (write-file-on-device "vmlinux.kpart"
+ (stat:size (stat "vmlinux.kpart"))
+ #$disk 0))))))
-(define* (depthcharge-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- (match entries
- ((entry)
- (let ((kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- ;; XXX: Make this a symlink.
- (signed-kernel kernel kernel-arguments initrd)))
- (_ (error "Too many bootloader menu entries!"))))
-
-(define install-depthcharge
- #~(lambda (bootloader device mount-point)
- (let ((kpart (string-append mount-point
- "/boot/depthcharge/vmlinux.kpart")))
- (write-file-on-device kpart (stat:size (stat kpart)) device 0))))
-
-(define depthcharge-bootloader
+(define depthcharge-veyron-speedy-bootloader
(bootloader
(name 'depthcharge)
- (package #f)
- (installer install-depthcharge)
- (configuration-file "/boot/depthcharge/vmlinux.kpart")
- (configuration-file-generator depthcharge-configuration-file)))
+ (installer (cute install-depthcharge "arm" "rk3288-veyron-speedy.dtb"
+ <...>))))
+
+(define-deprecated/alias depthcharge-bootloader
+ depthcharge-veyron-speedy-bootloader)
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index d9b6d8bf8a..c3ab6f3275 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,112 +22,102 @@
(define-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:export (extlinux-bootloader
+ #:export (install-extlinux-config ; for u-boot
+ extlinux-bootloader
+ extlinux-gpt-bootloader
extlinux-bootloader-gpt))
-(define* (extlinux-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- "Return the U-Boot configuration file corresponding to CONFIG, a
-<u-boot-configuration> object, and where the store is available at STORE-FS, a
-<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
-corresponding to old generations of the system."
-
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
-
- (define with-fdtdir?
- (bootloader-configuration-device-tree-support? config))
+\f
+;;;
+;;; Config procedures.
+;;;
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- #~(format port "LABEL ~a
+(define* (install-extlinux-config #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ "Installer for the extlinux configuration file, meant to be shared by all
+bootloaders that use the format to specify boot options."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets menu-entries device-tree-support? timeout)
+ (define (menu-entry->gexp entry)
+ (match-record entry <menu-entry> (label linux linux-arguments initrd)
+ (let* ((normkern (normalize-file entry linux))
+ (fdt #~(string-append "FDTDIR" (dirname #$normkern) "/lib/dtbs")))
+ #~(format port "LABEL ~a
MENU LABEL ~a
KERNEL ~a
~a
INITRD ~a
APPEND ~a
-~%"
- #$label #$label
- #$kernel
- (if #$with-fdtdir?
- (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
- "")
- #$initrd
- (string-join (list #$@kernel-arguments)))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (let ((timeout #$(bootloader-configuration-timeout config)))
- (format port "# This file was generated from your Guix configuration. Any changes
+~%" #$label #$label #$normkern
+ #$(if device-tree-support? fdt "")
+ #$(normalize-file entry initrd)
+ (string-join (list #$@linux-arguments))))))
+
+ (let ((ents (cons (boot-alternative->menu-entry current-boot-alternative)
+ (append menu-entries
+ (map boot-alternative->menu-entry old-boot-alternatives)))))
+ (with-targets targets
+ (('extlinux => (path :path))
+ #~(begin (mkdir-p #$path)
+ (call-with-output-file #$path
+ (lambda (port)
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
# will be lost upon reconfiguration.
UI menu.c32
MENU TITLE GNU Guix Boot Options
PROMPT ~a
-TIMEOUT ~a~%"
- (if (> timeout 0) 1 0)
- ;; timeout is expressed in 1/10s of seconds.
- (* 10 timeout))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "~%"))
- #~())))))
-
- (computed-file "extlinux.conf" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-
+TIMEOUT ~a~%" ;; timeout is expressed in tenths of a second
+ #$(if (> timeout 0) 1 0) #$(* 10 timeout))
+ #$@(map menu-entry->gexp ents)))))))))
\f
-
;;;
-;;; Install procedures.
+;;; Install procedure.
;;;
(define (install-extlinux mbr)
- #~(lambda (bootloader device mount-point)
- (let ((extlinux (string-append bootloader "/sbin/extlinux"))
- (install-dir (string-append mount-point "/boot/extlinux"))
- (syslinux-dir (string-append bootloader "/share/syslinux")))
- (for-each (lambda (file)
- (install-file file install-dir))
- (find-files syslinux-dir "\\.c32$"))
- (invoke/quiet extlinux "--install" install-dir)
- (write-file-on-device (string-append syslinux-dir "/" #$mbr)
- 440 device 0))))
-
-(define install-extlinux-mbr
- (install-extlinux "mbr.bin"))
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('extlinux => (path :path))
+ #~(begin
+ #$(apply install-extlinux-config args)
+ (copy-recursively #$(file-append syslinux "/share/syslinux") #$path)
+ (invoke/quiet #+(file-append syslinux "/sbin/extlinux")
+ "--install" #$path)))
+ (('disk => (disk :device))
+ #~(write-file-on-device #$(file-append syslinux "/share/syslinux/" mbr)
+ 440 #$disk 0)))))
-(define install-extlinux-gpt
- (install-extlinux "gptmbr.bin"))
\f
-
;;;
;;; Bootloader definitions.
;;;
(define extlinux-bootloader
(bootloader
- (name 'extlinux)
- (package syslinux)
- (installer install-extlinux-mbr)
- (configuration-file "/boot/extlinux/extlinux.conf")
- (configuration-file-generator extlinux-configuration-file)))
-
-(define extlinux-bootloader-gpt
+ (name 'extlinux)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (install-extlinux "mbr.bin"))))
+
+(define extlinux-gpt-bootloader
(bootloader
- (inherit extlinux-bootloader)
- (installer install-extlinux-gpt)))
+ (inherit extlinux-bootloader)
+ (installer (install-extlinux "gptmbr.bin"))))
+
+(define-deprecated/alias extlinux-bootloader-gpt extlinux-gpt-bootloader)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..71fcc90ec7 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,24 +28,26 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader grub)
- #:use-module (guix build union)
- #:use-module (guix records)
- #:use-module (guix store)
- #:use-module (guix utils)
- #:use-module (guix gexp)
#:use-module (gnu artwork)
#:use-module (gnu bootloader)
- #:use-module (gnu system uuid)
- #:use-module (gnu system file-systems)
- #:use-module (gnu system keyboard)
- #:use-module (gnu system locale)
#:use-module (gnu packages bootloaders)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
#:autoload (gnu packages xorg) (xkeyboard-config)
+ #:use-module (gnu system boot)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system keyboard)
+ #:use-module (gnu system locale)
+ #:use-module (gnu system uuid)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (guix utils)
#:use-module (ice-9 match)
- #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
#:export (grub-theme
grub-theme?
grub-theme-image
@@ -53,54 +56,109 @@ (define-module (gnu bootloader grub)
grub-theme-color-highlight
grub-theme-gfxmode
- install-grub-efi-removable
- make-grub-efi-netboot-installer
-
+ grub.dir ; for (gnu build image) iso9660 images
grub-bootloader
+ grub-minimal-bootloader
grub-efi-bootloader
+ ;; deprecated
grub-efi-removable-bootloader
grub-efi32-bootloader
grub-efi-netboot-bootloader
- grub-efi-netboot-removable-bootloader
- grub-mkrescue-bootloader
- grub-minimal-bootloader
+ grub-efi-netboot-removable-bootloader))
- grub-configuration))
-
-;;; Commentary:
+\f
;;;
-;;; Configuration of GNU GRUB.
+;;; General utils.
;;;
-;;; Code:
-(define* (normalize-file file mount-point store-directory-prefix)
- "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
-G-expression or other lowerable object denoting a file name."
+;; in-gexp procedure to sanitize a value to be inserted into a GRUB script
+(define (sanitize str)
+ "Sanitize a value for use in a GRUB script."
+ #~(let* ((glycerin (lambda (l r) (if (pair? l) (append l r) (cons l r))))
+ (isopropyl (lambda (c) (case c ((#\\ #\$ #\") '(#\\ ,c)) (else c)))))
+ (use-modules (srfi srfi-1))
+ (list->string (fold-right glycerin '()
+ (map isopropyl (string->list #$str))))))
- (define (strip-mount-point mount-point file)
- (if mount-point
- (if (string=? mount-point "/")
- file
- #~(let ((file #$file))
- (if (string-prefix? #$mount-point file)
- (substring #$file #$(string-length mount-point))
- file)))
- file))
- (define (prepend-store-directory-prefix store-directory-prefix file)
- (if store-directory-prefix
- #~(string-append #$store-directory-prefix #$file)
- file))
- (prepend-store-directory-prefix store-directory-prefix
- (strip-mount-point mount-point file)))
+(define (grub-format type 32?)
+ (string-append
+ (cond ((string-prefix? "pc" type) "i386")
+ ((target-x86-32?) "i386")
+ ((target-x86-64?) (if 32? "i386" "x86_64"))
+ ((target-arm32?) "arm")
+ ((target-aarch64?) (if 32? "arm" "arm64"))
+ ((target-powerpc?) "powerpc")
+ ((target-riscv64?) "riscv64")
+ (else (raise (formatted-message (G_ "unrecognized target arch '~a'!")
+ (or (%current-target-system) (%current-system))))))
+ "-" type))
+(define* (search/target type targets var #:optional (port #f))
+ "Returns a gexp of a GRUB search command for target TYPE, storing the result
+in VAR. Optionally outputs to the gexp PORT instead of returning a string."
+ (define (form name val)
+ #~(format #$port "search.~a \"~a\" ~a~%" #$name #$val #$var))
+ (with-targets targets
+ ((type => (path :devpath) (device :device) (fs :fs)
+ (label :label) (uuid :uuid))
+ (cond ((member fs '("tftp" "nfs")) #~(format #$port "set ~a=tftp~%" #$var))
+ (uuid (form "fs_uuid" (uuid->string uuid)))
+ (label (form "fs_label" label))
+ (else (form "file" (sanitize path)))))))
+
+
+
+(define* (search/menu-entry device file var #:optional (port #f))
+ "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
+a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
+code to set the variable VAR. This procedure is able to handle DEVICEs
+unmounted at evaltime."
+ (match device
+ ;; Preferably refer to DEVICE by its UUID or label. This is more
+ ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
+ ((? uuid? idfk) ; calling idfk uuid here errors for some reason
+ #~(format #$port "search.fs_uuid ~a ~a~%" #$(uuid->string device) #$var))
+ ((? file-system-label? label)
+ #~(format #$port "search.fs_label \"~a\" ~a~%"
+ #$(sanitize (file-system-label->string label)) #$var))
+ ((? (lambda (device)
+ (and (string? device) (string-contains device ":/"))) nfs-uri)
+ ;; If the device is an NFS share, then we assume that the expected
+ ;; file on that device (e.g. the GRUB background image or the kernel)
+ ;; has to be loaded over the network. Otherwise we would need an
+ ;; additional device information for some local disk to look for that
+ ;; file, which we do not have.
+ ;;
+ ;; TFTP is preferred to HTTP because it is used more widely and
+ ;; specified in standards more widely--especially BOOTP/DHCPv4
+ ;; defines a TFTP server for DHCP option 66, but not HTTP.
+ ;;
+ ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
+ ;; which can contain a HTTP or TFTP URL.
+ ;;
+ ;; Note: It is assumed that the file paths are of a similar
+ ;; setup on both the TFTP server and the NFS server (it is
+ ;; not possible to search for files on TFTP).
+ ;;
+ ;; TODO: Allow HTTP.
+ #~(format #$port "set ~a=tftp~%" #$var))
+ ((or #f (? string?))
+ #~(format #$port "search.file \"~a\" ~a~%" #$(sanitize file) #$var))))
+
+
+
+\f
+;;;
+;;; Theming.
+;;;
+
(define-record-type* <grub-theme>
;; Default theme contributed by Felipe López.
- grub-theme make-grub-theme
- grub-theme?
+ grub-theme make-grub-theme grub-theme?
(image grub-theme-image
(default (file-append %artwork-repository
"/grub/GuixSD-fully-black-4-3.svg")))
@@ -113,128 +171,274 @@ (define-record-type* <grub-theme>
(gfxmode grub-theme-gfxmode
(default '("auto")))) ;list of string
+(define (grub-theme-png theme)
+ "Return the GRUB background image defined in THEME. If the suffix of the
+image file is \".svg\", then it is converted into a PNG file with the
+resolution provided in CONFIG. Returns #f if no file is provided."
+ (match-record theme <grub-theme> (image resolution)
+ (match resolution
+ (((? number? width) . (? number? height))
+ (computed-file "grub-image.png"
+ (with-imported-modules '((gnu build svg) (guix build utils))
+ (with-extensions (list guile-rsvg guile-cairo)
+ #~(begin (use-modules (gnu build svg) (guix build utils))
+ (if (png-file? #$image) (copy-file #$image #$output)
+ (svg->png #$image #$output
+ #:width #$width
+ #:height #$height)))))))
+ (_ image))))
+
+
+
\f
;;;
-;;; Background image & themes.
+;;; Core config.
+;;; GRUB architecture works by having a bootstage load up a core.img, which then
+;;; sets the root and prefix variables, allowing grub to load its main config
+;;; and modules, and then enter normal mode. On i386-pc systems a boot.img is
+;;; flashed which loads the core.img from the MBR gap, but on efi systems the
+;;; core.img is just a PE executable, able to be booted directly. We set up a
+;;; minimal core.img capable of finding the user-configured 'install target to
+;;; load its config from there.
;;;
-(define (bootloader-theme config)
- "Return user defined theme in CONFIG if defined or a default theme
-otherwise."
- (or (bootloader-configuration-theme config) (grub-theme)))
-
-(define* (image->png image #:key width height)
- "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\".
-Otherwise the picture in IMAGE is just copied."
- (computed-file "grub-image.png"
- (with-imported-modules '((gnu build svg))
- (with-extensions (list guile-rsvg guile-cairo)
- #~(if (string-suffix? ".svg" #+image)
- (begin
- (use-modules (gnu build svg))
- (svg->png #+image #$output
- #:width #$width
- #:height #$height))
- (copy-file #+image #$output))))))
-
-(define* (grub-background-image config)
- "Return the GRUB background image defined in CONFIG or #f if none was found.
-If the suffix of the image file is \".svg\", then it is converted into a PNG
-file with the resolution provided in CONFIG."
- (let* ((theme (bootloader-theme config))
- (image (grub-theme-image theme)))
- (and image
- (match (grub-theme-resolution theme)
- (((? number? width) . (? number? height))
- (image->png image #:width width #:height height))
- (_ #f)))))
-
-(define (grub-locale-directory grub)
- "Generate a directory with the locales from GRUB."
- (define builder
- #~(begin
- (use-modules (ice-9 ftw))
- (let ((locale (string-append #$grub "/share/locale"))
- (out #$output))
- (mkdir out)
- (chdir out)
- (for-each (lambda (lang)
- (let ((file (string-append locale "/" lang
- "/LC_MESSAGES/grub.mo"))
- (dest (string-append lang ".mo")))
- (when (file-exists? file)
- (copy-file file dest))))
- (scandir locale)))))
- (computed-file "grub-locales" builder))
-
-(define* (eye-candy config store-device store-mount-point
- #:key store-directory-prefix port)
- "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
-concerned with graphics mode, background images, colors, and all that.
-STORE-DEVICE designates the device holding the store, and STORE-MOUNT-POINT is
-its mount point; these are used to determine where the background image and
-fonts must be searched for. STORE-DIRECTORY-PREFIX is a directory prefix to
-prepend to any store file name."
- (define (setup-gfxterm config)
- (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
- #~(format #f "
+(define (core.cfg targets store-crypto-devices)
+ "Returns a filelike object for a core configuration file good enough to
+decrypt STORE-CRYPTO-DEVICES and boot to normal."
+ (define (crypto-device->cryptomount dev)
+ (and (uuid? dev) ; ignore non-uuids - warning given by os
+ #~(format port "cryptomount -u ~a~%"
+ ;; cryptomount only accepts UUID without the hyphen.
+ #$(string-delete #\- (uuid->string dev)))))
+
+ (and=>
+ (with-targets targets
+ (('install => (path :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ #$@(filter ->bool
+ (map crypto-device->cryptomount store-crypto-devices))
+ #$(search/target 'install targets "root" #~port)
+ (format port "set \"prefix=($root)~a\"~%" #$(sanitize path))))))
+ (cut computed-file "core.cfg" <>)))
+
+
+
+;; TODO: do we need LVM support here?
+(define* (core.img grub format #:key bootloader-config store-crypto-devices
+ #:allow-other-keys)
+ "The core image for GRUB, built for FORMAT."
+ (let* ((targets (bootloader-configuration-targets bootloader-config))
+ (bios? (string-prefix? format "pc"))
+ (efi? (string=? format "efi"))
+ (32? (bootloader-configuration-32bit? bootloader-config))
+ (cfg (core.cfg targets store-crypto-devices)))
+ (and cfg
+ (and=>
+ (with-targets targets
+ (('install => (fs :fs))
+ (let ((tftp? (or (string=? fs "tftp") (string=? fs "nfs"))))
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils) (ice-9 textual-ports)
+ (srfi srfi-1))
+ (apply invoke #$(file-append grub "/bin/grub-mkimage")
+ "--output" #$output
+ "--config" #$cfg
+ "--prefix" "none" ; we override this in cfg
+ ;; bios pxe uses pxeboot instead of diskboot - diff format
+ "--format" #$(string-append (grub-format format 32?)
+ (if (and bios? tftp?) "-pxe" ""))
+ "--compression" "auto"
+ ;; modules
+ "minicmd"
+ (append
+ ;; disk drivers
+ '#$(if bios? '("biosdisk") '())
+ ;; partmaps (TODO: detect which to use?)
+ '#$(if tftp? '() '("part_msdos" "part_gpt"))
+ ;; file systems
+ '#$(cond ((member fs '("ext2" "ext3" "ext4")) '("ext2"))
+ ((member fs "vfat" "fat32") "fat")
+ ((and tftp? efi?) "efinet")
+ ((and tftp? bios?) "pxe")
+ (else (list fs)))
+ ;; store crypto devs
+ '#$(if (any uuid? store-crypto-devices)
+ '("luks" "luks2" "cryptomount") '())
+ ;; search module that cfg uses
+ (call-with-input-file #$cfg
+ (lambda (port)
+ (let* ((str (get-string-all port))
+ (use (lambda (s) (string-contains str s))))
+ (cond ((use "search.fs_uuid") '("search_fs_uuid"))
+ ((use "search.fs_label") '("search_label"))
+ ((use "search.file") '("search_fs_file"))
+ (else '()))))))))))))
+ (cut computed-file "core.img" <>
+ #:options '(#:local-build? #t #:substitutable? #f))))))
+
+
+
+\f
+;;;
+;;; Main config.
+;;; This is what does the heavy lifting after core.img finds it.
+;;;
+
+(define (menu-entry->gexp store extra-initrd port)
+ (lambda (entry)
+ (match-record entry <menu-entry>
+ (label device linux linux-arguments initrd
+ multiboot-kernel multiboot-arguments multiboot-modules chain-loader)
+ (let ((norm (compose sanitize (cut normalize-file entry <>))))
+ #~(begin
+ (format #$port "menuentry ~s {~% " #$label)
+ #$(search/menu-entry
+ device (or linux multiboot-kernel chain-loader) "boot" port)
+ #$@(cond
+ (linux
+ (list #~(format #$port " linux \"($boot)~a\" ~a~%"
+ #$(norm linux)
+ ;; grub passes rest of the line _verbatim_
+ (string-join (list #$@linux-arguments)))
+ #~(format #$port " initrd ~a \"($boot)~a\"~%"
+ (if #$extra-initrd (string-append "($boot)\""
+ (norm #$extra-initrd) "\"")
+ "")
+ #$(norm initrd))))
+ ;; previously, this provided a (wrong) root= argument. just
+ ;; don't bother anymore. better less info than wrong info
+ (multiboot-kernel
+ (cons #~(format #$port " multiboot \"($boot)~a\" ~a~%"
+ #$(norm multiboot-kernel)
+ (string-join (list #$@multiboot-arguments)))
+ (map (lambda (mod) #~(format port " module \"($boot)~a\"~%"
+ #$(norm mod)))
+ multiboot-modules)))
+ (chain-loader
+ (list #~(format #$port " chainloader \"~a\"~%"
+ #$(norm chain-loader)))))
+ (format #$port "}~%"))))))
+
+
+
+(define* (grub.cfg #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ locale
+ store-directory-prefix
+ #:allow-other-keys)
+ "Returns a valid grub config given installer inputs. Expects locales, keymap,
+and theme image at LOCALES-TARG, KEYMAP-TARG, and IMAGE-TARG, respectively."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match keyboard-layout here cause it's bound to its struct
+ (targets menu-entries default-entry timeout extra-initrd
+ theme terminal-outputs terminal-inputs serial-unit serial-speed)
+ (let* ((entry->gexp (menu-entry->gexp store-directory-prefix
+ extra-initrd #~port))
+ (terms->str (compose string-join (cut map symbol->string <>)))
+ (colors->str (lambda (c) (format #f "~a/~a" (assoc-ref c 'fg)
+ (assoc-ref c 'bg))))
+ (outputs (or terminal-outputs '(gfxterm))) ; set default outs
+ (inputs (or terminal-inputs '())) ; set default ins
+ (theme (or theme (grub-theme))))
+ (and=>
+ (with-targets targets
+ (('install => (install :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ ;; preamble
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
+# will be lost upon reconfiguration~%")
+ #$@(filter ->bool
+ (list
+ ;; menu settings
+ (and default-entry
+ #~(format port "set default=~a~%" #$default-entry))
+ (and timeout
+ #~(format port "set timeout=~a~%" #$timeout))
+ ;; gfxterm setup
+ (and (memq 'gfxterm outputs)
+ #~(format port "\
if loadfont unicode; then
set gfxmode=~a
insmod all_video
insmod gfxterm
-fi~%"
- #$(string-join
- (grub-theme-gfxmode (bootloader-theme config))
- ";"))
- ""))
-
- (define (theme-colors type)
- (let* ((theme (bootloader-theme config))
- (colors (type theme)))
- (string-append (symbol->string (assoc-ref colors 'fg)) "/"
- (symbol->string (assoc-ref colors 'bg)))))
-
- (define image
- (normalize-file (grub-background-image config)
- store-mount-point
- store-directory-prefix))
-
- (and image
- #~(format #$port "
-# Set 'root' to the partition that contains /gnu/store.
-~a
-
-~a
-~a
-
+fi~%" #$(string-join (grub-theme-gfxmode theme) ";")))
+ ;; io
+ (and (or serial-unit serial-speed)
+ #~(format port "serial --unit=~a --speed=~a~%"
+ ;; documented defaults are unit 0 at 9600 baud.
+ #$(number->string (or serial-unit 0))
+ #$(number->string (or serial-speed 9600))))
+ (and (pair? outputs)
+ #~(format port "terminal_output ~a~%"
+ #$(terms->str outputs)))
+ (and (pair? inputs)
+ #~(format port "terminal_input ~a~%"
+ #$(terms->str inputs)))
+ ;; locale
+ (and locale
+ #~(format port "\
+set \"locale_dir=($root)~a/locales\"
+set lang=~a~%" #$(sanitize install)
+ #$(locale-definition-source
+ (locale-name->definition locale))))
+ ;; keyboard layout
+ (and (bootloader-configuration-keyboard-layout
+ bootloader-config)
+ #~(format port "\
+insmod keylayouts
+keymap \"($root)~a/keymap~%\"" #$(sanitize install)))
+ ;; theme
+ (match-record theme <grub-theme>
+ (image color-normal color-highlight)
+ (and image
+ #~(format port "\
insmod png
-if background_image ~a; then
+if background_image \"($root)~a/image.png\"; then
set color_normal=~a
set color_highlight=~a
else
set menu_color_normal=cyan/blue
- set menu_color_highlight=white/blue
-fi~%"
- #$(grub-root-search store-device image)
- #$(setup-gfxterm config)
- #$(grub-setup-io config)
+ set menu_color_highlight=whiute/blue
+fi~%" #$(sanitize install)
+ #$(colors->str color-normal)
+ #$(colors->str color-highlight))))))
+ ;; menu entries
+ #$(entry->gexp
+ (boot-alternative->menu-entry current-boot-alternative))
+ #$@(map entry->gexp menu-entries)
+ #$@(if (pair? old-boot-alternatives)
+ (append (list #~(format port "submenu ~s {~%"
+ "GNU system, old configurations..."))
+ (map (compose entry->gexp
+ boot-alternative->menu-entry)
+ old-boot-alternatives)
+ (list #~(format port "}~%"))) '())
+ (format port "
+if [ \"${grub_platform}\" == efi ]; then
+ menuentry \"Firmware setup\" {
+ fwsetup
+ }
+fi~%")))))
+ (cut computed-file "grub.cfg" <>
+ ;; Since this file is rather unique, there's no point in trying to
+ ;; substitute it.
+ #:options '(#:local-build? #t #:substitutable? #f))))))
- #$image
- #$(theme-colors grub-theme-color-normal)
- #$(theme-colors grub-theme-color-highlight))))
-\f
-;;;
-;;; Configuration file.
-;;;
-(define* (keyboard-layout-file layout
- #:key
- (grub grub))
+(define (keyboard-layout-file layout grub)
"Process the X keyboard layout description LAYOUT, a <keyboard-layout> record,
and return a file in the format for GRUB keymaps. LAYOUT must be present in
the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
- (define builder
+ (computed-file
+ (string-append "grub-keymap."
+ (string-map (match-lambda (#\, #\-) (chr chr))
+ (keyboard-layout-name layout)))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
@@ -243,670 +447,175 @@ (define* (keyboard-layout-file layout
;; (from the 'console-setup' package).
(invoke #+(file-append grub "/bin/grub-mklayout")
"-i" #+(keyboard-layout->console-keymap layout)
- "-o" #$output))))
-
- (computed-file (string-append "grub-keymap."
- (string-map (match-lambda
- (#\, #\-)
- (chr chr))
- (keyboard-layout-name layout)))
- builder))
-
-(define (grub-setup-io config)
- "Return GRUB commands to configure the input / output interfaces. The result
-is a string that can be inserted in grub.cfg."
- (let* ((symbols->string (lambda (list)
- (string-join (map symbol->string list) " ")))
- (outputs (bootloader-configuration-terminal-outputs config))
- (inputs (bootloader-configuration-terminal-inputs config))
- (unit (bootloader-configuration-serial-unit config))
- (speed (bootloader-configuration-serial-speed config))
-
- ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
- ;; as documented in GRUB manual section "Simple Configuration
- ;; Handling".
- (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
- gfxterm vga_text mda_text morse spkmodem))
- (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
- at_keyboard usb_keyboard))
-
- (io (string-append
- ;; UNIT and SPEED are arguments to the same GRUB command
- ;; ("serial"), so we process them together.
- (if (or unit speed)
- (string-append
- "serial"
- (if unit
- ;; COM ports 1 through 4
- (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
- (string-append " --unit=" (number->string unit))
- #f)
- "")
- (if speed
- (if (exact-integer? speed)
- (string-append " --speed=" (number->string speed))
- #f)
- "")
- "\n")
- "")
- (if (null? inputs)
- ""
- (string-append
- "terminal_input "
- (symbols->string
- (map
- (lambda (input)
- (if (memq input valid-inputs) input #f)) inputs))
- "\n"))
- "terminal_output "
- (symbols->string
- (map
- (lambda (output)
- (if (memq output valid-outputs) output #f)) outputs)))))
- (format #f "~a" io)))
-
-(define (grub-root-search device file)
- "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
-a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
-code."
- ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
- ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
- ;; custom menu entries. In the latter case, don't emit a 'search' command.
- (if (and (string? file) (not (string-prefix? "/" file)))
- ""
- (match device
- ;; Preferably refer to DEVICE by its UUID or label. This is more
- ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
- ((? uuid? uuid)
- (format #f "search --fs-uuid --set ~a"
- (uuid->string device)))
- ((? file-system-label? label)
- (format #f "search --label --set ~a"
- (file-system-label->string label)))
- ((? (lambda (device)
- (and (string? device) (string-contains device ":/"))) nfs-uri)
- ;; If the device is an NFS share, then we assume that the expected
- ;; file on that device (e.g. the GRUB background image or the kernel)
- ;; has to be loaded over the network. Otherwise we would need an
- ;; additional device information for some local disk to look for that
- ;; file, which we do not have.
- ;;
- ;; We explicitly set "root=(tftp)" here even though if grub.cfg
- ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
- ;; automatically anyway. The reason is if you have a system that
- ;; used to be on NFS but now is local, root would be set to local
- ;; disk. If you then selected an older system generation that is
- ;; supposed to boot from network in the Grub boot menu, Grub still
- ;; wouldn't load those files from network otherwise.
- ;;
- ;; TFTP is preferred to HTTP because it is used more widely and
- ;; specified in standards more widely--especially BOOTP/DHCPv4
- ;; defines a TFTP server for DHCP option 66, but not HTTP.
- ;;
- ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
- ;; which can contain a HTTP or TFTP URL.
- ;;
- ;; Note: It is assumed that the file paths are of a similar
- ;; setup on both the TFTP server and the NFS server (it is
- ;; not possible to search for files on TFTP).
- ;;
- ;; TODO: Allow HTTP.
- "set root=(tftp)")
- ((or #f (? string?))
- #~(format #f "search --file --set ~a" #$file)))))
-
-(define* (make-grub-configuration grub config entries
- #:key
- (locale #f)
- (system (%current-system))
- (old-entries '())
- (store-crypto-devices '())
- store-directory-prefix)
- "Return the GRUB configuration file corresponding to CONFIG, a
-<bootloader-configuration> object, and where the store is available at
-STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
-entries corresponding to old generations of the system.
-STORE-CRYPTO-DEVICES contain the UUIDs of the encrypted units that must
-be unlocked to access the store contents.
-STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
-when booting a root file system on a Btrfs subvolume."
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (linux (menu-entry-linux entry))
- (device (menu-entry-device entry))
- (device-mount-point (menu-entry-device-mount-point entry))
- (multiboot-kernel (menu-entry-multiboot-kernel entry))
- (chain-loader (menu-entry-chain-loader entry)))
- (cond
- (linux
- (let ((arguments (menu-entry-linux-arguments entry))
- (linux (normalize-file linux
- device-mount-point
- store-directory-prefix))
- (initrd (normalize-file (menu-entry-initrd entry)
- device-mount-point
- store-directory-prefix))
- (extra-initrd (bootloader-configuration-extra-initrd config)))
- ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
- ;; Use the right file names for LINUX and INITRD in case
- ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
- ;; separate partition.
-
- ;; When STORE-DIRECTORY-PREFIX is defined, prepend it the linux and
- ;; initrd paths, to allow booting from a Btrfs subvolume.
- #~(format port "menuentry ~s {
- ~a
- linux ~a ~a
- initrd ~a ~a
-}~%"
- #$label
- #$(grub-root-search device linux)
- #$linux (string-join (list #$@arguments))
- (or #$extra-initrd "")
- #$initrd)))
- (multiboot-kernel
- (let* ((kernel (menu-entry-multiboot-kernel entry))
- (arguments (menu-entry-multiboot-arguments entry))
- ;; Choose between device names as understood by Mach's built-in
- ;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
- ;; in the "noide" case).
- (disk (if (member "noide" arguments) "w" "h"))
- (modules (menu-entry-multiboot-modules entry))
- (root-index 1)) ; XXX EFI will need root-index 2
- #~(format port "
-menuentry ~s {
- multiboot ~a root=part:~a:device:~ad0~a~a
-}~%"
- #$label
- #$kernel
- #$root-index
- #$disk
- (string-join (list #$@arguments) " " 'prefix)
- (string-join (map string-join '#$modules)
- "\n module " 'prefix))))
- (chain-loader
- #~(format port "
-menuentry ~s {
- ~a
- chainloader ~a
-}~%"
- #$label
- #$(grub-root-search device chain-loader)
- #$chain-loader)))))
-
- (define (crypto-devices)
- (define (crypto-device->cryptomount dev)
- (if (uuid? dev)
- #~(format port "cryptomount -u ~a~%"
- ;; cryptomount only accepts UUID without the hypen.
- #$(string-delete #\- (uuid->string dev)))
- ;; Other type of devices aren't implemented.
- #~()))
- (let ((devices (map crypto-device->cryptomount store-crypto-devices))
- (modules #~(format port "insmod luks~%insmod luks2~%")))
- (if (null? devices)
- devices
- (cons modules devices))))
-
- (define (sugar)
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- (eye-candy config
- device
- mount-point
- #:store-directory-prefix store-directory-prefix
- #:port #~port)))
-
- (define locale-config
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- #~(let ((locale #$(and locale
- (locale-definition-source
- (locale-name->definition locale))))
- (locales #$(and locale
- (normalize-file (grub-locale-directory grub)
- mount-point
- store-directory-prefix))))
- (when locale
- (format port "\
-# Localization configuration.
-~asearch --file --set ~a/en@quot.mo
-set locale_dir=~a
-set lang=~a~%"
- ;; Skip the search if there is an image, as it has already
- ;; been performed by eye-candy and traversing the store is
- ;; an expensive operation.
- #$(if (grub-theme-image (bootloader-theme config))
- "# "
- "")
- locales
- locales
- locale)))))
-
- (define keyboard-layout-config
- (let* ((layout (bootloader-configuration-keyboard-layout config))
- (keymap* (and layout
- (keyboard-layout-file layout #:grub grub)))
- (entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry))
- (keymap (and keymap*
- (normalize-file keymap* mount-point
- store-directory-prefix))))
- #~(when #$keymap
- (format port "\
-insmod keylayouts
-keymap ~a~%" #$keymap))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (format port
- "# This file was generated from your Guix configuration. Any changes
-# will be lost upon reconfiguration.
-")
- #$@(crypto-devices)
- #$(sugar)
- #$locale-config
- #$keyboard-layout-config
- (format port "
-set default=~a
-set timeout=~a~%"
- #$(bootloader-configuration-default-entry config)
- #$(bootloader-configuration-timeout config))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "
-submenu \"GNU system, old configurations...\" {~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "}~%"))
- #~())
- (format port "
-if [ \"${grub_platform}\" == efi ]; then
- menuentry \"Firmware setup\" {
- fwsetup
- }
-fi~%"))))
+ "-o" #$output)))))
+
+
+
+(define* (grub.dir grub #:key bootloader-config locale
+ #:allow-other-keys . args)
+ "Everything what should go in GRUB's prefix, including fonts, modules,
+locales, keymap, theme image, and grub.cfg."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match for keyboard-layout: identifier bound in this scope
+ (targets theme)
+ (let* ((theme (or theme (grub-theme)))
+ (keyboard-layout (bootloader-configuration-keyboard-layout
+ bootloader-config))
+ (lang (and=> locale (compose locale-definition-source
+ locale-name->definition)))
+ (lc-mesg (and=> lang (cut file-append grub "/share/locale" <>
+ "/LC_MESSAGES/grub.mo"))))
+ (computed-file "grub.dir"
+ (with-imported-modules '((guix build utils))
+ #~(begin (use-modules (guix build utils))
+ (mkdir-p #$output)
+ (chdir #$output)
+ ;; grub files
+ (copy-recursively #$(file-append grub "/lib/grub/") #$output
+ #:copy-file symlink)
+ (mkdir "fonts")
+ (symlink #$(file-append grub "/share/grub/unicode.pf2")
+ "fonts/unicode.pf2")
+ ;; config file
+ (symlink #$(apply grub.cfg args) "grub.cfg")
+ ;; locales
+ (when (and=> #$lc-mesg file-exists?)
+ (mkdir "locales")
+ (symlink #$lc-mesg (string-append "locales/" #$lang ".mo")))
+ ;; keymap
+ #$@(filter ->bool
+ (list
+ (and keyboard-layout
+ #~(symlink #$(keyboard-layout-file keyboard-layout grub)
+ "keymap"))
+ ;; image
+ (and (grub-theme-image theme)
+ #~(copy-file #$(grub-theme-png theme) "image.png"))))))
+ #:options '(#:local-build? #t #:substitutable? #f)))))
- ;; Since this file is rather unique, there's no point in trying to
- ;; substitute it.
- (computed-file "grub.cfg" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-(define (grub-configuration-file config . args)
- (let* ((bootloader (bootloader-configuration-bootloader config))
- (grub (bootloader-package bootloader)))
- (apply make-grub-configuration grub config args)))
-
-(define (grub-efi-configuration-file . args)
- (apply make-grub-configuration grub-efi args))
-
-(define grub-cfg "/boot/grub/grub.cfg")
\f
-
;;;
-;;; Install procedures.
+;;; Installers.
;;;
-(define install-grub
- #~(lambda (bootloader device mount-point)
- (let ((grub (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot")))
- ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE
- ;; is #f, then we populate the disk-image rooted at MOUNT-POINT.
- (if device
- (begin
- ;; Tell 'grub-install' that there might be a LUKS-encrypted
- ;; /boot or root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-
- ;; Hide potentially confusing messages from the user, such as
- ;; "Installing for i386-pc platform."
- (invoke/quiet grub "--no-floppy" "--target=i386-pc"
- "--boot-directory" install-dir
- device))
- ;; When creating a disk-image, only install a font and GRUB modules.
- (let* ((fonts (string-append install-dir "/grub/fonts")))
- (mkdir-p fonts)
- (copy-file (string-append bootloader "/share/grub/unicode.pf2")
- (string-append fonts "/unicode.pf2"))
- (copy-recursively (string-append bootloader "/lib/")
- install-dir))))))
-
-(define install-grub-disk-image
- #~(lambda (bootloader root-index image)
- ;; Install GRUB on the given IMAGE. The root partition index is
- ;; ROOT-INDEX.
- (let ((grub-mkimage
- (string-append bootloader "/bin/grub-mkimage"))
- (modules '("biosdisk" "part_msdos" "fat" "ext2"))
- (grub-bios-setup
- (string-append bootloader "/sbin/grub-bios-setup"))
- (root-device (format #f "hd0,msdos~a" root-index))
- (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img"))
- (device-map "device.map"))
-
- ;; Create a minimal, standalone GRUB image that will be written
- ;; directly in the MBR-GAP (space between the end of the MBR and the
- ;; first partition).
- (apply invoke grub-mkimage
- "-O" "i386-pc"
- "-o" "core.img"
- "-p" (format #f "(~a)/boot/grub" root-device)
- modules)
-
- ;; Create a device mapping file.
- (call-with-output-file device-map
- (lambda (port)
- (format port "(hd0) ~a~%" image)))
-
- ;; Copy the default boot.img, that will be written on the MBR sector
- ;; by GRUB-BIOS-SETUP.
- (copy-file boot-img "boot.img")
-
- ;; Install both the "boot.img" and the "core.img" files on the given
- ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB
- ;; written in the MBR-GAP. GRUB configuration and missing modules will
- ;; be read from ROOT-DEVICE.
- (invoke grub-bios-setup
- "-m" device-map
- "-r" root-device
- "-d" "."
- image))))
-
-(define install-grub-efi
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi-removable
- #~(lambda (bootloader efi-dir mount-point)
- ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
- ;; NOTE: efi-dir comes from target list of booloader configuration
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--removable"
- ;; "--no-nvram"
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi32
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- (cond ((target-x86?) "--target=i386-efi")
- ((target-arm?) "--target=arm-efi"))
- "--efi-directory" target-esp)))))
-
-(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
- "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
-its files in SUBDIR and its configuration file in GRUB-CFG.
-
-As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
-installer basically copies all files from the bootloader-package (or profile)
-into the bootloader-target directory.
-
-Additionally for network booting over TFTP, two relative symlinks to the store
-and to the GRUB-CFG file are necessary. Due to this a TFTP root directory must
-not be located on a FAT file-system.
-
-If the bootloader-target does not support symlinks, then it is assumed to be a
-kind of EFI System Partition (ESP). In this case an intermediate configuration
-file is created with the help of GRUB-EFI to load the GRUB-CFG.
-
-The installer is usable for any efi-bootloader-chain, which prepares the
-bootloader-profile in a way ready for copying.
-
-The installer does not manipulate the system's 'UEFI Boot Manager'.
-
-The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
-arguments. Its job is to copy the BOOTLOADER, which must be a pre-installed
-grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
-directory TARGET for the system whose root is mounted at MOUNT-POINT.
-
-MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
-or '/' for other 'guix system' commands.
-
-Where TARGET comes from the targets argument given to the
-bootloader-configuration in:
-
-(operating-system
- (bootloader (bootloader-configuration
- (targets '(\"/boot/efi\"))
- …))
- …)
-
-TARGET is required to be an absolute directory name, usually mounted via NFS,
-and finally needs to be provided by a TFTP server as
-the TFTP root directory.
-
-Usually the installer will be used to prepare network booting over TFTP. Then
-GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
-load more files from the store like tftp://server/gnu/store/…-linux…/Image.
-
-To make this possible two symlinks are created. The first symlink points
-relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
-MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
-MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.
-
-It is important to note that these symlinks need to be relative, as the absolute
-paths on the TFTP server side are unknown.
-
-It is also important to note that both symlinks will point outside the TFTP root
-directory and that the TARGET/%store-prefix symlink makes the whole store
-accessible via TFTP. Possibly the TFTP server must be configured to allow
-accesses outside its TFTP root directory. This all may need to be considered
-for security aspects. It is advised to disable any TFTP write access!
-
-The installer can also be used to prepare booting from local storage, if the
-underlying file-system, like FAT on an EFI System Partition (ESP), does not
-support symlinks. In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
-created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file. A
-symlink to the store is not needed in this case."
- (with-imported-modules '((guix build union))
- #~(lambda (bootloader target mount-point)
- ;; In context of a disk image creation TARGET will be #f and an
- ;; installer is expected to do necessary installations on MOUNT-POINT,
- ;; which will become the root file system. If TARGET is #f, this
- ;; installer has nothing to do, as it only cares about the EFI System
- ;; Partition (ESP).
- (when target
- (use-modules ((guix build union) #:select (symlink-relative))
- (ice-9 popen)
- (ice-9 rdelim))
- (let* ((mount-point/target (string-append mount-point target "/"))
- ;; When installing Guix, it is common to mount TARGET below
- ;; MOUNT-POINT rather than the root directory.
- (bootloader-target (if (file-exists? mount-point/target)
- mount-point/target
- target))
- (store (string-append mount-point (%store-prefix)))
- (store-link (string-append bootloader-target (%store-prefix)))
- (grub-cfg (string-append mount-point #$grub-cfg))
- (grub-cfg-link (string-append bootloader-target
- #$subdir "/"
- (basename grub-cfg))))
- ;; Copy the bootloader into the bootloader-target directory.
- ;; Should we beforehand recursively delete any existing file?
- (copy-recursively bootloader bootloader-target
- #:follow-symlinks? #t
- #:log (%make-void-port "w"))
- ;; For TFTP we need to install additional relative symlinks.
- ;; If we install on an EFI System Partition (ESP) or some other FAT
- ;; file-system, then symlinks cannot be created and are not needed.
- ;; Therefore we ignore exceptions when trying.
- ;; Prepare the symlink to the grub.cfg.
- (mkdir-p (dirname grub-cfg-link))
- (false-if-exception (delete-file grub-cfg-link))
- (if (unspecified?
- (false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
- ;; Symlinks are supported.
- (begin
- ;; Prepare the symlink to the store.
- (mkdir-p (dirname store-link))
- (false-if-exception (delete-file store-link))
- (symlink-relative store store-link))
- ;; Creating symlinks does not seem to be supported. Probably
- ;; an ESP is used. Add a script to search and load the actual
- ;; grub.cfg.
- (let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
- (port (open-pipe* OPEN_READ probe "--target=fs_uuid"
- grub-cfg))
- (search-root
- (match (read-line port)
- ((? eof-object?)
- ;; There is no UUID available. As a fallback search
- ;; everywhere for the grub.cfg.
- (string-append "search --file --set " #$grub-cfg))
- (fs-uuid
- ;; The UUID to load the grub.cfg from is known.
- (string-append "search --fs-uuid --set " fs-uuid))))
- (load-grub-cfg (string-append "configfile " #$grub-cfg)))
- (close-pipe port)
- (with-output-to-file grub-cfg-link
- (lambda ()
- (display (string-join (list search-root
- load-grub-cfg)
- "\n")))))))))))
+(define* (install-grub.dir grub #:key bootloader-config
+ #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('install => (path :path))
+ #~(copy-recursively #$(apply grub.dir grub args) #$path
+ #:log (%make-void-port "w")
+ #:follow-symlinks? #t
+ #:copy-file atomic-copy))))
+
+(define (install-grub-bios grub)
+ "Returns an installer for the bios-bootable grub package GRUB."
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (gbegin (apply install-grub.dir grub args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('disk => (device :device))
+ #~(invoke #$(file-append grub "/sbin/grub-bios-setup") "-v" "-v"
+ "--directory" "/" ; can't be blank
+ "--device-map" "" ; no dev map - need to specify
+ "--boot-image"
+ #$(file-append grub "/lib/grub/i386-pc/boot.img")
+ "--core-image" #$(apply core.img grub "pc" args)
+ "--root-device" #$(string-append "hostdisk/" device)
+ #$device))))))
+
+(define* (install-grub-efi #:key bootloader-config #:allow-other-keys . args)
+ "Installs grub into the system's uefi bootloader, taking into account
+user-specified requirements for a 32-bit or fallback bootloader."
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (grub (if 32? grub-efi32 grub-efi))
+ (core (apply core.img grub "efi" args))
+ (copy #~(lambda (dest) (copy-file #$core dest))))
+ (gbegin (apply install-grub.dir grub args)
+ (install-efi bootloader-config #~`((,#$copy "grub.efi" . "GNU GRUB"))))))
+
-\f
+\f
;;;
-;;; Bootloader definitions.
+;;; Bootloaders.
;;;
-;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
-;;; is fixed. Inheriting and overwriting the field 'configuration-file' will
-;;; break 'guix system delete-generations', 'guix system switch-generation',
-;;; and 'guix system roll-back'.
+
+(define %grub-default-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))))
(define grub-bootloader
(bootloader
- (name 'grub)
- (package grub)
- (installer install-grub)
- (disk-image-installer install-grub-disk-image)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub))))
(define grub-minimal-bootloader
(bootloader
- (inherit grub-bootloader)
- (package grub-minimal)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub-minimal))))
(define grub-efi-bootloader
(bootloader
- (name 'grub-efi)
- (package grub-efi)
- (installer install-grub-efi)
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
-
-(define grub-efi-removable-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (name 'grub-efi-removable-bootloader)
- (installer install-grub-efi-removable)))
+ (name 'grub-efi)
+ (default-targets (cons (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))
+ %grub-default-targets))
+ (installer install-grub-efi)))
-(define grub-efi32-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (installer install-grub-efi32)
- (name 'grub-efi32)
- (package grub-efi32)))
-(define (make-grub-efi-netboot-bootloader name subdir)
- (bootloader
- (name name)
- (package (make-grub-efi-netboot (symbol->string name) subdir))
- (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-efi-configuration-file)))
-
-(define grub-efi-netboot-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
- "efi/Guix"))
-
-(define grub-efi-netboot-removable-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
- "efi/boot"))
-
-(define grub-mkrescue-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (package grub-hybrid)))
\f
;;;
-;;; Compatibility macros.
+;;; deprecated shit!
+;;; use the bootloader-config flags instead! or, in the case of netboot, set
+;;; your 'install (or parent thereof) target fs to be "tftp" or "nfs"
;;;
-(define-syntax grub-configuration
- (syntax-rules (grub)
- ((_ (grub package) fields ...)
- (if (eq? package grub)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...)
- (bootloader-configuration
- (bootloader grub-efi-bootloader)
- fields ...)))
- ((_ fields ...)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...))))
-
-;;; grub.scm ends here
+(define (deprecated-installer installer removable? 32?)
+ (lambda args (apply installer
+ (substitute-keyword-arguments args
+ ((#:bootloader-config conf) (bootloader-configuration
+ (inherit conf)
+ (efi-removable? removable?)
+ (32bit? 32?)))))))
+
+(define-deprecated grub-efi-removable-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #t #f))))
+
+(define-deprecated grub-efi32-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #f #t))))
+
+(define %netboot-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot")
+ (file-system "tftp"))
+ (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+
+(define-deprecated grub-efi-netboot-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)))
+
+(define-deprecated grub-efi-netboot-removable-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)
+ (installer (deprecated-installer install-grub-efi #t #f))))
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index c5437a7b63..7d3e202f8c 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Herman Rimm <herman_rimm@protonmail.com>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,12 +25,11 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader u-boot)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
+ #:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
- #:export (u-boot-bootloader
- u-boot-a20-olinuxino-lime-bootloader
+ #:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
u-boot-bananapi-m2-ultra-bootloader
@@ -53,301 +53,172 @@ (define-module (gnu bootloader u-boot)
u-boot-ts7970-q-2g-1000mhz-c-bootloader
u-boot-wandboard-bootloader))
-(define install-u-boot
- #~(lambda (bootloader root-index image)
- (if bootloader
- (error "Failed to install U-Boot"))))
+(define (make-install-u-boot firmware installers)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('extlinux (apply install-extlinux-config args))
+ (('install => (path :path)) #~(let ((path #$path) #$firmware)))
+ (('disk => (disk :device)) #~(let ((disk #$disk)) #f #$@installers)))))
+
+(define-syntax-rule (define-u-bootloader def-name package firmware
+ (file size doffset) ...)
+ "Defines a u-boot installer DEF-NAME, using u-boot PACKAGE. Installs each
+given FILE of SIZE (or #f to autodetect) to the targetted disk at OFFSET.
+FIRMWARE is ran on the u-boot firmware directory for installation of supporting
+files, with the variable path set to the dir path."
+ (define def-name
+ (bootloader
+ (name 'u-boot)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (make-install-u-boot firmware
+ (list #~(let ((fw #$(file-append package "/libexec/" file)))
+ (write-file-on-device fw
+ #$(or size #~(stat:size (stat fw)))
+ disk #$doffset)) ...))))))
+
+\f
+;;;
+;;; Bootloader definitions.
+;;;
-(define install-beaglebone-black-u-boot
+(define-u-bootloader u-boot-beaglebone-black-bootloader
+ u-boot-am335x-boneblack #f
;; http://wiki.beyondlogic.org/index.php?title=BeagleBoneBlack_Upgrading_uBoot
;; This first stage bootloader called MLO (U-Boot SPL) is expected at
;; 0x20000 by BBB ROM code. The second stage bootloader will be loaded by
;; the MLO and is expected at 0x60000. Write both first stage ("MLO") and
- ;; second stage ("u-boot.img") images, read in BOOTLOADER directory, to the
- ;; specified DEVICE.
- #~(lambda (bootloader root-index image)
- (let ((mlo (string-append bootloader "/libexec/MLO"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device mlo (* 256 512)
- image (* 256 512))
- (write-file-on-device u-boot (* 1024 512)
- image (* 768 512)))))
-
-(define install-allwinner-u-boot
- #~(lambda (bootloader root-index image)
- (let ((u-boot (string-append bootloader
- "/libexec/u-boot-sunxi-with-spl.bin")))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 8 1024)))))
-
-(define install-allwinner64-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 8 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 40 1024)))))
-
-(define install-imx-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/SPL"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 1 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 69 1024)))))
-
-(define install-orangepi-r1-plus-lts-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-puma-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 512 512)))))
-
-(define install-firefly-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rock64-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rockpro64-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-pinebook-pro-rk3399-u-boot install-rockpro64-rk3399-u-boot)
-
-(define install-u-boot-ts7970-q-2g-1000mhz-c-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.imx (string-append bootloader "/libexec/u-boot.imx"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.imx install-dir))))
-
-(define install-sifive-unmatched-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/spl/u-boot-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append
- bootloader "/libexec/spl/u-boot-spl.bin.normal.out"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-uEnv.txt
- #~(lambda (bootloader device mount-point)
- (mkdir-p (string-append mount-point "/boot"))
- (call-with-output-file (string-append mount-point "/boot/uEnv.txt")
+ ;; second stage ("u-boot.img") images to the target.
+ ("MLO" (* 256 512) (* 256 512))
+ ("u-boot.img" (* 1024 512) (* 768 512)))
+
+(define-u-bootloader u-boot-sifive-unmatched-bootloader
+ u-boot-sifive-unmatched #f
+ ("spl/u-boot-spl.bin" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+(define-u-bootloader u-boot-starfive-visionfive2-bootloader
+ u-boot-starfive-visionfive2
+ #~(begin (mkdir-p path)
+ (call-with-output-file (string-append path "/uEnv.txt")
(lambda (port)
(format port
- ;; if board SPI use vender's u-boot, will find
- ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
- ;; that users will update this u-boot, so set it.
- "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%")))))
+ ;; if board SPI use vender's u-boot, will find
+ ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
+ ;; that users will update this u-boot, so set it.
+ "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%"))))
+ ("spl/u-boot-spl.bin.normal.out" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+\f
+;;;
+;;; Allwinner bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))))
+
-(define install-qemu-riscv64-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.bin (string-append bootloader "/libexec/u-boot.bin"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.bin install-dir))))
+(define-u-bootloader-allwinner u-boot-nintendo-nes-classic-edition-bootloader
+ u-boot-nintendo-nes-classic-edition)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime-bootloader
+ u-boot-a20-olinuxino-lime)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime2-bootloader
+ u-boot-a20-olinuxino-lime2)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-micro-bootloader
+ u-boot-a20-olinuxino-micro)
+
+(define-u-bootloader-allwinner u-boot-bananapi-m2-ultra-bootloader
+ u-boot-bananapi-m2-ultra)
+
+(define-u-bootloader-allwinner u-boot-cubietruck-bootloader u-boot-cubietruck)
+
+(define-u-bootloader-allwinner u-boot-pine64-lts-bootloader u-boot-pine64-lts)
\f
+;;;
+;;; Allwinner64 bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner64 def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))
+ ("u-boot-sunxi-with-spl.fit.itb" #f (* 40 1024))))
+
+
+(define-u-bootloader-allwinner64 u-boot-pine64-plus-bootloader
+ u-boot-pine64-plus)
+
+(define-u-bootloader-allwinner64 u-boot-pinebook-bootloader u-boot-pinebook)
+\f
;;;
-;;; Bootloader definitions.
+;;; IMX bootloader definitions.
;;;
+(define-syntax-rule (define-u-bootloader-imx def-name package)
+ (define-u-bootloader def-name package #f
+ ("SPL" #f (* 8 1024))
+ ("u-boot.img" #f (* 40 1024))))
-(define u-boot-bootloader
- (bootloader
- (inherit extlinux-bootloader)
- (name 'u-boot)
- (package #f)
- (installer #f)
- (disk-image-installer install-u-boot)))
-
-(define u-boot-beaglebone-black-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-am335x-boneblack)
- (disk-image-installer install-beaglebone-black-u-boot)))
-
-(define u-boot-allwinner-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner-u-boot)))
-
-(define u-boot-allwinner64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner64-u-boot)))
-
-(define u-boot-imx-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-imx-u-boot)))
-
-(define u-boot-nintendo-nes-classic-edition-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-nintendo-nes-classic-edition)))
-
-(define u-boot-a20-olinuxino-lime-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime)))
-
-(define u-boot-a20-olinuxino-lime2-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime2)))
-
-(define u-boot-a20-olinuxino-micro-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-micro)))
-
-(define u-boot-bananapi-m2-ultra-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-bananapi-m2-ultra)))
-
-(define u-boot-cubietruck-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-cubietruck)))
-
-(define u-boot-firefly-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-firefly-rk3399)
- (disk-image-installer install-firefly-rk3399-u-boot)))
-
-(define u-boot-mx6cuboxi-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-mx6cuboxi)))
-
-(define u-boot-wandboard-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-wandboard)))
-
-(define u-boot-novena-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-novena)))
-
-(define u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-orangepi-r1-plus-lts-rk3328)
- (disk-image-installer install-orangepi-r1-plus-lts-rk3328-u-boot)))
-
-(define u-boot-pine64-plus-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pine64-plus)))
-
-(define u-boot-pine64-lts-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-pine64-lts)))
-
-(define u-boot-pinebook-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pinebook)))
-
-(define u-boot-puma-rk3399-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-puma-rk3399)
- (disk-image-installer install-puma-rk3399-u-boot)))
-
-(define u-boot-rock64-rk3328-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rock64-rk3328)
- (disk-image-installer install-rock64-rk3328-u-boot)))
-(define u-boot-rockpro64-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rockpro64-rk3399)
- (disk-image-installer install-rockpro64-rk3399-u-boot)))
+(define-u-bootloader-imx u-boot-mx6cuboxi-bootloader u-boot-mx6cuboxi)
+
+(define-u-bootloader-imx u-boot-wandboard-bootloader u-boot-wandboard)
-(define u-boot-pinebook-pro-rk3399-bootloader
+(define-u-bootloader-imx u-boot-novena-bootloader u-boot-novena)
+
+\f
+;;;
+;;; Rockchip bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-rockchip def-name package)
;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-pinebook-pro-rk3399)
- (disk-image-installer install-pinebook-pro-rk3399-u-boot)))
-
-(define u-boot-ts7970-q-2g-1000mhz-c-bootloader
- ;; This bootloader doesn't really need to be installed, as it is read from
- ;; an SPI memory chip, not the SD card. It is copied to /boot/u-boot.imx
- ;; for convenience and should be manually flashed at the U-Boot prompt.
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-ts7970-q-2g-1000mhz-c)
- (installer install-u-boot-ts7970-q-2g-1000mhz-c-u-boot)
- (disk-image-installer #f)))
-
-(define u-boot-sifive-unmatched-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-sifive-unmatched)
- (disk-image-installer install-sifive-unmatched-u-boot)))
-
-(define u-boot-starfive-visionfive2-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-starfive-visionfive2)
- (installer install-starfive-visionfive2-uEnv.txt)
- (disk-image-installer install-starfive-visionfive2-u-boot)))
-
-(define u-boot-qemu-riscv64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-qemu-riscv64)
- (installer install-qemu-riscv64-u-boot)
- (disk-image-installer #f)))
+ (define-u-bootloader def-name package #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 16384 512))))
+
+(define-u-bootloader-rockchip u-boot-firefly-rk3399-bootloader
+ u-boot-firefly-rk3399)
+
+(define-u-bootloader-rockchip u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+ u-boot-orangepi-r1-plus-lts-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rock64-rk3328-bootloader
+ u-boot-rock64-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rockpro64-rk3399-bootloader
+ u-boot-rockpro64-rk3399)
+
+(define-u-bootloader-rockchip u-boot-pinebook-pro-rk3399-bootloader
+ u-boot-pinebook-pro-rk3399)
+
+(define-u-bootloader u-boot-puma-rk3399-bootloader u-boot-puma-rk3399 #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 512 512)))
+
+\f
+;;;
+;;; Copy-only bootloader definitions.
+;;;
+
+;; These bootloaders don't really need to be installed, as they are read from
+;; an SPI memory chip or directly from the FS, not the disk.
+(define-syntax-rule (define-u-bootloader-copy def-name package file)
+ (define-u-bootloader def-name package
+ #~(install-file #$(file-append package "/libexec/" file) path)))
+
+;; user should manually install this to SPI flash
+;; TODO: write directly to SPI flash? unless wear issues are a problem.
+(define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
+ u-boot-ts7970-q-2g-1000mhz-c "u-boot.imx")
+
+(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
+ u-boot-qemu-riscv64 "u-boot.bin")
diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm
index af6063a884..b59287d759 100644
--- a/gnu/build/bootloader.scm
+++ b/gnu/build/bootloader.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,20 +21,45 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build bootloader)
+ #:autoload (guix build syscalls) (free-disk-space)
#:use-module (guix build utils)
- #:use-module (guix utils)
- #:use-module (ice-9 binary-ports)
+ #: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)
- #:export (write-file-on-device
- install-efi-loader))
+ #: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))
\f
;;;
;;; 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 block ...)
+ "Run blocks... while chdir'd into a temporary directory."
+ ;; mkdtemp under POSIX.1-2008 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 () block ...)
+ (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
@@ -56,57 +82,78 @@ (define (write-file-on-device file size device offset)
;;; EFI bootloader.
;;;
-(define* (install-efi grub grub-config esp #:key targets)
- "Write a self-contained GRUB EFI loader to the mounted ESP using
-GRUB-CONFIG.
-
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let* ((system %host-type)
- ;; Hard code the output location to a well-known path recognized by
- ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
- ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
- (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
- (efi-directory (string-append esp "/EFI/BOOT"))
- ;; Map grub target names to boot file names.
- (efi-targets (or targets
- (cond ((string-prefix? "x86_64" system)
- '("x86_64-efi" . "BOOTX64.EFI"))
- ((string-prefix? "i686" system)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((string-prefix? "armhf" system)
- '("arm-efi" . "BOOTARM.EFI"))
- ((string-prefix? "aarch64" system)
- '("arm64-efi" . "BOOTAA64.EFI"))))))
- ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
- (setenv "TMPDIR" esp)
-
- (mkdir-p efi-directory)
- (invoke grub-mkstandalone "-O" (car efi-targets)
- "-o" (string-append efi-directory "/"
- (cdr efi-targets))
- ;; Graft the configuration file onto the image.
- (string-append "boot/grub/grub.cfg=" grub-config))))
+(define parse-bootnums
+ (make-regexp "^Boot([0-9a-fA-F]+).*[^A-Za-z]File\\(([^)]+)\\)$" regexp/newline))
-(define* (install-efi-loader grub-efi esp #:key targets)
- "Install in ESP directory the given GRUB-EFI bootloader. Configure it to
-load the Grub bootloader located in the 'Guix_image' root partition.
+;; 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))))
+ (unless (zero? status)
+ (raise-exception
+ (formatted-message (G_ "efibootmgr exited with error code ~a") status)))
+ (fold-matches parse-bootnums text '()
+ (lambda (match acc)
+ (let* ((path (match:substring match 2))
+ (bootnum (match:substring match 1)))
+ (cons (cons path bootnum) acc))))))
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let ((grub-config "grub.cfg"))
- (call-with-output-file grub-config
- (lambda (port)
- ;; Create a tiny configuration file telling the embedded grub where to
- ;; load the real thing. XXX This is quite fragile, and can prevent
- ;; the image from booting when there's more than one volume with this
- ;; label present. Reproducible almost-UUIDs could reduce the risk
- ;; (not eliminate it).
- (format port
- "insmod part_msdos~@
- insmod part_gpt~@
- search --set=root --label Guix_image~@
- configfile /boot/grub/grub.cfg~%")))
- (install-efi grub-efi grub-config esp #:targets targets)
- (delete-file grub-config)))
+(define (install-efi efibootmgr vendir loader* disk plan)
+ "See 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)))))
+ (builder name) ; build to a tmp file so we can check size
+ ;; 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))
+ ;; esp 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 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!~%")))
+ ;; boot order. recall efi-bootnums to get fresh list with new installs
+ ;; 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"
+ (let ((num (cute assoc-ref (efi-bootnums efibootmgr) <>))) ; cute is eager
+ (string-join (filter-map (compose num loaderof) plan-files) ",")))))
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 49dc01c0d1..b1abc99bba 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -28,6 +28,7 @@ (define-module (gnu build image)
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
+ #:use-module (guix deprecation)
#:use-module (guix store database)
#:use-module (guix utils)
#:use-module (gnu build bootloader)
@@ -181,30 +182,13 @@ (define* (register-closure prefix closure
#:prefix prefix
#:registration-time %epoch)))))
-(define* (initialize-efi-partition root
- #:key
- grub-efi
- #:allow-other-keys)
- "Install in ROOT directory, an EFI loader using GRUB-EFI."
- (install-efi-loader grub-efi root))
-
-(define* (initialize-efi32-partition root
- #:key
- grub-efi32
- #:allow-other-keys)
- "Install in ROOT directory, an EFI 32bit loader using GRUB-EFI32."
- (install-efi-loader grub-efi32 root
- #:targets (cond ((target-x86?)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((target-arm?)
- '("arm-efi" . "BOOTARM.EFI")))))
+(define (initialize-efi-partition root . rest)
+ (mkdir-p (string-append root "/EFI")))
+
+(define-deprecated/alias initialize-efi32-partition initialize-efi-partition)
(define* (initialize-root-partition root
#:key
- bootcfg
- bootcfg-location
- bootloader-package
- bootloader-installer
(copy-closures? #t)
(deduplicate? #t)
references-graphs
@@ -251,18 +235,10 @@ (define* (initialize-root-partition root
(unless copy-closures?
(delete-file root-store)
- (rename-file tmp-store root-store)))
-
- ;; There's no point installing a bootloader if we do not populate the store.
- (when copy-closures?
- (when bootloader-installer
- (display "installing bootloader...\n")
- (bootloader-installer bootloader-package #f root))
- (when bootcfg
- (install-boot-config bootcfg bootcfg-location root))))
+ (rename-file tmp-store root-store))))
(define* (make-iso9660-image xorriso grub-mkrescue-environment
- grub bootcfg system-directory root target
+ grub grub.dir system-directory root target
#:key (volume-id "Guix_image") (volume-uuid #f)
register-closures? (references-graphs '())
(compression? #t))
@@ -321,7 +297,7 @@ (define* (make-iso9660-image xorriso grub-mkrescue-environment
(apply invoke grub-mkrescue
(string-append "--xorriso=" grub-mkrescue-sed.sh)
"-o" target
- (string-append "boot/grub/grub.cfg=" bootcfg)
+ (string-append "boot/grub=" grub.dir)
root
"--"
;; Set all timestamps to 1.
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 0aa227b4d8..6b5435f13c 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -25,8 +25,7 @@ (define-module (gnu build install)
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (install-boot-config
- evaluate-populate-directive
+ #:export (evaluate-populate-directive
populate-root-file-system
install-database-and-gc-roots
populate-single-profile-directory
@@ -42,19 +41,6 @@ (define-module (gnu build install)
;;;
;;; Code:
-(define (install-boot-config bootcfg bootcfg-location mount-point)
- "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note
-that the caller must make sure that BOOTCFG is registered as a GC root so
-that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
- (let* ((target (string-append mount-point bootcfg-location))
- (pivot (string-append target ".new")))
- (mkdir-p (dirname target))
-
- ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
- ;; work when /boot is on a separate partition. Do that atomically.
- (copy-file bootcfg pivot)
- (rename-file pivot target)))
-
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
diff --git a/gnu/image.scm b/gnu/image.scm
index 7fb06dec10..6a3251014f 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -35,6 +35,7 @@ (define-module (gnu image)
partition-label
partition-uuid
partition-flags
+ partition-target
partition-initializer
image
@@ -131,6 +132,8 @@ (define-record-type* <partition> partition make-partition
(flags partition-flags
(default '()) ;list of symbols
(sanitize validate-partition-flags))
+ (target partition-target ; bootloader target type: symbol | #f
+ (default #f))
(initializer partition-initializer
(default #false))) ;gexp | #false
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 51fa7cf9d9..83682ea539 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1454,15 +1454,19 @@ (define (root-user-partition? partition)
(define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
- (let* ((root-partition (find root-user-partition?
- user-partitions))
+ (let* ((root-partition (find root-user-partition? user-partitions))
(root-partition-disk (user-partition-disk-file-name root-partition)))
`((bootloader-configuration
,@(if (efi-installation?)
`((bootloader grub-efi-bootloader)
- (targets (list ,(default-esp-mount-point))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path ,(default-esp-mount-point))))))
`((bootloader grub-bootloader)
- (targets (list ,root-partition-disk))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ ;; TODO: we should provide a uuid or label here
+ (device ,root-partition-disk))))))
;; XXX: Assume we defined the 'keyboard-layout' field of
;; <operating-system> right above.
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 8dd8c342a0..4a9d3faee1 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -505,18 +505,15 @@ (define (deploy-managed-host machine)
(machine-ssh-session machine)
(machine-become-command machine)))
- (mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-alternatives (machine->boot-alternatives machine)))
+ (mlet %store-monad ((_ (check-deployment-sanity machine)))
;; Make sure code that check %CURRENT-SYSTEM, such as
;; %BASE-INITRD-MODULES, gets to see the right value.
(parameterize ((%current-system system)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters boot-alternatives)))
- (bootloader-configuration (operating-system-bootloader os))
- (bootcfg (operating-system-bootcfg os menu-entries)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootmeta (operating-system-bootmeta os)))
(define-syntax-rule (eval/error-handling condition handler ...)
;; Return a wrapper around EVAL such that HANDLER is evaluated if an
;; exception is raised.
@@ -548,13 +545,15 @@ (define (deploy-managed-host machine)
(inferior-exception-arguments
c)))
os)
- (install-bootloader (eval/error-handling c
- (raise (formatted-message
- (G_ "\
+ (mlet %store-monad
+ ((boot-alternatives (machine->boot-alternatives machine)))
+ (apply install-bootloader
+ (eval/error-handling c
+ (raise (formatted-message
+ (G_ "\
failed to install bootloader on '~a':~%~{~s ~}~%")
- host
- (inferior-exception-arguments c))))
- bootloader-configuration bootcfg)))))))))
+ host (inferior-exception-arguments c))))
+ bootloader-config boot-alternatives bootmeta))))))))))
\f
;;;
@@ -585,32 +584,28 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
- (_ -> (if (< (length boot-alternatives) 2)
- (raise roll-back-failure)))
- (chosen-alternative (second boot-alternatives))
- (parameters (boot-alternative-parameters chosen-alternative))
- (entries -> (list (boot-parameters->menu-entry parameters)))
- (locale -> (boot-parameters-locale parameters))
- (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
- (store-dir -> (boot-parameters-store-directory-prefix parameters))
- (old-entries -> (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (drop boot-alternatives 2))))
- (bootloader -> (operating-system-bootloader
- (machine-operating-system machine)))
- (bootcfg (lower-object
- ((bootloader-configuration-file-generator
- (bootloader-configuration-bootloader
- bootloader))
- bootloader entries
- #:locale locale
- #:store-crypto-devices crypto-dev
- #:store-directory-prefix store-dir
- #:old-entries old-entries)))
- (remote-result (machine-remote-eval machine remote-exp)))
- (when (eqv? 'error remote-result)
- (raise roll-back-failure))))
+ (mlet %store-monad ((boot-alternatives (machine->boot-alternatives machine)))
+ (when (< (length boot-alternatives) 2) (raise roll-back-failure))
+ (mlet* %store-monad ((remote-result (machine-remote-eval machine remote-exp)))
+ (mwhen (eqv? 'error remote-result)
+ (raise roll-back-failure)))
+
+ (mlet* %store-monad ((os -> (machine-operating-system machine))
+ (chosen -> (cadr boot-alternatives))
+ (alts -> (cons* chosen (car boot-alternatives)
+ (cddr boot-alternatives)))
+ (params -> (boot-alternative-parameters chosen))
+ (locale -> (boot-parameters-locale chosen))
+ (crypto-dev -> (boot-parameters-store-crypto-devices
+ chosen))
+ (store-pre -> (boot-parameters-store-directory-prefix
+ chosen)))
+ (install-bootloader (cute machine-remote-eval machine <>)
+ (operating-system-bootloader os)
+ alts
+ #:locale locale
+ #:store-crypto-devices crypto-dev
+ #:store-directory-prefix store-pre))))
\f
;;;
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 4072df50d7..12f918a123 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -498,92 +498,6 @@ (define-public grub-hybrid
basename))))
(scandir input-dir)))))))))))
-(define-public (make-grub-efi-netboot name subdir)
- "Make a grub-efi-netboot package named NAME, which will be able to boot over
-network via TFTP by accessing its files in the SUBDIR of a TFTP root directory.
-This package is also able to boot from local storage devices.
-
-A bootloader-installer basically needs to copy the package content into the
-bootloader-target directory, which will usually be the TFTP root, as
-'grub-mknetdir' will be invoked already during the package creation.
-
-Alternatively the bootloader-target directory can be a mounted EFI System
-Partition (ESP), or a similar partition with a FAT file system, for booting
-from local storage devices.
-
-The name of the GRUB EFI binary will conform to the UEFI specification for
-removable media. Depending on the system it will be e.g. bootx64.efi or
-bootaa64.efi below SUBDIR.
-
-The SUBDIR argument needs to be set to \"efi/boot\" to create a package which
-conforms to the UEFI specification for removable media.
-
-The SUBDIR argument defaults to \"efi/Guix\", as it is also the case for
-'grub-efi-bootloader'."
- (package
- (name name)
- (version (package-version grub-efi))
- ;; Source is not needed, but it cannot be omitted.
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (let* ((system (string-split (nix-system->gnu-triplet
- (or (%current-target-system)
- (%current-system)))
- #\-))
- (arch (first system))
- (boot-efi
- (match system
- ;; These are the supportend systems and the names defined by
- ;; the UEFI standard for removable media.
- (("i686" _ ...) "/bootia32.efi")
- (("x86_64" _ ...) "/bootx64.efi")
- (("arm" _ ...) "/bootarm.efi")
- (("aarch64" _ ...) "/bootaa64.efi")
- (("riscv" _ ...) "/bootriscv32.efi")
- (("riscv64" _ ...) "/bootriscv64.efi")
- ;; Other systems are not supported, although defined.
- ;; (("riscv128" _ ...) "/bootriscv128.efi")
- ;; (("ia64" _ ...) "/bootia64.efi")
- ((_ ...) #f)))
- (core-efi (string-append
- ;; This is the arch dependent file name of GRUB, e.g.
- ;; i368-efi/core.efi or arm64-efi/core.efi.
- (match arch
- ("i686" "i386")
- ("aarch64" "arm64")
- ("riscv" "riscv32")
- (_ arch))
- "-efi/core.efi")))
- (list
- #:modules '((guix build utils))
- #:builder
- #~(begin
- (use-modules (guix build utils))
- (let* ((bootloader #$(this-package-input "grub-efi"))
- (net-dir #$output)
- (sub-dir (string-append net-dir "/" #$subdir "/"))
- (boot-efi (string-append sub-dir #$boot-efi))
- (core-efi (string-append sub-dir #$core-efi)))
- ;; Install GRUB, which refers to the grub.cfg, with support for
- ;; encrypted partitions,
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
- (string-append "--net-directory=" net-dir)
- (string-append "--subdir=" #$subdir)
- ;; These modules must be pre-loaded to allow booting
- ;; from an ESP or a similar partition with a FAT
- ;; file system.
- (string-append "--modules=part_msdos part_gpt fat"))
- ;; Move GRUB's core.efi to the removable media name.
- (false-if-exception (delete-file boot-efi))
- (rename-file core-efi boot-efi))))))
- (inputs (list grub-efi))
- (synopsis (package-synopsis grub-efi))
- (description (package-description grub-efi))
- (home-page (package-home-page grub-efi))
- (license (package-license grub-efi))))
-
(define-public syslinux
(let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
(package
diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index c4f03c3ed9..66f980dd79 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -19,8 +19,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages raspberry-pi)
- #:use-module (gnu bootloader)
- #:use-module (gnu bootloader grub)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages algebra)
@@ -328,22 +326,6 @@ (define (make-raspi-bcm28-dtbs linux)
(format #f "The device-tree files for Raspberry Pi models from ~a."
(package-name linux)))))
-(define-public grub-efi-bootloader-chain-raspi-64
- ;; A bootloader capable to boot a Raspberry Pi over network via TFTP or from
- ;; a local storage like a micro SD card. It neither installs firmware nor
- ;; device-tree files for the Raspberry Pi. It just assumes them to be
- ;; existing in boot/efi in the same way that some UEFI firmware with ACPI
- ;; data is usually assumed to be existing on PCs. It creates firmware
- ;; configuration files and a bootloader-chain with U-Boot to provide an EFI
- ;; API for the final GRUB bootloader. It also serves as a blue-print to
- ;; create an a custom bootloader-chain with firmware and device-tree
- ;; packages or files.
- (efi-bootloader-chain grub-efi-netboot-removable-bootloader
- #:packages (list u-boot-rpi-arm64-efi-bin)
- #:files (list %raspi-config-txt
- %raspi-bcm27-dtb-txt
- %raspi-u-boot-bootloader-txt)))
-
(define (make-raspi-defconfig arch defconfig sha256-as-base32)
"Make for the architecture ARCH a file-like object from the DEFCONFIG file
with the hash SHA256-AS-BASE32. This object can be used as the #:defconfig
diff --git a/gnu/system.scm b/gnu/system.scm
index 4a084b2ecf..a345b52d55 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -140,10 +140,11 @@ (define-module (gnu system)
operating-system-derivation
operating-system-profile
- operating-system-bootcfg
+ operating-system-bootmeta
operating-system-etc-directory
operating-system-locale-directory
operating-system-boot-script
+ operating-system-boot-parameters
operating-system-uuid
operating-system-with-gc-roots
@@ -171,6 +172,9 @@ (define-module (gnu system)
;;;
;;; Code:
+(define (convert-bootloader-field bootloader)
+ (if (list? bootloader) bootloader (list bootloader)))
+
(define-with-syntax-properties (warn-hosts-file-field-deprecation
(value properties))
(when value
@@ -193,7 +197,9 @@ (define-record-type* <operating-system> operating-system
(default %default-kernel-arguments)) ; list of gexps/strings
(hurd operating-system-hurd
(default #f)) ; package
- (bootloader operating-system-bootloader) ; <bootloader-configuration>
+ (bootloader operating-system-bootloader ; <bootloader-configuration>
+ (default '())
+ (sanitize convert-bootloader-field))
(label operating-system-label ; string
(thunked)
(default (operating-system-default-label this-operating-system)))
@@ -1208,30 +1214,17 @@ (define (operating-system-store-file-system os)
"Return the file system that contains the store of OS."
(store-file-system (operating-system-file-systems os)))
-(define* (operating-system-bootcfg os #:optional (old-entries '()))
- "Return the bootloader configuration file for OS. Use OLD-ENTRIES,
-a list of <menu-entry>, to populate the \"old entries\" menu."
+(define (operating-system-bootmeta os)
+ "Return operating system information to be passed to the bootloader
+installers."
(let* ((file-systems (operating-system-file-systems os))
+ (store-root (btrfs-store-subvolume-file-name file-systems))
(root-fs (operating-system-root-file-system os))
- (root-device (file-system-device root-fs))
(locale (operating-system-locale os))
- (crypto-devices (operating-system-bootloader-crypto-devices os))
- (params (operating-system-boot-parameters
- os root-device
- #:system-kernel-arguments? #t))
- (entry (boot-parameters->menu-entry params))
- (bootloader-conf (operating-system-bootloader os)))
-
- (define generate-config-file
- (bootloader-configuration-file-generator
- (bootloader-configuration-bootloader bootloader-conf)))
-
- (generate-config-file bootloader-conf (list entry)
- #:old-entries old-entries
- #:locale locale
- #:store-crypto-devices crypto-devices
- #:store-directory-prefix
- (btrfs-store-subvolume-file-name file-systems))))
+ (crypto-devices (operating-system-bootloader-crypto-devices os)))
+ (list #:store-crypto-devices crypto-devices
+ #:store-directory-prefix store-root
+ #:locale locale)))
(define (operating-system-multiboot-modules os)
(if (operating-system-hurd os) (hurd-multiboot-modules os) '()))
@@ -1295,9 +1288,9 @@ (define* (operating-system-boot-parameters os root-device
(file-systems (operating-system-file-systems os))
(crypto-devices (operating-system-bootloader-crypto-devices os))
(locale (operating-system-locale os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os)))
- (bootloader-name (bootloader-name bootloader))
+ (bootloader (map bootloader-configuration-bootloader
+ (operating-system-bootloader os)))
+ (bootloader-name (map bootloader-name bootloader))
(label (operating-system-label os))
(multiboot-modules (operating-system-multiboot-modules os)))
(boot-parameters
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 833caef496..2b5302ce5f 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -81,6 +81,7 @@ (define-module (gnu system boot)
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
+ boot-alternative->menu-entry
ensure-not-/dev
system-linux-image-file-name))
@@ -171,7 +172,8 @@ (define (read-boot-parameters port)
(bootloader-name
(match (assq 'bootloader-name rest)
- ((_ args) args)
+ ((_ (args ...)) args)
+ ((_ args) (list args))
(#f 'grub))) ; for compatibility reasons.
(bootloader-menu-entries
@@ -340,6 +342,7 @@ (define (boot-parameters->menu-entry conf)
(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)
@@ -353,6 +356,9 @@ (define (boot-parameters->menu-entry conf)
(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
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index b0c96c60f0..050f5b578b 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system image)
+ #:use-module (guix deprecation)
#:use-module (guix diagnostics)
#:use-module (guix discovery)
#:use-module (guix gexp)
@@ -42,6 +44,7 @@ (define-module (gnu system image)
#:use-module (gnu services base)
#:use-module (gnu system)
#:use-module (gnu system accounts)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system linux-container)
#:use-module (gnu system uuid)
@@ -133,12 +136,10 @@ (define esp-partition
;; FAT-ness is based on file system size (16 in this case).
(file-system "vfat")
(flags '(esp))
- (initializer (gexp initialize-efi-partition))))
+ (target 'esp)
+ (initializer #~initialize-efi-partition)))
-(define esp32-partition
- (partition
- (inherit esp-partition)
- (initializer (gexp initialize-efi32-partition))))
+(define-deprecated/alias esp32-partition esp-partition)
(define root-partition
(partition
@@ -149,6 +150,7 @@ (define root-partition
;; with U-Boot.
(file-system-options (list "-O" "^metadata_csum,^64bit"))
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))
(define mbr-disk-image
@@ -173,11 +175,7 @@ (define efi-disk-image
(partition-table-type 'gpt)
(partitions (list esp-partition root-partition))))
-(define efi32-disk-image
- (image-without-os
- (format 'disk-image)
- (partition-table-type 'gpt)
- (partitions (list esp32-partition root-partition))))
+(define-deprecated/alias efi32-disk-image efi-disk-image)
(define iso9660-image
(image-without-os
@@ -238,10 +236,7 @@ (define efi-raw-image-type
(name 'efi-raw)
(constructor (cut image-with-os efi-disk-image <>))))
-(define efi32-raw-image-type
- (image-type
- (name 'efi32-raw)
- (constructor (cut image-with-os efi32-disk-image <>))))
+(define-deprecated/alias efi32-raw-image-type efi-raw-image-type)
(define qcow2-image-type
(image-type
@@ -350,10 +345,6 @@ (define (find-root-partition image)
(raise (formatted-message
(G_ "image lacks a partition with the 'boot' flag")))))
-(define (root-partition-index image)
- "Return the index of the root partition of the given IMAGE."
- (1+ (srfi-1:list-index root-partition? (image-partitions image))))
-
\f
;;
;; Disk image.
@@ -362,8 +353,8 @@ (define (root-partition-index image)
(define* (system-disk-image image
#:key
(name "disk-image")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '()))
"Return as a file-like object, the disk-image described by IMAGE. Said
@@ -380,6 +371,28 @@ (define* (system-disk-image image
(define genimage-name "image")
+ (define (targets current)
+ ;; provides list of target overrides for a given CURRENT partition, which
+ ;; may be #f for the full-disk targets.
+
+ ;; XXX: how we pass paths is v much a hack
+ (cons (bootloader-target
+ (type 'disk)
+ (device (and (not current) (string-append "images/" genimage-name)))
+ (expected? (->bool current)))
+ (map (lambda (partition)
+ (let ((current? (and current (eq? (partition-target partition)
+ (partition-target current)))))
+ (bootloader-target
+ (type (partition-target partition))
+ (expected? (not current?))
+ (path (and current? "tmp-root"))
+ (offset #f)
+ (file-system (partition-file-system partition))
+ (label (partition-label partition))
+ (uuid (partition-uuid partition)))))
+ (filter partition-target (image-partitions image)))))
+
(define (image->genimage-cfg image)
;; Return as a file-like object, the genimage configuration file
;; describing the given IMAGE.
@@ -460,7 +473,8 @@ (define* (system-disk-image image
(list dosfstools fakeroot mtools))
(else
'())))
- (image-root "tmp-root"))
+ (image-root (string-append (getcwd) "/tmp-root"))
+ (copy-closures? (not #$(image-shared-store? image))))
(sql-schema #$schema)
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
@@ -476,18 +490,13 @@ (define* (system-disk-image image
(initializer image-root
#:references-graphs '#$graph
#:deduplicate? #f
- #:copy-closures? (not
- #$(image-shared-store? image))
- #:system-directory #$os
- #:grub-efi #+grub-efi
- #:grub-efi32 #+grub-efi32
- #:bootloader-package
- #+(bootloader-package bootloader)
- #:bootloader-installer
- #+(bootloader-installer bootloader)
- #:bootcfg #$bootcfg
- #:bootcfg-location
- #$(bootloader-configuration-file bootloader))
+ #:copy-closures? copy-closures?
+ #:system-directory #$os)
+ ;; no point installing a bootloader if we don't populate store
+ (when copy-closures?
+ ;; root-offset isn't necessary - we override 'root
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets partition)))
(make-partition-image #$(partition->gexp partition)
#$output
image-root)))))
@@ -534,14 +543,6 @@ (define* (system-disk-image image
(image-partition-table-type image)))
(else "")))
- (when (and (memq (bootloader-name bootloader)
- '(grub-efi grub-efi32 grub-efi-removable-bootloader))
- (not
- (gpt-image? image)))
- (raise
- (formatted-message
- (G_ "EFI bootloader required with GPT partitioning"))))
-
(let* ((format (image-format image))
(image-type (format->image-type format))
(image-type-options (genimage-type-options image-type image))
@@ -552,13 +553,15 @@ (define* (system-disk-image image
(let ((format (@ (ice-9 format) format)))
(call-with-output-file #$output
(lambda (port)
- (format port
- "\
+ (format port "\
image ~a {
~/~a {~a}
~{~a~^~%~}
-}~%" #$genimage-name #$image-type #$image-type-options
- (list #$@partitions-config))))))))
+}~%"
+ #$genimage-name
+ #$image-type
+ #$image-type-options
+ (list #$@partitions-config))))))))
(computed-file "genimage.cfg" builder)))
(let* ((image-name (image-name image))
@@ -570,17 +573,13 @@ (define* (system-disk-image image
(builder
(with-imported-modules*
(let ((inputs '#+(list genimage coreutils findutils qemu-minimal))
- (bootloader-installer
- #+(bootloader-disk-image-installer bootloader))
(out-image (string-append "images/" #$genimage-name)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(genimage #$(image->genimage-cfg image))
- ;; Install the bootloader directly on the disk-image.
- (when bootloader-installer
- (bootloader-installer
- #+(bootloader-package bootloader)
- #$(root-partition-index image)
- out-image))
+ ;; don't install bootloader unless installing store
+ (unless #$(image-shared-store? image)
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets #f)))
(convert-disk-image out-image '#$format #$output)))))
(computed-file name builder
#:local-build? #f ;too I/O-intensive
@@ -600,8 +599,8 @@ (define (has-guix-service-type? os)
(define* (system-iso9660-image image
#:key
(name "image.iso")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '())
(grub-mkrescue-environment '()))
@@ -621,7 +620,6 @@ (define* (system-iso9660-image image
(uuid-bytevector (partition-uuid partition)))))
(let* ((os (image-operating-system image))
- (bootloader (bootloader-package bootloader))
(compression? (image-compression? image))
(substitutable? (image-substitutable? image))
(schema (local-file (search-path %load-path
@@ -629,6 +627,14 @@ (define* (system-iso9660-image image
(graph (match inputs
(((names . _) ...)
names)))
+ (config (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list (bootloader-target
+ (type 'root)
+ (path "tmp-root"))
+ (bootloader-target
+ (type 'install)
+ (path "boot/grub"))))))
(builder
(with-imported-modules*
(let* ((inputs '#$(list parted e2fsprogs dosfstools xorriso
@@ -649,10 +655,12 @@ (define* (system-iso9660-image image
#:references-graphs '#$graph
#:deduplicate? #f
#:system-directory #$os)
+
(make-iso9660-image #$xorriso
'#$grub-mkrescue-environment
- #$bootloader
- #$bootcfg
+ #$grub-hybrid
+ #$(apply grub.dir grub-hybrid
+ #:bootloader-config config bootmeta)
#$os
image-root
#$output
@@ -954,11 +962,7 @@ (define (operating-system-for-image image)
file-systems
#:volatile-root? volatile-root?
rest)))
- (bootloader (if (eq? format 'iso9660)
- (bootloader-configuration
- (inherit
- (operating-system-bootloader base-os))
- (bootloader grub-mkrescue-bootloader))
+ (bootloader (if (eq? format 'iso9660) '()
(operating-system-bootloader base-os)))
(file-systems (cons (file-system
(mount-point "/")
@@ -1007,17 +1011,28 @@ (define* (system-image image)
(image* (image-with-os* image os))
(image-format (image-format image))
(register-closures? (has-guix-service-type? os))
- (bootcfg (operating-system-bootcfg os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os))))
+ ;; force removable - images don't have efivarfs
+ (bootloader-config (map (lambda (c) (bootloader-configuration
+ (inherit c)
+ (efi-removable? #t)))
+ (operating-system-bootloader os)))
+ (alt (boot-alternative
+ (generation 1)
+ (system-path "/var/guix/profiles/system-1-link")
+ (epoch 0)
+ (parameters (operating-system-boot-parameters os
+ (partition-uuid (find-root-partition image*))
+ #:system-kernel-arguments? #t))))
+ (bootmeta (cons* #:current-boot-alternative alt
+ #:old-boot-alternatives '()
+ (operating-system-bootmeta os))))
(cond
((memq image-format '(disk-image compressed-qcow2))
(system-disk-image image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))))
+ #:inputs `(("system" ,os))))
((memq image-format '(docker))
(system-docker-image image*))
((memq image-format '(tarball))
@@ -1027,11 +1042,10 @@ (define* (system-image image)
((memq image-format '(iso9660))
(system-iso9660-image
image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))
+ #:inputs `(("system" ,os))
;; Make sure to use a mode that does no imply
;; HFS+ tree creation that may fail with:
;;
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 9b618f7dc6..8fb00a6903 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -41,9 +41,7 @@ (define-module (gnu system images hurd)
(define hurd-barebones-os
(operating-system
(inherit %hurd-default-operating-system)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 810e2bed5f..a7a1f499dd 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -39,8 +39,7 @@ (define novena-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-novena-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-novena-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm-generic)
(kernel-arguments '("console=ttymxc1,115200"))
diff --git a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
index 6ec644f113..a3dae24377 100644
--- a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
+++ b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
@@ -39,8 +39,7 @@ (define orangepi-r1-plus-lts-rk3328-barebones-os
(timezone "Europe/Amsterdam")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 457ff4345f..b166838ddd 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -41,8 +41,7 @@ (define pine64-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pine64-lts-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pine64-lts-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 3a0f3abf1f..b26adfb7b9 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -38,8 +38,7 @@ (define pinebook-pro-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pinebook-pro-rk3399-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pinebook-pro-rk3399-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index b3dcfc6193..0b243662d6 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -39,8 +39,7 @@ (define rock64-barebones-os
(timezone "Europe/Oslo")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-rock64-rk3328-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader u-boot-rock64-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/unmatched.scm b/gnu/system/images/unmatched.scm
index d40a32f184..7eb147bbab 100644
--- a/gnu/system/images/unmatched.scm
+++ b/gnu/system/images/unmatched.scm
@@ -39,8 +39,7 @@ (define unmatched-barebones-os
(timezone "Asia/Jerusalem")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-sifive-unmatched-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-sifive-unmatched-bootloader)))
(initrd-modules '())
(kernel linux-libre-riscv64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/visionfive2.scm b/gnu/system/images/visionfive2.scm
index 26f70afbc1..a1c0733692 100644
--- a/gnu/system/images/visionfive2.scm
+++ b/gnu/system/images/visionfive2.scm
@@ -62,8 +62,7 @@ (define visionfive2-barebones-os
(timezone "Etc/UTC")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-starfive-visionfive2-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-starfive-visionfive2-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "Guix_image"))
(mount-point "/")
diff --git a/gnu/system/images/wsl2.scm b/gnu/system/images/wsl2.scm
index d9aaa1a271..1501cb9a90 100644
--- a/gnu/system/images/wsl2.scm
+++ b/gnu/system/images/wsl2.scm
@@ -127,16 +127,6 @@ (define dummy-package
(description #f)
(license (fsdg-compatible "dummy"))))
-(define dummy-bootloader
- (bootloader
- (name 'dummy-bootloader)
- (package dummy-package)
- (configuration-file "/dev/null")
- (configuration-file-generator
- (lambda (. _rest)
- (plain-file "dummy-bootloader" "")))
- (installer #~(const #t))))
-
(define dummy-kernel dummy-package)
(define (dummy-initrd . _rest)
@@ -146,9 +136,7 @@ (define-public wsl-os
(operating-system
(host-name "gnu")
(timezone "Etc/UTC")
- (bootloader
- (bootloader-configuration
- (bootloader dummy-bootloader)))
+ ;; no bootloader
(kernel dummy-kernel)
(initrd dummy-initrd)
(initrd-modules '())
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 0195a0804d..e76d12e95a 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -77,8 +77,7 @@ (define-module (gnu system install)
rock64-installation-os
rockpro64-installation-os
rk3399-puma-installation-os
- wandboard-installation-os
- os-with-u-boot))
+ wandboard-installation-os))
;;; Commentary:
;;;
@@ -503,9 +502,7 @@ (define installation-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(name-service-switch %mdns-host-lookup-nss)
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader (bootloader-configuration (bootloader grub-bootloader)))
(label (string-append "GNU Guix installation "
(or (getenv "GUIX_DISPLAYED_VERSION")
(package-version guix))))
@@ -555,30 +552,14 @@ (define installation-os
%installer-disk-utilities
%base-packages))))
-(define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
- (triplet "arm-linux-gnueabihf"))
- "Given OS, amend it with the u-boot bootloader for BOARD,
-installed to BOOTLOADER-TARGET (a drive), compiled for TRIPLET.
-
-If you want a serial console, make sure to specify one in your
-operating-system's kernel-arguments (\"console=ttyS0\" or similar)."
- (operating-system (inherit os)
- (bootloader (bootloader-configuration
- (bootloader (bootloader (inherit u-boot-bootloader)
- (package (make-u-boot-package board triplet))))
- (targets (list bootloader-target))))))
-
-(define* (embedded-installation-os bootloader bootloader-target tty
- #:key (extra-modules '()))
+(define* (embedded-installation-os bootloader tty #:key (extra-modules '()))
"Return an installation os for embedded systems.
The initrd gets the extra modules EXTRA-MODULES.
A getty is provided on TTY.
The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
(operating-system
(inherit installation-os)
- (bootloader (bootloader-configuration
- (bootloader bootloader)
- (targets (list bootloader-target))))
+ (bootloader (bootloader-configuration (bootloader bootloader)))
(kernel linux-libre)
(kernel-arguments
(cons (string-append "console=" tty)
@@ -587,7 +568,6 @@ (define* (embedded-installation-os bootloader bootloader-target tty
(define beaglebone-black-installation-os
(embedded-installation-os u-boot-beaglebone-black-bootloader
- "/dev/sda"
"ttyO0"
#:extra-modules
;; This module is required to mount the sd card.
@@ -596,77 +576,62 @@ (define beaglebone-black-installation-os
(define a20-olinuxino-lime-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define a20-olinuxino-lime2-emmc-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define a20-olinuxino-micro-installation-os
(embedded-installation-os u-boot-a20-olinuxino-micro-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define bananapi-m2-ultra-installation-os
(embedded-installation-os u-boot-bananapi-m2-ultra-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define firefly-rk3399-installation-os
(embedded-installation-os u-boot-firefly-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define mx6cuboxi-installation-os
(embedded-installation-os u-boot-mx6cuboxi-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
(define novena-installation-os
(embedded-installation-os u-boot-novena-bootloader
- "/dev/mmcblk1" ; SD card storage
"ttymxc1"))
(define nintendo-nes-classic-edition-installation-os
(embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader
- "/dev/mmcblk0" ; SD card (solder it yourself)
"ttyS0"))
(define orangepi-r1-plus-lts-rk3328-installation-os
(embedded-installation-os u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pine64-plus-installation-os
(embedded-installation-os u-boot-pine64-plus-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pinebook-installation-os
(embedded-installation-os u-boot-pinebook-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define rock64-installation-os
(embedded-installation-os u-boot-rock64-rk3328-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rockpro64-installation-os
(embedded-installation-os u-boot-rockpro64-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rk3399-puma-installation-os
(embedded-installation-os u-boot-puma-rk3399-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define wandboard-installation-os
(embedded-installation-os u-boot-wandboard-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
;; Return the default os here so 'guix system' can consume it directly.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a2743453e7..be12ae6b6c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -172,17 +172,6 @@ (define* (virtualized-operating-system os
(operating-system
(inherit os)
- ;; XXX: Until we run QEMU with UEFI support (with the OVMF firmware),
- ;; force the traditional i386/BIOS method.
- ;; See <https://bugs.gnu.org/28768>.
- (bootloader (bootloader-configuration
- (inherit (operating-system-bootloader os))
- (bootloader
- (if (target-riscv64? (or target system))
- u-boot-qemu-riscv64-bootloader
- grub-bootloader))
- (targets '("/dev/vda"))))
-
(initrd (lambda (file-systems . rest)
(apply (operating-system-initrd os)
file-systems
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..18a2fc119b 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -140,7 +140,7 @@ (define-os-with-source (%minimal-extlinux-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
- (bootloader extlinux-bootloader-gpt)
+ (bootloader extlinux-gpt-bootloader)
(targets (list "/dev/vdb"))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1464,9 +1464,11 @@ (define-os-with-source (%btrfs-raid10-root-os
(host-name "hurd")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets (list "/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde"))))
+ (bootloader (map (lambda (targ)
+ (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list targ))))
+ '("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (uuid "16ff18e2-eb41-4324-8df5-80d3b53c411b"))
diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm
index bcc7645fa3..8aa5311171 100644
--- a/gnu/tests/reconfigure.scm
+++ b/gnu/tests/reconfigure.scm
@@ -30,8 +30,7 @@ (define-module (gnu tests reconfigure)
#:use-module (guix scripts system reconfigure)
#:use-module (guix store)
#:export (%test-switch-to-system
- %test-upgrade-services
- %test-install-bootloader))
+ %test-upgrade-services))
;;; Commentary:
;;;
@@ -178,83 +177,6 @@ (define* (run-upgrade-services-test)
(disable (upgrade-services-program '() '() '(dummy) '())))
(test enable disable))))
-(define* (run-install-bootloader-test)
- "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a
-bootloader's configuration file."
- (define os
- (marionette-operating-system
- (simple-operating-system)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
-
- (define vm (virtual-machine
- (operating-system os)
- (volatile? #f)))
-
- (define (test script)
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (ice-9 regex)
- (srfi srfi-1)
- (srfi srfi-64))
-
- (define marionette
- (make-marionette (list #$vm)))
-
- ;; Return the system generation paths that have GRUB menu entries.
- (define (generations-in-grub-cfg marionette)
- (let ((grub-cfg (marionette-eval
- '(begin
- (use-modules (rnrs io ports))
- (call-with-input-file "/boot/grub/grub.cfg"
- get-string-all))
- marionette)))
- (map (lambda (parameter)
- (second (string-split (match:substring parameter) #\=)))
- (list-matches "system=[^ ]*" grub-cfg))))
-
- (test-runner-current (system-test-runner #$output))
- (test-begin "install-bootloader")
-
- (test-assert "no prior menu entry for system generation"
- (not (member #$os (generations-in-grub-cfg marionette))))
-
- (test-assert "script successfully evaluated"
- (marionette-eval
- '(primitive-load #$script)
- marionette))
-
- (test-assert "menu entry created for system generation"
- (member #$os (generations-in-grub-cfg marionette)))
-
- (test-end))))
-
- (let* ((bootloader ((compose bootloader-configuration-bootloader
- operating-system-bootloader)
- os))
- ;; The typical use-case for 'install-bootloader-program' is to read
- ;; the boot parameters for the existing menu entries on the system,
- ;; parse them with 'boot-parameters->menu-entry', and pass the
- ;; results to 'operating-system-bootcfg'. However, to obtain boot
- ;; parameters, we would need to start the marionette, which we should
- ;; ideally avoid doing outside of the 'test' G-Expression. Thus, we
- ;; generate a bootloader configuration for the script as if there
- ;; were no existing menu entries. In the grand scheme of things, this
- ;; matters little -- these tests should not make assertions about the
- ;; behavior of 'operating-system-bootcfg'.
- (bootcfg (operating-system-bootcfg os '()))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (gexp->derivation
- "install-bootloader"
- ;; Due to the read-only nature of the virtual machines used in the system
- ;; test suite, the bootloader installer script is omitted. 'grub-install'
- ;; would attempt to write directly to the virtual disk if the
- ;; installation script were run.
- (test
- (install-bootloader-program #f #f #f bootcfg bootcfg-file '(#f) "/")))))
-
-
(define %test-switch-to-system
(system-test
(name "switch-to-system")
@@ -267,9 +189,3 @@ (define %test-upgrade-services
(description "Upgrade the Shepherd by unloading obsolete services and
loading new services.")
(value (run-upgrade-services-test))))
-
-(define %test-install-bootloader
- (system-test
- (name "install-bootloader")
- (description "Install a bootloader and its configuration file.")
- (value (run-install-bootloader-test))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 344bb74151..8c12acc296 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -209,7 +209,7 @@ (define* (copy-closure item target
(define* (install os-drv target
#:key (log-port (current-output-port))
- install-bootloader? bootloader bootcfg)
+ install-bootloader? bootloaders bootmeta)
"Copy the closure of BOOTCFG, which includes the output of OS-DRV, to
directory TARGET. TARGET must be an absolute directory name since that's what
'register-path' expects.
@@ -247,24 +247,27 @@ (define* (install os-drv target
(chmod target #o755)
(let ((os-dir (derivation->output-path os-drv))
(format (lift format %store-monad))
- (populate (lift2 populate-root-file-system %store-monad)))
-
- (mlet %store-monad ((bootcfg (lower-object bootcfg)))
- (mbegin %store-monad
- ;; Copy the closure of BOOTCFG, which includes OS-DIR,
- ;; eventual background image and so on.
- (maybe-copy (derivation->output-path bootcfg))
-
- ;; Create a bunch of additional files.
- (format log-port "populating '~a'...~%" target)
- (populate os-dir target)
-
+ (populate (lift2 populate-root-file-system %store-monad))
+ (profile (string-append target "/var/guix/profiles/system")))
+
+ (mbegin %store-monad
+ ;; Create a bunch of system files.
+ (format log-port "populating '~a'...~%" target)
+ (populate os-dir target)
+
+ ;; Copy the bootloader's closure, which includes OS-DIR,
+ ;; eventual background image and so on.
+ (mlet* %store-monad
+ ((alt -> (generation->boot-alternative profile 1))
+ (inst (apply install-bootloader local-eval bootloaders
+ (list alt) #:dry-run (not install-bootloader?)
+ #:root-offset target bootmeta)))
+ (maybe-copy (derivation->output-path inst)))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target target)
(return
(info (G_ "bootloader successfully installed on~{ ~a~}~%")
- (bootloader-configuration-targets bootloader))))))))
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))))
\f
;;;
@@ -389,20 +392,13 @@ (define (install-bootloader-from-provenance store number)
(let* ((generation (generation-file-name %system-profile number))
(os (receive (_ os) (system-provenance generation)
(and=> os read-operating-system)))
- (bootloader-config (operating-system-bootloader os))
- (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (new (generation->boot-alternative %system-profile number))
(numbers (delv number (reverse (generation-numbers %system-profile))))
(old (profile->boot-alternatives %system-profile numbers)))
(if os
(run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object (operating-system-bootcfg os old)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))
+ (apply install-bootloader local-eval (operating-system-bootloader os)
+ (cons new old) (operating-system-bootmeta os)))
(leave (G_ "cannot rollback to provenanceless generation '~a'~%")
number))))
@@ -489,7 +485,7 @@ (define* (display-system-generation number
(format #t (G_ " canonical file name: ~a~%") (readlink* generation))
;; TRANSLATORS: Please preserve the two-space indentation.
(format #t (G_ " label: ~a~%") label)
- (format #t (G_ " bootloader: ~a~%") bootloader-name)
+ (format #t (G_ " bootloader: ~a~%") (string-join bootloader-name))
;; TRANSLATORS: The '~[', '~;', and '~]' sequences in this string must
;; be preserved. They denote conditionals, such that the result will
@@ -775,18 +771,11 @@ (define* (perform-action action image
(define os
(image-operating-system image))
- (define bootloader
+ (define bootloaders
(operating-system-bootloader os))
- (define bootcfg
- (and (memq action '(init reconfigure))
- (operating-system-bootcfg
- os
- (if (eq? action 'init)
- '()
- (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (profile->boot-alternatives)))))))
+ (define bootmeta
+ (operating-system-bootmeta os))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
@@ -817,10 +806,7 @@ (define* (perform-action action image
;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root.
;; See <http://bugs.gnu.org/21068>.
- (drvs (mapm/accumulate-builds lower-object
- (if (memq action '(init reconfigure))
- (list sys bootcfg)
- (list sys))))
+ (drvs (mapm/accumulate-builds lower-object (list sys)))
(% (if derivations-only?
(return (for-each (compose println derivation-file-name)
drvs))
@@ -838,12 +824,16 @@ (define* (perform-action action image
(format #t (G_ "activating system...~%"))
(mbegin %store-monad
(switch-to-system local-eval os)
+ (apply install-bootloader local-eval bootloaders
+ (profile->boot-alternatives)
+ #:dry-run? (not install-bootloader?)
+ (if target (cons* #:root-offset target bootmeta) bootmeta))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target (or target "/"))
(return
(info (G_ "bootloader successfully installed on '~a'~%")
- (bootloader-configuration-targets bootloader))))
+ (map bootloader-target-path
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))
(with-shepherd-error-handling
(upgrade-shepherd-services local-eval os)
(return (format #t (G_ "\
@@ -857,8 +847,8 @@ (define* (perform-action action image
target)
(install sys (canonicalize-path target)
#:install-bootloader? install-bootloader?
- #:bootloader bootloader
- #:bootcfg bootcfg))
+ #:bootloaders bootloaders
+ #:bootmeta bootmeta))
(else
;; All we had to do was to build SYS and maybe register an
;; indirect GC root.
@@ -1254,11 +1244,7 @@ (define (process-action action args opts)
(G_ "image lacks an operating-system")))))
(target-file (match args
((first second) second)
- (_ #f)))
- (bootloader-targets
- (and bootloader?
- (bootloader-configuration-targets
- (operating-system-bootloader os)))))
+ (_ #f))))
(define (graph-backend)
(lookup-backend (assoc-ref opts 'graph-backend)))
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 604ba08fee..8add639e6a 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -209,101 +210,83 @@ (define* (upgrade-shepherd-services eval os)
;;; Bootloader configuration.
;;;
-(define (install-bootloader-program installer disk-installer
- bootloader-package bootcfg
- bootcfg-file devices target)
+(define (install-bootloader-program configs offset chosen-alt old-alts locale
+ store-crypto-devices store-directory-prefix)
"Return an executable store item that, upon being evaluated, will install
BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICES, a list of file system
devices, at TARGET, a mount point, and subsequently run INSTALLER from
BOOTLOADER-PACKAGE."
(program-file
- "install-bootloader.scm"
- (with-extensions (list guile-gcrypt)
- (with-imported-modules `(,@(source-module-closure
- '((gnu build bootloader)
- (gnu build install)
- (guix store)
- (guix utils))
- #:select? not-config?)
- ((guix config) => ,(make-config.scm)))
- #~(begin
- (use-modules (gnu build bootloader)
- (gnu build install)
- (guix build utils)
- (guix store)
- (guix utils)
- (ice-9 binary-ports)
- (ice-9 match)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (let* ((gc-root (string-append #$target %gc-roots-directory "/bootcfg"))
- (new-gc-root (string-append gc-root ".new")))
- ;; #$bootcfg has dependencies.
- ;; The bootloader magically loads the configuration from
- ;; (string-append #$target #$bootcfg-file) (for example
- ;; "/boot/grub/grub.cfg").
- ;; If we didn't do something special, the garbage collector
- ;; would remove the dependencies of #$bootcfg.
- ;; Register #$bootcfg as a GC root.
- ;; Preserve the previous activation's garbage collector root
- ;; until the bootloader installer has run, so that a failure in
- ;; the bootloader's installer script doesn't leave the user with
- ;; a broken installation.
- (switch-symlinks new-gc-root #$bootcfg)
- (install-boot-config #$bootcfg #$bootcfg-file #$target)
- (when (or #$installer #$disk-installer)
- (catch #t
- (lambda ()
- ;; The bootloader might not support installation on a
- ;; mounted directory using the BOOTLOADER-INSTALLER
- ;; procedure. In that case, fallback to installing the
- ;; bootloader directly on DEVICES using the
- ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
- (if #$installer
- (for-each (lambda (device)
- (#$installer #$bootloader-package device
- #$target))
- '#$devices)
- (for-each (lambda (device)
- (#$disk-installer #$bootloader-package
- 0 device))
- '#$devices)))
- (lambda args
- (delete-file new-gc-root)
- (match args
- (('%exception exception) ;Guile 3 SRFI-34 or similar
- (raise-exception exception))
- ((key . args)
- (apply throw key args))))))
- ;; We are sure that the installation of the bootloader
- ;; succeeded, so we can replace the old GC root by the new
- ;; GC root now.
- (rename-file new-gc-root gc-root)))))))
+ "install-bootloader.scm"
+ ;; three sources of boot entries: bootloader-configuration-menu-entries,
+ ;; current-boot-alternative, and old-boot-alternatives.
+ (let ((args (list #:current-boot-alternative chosen-alt
+ #:old-boot-alternatives old-alts
+ #:locale locale
+ #:store-directory-prefix store-directory-prefix
+ #:store-crypto-devices store-crypto-devices)))
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules
+ `(,@(source-module-closure '((gnu build bootloader)
+ (gnu build install)
+ (guix store)
+ (guix utils))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (gnu build bootloader)
+ (gnu build install)
+ (guix build utils)
+ (guix store)
+ (guix utils)
+ (ice-9 binary-ports)
+ (ice-9 match)
+ (srfi srfi-34)
+ (srfi srfi-35))
+ ;; bootloader-installer is passed an additional #:target argument
+ ;; denoting the specific target currently being installed to.
+ ;; bootloaders should determine when to fully reinstall themselves.
+ #$(bootloader-configurations->gexp configs args
+ #:root-offset offset)))))))
-(define* (install-bootloader eval configuration bootcfg
- #:key
- (run-installer? #t)
- (target "/"))
+(define* (install-bootloader eval configs alts #:key locale
+ store-crypto-devices store-directory-prefix
+ (root-offset "/") (dry-run? #f))
"Using EVAL, a monadic procedure taking a single G-Expression as an argument,
-configure the bootloader on TARGET such that OS will be booted by default and
-additional configurations specified by MENU-ENTRIES can be selected."
- (let* ((bootloader (bootloader-configuration-bootloader configuration))
- (installer (and run-installer?
- (bootloader-installer bootloader)))
- (disk-installer (and run-installer?
- (bootloader-disk-image-installer bootloader)))
- (package (bootloader-package bootloader))
- (devices (bootloader-configuration-targets configuration))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
- (primitive-load #$(install-bootloader-program installer
- disk-installer
- package
- bootcfg
- bootcfg-file
- devices
- target))))))
+configure the bootloader with bootloader-configuration CONFIG such that
+ALTS may be selected, with the first element being the default. If QUICK? only
+the bootloader config is reinstalled. Returns the config installer drv."
+ (mlet* %store-monad
+ ((program (lower-object
+ (install-bootloader-program configs root-offset
+ (car alts) (cdr alts) locale
+ store-crypto-devices store-directory-prefix))))
+ (mbegin %store-monad
+ (eval
+ (with-imported-modules `(,@(source-module-closure '((guix build utils)
+ (guix store))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (guix build utils) (guix store))
+ (parameterize ((current-warning-port (%make-void-port "w")))
+ (let* ((gc-root (string-append
+ #$root-offset %gc-roots-directory "/bootcfg"))
+ (new-gc-root (string-append gc-root ".new")))
+ ;; since the installers are gexps directly included, we add
+ ;; the installer runner as a gc root. this should make sure
+ ;; no bootloader files get gc'd. only remove the old one on
+ ;; success.
+ ;; XXX: is this still necessary?
+ (switch-symlinks new-gc-root #$program)
+ (dynamic-wind (const #t)
+ (lambda ()
+ (unless #$dry-run? (primitive-load #$program))
+ (rename-file new-gc-root gc-root))
+ (lambda () ; delete new root if failed
+ (when (file-exists? new-gc-root)
+ (delete-file new-gc-root)))))))))
+ (return program))))
\f
;;;
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 05/15] gnu: system: Remove useless boot parameters.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (3 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
` (16 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter
* gnu/system.scm (operating-system-boot-parameters,
operating-system-boot-parameters-file): Delete
bootloader-menu-entries.
* gnu/system/boot.scm (boot-parameters)[bootloader-menu-entries]: Delete
fields.
(read-boot-parameters): Don't read bootloader-menu-entries.
* tests/boot-parameters.scm (%grub-boot-parameters,
test-read-boot-parameters, test-read-boot-parameters): Don't include
bootloader-menu-entries.
("read, bootloader-menu-entries, default value"): Delete test.
Change-Id: I46d9cff4604dbfcf654b0820fdb77e72aecffbb4
---
gnu/system.scm | 7 -------
gnu/system/boot.scm | 8 --------
tests/boot-parameters.scm | 14 ++------------
3 files changed, 2 insertions(+), 27 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index a345b52d55..66c1a80733 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1304,8 +1304,6 @@ (define* (operating-system-boot-parameters os root-device
(initrd initrd)
(multiboot-modules multiboot-modules)
(bootloader-name bootloader-name)
- (bootloader-menu-entries
- (bootloader-configuration-menu-entries (operating-system-bootloader os)))
(locale locale)
(store-device (ensure-not-/dev (file-system-device store)))
(store-directory-prefix (btrfs-store-subvolume-file-name file-systems))
@@ -1347,11 +1345,6 @@ (define* (operating-system-boot-parameters-file os)
#$(boot-parameters-multiboot-modules params)))
#~())
(bootloader-name #$(boot-parameters-bootloader-name params))
- (bootloader-menu-entries
- #$(map menu-entry->sexp
- (or (and=> (operating-system-bootloader os)
- bootloader-configuration-menu-entries)
- '())))
(locale #$(boot-parameters-locale params))
(store
(device
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 2b5302ce5f..4d89827ced 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -54,7 +54,6 @@ (define-module (gnu system boot)
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
@@ -113,8 +112,6 @@ (define-record-type* <boot-parameters>
;; 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)
@@ -176,11 +173,6 @@ (define (read-boot-parameters port)
((_ args) (list 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))
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 2e7976aa6c..f214de360d 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -64,7 +64,6 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
@@ -107,7 +106,6 @@ (define* (test-read-boot-parameters
#:key
(version %boot-parameters-version)
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(label %default-label)
(root-device (quote-uuid %default-root-device))
(kernel %default-kernel)
@@ -127,7 +125,7 @@ (define* (test-read-boot-parameters
(cond ((eq? 'false val) (format #false fmt #false))
(val (format #false fmt val))
(else "")))
- (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a~a)"
+ (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a)"
(sexp-or-nothing " (version ~S)" version)
(sexp-or-nothing " (label ~S)" label)
(sexp-or-nothing " (root-device ~S)" root-device)
@@ -145,9 +143,7 @@ (define* (test-read-boot-parameters
store-crypto-devices))
"")
(sexp-or-nothing " (locale ~S)" locale)
- (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)
- (sexp-or-nothing " (bootloader-menu-entries ~S)"
- bootloader-menu-entries)))
+ (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)))
(let ((str (generate-boot-parameters)))
(call-with-input-string str read-boot-parameters)))
@@ -170,7 +166,6 @@ (define* (test-read-boot-parameters
(test-assert "read, construction, optional fields"
(and (test-read-boot-parameters #:bootloader-name #false)
- (test-read-boot-parameters #:bootloader-menu-entries #false)
(test-read-boot-parameters #:kernel-arguments #false)
(test-read-boot-parameters #:with-store #false)
(test-read-boot-parameters #:store-device #false)
@@ -223,11 +218,6 @@ (define* (test-read-boot-parameters
(boot-parameters-bootloader-name
(test-read-boot-parameters #:bootloader-name #false)))
-(test-eq "read, bootloader-menu-entries, default value"
- '()
- (boot-parameters-bootloader-menu-entries
- (test-read-boot-parameters #:bootloader-menu-entries #false)))
-
(test-eq "read, kernel-arguments, default value"
'()
(boot-parameters-kernel-arguments
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 06/15] gnu: bootloader: Add raspberry pi bootloader.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (4 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
` (15 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Efraim Flashner, Lilah Tascheter,
Vagrant Cascadian
Less adding and more making it an actual bootloader rather than some
weirdly specified packages.
* gnu/bootloader/u-boot.scm (rpi-config, install-rpi): New procedures.
(define-u-bootloader-rpi): New macro.
(u-boot-rpi-2-bootloader, u-boot-rpi-3-bootloader,
u-boot-rpi-4-bootloader, u-boot-rpi-bootloader): New variables.
* gnu/packages/bootloaders.scm (make-u-boot-bin-package): Delete
procedure.
(%u-boot-rpi-efi-description, %u-boot-rpi-efi-description-32-bit,
u-boot-rpi-2-efi, u-boot-rpi-3-32b-efi, u-boot-rpi-4-32b-efi,
u-boot-rpi-arm64-efi, u-boot-rpi-2-bin, u-boot-rpi-3_32b-bin,
u-boot-rpi-4_32b-bin, u-boot-rpi-arm64-bin, u-boot-rpi-2-efi-bin,
u-boot-rpi-3-32b-efi-bin, u-boot-rpi-4-32b-efi-bin,
u-boot-rpi-arm64-efi-bin): Delete variables.
Change-Id: I5139a0b00ec89189e8e7c84e06a7a3b7240259cd
---
gnu/bootloader/u-boot.scm | 66 ++++++++++++++++++++++++-
gnu/packages/bootloaders.scm | 94 +++---------------------------------
2 files changed, 71 insertions(+), 89 deletions(-)
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 7d3e202f8c..e8dfe9b3a2 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -28,7 +28,10 @@ (define-module (gnu bootloader u-boot)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages raspberry-pi)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix utils)
#:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
@@ -51,7 +54,11 @@ (define-module (gnu bootloader u-boot)
u-boot-qemu-riscv64-bootloader
u-boot-starfive-visionfive2-bootloader
u-boot-ts7970-q-2g-1000mhz-c-bootloader
- u-boot-wandboard-bootloader))
+ u-boot-wandboard-bootloader
+ u-boot-rpi-2-bootloader
+ u-boot-rpi-3-bootloader
+ u-boot-rpi-4-bootloader
+ u-boot-rpi-bootloader))
(define (make-install-u-boot firmware installers)
(lambda* (#:key bootloader-config #:allow-other-keys . args)
@@ -222,3 +229,60 @@ (define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
u-boot-qemu-riscv64 "u-boot.bin")
+
+\f
+;;;
+;;; RasPi bootloader definitions.
+;;;
+
+(define (rpi-config 32?)
+ ;; allows a user-specified custom.txt
+ (plain-file "config.txt"
+ (format #f
+ "arm_64bit=~a~%enable_uart=1~%kernel=u-boot.bin~%include custom.txt~%"
+ (if (or 32? (not (target-64bit?))) "0" "1"))))
+
+(define (install-rpi u-boot-32 u-boot-64)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('install (apply install-extlinux-config args))
+ (('firmware => (firmware :path))
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (use-32? (or 32? (not (target-64bit?)) (not u-boot-64))))
+ #~(begin
+ (atomic-copy #$(file-append (if use-32? u-boot-32 u-boot-64)
+ "/libexec/u-boot.bin")
+ (string-append #$firmware "/u-boot.bin"))
+ (atomic-copy #$(rpi-config use-32?)
+ (string-append #$firmware "/config.txt"))))))))
+
+(define-syntax-rule (define-u-bootloader-rpi def-name u-boot-32 u-boot-64)
+ (define def-name
+ (bootloader (name 'u-boot)
+ (default-targets
+ (list (bootloader-target (type 'install)
+ (offset 'firmware)
+ (path "extlinux"))
+ (bootloader-target (type 'firmware)
+ (offset 'root)
+ (path "boot"))))
+ (installer (install-rpi u-boot-32 u-boot-64)))))
+
+
+;; These neither install firmware nor device-tree files for the Raspberry Pi.
+;; They just assume them to be existing in 'install in the same way that some
+;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
+;; They can be used with either extlinux or as UEFI firmware (alongside, eg,
+;; GRUB).
+(define-u-bootloader-rpi u-boot-rpi-2-bootloader
+ u-boot-rpi-2 #f)
+
+(define-u-bootloader-rpi u-boot-rpi-3-bootloader
+ u-boot-rpi-3-32b u-boot-rpi-arm64)
+
+(define-u-bootloader-rpi u-boot-rpi-4-bootloader
+ u-boot-rpi-4-32b u-boot-rpi-arm64)
+
+;; Usable for any 64-bit raspberry pi.
+(define-u-bootloader-rpi u-boot-rpi-bootloader
+ #f u-boot-rpi-arm64)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 12f918a123..e78602379d 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -1409,40 +1409,8 @@ (define-public u-boot-pinebook-pro-rk3399
(modify-inputs (package-inputs base)
(append arm-trusted-firmware-rk3399))))))
-(define*-public (make-u-boot-bin-package u-boot-package
- #:key
- (u-boot-bin "u-boot.bin"))
- "Return a package with a single U-BOOT-BIN file from the U-BOOT-PACKAGE.
-The package name will be that of the U-BOOT package suffixed with \"-bin\"."
- (package
- (name (string-append (package-name u-boot-package) "-bin"))
- (version (package-version u-boot-package))
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (list
- #:builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils))
- (mkdir #$output)
- (symlink (search-input-file %build-inputs
- (string-append "libexec/" #$u-boot-bin))
- (string-append #$output "/" #$u-boot-bin))))))
- (inputs (list u-boot-package))
- (home-page (package-home-page u-boot-package))
- (synopsis (package-synopsis u-boot-package))
- (description (string-append
- (package-description u-boot-package)
- "\n\n"
- (format #f
- "This package only contains the file ~a."
- u-boot-bin)))
- (license (package-license u-boot-package))))
-
-(define-public %u-boot-rpi-efi-configs
- '("CONFIG_OF_EMBED"
- "CONFIG_OF_BOARD=y"))
+;; get dtbs from firmware to support dtoverlays
+(define-public %u-boot-rpi-configs '("CONFIG_OF_EMBED" "CONFIG_OF_BOARD=y"))
(define %u-boot-rpi-description-32-bit
"This is a 32-bit build of U-Boot.")
@@ -1451,76 +1419,26 @@ (define %u-boot-rpi-description-64-bit
"This is a common 64-bit build of U-Boot for all 64-bit capable Raspberry Pi
variants.")
-(define %u-boot-rpi-efi-description
- "It allows network booting and uses the device-tree from the firmware,
-allowing the usage of overlays. It can act as an EFI firmware for the
-grub-efi-netboot-removable-bootloader.")
-
-(define %u-boot-rpi-efi-description-32-bit
- (string-append %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-32-bit))
-
(define-public u-boot-rpi-2
(make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-3-32b
(make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-4-32b
(make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-arm64
(make-u-boot-package "rpi_arm64" "aarch64-linux-gnu"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-64-bit))
-(define-public u-boot-rpi-2-efi
- (make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-3-32b-efi
- (make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-4-32b-efi
- (make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-arm64-efi
- (make-u-boot-package "rpi_arm64""aarch64-linux-gnu"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description (string-append
- %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-64-bit)))
-
-(define-public u-boot-rpi-2-bin (make-u-boot-bin-package u-boot-rpi-2))
-
-(define-public u-boot-rpi-3_32b-bin (make-u-boot-bin-package u-boot-rpi-3-32b))
-
-(define-public u-boot-rpi-4_32b-bin (make-u-boot-bin-package u-boot-rpi-4-32b))
-
-(define-public u-boot-rpi-arm64-bin (make-u-boot-bin-package u-boot-rpi-arm64))
-
-(define-public u-boot-rpi-2-efi-bin (make-u-boot-bin-package u-boot-rpi-2-efi))
-
-(define-public u-boot-rpi-3-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-3-32b-efi))
-
-(define-public u-boot-rpi-4-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-4-32b-efi))
-
-(define-public u-boot-rpi-arm64-efi-bin
- (make-u-boot-bin-package u-boot-rpi-arm64-efi))
-
(define u-boot-ts-mx6
;; There is no release; use the latest commit of the
;; 'imx_v2015.04_3.14.52_1.1.0_ga' branch.
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 07/15] gnu: system: Fix bootloader crypto device recognition.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (5 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 9:22 ` Tomas Volf
2024-08-04 3:55 ` [bug#72457] [PATCH 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
` (14 subsequent siblings)
21 siblings, 1 reply; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter
* gnu/system.scm (operating-system-bootloader-crypto-devices): Check for
luks-device-mapping-with-options in addition to luks-device-mapping.
Change-Id: Iafc9afe608640b97083c4d559c9240846330472a
---
gnu/system.scm | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 66c1a80733..8926e1b065 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -400,10 +400,11 @@ (define operating-system-bootloader-crypto-devices
(mlambdaq (os) ;to avoid duplicated output
"Return the sources of the LUKS mapped devices specified by UUID."
;; XXX: Device ordering is important, we trust the returned one.
- (let* ((luks-devices (filter (lambda (m)
- (eq? luks-device-mapping
- (mapped-device-type m)))
- (operating-system-boot-mapped-devices os)))
+ (let* ((luks? (lambda (m) (let ((t (mapped-device-type m)))
+ (or (eq? luks-device-mapping t)
+ (eq? luks-device-mapping-with-options t)))))
+ (luks-devices (filter luks?
+ (operating-system-boot-mapped-devices os)))
(uuid-crypto-devices non-uuid-crypto-devices
(partition (compose uuid? mapped-device-source)
luks-devices)))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 07/15] gnu: system: Fix bootloader crypto device recognition.
2024-08-04 3:55 ` [bug#72457] [PATCH 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
@ 2024-08-04 9:22 ` Tomas Volf
0 siblings, 0 replies; 95+ messages in thread
From: Tomas Volf @ 2024-08-04 9:22 UTC (permalink / raw)
To: Lilah Tascheter; +Cc: 72457
[-- Attachment #1: Type: text/plain, Size: 2039 bytes --]
On 2024-08-03 22:55:27 -0500, Lilah Tascheter wrote:
> * gnu/system.scm (operating-system-bootloader-crypto-devices): Check for
> luks-device-mapping-with-options in addition to luks-device-mapping.
>
> Change-Id: Iafc9afe608640b97083c4d559c9240846330472a
> ---
> gnu/system.scm | 9 +++++----
> 1 file changed, 5 insertions(+), 4 deletions(-)
>
> diff --git a/gnu/system.scm b/gnu/system.scm
> index 66c1a80733..8926e1b065 100644
> --- a/gnu/system.scm
> +++ b/gnu/system.scm
> @@ -400,10 +400,11 @@ (define operating-system-bootloader-crypto-devices
> (mlambdaq (os) ;to avoid duplicated output
> "Return the sources of the LUKS mapped devices specified by UUID."
> ;; XXX: Device ordering is important, we trust the returned one.
> - (let* ((luks-devices (filter (lambda (m)
> - (eq? luks-device-mapping
> - (mapped-device-type m)))
> - (operating-system-boot-mapped-devices os)))
> + (let* ((luks? (lambda (m) (let ((t (mapped-device-type m)))
> + (or (eq? luks-device-mapping t)
> + (eq? luks-device-mapping-with-options t)))))
I think this will not work as expected. luks-device-mapping-with-options is a
procedure to be called, not an object you can eq? against.
Typical use case:
(mapped-device
(source "/dev/sdb1)
(target "data)
(type (luks-device-mapping-with-options
#:key-file "/crypto.key")))
> + (luks-devices (filter luks?
> + (operating-system-boot-mapped-devices os)))
> (uuid-crypto-devices non-uuid-crypto-devices
> (partition (compose uuid? mapped-device-source)
> luks-devices)))
> --
> 2.45.2
>
>
--
There are only two hard things in Computer Science:
cache invalidation, naming things and off-by-one errors.
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]
^ permalink raw reply [flat|nested] 95+ messages in thread
* [bug#72457] [PATCH 08/15] gnu: packages: Add pesign.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (6 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
` (13 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter
* gnu/packages/efi.scm (pesign): New variable.
Change-Id: I00fcc679d9514c85d508183b9ec7e121e0a814db
---
gnu/packages/efi.scm | 47 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 47 insertions(+)
diff --git a/gnu/packages/efi.scm b/gnu/packages/efi.scm
index 499745eba1..417b70d91b 100644
--- a/gnu/packages/efi.scm
+++ b/gnu/packages/efi.scm
@@ -24,8 +24,10 @@ (define-module (gnu packages efi)
#:use-module (gnu packages bash)
#:use-module (gnu packages linux)
#:use-module (gnu packages man)
+ #:use-module (gnu packages nss)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages popt)
#:use-module (gnu packages tls)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
@@ -153,6 +155,51 @@ (define-public sbsigntools
(home-page "https://git.kernel.org/pub/scm/linux/kernel/git/jejb/sbsigntools.git/")
(license license:gpl3+)))
+(define-public pesign
+ (package
+ (name "pesign")
+ (version "116")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/rhboot/pesign")
+ (commit version)))
+ (snippet #~(substitute* "Make.defaults"
+ (("pkg-config-ccldflags") "pkg-config-ldflags")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "0fnqfiivj46bha4hsnwiqy8vq8b4i3w2dig0h9h2k4j7yq7r5qvj"))))
+ (build-system gnu-build-system)
+ (arguments
+ (list #:tests? #f
+ #:modules '((guix build gnu-build-system)
+ (guix build utils)
+ (ice-9 match))
+ #:phases #~(modify-phases %standard-phases (delete 'configure))
+ #:make-flags
+ (let ((system (%current-system)) (target (%current-target-system)))
+ (define (arch s) (match (string-split s #\-)
+ (("i386" _ ...) "ia32")
+ (("i486" _ ...) "ia32")
+ (("i586" _ ...) "ia32")
+ (("i686" _ ...) "ia32")
+ ((x _ ...) x)))
+ #~(list "prefix=/" "libdir=/lib/"
+ (string-append "DESTDIR=" #$output)
+ (string-append "HOSTARCH=" #$(arch system))
+ (string-append "ARCH=" #$(arch (or target system)))
+ (string-append "CROSS_COMPILE="
+ #$@(if target (list target "-gcc") '()))))))
+ (inputs (list efivar nspr nss popt `(,util-linux "lib")))
+ (native-inputs (list mandoc pkg-config))
+ (synopsis "PE-COFF binary signing tools")
+ (description "Supports EFI keygen and subsequent signing of PE-COFF
+binaries. Contains the tools authvar, efikeygen, pesigcheck, pesign,
+pesign-client, and pesum.")
+ (home-page "https://github.com/rhboot/pesign")
+ (license license:gpl2+)))
+
(define-public efitools
(package
(name "efitools")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 09/15] gnu: packages: Add ukify.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (7 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
` (12 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Efraim Flashner, Vagrant Cascadian
* gnu/packages/bootloaders.scm
(systemd-version,systemd-source,ukify): New variables.
Change-Id: Icde59b7266529c8002331ff0375e0a35af3a2add
---
gnu/packages/bootloaders.scm | 54 ++++++++++++++++++++++++++++++++++++
1 file changed, 54 insertions(+)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index e78602379d..04bb1b06f0 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -20,6 +20,7 @@
;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Herman Rimm <herman@rimm.ee>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,6 +48,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages disk)
+ #:use-module (gnu packages efi)
#:use-module (gnu packages firmware)
#:use-module (gnu packages flex)
#:use-module (gnu packages fontutils)
@@ -73,11 +75,13 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages valgrind)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages xorg)
+ #:use-module (gnu packages python-crypto)
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz)
#:use-module (guix build-system gnu)
#:use-module (guix build-system meson)
#:use-module (guix build-system pyproject)
+ #:use-module (guix build-system python)
#:use-module (guix build-system trivial)
#:use-module (guix download)
#:use-module (guix gexp)
@@ -573,6 +577,56 @@ (define-public syslinux
;; Also contains:
license:expat license:isc license:zlib)))))
+(define systemd-version "255")
+(define systemd-source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/systemd/systemd")
+ (commit (string-append "v" systemd-version))))
+ (file-name (git-file-name "systemd" systemd-version))
+ (snippet #~(substitute* "src/ukify/ukify.py" ; remove after python 3.11
+ (("datetime\\.UTC") "datetime.timezone.utc")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+
+(define-public ukify
+ (package
+ (name "ukify")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system python-build-system)
+ (arguments
+ (list #:phases
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key inputs #:allow-other-keys)
+ (define (get-tool tool)
+ (search-input-file inputs (string-append "bin/" tool)))
+
+ (substitute* "src/ukify/ukify.py" ; hardcode tool paths
+ (("(find_tool\\(')(readelf|sbsign|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',"))
+ (("('name': ')(sbverify|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',")))))
+ (delete 'check)
+ (replace 'install
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let* ((bin (string-append #$output "/bin"))
+ (file (string-append bin "/ukify")))
+ (mkdir-p bin)
+ (copy-file "src/ukify/ukify.py" file)))))))
+ (inputs
+ (list binutils pesign python-cryptography python-pefile sbsigntools))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI tool")
+ (description "@command{ukify} joins together a UKI stub, linux kernel, initrd,
+kernel arguments, and optional secure boot signatures into a single, UEFI-bootable
+image.")
+ (license license:lgpl2.1+)))
+
(define-public dtc
(package
(name "dtc")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 10/15] gnu: packages: Add systemd-stub.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (8 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
` (11 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Efraim Flashner, Lilah Tascheter,
Vagrant Cascadian
* gnu/bootloader.scm (%efi-supported-systems, lazy-efibootmgr): New variable.
(install-efi): Use lazy-efibootmgr.
* gnu/packages/bootloaders.scm (systemd-stub): New variable.
Change-Id: I974bad9ff7a52f736286d05de53f7c5ccb60b9d6
---
gnu/bootloader.scm | 13 +++++++++--
gnu/packages/bootloaders.scm | 43 ++++++++++++++++++++++++++++++++++++
2 files changed, 54 insertions(+), 2 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 2bb13437dc..27b0c51342 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -28,7 +28,6 @@ (define-module (gnu bootloader)
#:autoload (gnu build file-systems)
(read-partition-label read-partition-uuid
find-partition-by-label find-partition-by-uuid)
- #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:autoload (guix build syscalls)
@@ -114,6 +113,7 @@ (define-module (gnu bootloader)
bootloader-configuration->gexp
bootloader-configurations->gexp
+ %efi-supported-systems
efi-arch
install-efi))
@@ -633,6 +633,11 @@ (define (bootloader-configurations->gexp bootloader-configs . rest)
;;; EFI shit
;;;
+;; systems currently supported by efi-arch. should be used for packages relying
+;; on it.
+(define %efi-supported-systems
+ '("i686-linux" "x86_64-linux" "armhf-linux" "aarch64-linux" "riscv64-linux"))
+
(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
(32? #f))
"Returns the UEFI architecture name for the current target, in lowercase."
@@ -644,6 +649,10 @@ (define* (efi-arch #:key (target (or (%current-target-system) (%current-system))
(else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
target)))))
+(define (lazy-efibootmgr)
+ "Lazy-loaded efibootmgr package, in order to prevent circular refs."
+ (module-ref (resolve-interface '(gnu packages linux)) 'efibootmgr))
+
(define (install-efi bootloader-config plan)
"Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
@@ -666,5 +675,5 @@ (define (install-efi bootloader-config plan)
;; normal install when not doing a removable config
(with-targets targets
(('vendir => (vendir :path) (loader :devpath) (disk :device))
- #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #~(install-efi #+(file-append (lazy-efibootmgr) "/sbin/efibootmgr")
#$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 04bb1b06f0..2bc04059d2 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -38,6 +38,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages bootloaders)
+ #:use-module (gnu bootloader)
#:use-module (gnu packages)
#:use-module (gnu packages assembly)
#:use-module (gnu packages base)
@@ -54,6 +55,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gcc)
#:use-module (gnu packages gettext)
+ #:use-module (gnu packages gperf)
#:use-module (gnu packages linux)
#:use-module (gnu packages llvm)
#:use-module (gnu packages man)
@@ -592,6 +594,47 @@ (define systemd-source
(base32
"1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+(define-public systemd-stub
+ (package
+ (name "systemd-stub")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system meson-build-system)
+ (arguments
+ (list #:configure-flags
+ #~(list "-Dmode=release" "-Defi=true" "-Dsbat-distro=guix"
+ "-Dsbat-distro-generation=1" ; package revision!
+ "-Dsbat-distro-summary=Guix System"
+ "-Dsbat-distro-url=https://guix.gnu.org"
+ #$(string-append "-Dsbat-distro-pkgname="
+ (package-name this-package))
+ #$(string-append "-Dsbat-distro-version="
+ (package-version this-package)))
+ #:phases
+ ;; TODO: 32bit support
+ (let* ((stub (string-append
+ "src/boot/efi/linux" (efi-arch) ".efi.stub")))
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key parallel-build? #:allow-other-keys)
+ (invoke "ninja" #$stub
+ "-j" (if parallel-build?
+ (number->string (parallel-job-count)) "1"))))
+ (replace 'install
+ (lambda _
+ (let ((libexec (string-append #$output "/libexec")))
+ (install-file #$stub libexec))))
+ (delete 'check)))))
+ (supported-systems %efi-supported-systems)
+ (inputs (list libcap python-pyelftools `(,util-linux "lib")))
+ (native-inputs (list gperf pkg-config python-3 python-jinja2))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI stub")
+ (description "Simple UEFI boot stub that loads a conjoined kernel image and
+supporting data to their proper locations, before chainloading to the kernel.
+Supports measured and/or verified boot environments.")
+ (license license:lgpl2.1+)))
+
(define-public ukify
(package
(name "ukify")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 11/15] gnu: bootloaders: Add uki-efi-bootloader.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (9 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
` (10 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Lilah Tascheter
* gnu/bootloader.scm (<bootloader-configuration>): New keypair field.
* gnu/bootloader/uki.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add bootloader/uki.scm.
Change-Id: I2097da9f3dd35137b3419f6d0545de26d53cb6da
---
gnu/bootloader.scm | 3 ++
gnu/bootloader/uki.scm | 96 ++++++++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 100 insertions(+)
create mode 100644 gnu/bootloader/uki.scm
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 27b0c51342..a2a70d362f 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -100,6 +100,7 @@ (define-module (gnu bootloader)
bootloader-configuration-default-entry
bootloader-configuration-efi-removable?
bootloader-configuration-32bit?
+ bootloader-configuration-keypair
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -523,6 +524,8 @@ (define-record-type* <bootloader-configuration>
(default #f)) ;bool
(32bit? bootloader-configuration-32bit?
(default #f)) ;bool
+ (keypair bootloader-configuration-keypair
+ (default #f)) ;(cert . priv) pair
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
diff --git a/gnu/bootloader/uki.scm b/gnu/bootloader/uki.scm
new file mode 100644
index 0000000000..4871dbe037
--- /dev/null
+++ b/gnu/bootloader/uki.scm
@@ -0,0 +1,96 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; 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 bootloader uki)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages efi)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu system boot)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:export (uki-efi-bootloader))
+
+;; TODO: support 32bit/mixed-mode UEFI.
+;; https://github.com/systemd/systemd/issues/17056 may be relevant
+(define bootcfg->menu-entry->builder
+ (match-record-lambda <bootloader-configuration> (32bit? theme keypair)
+ (match-record-lambda <menu-entry>
+ (label linux linux-arguments initrd chain-loader)
+ ;; support chainloader in order to allow arbitrary signed EFI binaries
+ (cond
+ ((and chain-loader keypair)
+ #~(lambda (dest)
+ (invoke/quiet #+(sbsigntools "/bin/sbsign")
+ "--cert" #$(car keypair) "--key" #$(cdr keypair)
+ "--output" dest #$chain-loader)
+ (invoke/quiet #+(sbsigntools "/bin/sbverify")
+ "--cert" #$(car keypair) dest)))
+ (chain-loader #~(lambda (dest) (copy-file #$chain-loader dest)))
+ (linux
+ (let* ((arch (efi-arch #:32? 32bit?))
+ (stub (file-append systemd-stub
+ "/libexec/linux" arch ".efi.stub")))
+ #~(lambda (dest)
+ (invoke/quiet #+(file-append ukify "/bin/ukify")
+ "build" "--output" dest
+ "--linux" #$linux "--initrd" #$initrd
+ "--cmdline" (string-join (list #$@linux-arguments))
+ "--os-release" #$label "--stub" #$stub "--efi-arch" #$arch
+ #$@(if theme #~("--splash" #$theme) '())
+ #$@(if keypair #~("--secureboot-certificate" #$(car keypair)
+ "--secureboot-private-key" #$(cdr keypair))
+ '())))))
+ (else (leave (G_ "uki-efi-bootloader doesn't support multiboot")))))))
+
+;; we cannot use guix's build system to make UKI images for two reasons:
+;; 1. signing is necessarily non-reproducable, especially since keys should not
+;; be in the store, or else risk being publically accessible.
+;; 2. menu-entries may reference files which do not exist in the store.
+(define* (install-uki #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ (define* (menu-entry->plan entry num #:optional (prefix "menu-entry"))
+ #~(cons* #$((bootcfg->menu-entry->builder bootloader-config) entry)
+ #$(string-append prefix "-" (number->string num) ".efi")
+ #$(menu-entry-label entry)))
+
+ (define (boot-alternative->plan alt)
+ (menu-entry->plan (boot-alternative->menu-entry alt)
+ (boot-alternative-generation alt)
+ "generation"))
+
+ (install-efi bootloader-config
+ (let ((entries (bootloader-configuration-menu-entries bootloader-config)))
+ #~(list #$(boot-alternative->plan current-boot-alternative)
+ #$@(map menu-entry->plan entries (iota (length entries)))
+ #$@(map boot-alternative->plan old-boot-alternatives)))))
+
+
+
+(define uki-efi-bootloader
+ (bootloader
+ (name 'uki-efi)
+ (default-targets (list (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+ (installer install-uki)))
diff --git a/gnu/local.mk b/gnu/local.mk
index 8375e13709..32ed753ee2 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -93,6 +93,7 @@ GNU_SYSTEM_MODULES = \
%D%/bootloader/extlinux.scm \
%D%/bootloader/u-boot.scm \
%D%/bootloader/depthcharge.scm \
+ %D%/bootloader/uki.scm \
%D%/ci.scm \
%D%/compression.scm \
%D%/home.scm \
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 12/15] gnu: system: Update examples.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (10 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
` (9 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Florian Pelz, Ludovic Court??s,
Matthew Trzcinski, Maxim Cournoyer
* gnu/system/examples/asus-c201.tmpl (bootloader): Use new depthcharge
bootloader name scheme and update to new target system.
* gnu/system/examples/bare-bones.tmpl (bootloader),
gnu/system/examples/bare-hurd.tmpl (bootloader),
gnu/system/examples/beaglebone-black.tmpl (bootloader),
gnu/system/examples/desktop.tmpl (bootloader),
gnu/system/examples/lightweight-desktop.tmpl (bootloader),
gnu/system/examples/plasma.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64-nfs-root.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64.tmpl (bootloader): Use new target system.
* gnu/system/examples/docker-image.tmpl (bootloader): Delete.
* gnu/system/examples/vm-image.tmpl (bootloader): Use auto image target.
Change-Id: I3675f17ae9cd94cff99328762600fb4e491bc9f2
---
gnu/system/examples/asus-c201.tmpl | 6 +++--
gnu/system/examples/bare-bones.tmpl | 7 ++++--
gnu/system/examples/bare-hurd.tmpl | 4 +++-
gnu/system/examples/beaglebone-black.tmpl | 6 +++--
gnu/system/examples/desktop.tmpl | 4 +++-
gnu/system/examples/docker-image.tmpl | 6 ++---
gnu/system/examples/lightweight-desktop.tmpl | 4 +++-
gnu/system/examples/plasma.tmpl | 4 +++-
.../examples/raspberry-pi-64-nfs-root.tmpl | 23 ++++++++++++-------
gnu/system/examples/raspberry-pi-64.tmpl | 18 ++++++++-------
gnu/system/examples/vm-image.tmpl | 5 ++--
11 files changed, 54 insertions(+), 33 deletions(-)
diff --git a/gnu/system/examples/asus-c201.tmpl b/gnu/system/examples/asus-c201.tmpl
index 019111c167..eec185eebf 100644
--- a/gnu/system/examples/asus-c201.tmpl
+++ b/gnu/system/examples/asus-c201.tmpl
@@ -14,8 +14,10 @@
;; Assuming /dev/mmcblk0p1 is the kernel partition, and
;; "my-root" is the label of the target root file system.
(bootloader (bootloader-configuration
- (bootloader depthcharge-bootloader)
- (targets '("/dev/mmcblk0p1"))))
+ (bootloader depthcharge-veyron-speedy-bootloader)
+ (targets (list (bootloader-target
+ (type 'part)
+ (device "/dev/mmcblk0p1"))))))
;; The ASUS C201PA requires a very particular kernel to boot,
;; as well as the following arguments.
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index 7b6a4b09b0..9eed05f2e0 100644
--- a/gnu/system/examples/bare-bones.tmpl
+++ b/gnu/system/examples/bare-bones.tmpl
@@ -13,10 +13,13 @@
;; Boot in "legacy" BIOS mode, assuming /dev/sdX is the
;; target hard disk, and "my-root" is the label of the target
- ;; root file system.
+ ;; root file system. If you're just building an image, the
+ ;; 'targets' field may be omitted.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
;; It's fitting to support the equally bare bones ‘-nographic’
;; QEMU option, which also nicely sidesteps forcing QWERTY.
(kernel-arguments (list "console=ttyS0,115200"))
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 463c7ee798..8dd700cd9d 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -32,7 +32,9 @@
(inherit %hurd-default-operating-system)
(bootloader (bootloader-configuration
(bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl
index 18bbb2723c..99963ef2fe 100644
--- a/gnu/system/examples/beaglebone-black.tmpl
+++ b/gnu/system/examples/beaglebone-black.tmpl
@@ -11,11 +11,13 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
- ;; Assuming /dev/mmcblk1 is the eMMC, and "my-root" is
+ ;; Assuming /dev/mmcblk1 is the eMMC. and "my-root" is
;; the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader u-boot-beaglebone-black-bootloader)
- (targets '("/dev/mmcblk1"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/mmcblk1"))))))
;; This module is required to mount the SD card.
(initrd-modules (cons "omap_hsmmc" %base-initrd-modules))
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index 2d65f22294..30dbdeea31 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -20,7 +20,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout)))
;; Specify a mapped device for the encrypted root partition.
diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl
index 7123917af4..6d3114a0bc 100644
--- a/gnu/system/examples/docker-image.tmpl
+++ b/gnu/system/examples/docker-image.tmpl
@@ -9,6 +9,8 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
+ ;; Bootloader can be left blank!
+
;; This is where user accounts are specified. The "root" account is
;; implicit, and is initially created with the empty password.
(users (cons (user-account
@@ -34,10 +36,6 @@
;; similar services for us.
;; This will be ignored.
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("does-not-matter"))))
- ;; This will be ignored, too.
(file-systems (list (file-system
(device "does-not-matter")
(mount-point "/")
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index c061284ba8..0964238cb0 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -17,7 +17,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))
;; Assume the target root file system is labelled "my-root",
;; and the EFI System Partition has UUID 1234-ABCD.
diff --git a/gnu/system/examples/plasma.tmpl b/gnu/system/examples/plasma.tmpl
index c3850ffe37..a81916ffe9 100644
--- a/gnu/system/examples/plasma.tmpl
+++ b/gnu/system/examples/plasma.tmpl
@@ -15,7 +15,9 @@
;; is the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device "my-root")
diff --git a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
index 1baca02491..85476854f3 100644
--- a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
+++ b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
@@ -25,14 +25,21 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi")))))
+ (bootloader-configuration
+ (bootloader grub-efi-bootloader)
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel-arguments '("ip=dhcp"))
(kernel (customize-linux #:linux linux-libre-arm64-generic
#:extra-version "arm64-generic-netboot"
diff --git a/gnu/system/examples/raspberry-pi-64.tmpl b/gnu/system/examples/raspberry-pi-64.tmpl
index 414d8ac7a5..d5b90b9705 100644
--- a/gnu/system/examples/raspberry-pi-64.tmpl
+++ b/gnu/system/examples/raspberry-pi-64.tmpl
@@ -24,14 +24,16 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel (customize-linux #:linux linux-libre-arm64-generic
;; It is possible to use a specific defconfig
;; file, for example the "bcmrpi3_defconfig" with
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index 589de493b1..050c0bb971 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -38,11 +38,10 @@ accounts.\x1b[0m
(firmware '())
- ;; Below we assume /dev/vda is the VM's hard disk.
- ;; Adjust as needed.
+ ;; Images automatically get the 'root, 'esp, and 'disk targets configured as
+ ;; needed.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 13/15] doc: Update bootloader documentation.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (11 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
` (8 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Florian Pelz, Ludovic Court??s,
Matthew Trzcinski, Maxim Cournoyer
* doc/guix.texi
(Manual Installation)[Proceeding with the Installation]: Offload
target reference.
(System Installation)[Building the Installation Image]: Use beaglebone
as the example, and don't reference deleted variables.
(System Configuration)[Using the Configuration System]: Update
example.
[operating-system Reference]<bootloader>: Can use multiple
bootloaders.
[Keyboard Layout]: Update example.
[Bootloader Configuration]<bootloader>: Update documentation for all
bootloaders, and add new ones. Document new fields efi-removable?,
32bit?, and keypair. Update terminal-outputs and terminal-outputs to
not be GRUB-specific.
<bootloader-target>: New record.
<menu-entry>: Remove now-unsupported GRUB specifics in linux. Move
device documentation and add some for device-mount-point and
device-subvol. Fix typo in multiboot-arguments. Document chain-loader
for arbitrary bootloaders.
[Invoking guix system]<switch-generation>: Bootloaders are now
reinstalled.
<image> Other bootloaders may be used.
[Invoking guix deploy]: Update template.
(Creating System Images)[image Reference]<partition Reference>: Add
target field.
[Instantiate an Image]: Update examples and update formatting.
<efi32-disk-image, efi32-raw-image-type>: Delete.
[image-type Reference]<pinebook-pro-image-type, rock64-image-type>:
Reword slightly.
Change-Id: I45ac9d5ad3cb491c693e9a4b2f0b44b527478ee7
---
doc/guix.texi | 458 +++++++++++++++++++++++++++++---------------------
1 file changed, 262 insertions(+), 196 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 41814042f5..b5f35a9066 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2516,12 +2516,9 @@ Proceeding with the Installation
Make sure the @code{bootloader-configuration} form refers to the targets
you want to install GRUB on. It should mention @code{grub-bootloader}
if you are installing GRUB in the legacy way, or
-@code{grub-efi-bootloader} for newer UEFI systems. For legacy systems,
-the @code{targets} field contain the names of the devices, like
-@code{(list "/dev/sda")}; for UEFI systems it names the paths to mounted
-EFI partitions, like @code{(list "/boot/efi")}; do make sure the paths
-are currently mounted and a @code{file-system} entry is specified in
-your configuration.
+@code{grub-efi-bootloader} for newer UEFI systems.
+@xref{Bootloader Configuration} for information on how to format the
+@code{targets} field.
@item
Be sure that your file system labels match the value of their respective
@@ -2653,11 +2650,13 @@ Building the Installation Image
includes the bootloader, specifically:
@example
-guix system image --system=armhf-linux -e '((@@ (gnu system install) os-with-u-boot) (@@ (gnu system install) installation-os) "A20-OLinuXino-Lime2")'
+guix system image --system=armhf-linux -e '(@ (gnu system install) beaglebone-black-installation-os)'
@end example
-@code{A20-OLinuXino-Lime2} is the name of the board. If you specify an invalid
-board, a list of possible boards will be printed.
+@code{beaglebone-black} is the name of the board. Similar
+@code{installation-os} variables exist for most other supported boards.
+Otherwise, you can use @code{embedded-installation-os}, passing it a u-boot
+bootloader and the desired console tty.
@c *********************************************************************
@@ -17229,7 +17228,9 @@ Using the Configuration System
@lisp
(bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi")))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi")))))
@end lisp
@xref{Bootloader Configuration}, for more information on the available
@@ -17535,8 +17536,10 @@ operating-system Reference
List of strings or gexps representing additional arguments to pass on
the command-line of the kernel---e.g., @code{("console=ttyS0")}.
-@item @code{bootloader}
-The system bootloader configuration object. @xref{Bootloader Configuration}.
+@item @code{bootloader} (default: '())
+The system bootloader configuration object. Can either be a single
+@code{bootloader-configuration} or a list of them, to install multiple or no
+bootloaders. @xref{Bootloader Configuration}.
@item @code{label}
This is the label (a string) as it appears in the bootloader's menu entry.
@@ -18731,7 +18734,9 @@ Keyboard Layout
(keyboard-layout (keyboard-layout "tr")) ;for the console
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout))) ;for GRUB
(services (cons (set-xorg-configuration
(xorg-configuration ;for Xorg
@@ -42119,132 +42124,124 @@ Bootloader Configuration
@cindex EFI, bootloader
@cindex UEFI, bootloader
@cindex BIOS, bootloader
-The bootloader to use, as a @code{bootloader} object. For now
-@code{grub-bootloader}, @code{grub-efi-bootloader},
-@code{grub-efi-removable-bootloader}, @code{grub-efi-netboot-bootloader},
-@code{grub-efi-netboot-removable-bootloader}, @code{extlinux-bootloader}
-and @code{u-boot-bootloader} are supported.
+The bootloader to use, as a @code{bootloader} object. Available bootloaders, in
+addition to what target types they require, are as follows:
-@cindex ARM, bootloaders
-@cindex AArch64, bootloaders
-Available bootloaders are described in @code{(gnu bootloader @dots{})}
-modules. In particular, @code{(gnu bootloader u-boot)} contains definitions
-of bootloaders for a wide range of ARM and AArch64 systems, using the
-@uref{https://www.denx.de/wiki/U-Boot/, U-Boot bootloader}.
+@itemize
+@vindex depthcharge-veyron-speedy-bootloader
+@item @code{depthcharge-veyron-speedy-bootloader}
+For the Asus C201. Requires a @code{'part} target, denoting the partition to
+install the kernel blob as a @code{device}, @code{label}, or @code{uuid}.
@vindex grub-bootloader
-@code{grub-bootloader} allows you to boot in particular Intel-based machines
-in ``legacy'' BIOS mode.
+@item @code{grub-bootloader}
+GRUB2 for BIOS systems. Requires a @code{'disk} target providing either a
+@code{device}, @code{label}, or @code{uuid}. If root is mounted over NFS, it
+will load its files and the Guix System over
+@acronym{PXE, Preboot eXecution Environment}.
+
+@vindex grub-minimal-bootloader
+@item @code{grub-minimal-bootloader}
+As above, but using a minimal build of GRUB.
@vindex grub-efi-bootloader
-@code{grub-efi-bootloader} allows to boot on modern systems using the
-@dfn{Unified Extensible Firmware Interface} (UEFI). This is what you should
-use if the installation image contains a @file{/sys/firmware/efi} directory
-when you boot it on your system.
-
-@vindex grub-efi-removable-bootloader
-@code{grub-efi-removable-bootloader} allows you to boot your system from
-removable media by writing the GRUB file to the UEFI-specification location of
-@file{/EFI/BOOT/BOOTX64.efi} of the boot directory, usually @file{/boot/efi}.
-This is also useful for some UEFI firmwares that ``forget'' their configuration
-from their non-volatile storage. Like @code{grub-efi-bootloader}, this can only
-be used if the @file{/sys/firmware/efi} directory is available.
+@item @code{grub-efi-bootloader}
+GRUB2 for "modern" systems using the @dfn{Unified Extensible Firmware Interface}
+(UEFI). Requires an @code{'esp} target providing a @code{path} to the mount
+point of the EFI System Partition. If root is mounted over NFS, it will load
+its files and the Guix System over a
+@acronym{TFTP, Trivial File Transfer Protocol} server as configured over
+@acronym{DHCP, Dynamic Host Configuration Protocol} as per PXE.
+
+@vindex extlinux-bootloader
+@item @code{extlinux-bootloader}
+Extlinux for "legacy" BIOS systems. Requires a @code{'disk} target providing
+either a @code{device}, @code{label}, or @code{uuid}.
+
+@vindex extlinux-gpt-bootloader
+@item @code{extlinux-gpt-bootloader}
+As above, but for systems using the GPT instead of MBR partition table.
+
+@cindex Secure Boot, UEFI
+@vindex uki-efi-bootloader
+@item @code{uki-efi-bootloader}
+Makes and installs UKI images for UEFI systems. Requires an @code{'esp} target
+providing a @code{path} to the mount point of the EFI System Partition. Not all
+system generations may be available with this option, as UKI images contain the
+entire kernel and initramfs, and ESPs tend to be small.
+
+Full disk encryption with @code{uki-efi-bootloader} only requires a single
+password entry with fast decryption, in contrast to GRUB2 requiring a second
+password entry with slow, LUKS1-only decryption.
+
+This is the only bootloader to currently support UEFI secure boot, when
+configured as below.
-@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
-@end quotation
+@cindex ARM, bootloaders
+@cindex AArch64, bootloaders
+@vindex u-boot-a20-olinuxino-lime-bootloader
+@vindex u-boot-a20-olinuxino-lime2-bootloader
+@vindex u-boot-a20-olinuxino-micro-bootloader
+@vindex u-boot-bananapi-m2-ultra-bootloader
+@vindex u-boot-beaglebone-black-bootloader
+@vindex u-boot-cubietruck-bootloader
+@vindex u-boot-firefly-rk3399-bootloader
+@vindex u-boot-mx6cuboxi-bootloader
+@vindex u-boot-nintendo-nes-classic-edition-bootloader
+@vindex u-boot-novena-bootloader
+@vindex u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+@vindex u-boot-pine64-plus-bootloader
+@vindex u-boot-pine64-lts-bootloader
+@vindex u-boot-pinebook-bootloader
+@vindex u-boot-pinebook-pro-rk3399-bootloader
+@vindex u-boot-puma-rk3399-bootloader
+@vindex u-boot-rock64-rk3328-bootloader
+@vindex u-boot-rockpro64-rk3399-bootloader
+@vindex u-boot-sifive-unmatched-bootloader
+@vindex u-boot-qemu-riscv64-bootloader
+@vindex u-boot-starfive-visionfive2-bootloader
+@vindex u-boot-ts7970-q-2g-1000mhz-c-bootloader
+@vindex u-boot-wandboard-bootloader
+@vindex u-boot-rpi-2-bootloader
+@vindex u-boot-rpi-3-bootloader
+@vindex u-boot-rpi-4-bootloader
+@vindex u-boot-rpi-bootloader
+@item U-Boot
+U-Boot has individual bootloaders @code{u-boot-board-bootloader} for each
+of the following @code{board}s: @code{a20-olinuxino-lime},
+@code{a20-olinuxino-lime2}, @code{a20-olinuxino-micro},
+@code{bananapi-m2-ultra}, @code{beaglebone-black}, @code{cubietruck},
+@code{firefly-rk3399}, @code{mx6cuboxi}, @code{nintendo-nes-classic-edition},
+@code{novena}, @code{orangepi-r1-plus-lts-rk3328}, @code{pine64-plus},
+@code{pine64-lts}, @code{pinebook}, @code{pinebook-pro-rk3399},
+@code{puma-rk3399}, @code{rock64-rk3328}, @code{rockpro64-rk3399},
+@code{rpi-2}, @code{rpi-3}, @code{rpi-4}, @code{rpi}, @code{sifive-unmatched},
+@code{ts7970-q-2g-1000mhz-c}, @code{qemu-riscv64}, and @code{wandboard}.
+
+Each of these requires a @code{'disk} target providing either a @code{device},
+@code{label}, or @code{uuid}, except for @code{ts7970-q-2g-1000mhz-c} and
+@code{qemu-riscv64}, in which the bootloader just copies U-Boot to
+@file{/boot/u-boot.imx} or @file{/boot/u-boot.bin}, respectively. You should
+then manually flash it to the SPI flash at the U-Boot prompt.
+
+By default Guix configures U-Boot to boot using a generated extlinux config, but
+U-Boot does support loading UEFI bootloaders, if you want to combine it with
+another.
+@end itemize
-@vindex grub-efi-netboot-bootloader
-@code{grub-efi-netboot-bootloader} allows you to boot your system over network
-through TFTP@. In combination with an NFS root file system this allows you to
-build a diskless Guix system.
-
-The installation of the @code{grub-efi-netboot-bootloader} generates the
-content of the TFTP root directory at @code{targets} (@pxref{Bootloader
-Configuration, @code{targets}}) below the sub-directory @file{efi/Guix}, to be
-served by a TFTP server. You may want to mount your TFTP server directories
-onto the @code{targets} to move the required files to the TFTP server
-automatically during installation.
-
-If you plan to use an NFS root file system as well (actually if you mount the
-store from an NFS share), then the TFTP server needs to serve the file
-@file{/boot/grub/grub.cfg} and other files from the store (like GRUBs background
-image, the kernel (@pxref{operating-system Reference, @code{kernel}}) and the
-initrd (@pxref{operating-system Reference, @code{initrd}})), too. All these
-files from the store will be accessed by GRUB through TFTP with their normal
-store path, for example as
-@file{tftp://tftp-server/gnu/store/…-initrd/initrd.cpio.gz}.
-
-Two symlinks are created to make this possible. For each target in the
-@code{targets} field, the first symlink is
-@samp{target}@file{/efi/Guix/boot/grub/grub.cfg} pointing to
-@file{../../../boot/grub/grub.cfg}, where @samp{target} may be
-@file{/boot}. In this case the link is not leaving the served TFTP root
-directory, but otherwise it does. The second link is
-@samp{target}@file{/gnu/store} and points to @file{../gnu/store}. This
-link is leaving the served TFTP root directory.
-
-The assumption behind all this is that you have an NFS server exporting
-the root file system for your Guix system, and additionally a TFTP
-server exporting your @code{targets} directories—usually a single
-@file{/boot}—from that same root file system for your Guix system. In
-this constellation the symlinks will work.
-
-For other constellations you will have to program your own bootloader
-installer, which then takes care to make necessary files from the store
-accessible through TFTP, for example by copying them into the TFTP root
-directory for your @code{targets}.
-
-It is important to note that symlinks pointing outside the TFTP root directory
-may need to be allowed in the configuration of your TFTP server. Further the
-store link exposes the whole store through TFTP@. Both points need to be
-considered carefully for security aspects. It is advised to disable any TFTP
-write access!
-
-Please note, that this bootloader will not modify the ‘UEFI Boot Manager’ of
-the system.
-
-Beside the @code{grub-efi-netboot-bootloader}, the already mentioned TFTP and
-NFS servers, you also need a properly configured DHCP server to make the booting
-over netboot possible. For all this we can currently only recommend you to look
-for instructions about @acronym{PXE, Preboot eXecution Environment}.
-
-If a local EFI System Partition (ESP) or a similar partition with a FAT
-file system is mounted in @code{targets}, then symlinks cannot be
-created. In this case everything will be prepared for booting from
-local storage, matching the behavior of @code{grub-efi-bootloader}, with
-the difference that all GRUB binaries are copied to @code{targets},
-necessary for booting over the network.
-
-@vindex grub-efi-netboot-removable-bootloader
-@code{grub-efi-netboot-removable-bootloader} is identical to
-@code{grub-efi-netboot-bootloader} with the exception that the
-sub-directory @file{efi/boot} will be used instead of @file{efi/Guix} to
-comply with the UEFI specification for removable media.
+@item @code{targets}
+This is a list of @code{bootloader-target} (see below) structures denoting
+where the bootloader should install itself. Interpretation of specific target
+types and target requirements depend on the specific @code{bootloader} used.
@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
+Bootloaders have a set of default targets, that can interact with user-specified
+targets. For UEFI bootloaders using the @code{'esp} target, this typically
+includes a @code{'vendir} target. If you configure multiple UEFI bootloaders,
+you should set different @code{'vendir} target @code{path}s for each, each
+@code{offset} from @code{'esp}.
@end quotation
-@item @code{targets}
-This is a list of strings denoting the targets onto which to install the
-bootloader.
-
-The interpretation of targets depends on the bootloader in question.
-For @code{grub-bootloader}, for example, they should be device names
-understood by the bootloader @command{installer} command, such as
-@code{/dev/sda} or @code{(hd0)} (@pxref{Invoking grub-install,,, grub,
-GNU GRUB Manual}). For @code{grub-efi-bootloader} and
-@code{grub-efi-removable-bootloader} they should be mount
-points of the EFI file system, usually @file{/boot/efi}. For
-@code{grub-efi-netboot-bootloader}, @code{targets} should be the mount
-points corresponding to TFTP root directories served by your TFTP
-server.
-
@item @code{menu-entries} (default: @code{'()})
A possibly empty list of @code{menu-entry} objects (see below), denoting
entries to appear in the bootloader menu, in addition to the current
@@ -42254,6 +42251,29 @@ Bootloader Configuration
The index of the default boot menu entry. Index 0 is for the entry of the
current system.
+@item @code{efi-removable?} (default: @var{#f})
+Used by all UEFI bootloaders to determine whether they should be installed to
+the UEFI standard fallback bootloader path (on x86_64,
+@file{/EFI/BOOT/BOOTX64.EFI}). This allows it to be booted from removable media
+or otherwise in cases where the system has not been booted from UEFI already.
+
+@quotation Warning
+This will override any other bootloaders installed to the same path!
+@end quotation
+
+@item @code{32bit?} (default: @var{#f})
+Some 64-bit systems require their bootloaders to be 32-bit, including some early
+UEFI systems and some Raspberry Pis. If that is the case, and the bootloader
+supports it, setting this option will force the bootloader to install as if it
+were on a 32-bit system.
+
+@item @code{keypair} (default: @var{#f})
+Designates a keypair to be used by bootloaders that support some kind of
+cryptographic signature, such as UEFI Secure Boot. This must be a pair
+@code{'(cert . priv)} of paths to the public key (@code{cert}) and private key
+(@code{priv}). The keys these paths point to should be owned by root with 600
+permissions for security purposes.
+
@item @code{timeout} (default: @code{5})
The number of seconds to wait for keyboard input before booting. Set to
0 to boot immediately, and to -1 to wait indefinitely.
@@ -42276,19 +42296,20 @@ Bootloader Configuration
is provided, some bootloaders might use a default theme, that's true
for GRUB.
-@item @code{terminal-outputs} (default: @code{'(gfxterm)})
+@item @code{terminal-outputs} (default: @var{#f})
The output terminals used for the bootloader boot menu, as a list of
-symbols. GRUB accepts the values: @code{console}, @code{serial},
-@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text},
-@code{mda_text}, @code{morse}, and @code{pkmodem}. This field
-corresponds to the GRUB variable @code{GRUB_TERMINAL_OUTPUT} (@pxref{Simple
-configuration,,, grub,GNU GRUB manual}).
-
-@item @code{terminal-inputs} (default: @code{'()})
+symbols. When @var{#f}, the default is used. For GRUB this is @code{gfxterm}.
+GRUB accepts the values: @code{console}, @code{serial}, @code{serial_@{0-3@}},
+@code{gfxterm}, @code{vga_text}, @code{mda_text}, @code{morse}, and
+@code{pkmodem}. This field corresponds to the GRUB variable
+@code{GRUB_TERMINAL_OUTPUT}
+(@pxref{Simple configuration,,, grub,GNU GRUB manual}).
+
+@item @code{terminal-inputs} (default: @var{#f})
The input terminals used for the bootloader boot menu, as a list of
-symbols. For GRUB, the default is the native platform terminal as
-determined at run-time. GRUB accepts the values: @code{console},
-@code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
+symbols. When @var{#f}, the default is used. For GRUB, this is the native
+platform terminal as determined at run-time. GRUB accepts the values:
+@code{console}, @code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
@code{usb_keyboard}. This field corresponds to the GRUB variable
@code{GRUB_TERMINAL_INPUT} (@pxref{Simple configuration,,, grub,GNU GRUB
manual}).
@@ -42364,6 +42385,53 @@ Bootloader Configuration
@end deftp
+@vindex bootloader-target
+Configuring bootloader targets uses a specialized record designed for clarity
+and to abstract the varying user-supplied paths bootloaders may need. Only the
+@code{type} field is required; Guix will attempt to extrapolate as needed from
+what information you provide, though at least one of @code{path}, @code{device},
+@code{label}, or @code{uuid} is required to do so.
+
+@deftp {Data Type} bootloader-target
+The type of a target as used in @code{bootloader-configuration}.
+
+@table @asis
+
+@item @code{type}
+What target this record is describing. Must be a symbol, for example @code{'esp}
+or @code{'disk}.
+
+@item @code{path} (default: @var{#f})
+@code{path} denotes a string path, usually interpreted by the bootloader to
+signify a mount point (such as in the case of @code{'esp}). This value is
+automatically offset from the target denoted by @code{offset}, even if the path
+given is absolute. This allows for bootloaders to know what device or partition
+a @code{path} is actually stored on, and how to locate it.
+
+@item @code{offset} (default: @code{'root} when @code{path}, otherwise @var{#f})
+All @code{path} values, even if absolute, are automatically offset from another.
+@code{offset} is a symbol denoting which target type the path should be offset
+from. This allows for bootloaders to know what device or partition a
+@code{path} is actually stored on, and how to locate it.
+
+For most setups, you don't need to deal with this.
+
+@item @code{device} (default: @var{#f})
+@itemx @code{label} (default: @var{#f})
+@itemx @code{uuid} (default: @var{#f})
+These all work as a way of defining some kind of physical device or partition.
+@code{uuid} (taking a @code{uuid} record) and @code{label} (taking a string) are
+vastly preferred over device (a string denoting a filesystem path to a block
+device), as block device names are inconsistant and unrecognized at boot-time.
+
+@item @code{file-system} (default: @var{#f})
+A string denoting a file system type, as used in @ref{File Systems}. Unless
+your filesystem isn't being detected properly, or is unmounted at bootloader
+install-time, you shouldn't need to specify this.
+
+@end table
+@end deftp
+
@cindex dual boot
@cindex boot menu
Should you want to list additional boot menu entries @i{via} the
@@ -42375,6 +42443,8 @@ Bootloader Configuration
@lisp
(menu-entry
(label "The Other Distro")
+ (device (file-system-label "boot"))
+ (device-mount-point "/boot")
(linux "/boot/old/vmlinux-2.6.32")
(linux-arguments '("root=/dev/sda2"))
(initrd "/boot/old/initrd"))
@@ -42390,6 +42460,28 @@ Bootloader Configuration
@item @code{label}
The label to show in the menu---e.g., @code{"GNU"}.
+@item @code{device} (default: @var{#f})
+The device where any files specified below are to be found--eg, for GRUB,
+@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
+
+This may be a file system label (a string), a file system UUID (a
+bytevector, @pxref{File Systems}), or @code{#f}, in which case
+the bootloader will search the device containing the file specified by
+the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
+must @emph{not} be an OS device name such as @file{/dev/sda1}.
+
+@item @code{device-mount-point} (default: @var{#f})
+This is where @code{device} is mounted onto your file system. If provided, it
+allows for you to specify full paths for provided files, which will be
+automatically realized into paths local to their device.
+
+This is not necessary if specified files are already referring to files local to
+@code{device}, including if they're on your root filesystem.
+
+@item @code{device-subvol} (default: @var{#f})
+This is a btrfs subvolume name, useful in case you wish to access files from a
+btrfs subvolume on a device. @xref{Btrfs file system}.
+
@item @code{linux} (default: @code{#f})
The Linux kernel image to boot, for example:
@@ -42397,17 +42489,6 @@ Bootloader Configuration
(file-append linux-libre "/bzImage")
@end lisp
-For GRUB, it is also possible to specify a device explicitly in the
-file path using GRUB's device naming convention (@pxref{Naming
-convention,,, grub, GNU GRUB manual}), for example:
-
-@example
-"(hd0,msdos1)/boot/vmlinuz"
-@end example
-
-If the device is specified explicitly as above, then the @code{device}
-field is ignored entirely.
-
@item @code{linux-arguments} (default: @code{'()})
The list of extra Linux kernel command-line arguments---e.g.,
@code{'("console=ttyS0")}.
@@ -42416,16 +42497,6 @@ Bootloader Configuration
A G-Expression or string denoting the file name of the initial RAM disk
to use (@pxref{G-Expressions}).
-@item @code{device} (default: @code{#f})
-The device where the kernel and initrd are to be found---i.e., for GRUB,
-@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
-
-This may be a file system label (a string), a file system UUID (a
-bytevector, @pxref{File Systems}), or @code{#f}, in which case
-the bootloader will search the device containing the file specified by
-the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
-must @emph{not} be an OS device name such as @file{/dev/sda1}.
-
@item @code{multiboot-kernel} (default: @code{#f})
The kernel to boot in Multiboot-mode (@pxref{multiboot,,, grub, GNU GRUB
manual}). When this field is set, a Multiboot menu-entry is generated.
@@ -42448,7 +42519,7 @@ Bootloader Configuration
To use the new and still experimental
@uref{https://darnassus.sceen.net/~hurd-web/rump_kernel/, rumpdisk
user-level disk driver} instead of GNU@tie{}Mach's in-kernel IDE driver,
-set @code{kernel-arguments} to:
+set @code{multiboot-arguments} to:
@lisp
'("noide")
@@ -42471,10 +42542,11 @@ Bootloader Configuration
@end lisp
@item @code{chain-loader} (default: @code{#f})
-A string that can be accepted by @code{grub}'s @code{chainloader}
-directive. This has no effect if either @code{linux} or
-@code{multiboot-kernel} fields are specified. The following is an
-example of chainloading a different GNU/Linux system.
+Varies slightly depending on bootloader. For @code{grub}, this is anything that
+the @code{chainloader} directive can accept
+(@pxref{Chain-loading,,, grub, GNU GRUB manual}). For @code{uki-efi}, this is
+any efi binary to be installed alongside the system. The following is an example
+of chainloading a different GNU/Linux system.
@lisp
(bootloader
@@ -42682,10 +42754,6 @@ Invoking guix system
supported by the bootloader being used. The next time the system
boots, it will use the specified system generation.
-The bootloader itself is not being reinstalled when using this
-command. Thus, the installed bootloader is used with an updated
-configuration file.
-
The target generation can be specified explicitly by its generation
number. For example, the following invocation would switch to system
generation 7:
@@ -42706,11 +42774,10 @@ Invoking guix system
@end example
Currently, the effect of invoking this action is @emph{only} to switch
-the system profile to an existing generation and rearrange the
-bootloader menu entries. To actually start using the target system
-generation, you must reboot after running this action. In the future,
-it will be updated to do the same things as @command{reconfigure},
-like activating and deactivating services.
+the system profile to an existing generation and reinstall the bootloader. To
+actually start using the target system generation, you must reboot after
+running this action. In the future, it will be updated to do the same things
+as @command{reconfigure}, like activating and deactivating services.
This action will fail if the specified generation does not exist.
@@ -42886,11 +42953,9 @@ Invoking guix system
When using the @code{qcow2} image type, the returned image is in qcow2
format, which the QEMU emulator can efficiently use. @xref{Running Guix
in a VM}, for more information on how to run the image in a virtual
-machine. The @code{grub-bootloader} bootloader is always used
-independently of what is declared in the @code{operating-system} file
-passed as argument. This is to make it easier to work with QEMU, which
-uses the SeaBIOS BIOS by default, expecting a bootloader to be installed
-in the Master Boot Record (MBR).
+machine. Currently, QEMU as packaged in Guix does not have UEFI support,
+so you should select a bootloader for BIOS systems in your
+@code{operating-system} configuration.
@cindex docker-image, creating docker images
When using the @code{docker} image type, a Docker image is produced.
@@ -43208,7 +43273,6 @@ Invoking guix deploy
;; forwarded to the host's loopback interface.
(use-service-modules networking ssh)
-(use-package-modules bootloaders)
(define %system
(operating-system
@@ -43216,7 +43280,9 @@ Invoking guix deploy
(timezone "Etc/UTC")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sda"))))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
@@ -47800,6 +47866,12 @@ partition Reference
this flag set, usually the root one. The @code{'esp} flag identifies a
UEFI System Partition.
+@item @code{target} (default: @var{#f})
+If provided, this partition provides itself as a bootloader target
+(@pxref{Bootloader Configuration}). Most commonly, this is used to provide the
+@code{'root} and @code{'esp} targets, with the root partition and EFI System
+Partition, respectively, though this can provide any target necessary.
+
@item @code{initializer} (default: @code{#false})
The partition initializer procedure as a gexp. This procedure is called
to populate a partition. If no initializer is passed, the
@@ -47848,6 +47920,7 @@ Instantiate an Image
(label "GNU-ESP")
(file-system "vfat")
(flags '(esp))
+ (target 'esp)
(initializer (gexp initialize-efi-partition)))
(partition
(size (* 50 MiB))
@@ -47864,14 +47937,15 @@ Instantiate an Image
(label root-label)
(file-system "ext4")
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))))
@end lisp
-Note that the first and third partitions use generic initializers
-procedures, initialize-efi-partition and initialize-root-partition
-respectively. The initialize-efi-partition installs a GRUB EFI loader
-that is loading the GRUB bootloader located in the root partition. The
-initialize-root-partition instantiates a complete system as defined by
+Note that the first and third partitions use generic initializer
+procedures, @code{initialize-efi-partition} and @code{initialize-root-partition}
+respectively. @code{initialize-efi-partition} simply creates the directory
+structure for an EFI bootloader to install itself to.
+@code{initialize-root-partition} instantiates a complete system as defined by
the @code{%simple-os} operating-system.
You can now run:
@@ -47929,10 +48003,6 @@ Instantiate an Image
@code{i686} machines, supporting BIOS or UEFI booting.
@end defvar
-@defvar efi32-disk-image
-Same as @code{efi-disk-image} but with a 32 bits EFI partition.
-@end defvar
-
@defvar iso9660-image
An ISO-9660 image composed of a single bootable partition. This image
can also be used on most @code{x86_64} and @code{i686} machines.
@@ -48023,10 +48093,6 @@ image-type Reference
Build an image based on the @code{efi-disk-image} image.
@end defvar
-@defvar efi32-raw-image-type
-Build an image based on the @code{efi32-disk-image} image.
-@end defvar
-
@defvar qcow2-image-type
Build an image based on the @code{mbr-disk-image} image but with the
@code{compressed-qcow2} image format.
@@ -48054,14 +48120,14 @@ image-type Reference
@defvar pinebook-pro-image-type
Build an image that is targeting the Pinebook Pro machine. The MBR
image contains a single partition starting at a @code{9MiB} offset. The
-@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader will be
+@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader can be
installed in this gap.
@end defvar
@defvar rock64-image-type
Build an image that is targeting the Rock64 machine. The MBR image
contains a single partition starting at a @code{16MiB} offset. The
-@code{u-boot-rock64-rk3328-bootloader} bootloader will be installed in
+@code{u-boot-rock64-rk3328-bootloader} bootloader can be installed in
this gap.
@end defvar
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 14/15] gnu: tests: Update tests to new targets system.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (12 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 3:55 ` [bug#72457] [PATCH 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
` (7 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Maxim Cournoyer
* gnu/services/virtualization.scm
(%virtual-build-machine-operating-system): Remove bootloader.
(%hurd-vm-operating-system): Remove targets.
* gnu/system/hurd.scm (%hurd-default-operating-system): Remove targets.
* gnu/tests.scm (%simple-os), gnu/tests/ganeti.scm (%ganeti-os),
gnu/tests/image.scm (%simple-efi-os),
gnu/tests/install.scm (%minimal-os, %minimal-extlinux-os,
%minimal-os-on-vda, %separate-home-os, %separate-store-os, %raid-root-os,
%encrypted-root-os, %lvm-separate-home-os, %encrypted-home-os,
%encrypted-home-os-key-file, %encrypted-root-not-boot-os,
%btrfs-root-os-source, %btrfs-raid-root-os-source,
%btrfs-root-on-subvolume-os, %btrfs-raid10-root-os, %jfs-root-os,
%f2fs-root-os, %xfs-root-os), gnu/tests/nfs.scm (%base-os),
gnu/tests/telephony.scm (make-jami-os), gnu/tests/vnc.scm (%xvnc-os):
Update bootloader targets.
Change-Id: I3d66a839a9b2a73b8b65946950728b1e0155ca1e
---
gnu/services/virtualization.scm | 11 ++---
gnu/system/hurd.scm | 4 +-
gnu/tests.scm | 4 +-
gnu/tests/ganeti.scm | 4 +-
gnu/tests/image.scm | 4 +-
gnu/tests/install.scm | 72 ++++++++++++++++++++++++---------
gnu/tests/nfs.scm | 4 +-
gnu/tests/telephony.scm | 4 +-
gnu/tests/vnc.scm | 4 +-
tests/boot-parameters.scm | 2 +-
10 files changed, 77 insertions(+), 36 deletions(-)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index d87e494348..f698532a94 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1191,17 +1191,13 @@ (define %minimal-vm-syslog-config
(define %virtual-build-machine-operating-system
(operating-system
(host-name "build-machine")
-
(locale "en_US.utf8")
(locale-definitions
;; Save space by providing only one locale.
(list (locale-definition (name "en_US.utf8")
(source "en_US")
(charset "UTF-8"))))
-
- (bootloader (bootloader-configuration ;unused
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/null"))))
+ ;; no bootloader
(file-systems (cons (file-system ;unused
(mount-point "/")
(device "none")
@@ -1624,9 +1620,8 @@ (define %hurd-vm-operating-system
(host-name "childhurd")
(timezone "Europe/Amsterdam")
(bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))
- (timeout 0)))
+ (bootloader grub-minimal-bootloader)
+ (timeout 0)))
(packages (cons* gdb-minimal
(operating-system-packages
%hurd-default-operating-system)))
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index cbe0081382..af04e82485 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -119,9 +119,7 @@ (define %hurd-default-operating-system
(kernel %hurd-default-operating-system-kernel)
(kernel-arguments '())
(hurd hurd)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(initrd #f)
(initrd-modules '())
(firmware '())
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 5ff9db82fc..f46ccf5174 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -237,7 +237,9 @@ (define %simple-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device"/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
index 29eb354044..789879b26f 100644
--- a/gnu/tests/ganeti.scm
+++ b/gnu/tests/ganeti.scm
@@ -40,7 +40,9 @@ (define %ganeti-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/image.scm b/gnu/tests/image.scm
index be6852cae0..8d960cf7b8 100644
--- a/gnu/tests/image.scm
+++ b/gnu/tests/image.scm
@@ -55,7 +55,9 @@ (define %simple-efi-os
(inherit %simple-os)
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))))
;; An MBR disk image with a single ext4 partition.
(define i1
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 18a2fc119b..d67a71f12e 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -103,7 +103,9 @@ (define-os-with-source (%minimal-os %minimal-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -141,7 +143,9 @@ (define-os-with-source (%minimal-extlinux-os
(bootloader (bootloader-configuration
(bootloader extlinux-gpt-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -434,7 +438,9 @@ (define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -510,7 +516,9 @@ (define-os-with-source (%separate-home-os %separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "my-root"))
@@ -565,7 +573,9 @@ (define-os-with-source (%separate-store-os %separate-store-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "root-fs"))
@@ -642,7 +652,9 @@ (define-os-with-source (%raid-root-os %raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
;; Add a kernel module for RAID-1 (aka. "mirror").
@@ -725,7 +737,9 @@ (define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -858,7 +872,9 @@ (define-os-with-source (%lvm-separate-home-os %lvm-separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(mapped-devices (list (mapped-device
@@ -943,7 +959,9 @@ (define-os-with-source (%encrypted-home-os %encrypted-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -1070,7 +1088,9 @@ (define-os-with-source (%encrypted-home-os-key-file
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))
(extra-initrd "/key-file.cpio")))
(kernel-arguments '("console=ttyS0"))
@@ -1130,7 +1150,9 @@ (define-os-with-source (%encrypted-root-not-boot-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(mapped-devices (list (mapped-device
(source
@@ -1232,7 +1254,9 @@ (define-os-with-source (%btrfs-root-os %btrfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1306,7 +1330,9 @@ (define-os-with-source (%btrfs-raid-root-os %btrfs-raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1374,7 +1400,9 @@ (define-os-with-source (%btrfs-root-on-subvolume-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "btrfs-pool"))
@@ -1467,7 +1495,9 @@ (define-os-with-source (%btrfs-raid10-root-os
(bootloader (map (lambda (targ)
(bootloader-configuration
(bootloader grub-bootloader)
- (targets (list targ))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device targ))))))
'("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
@@ -1577,7 +1607,9 @@ (define-os-with-source (%jfs-root-os %jfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1650,7 +1682,9 @@ (define-os-with-source (%f2fs-root-os %f2fs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1723,7 +1757,9 @@ (define-os-with-source (%xfs-root-os %xfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 0d9972e0e9..2f97126df7 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -51,7 +51,9 @@ (define %base-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems %base-file-systems)
(users %base-user-accounts)
(packages (cons*
diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index f03ea963f7..ee858d9c91 100644
--- a/gnu/tests/telephony.scm
+++ b/gnu/tests/telephony.scm
@@ -90,7 +90,9 @@ (define* (make-jami-os #:key provisioning? partial?)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/vnc.scm b/gnu/tests/vnc.scm
index ab1c2749f3..cba9c565e0 100644
--- a/gnu/tests/vnc.scm
+++ b/gnu/tests/vnc.scm
@@ -51,7 +51,9 @@ (define %xvnc-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index f214de360d..f343dbdfdb 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -63,7 +63,7 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
- (bootloader-name 'grub)
+ (bootloader-name '(grub))
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 15/15] teams: Add bootloading team.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (13 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
@ 2024-08-04 3:55 ` Lilah Tascheter via Guix-patches
2024-08-04 8:53 ` [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Sergey Trofimov
` (6 subsequent siblings)
21 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 3:55 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter
Might as well, to help ease the transition.
* etc/teams.scm (bootloaders): New team.
(Lilah Tascheter): Create add to above.
Change-Id: I63620f4e3151bb8e3d0bdf619fc70501af6397a0
---
etc/teams.scm | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/etc/teams.scm b/etc/teams.scm
index 408ebbf3d9..d9af4ad7bb 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -328,6 +328,12 @@ (define-team embedded
#:scope (list "gnu/packages/bootloaders.scm"
"gnu/packages/firmware.scm")))
+(define-team bootloaders
+ (team 'bootloaders
+ #:name "Bootloaders"
+ #:scope (list "gnu/bootloader.scm"
+ (make-regexp* "^gnu/bootloader/"))))
+
(define-team rust
(team 'rust
#:name "Rust"
@@ -746,6 +752,10 @@ (define-member (person "Nicolas Goaziou"
"guix@nicolasgoaziou.fr")
tex)
+(define-member (person "Lilah Tascheter"
+ "lilah@lunabee.space")
+ bootloaders)
+
\f
(define (find-team name)
(or (hash-ref %teams (string->symbol name))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (14 preceding siblings ...)
2024-08-04 3:55 ` [bug#72457] [PATCH 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
@ 2024-08-04 8:53 ` Sergey Trofimov
2024-08-04 9:19 ` Sergey Trofimov
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (5 subsequent siblings)
21 siblings, 1 reply; 95+ messages in thread
From: Sergey Trofimov @ 2024-08-04 8:53 UTC (permalink / raw)
To: Lilah Tascheter; +Cc: 72457
Lilah Tascheter <lilah@lunabee.space> writes:
> The big thing is that this definately needs to be tested. We support lots of
> bootloaders for lots of hardware and I definately do not possess any of it.
> Please test this and send back the results for me to revise any bugs. I've made
> sure as many tests as I could run work, and that GRUB and uefi-uki-bootloader
> work both in regular systems and disk images.
>
I've built a new system generation, but it didn't apply properly,
showing this error:
--8<---------------cut here---------------start------------->8---
196:43 4 (_ #(#(#(#(#(#(#(#(#(#(#(#(#<directory (gnu bootloader grub) 7fa9e0f99dc0>) install (#<<bootloader-target> type: vendir expected?: #f path: "EFI/Guix" offset: #<procedure offset (a)> device: #f file-system: #f label: #f uuid: #f> #<<bootloader-target> type: install expected?: #f path: "boot" offset: #<procedure offset (a)> device: "/dev/sda1" file-system: "vfat" label: "GNU-ESP" uuid: #vu8(77 160 163 107)> #<<bootloader-target> type: root expected?: #f path: "/" offset: #<procedure offset (a)> device: "/dev/sda2" file-system: "ext4" label: "Guix_image" uuid: #vu8(246 188 138 216 255 26 23 84 83 48 172 24 246 188 138 216)> #<<bootloader-target> type: esp expected?: #f path: "/boot" offset: #<procedure offset (a)> device: "/dev/sda1" file-system: "vfat" label: "GNU-ESP" uuid: #vu8(77 160 163 107)>) "root" #<gexp port /storage/devel/ext/guix/gnu/bootloader/grub.scm:221:54 7fa9e2a11e40>) #<variable 7fa9e4b2b3a0 value: #<procedure form (a b)>>) (…)) #) #) #) #) #) #) #) #))
In gnu/system/uuid.scm:
89:19 3 (dce-uuid->string #vu8(77 160 163 107))
In unknown file:
2 (bytevector-uint-ref #vu8(77 160 163 107) 4 big 2)
In ice-9/boot-9.scm:
1685:16 1 (raise-exception _ #:continuable? _)
1685:16 0 (raise-exception _ #:continuable? _)
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
In procedure bytevector-uint-ref: Value out of range: 4
--8<---------------cut here---------------end--------------->8---
Relevant config part:
--8<---------------cut here---------------start------------->8---
(bootloader
(bootloader-configuration
(bootloader grub-efi-bootloader)
(targets (list (bootloader-target
(type 'esp)
(path "/boot"))))))
(file-systems
(cons* (file-system
(mount-point "/")
(device (file-system-label "Guix_image"))
(type "ext4"))
(file-system
(mount-point "/boot")
(device (file-system-label "GNU-ESP"))
(type "vfat"))
%base-file-systems))
--8<---------------cut here---------------end--------------->8---
Filesystem info:
--8<---------------cut here---------------start------------->8---
$ lsblk -o name,fstype,uuid,label,partuuid,partlabel
NAME FSTYPE UUID LABEL PARTUUID PARTLABEL
sda
├─sda1 vfat 6BA3-A04D GNU-ESP 1ec0ace3-d9b3-4254-b9f4-c4aa21e572cd GNU-ESP
└─sda2 ext4 f6bc8ad8-ff1a-1754-5330-ac18f6bc8ad8 Guix_image 6dfb79bf-9ec3-4722-91f8-b8e08b8c52a0 Guix_image
--8<---------------cut here---------------end--------------->8---
Should PARTUUID be used instead of fs UUID? I wasn't able to quickly locate the
place where to make this change.
^ permalink raw reply [flat|nested] 95+ messages in thread* [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem.
2024-08-04 8:53 ` [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Sergey Trofimov
@ 2024-08-04 9:19 ` Sergey Trofimov
0 siblings, 0 replies; 95+ messages in thread
From: Sergey Trofimov @ 2024-08-04 9:19 UTC (permalink / raw)
To: Lilah Tascheter; +Cc: 72457
Sergey Trofimov <sarg@sarg.org.ru> writes:
> Lilah Tascheter <lilah@lunabee.space> writes:
>
>> The big thing is that this definately needs to be tested. We support lots of
>> bootloaders for lots of hardware and I definately do not possess any of it.
>> Please test this and send back the results for me to revise any bugs. I've made
>> sure as many tests as I could run work, and that GRUB and uefi-uki-bootloader
>> work both in regular systems and disk images.
>>
>
> I've built a new system generation, but it didn't apply properly,
> showing this error:
>
I solved it by explicitly specifying uuid in bootloader-target: `(uuid "6BA3-A04D" 'fat)`.
Another issue is that `./pre-inst-env guix system list-generations` fails to print
older generations. Older guix prints fine even generations created with
the new bootloader code.
--8<---------------cut here---------------start------------->8---
619:8 3 (_ #(#(#(#(#(#(#(#(#(#(#(#(#<directory (guix scripts system) 7fcc08817b40>) 120 "/var/guix/profiles/system" #f) #<variable 7fcbef
8cd0 value: #<procedure display-channel (a)>>) "/var/guix/profiles/system-120-link") #<<boot-parameters> label: "GNU with Linux 6.9.7" root-de
ce: #<file-system-label "Guix_image"> bootloader-name: (grub-efi) store-device: #<file-system-label "Guix_image"> store-mount-point: "/" store
irectory-prefix: #f store-crypto-devices: () locale: "en_GB.UTF-8" kernel: "/gnu/store/c2xsizqd0rw8jxmrfvvwrvzwmb75r028-linux-6.9.7/bzImage" k
nel-arguments: ("root=Guix_image" #<gexp (string-append (if #<gexp-input #t:out> "gnu.system=" "--system=") #<gexp-input "/var/guix/profiles/s
tem-120-link":out>) /storage/devel/ext/guix/gnu/system/boot.scm:299:11 7fcbee836150> #<gexp (string-append (if #<gexp-input #t:out> "gnu.load=
"--load=") #<gexp-input "/var/guix/profiles/system-120-link":out> "/boot") /storage/devel/ext/guix/gnu/syste…>) #) #) #) #) #) #) …))
163:9 2 (_ #(#(#(#(#(#(#(#(#(#(#(#(#<directory (guix scripts system) 7fcc08817b40>) 120 "/var/guix/profiles/system" #f) #<variable 7fcbef
8cd0 value: #<procedure display-channel (a)>>) "/var/guix/profiles/system-120-link") #<<boot-parameters> label: "GNU with Linux 6.9.7" root-de
ce: #<file-system-label "Guix_image"> bootloader-name: (grub-efi) store-device: #<file-system-label "Guix_image"> store-mount-point: "/" store
irectory-prefix: #f store-crypto-devices: () locale: "en_GB.UTF-8" kernel: "/gnu/store/c2xsizqd0rw8jxmrfvvwrvzwmb75r028-linux-6.9.7/bzImage" k
nel-arguments: ("root=Guix_image" #<gexp (string-append (if #<gexp-input #t:out> "gnu.system=" "--system=") #<gexp-input "/var/guix/profiles/s
tem-120-link":out>) /storage/devel/ext/guix/gnu/system/boot.scm:299:11 7fcbee836150> #<gexp (string-append (if #<gexp-input #t:out> "gnu.load=
"--load=") #<gexp-input "/var/guix/profiles/system-120-link":out> "/boot") /storage/devel/ext/guix/gnu/syste…>) #) #) #) #) #) #) …))
In unknown file:
1 (string-join (grub-efi) #<undefined> #<undefined>)
In ice-9/boot-9.scm:
1685:16 0 (raise-exception _ #:continuable? _)
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
In procedure string-append: Wrong type (expecting string): grub-efi
--8<---------------cut here---------------end--------------->8---
^ permalink raw reply [flat|nested] 95+ messages in thread
* [bug#72457] [PATCH v2 00/15] Rewrite bootloader subsystem.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (15 preceding siblings ...)
2024-08-04 8:53 ` [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Sergey Trofimov
@ 2024-08-04 18:05 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
` (15 more replies)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (4 subsequent siblings)
21 siblings, 16 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:05 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov
Thanks you two! This patch series should fix those issues; feel free to
double-check though :)
Lilah Tascheter (15):
guix: scripts: Rewrite reinstall-bootloader to use provenance data.
gnu: Add bootloader target infastructure.
guix: scripts: Remove unused code.
gnu: Core bootloader changes.
gnu: system: Remove useless boot parameters.
gnu: bootloader: Add raspberry pi bootloader.
gnu: system: Fix bootloader crypto device recognition.
gnu: packages: Add pesign.
gnu: packages: Add ukify.
gnu: packages: Add systemd-stub.
gnu: bootloaders: Add uki-efi-bootloader.
gnu: system: Update examples.
doc: Update bootloader documentation.
gnu: tests: Update tests to new targets system.
teams: Add bootloading team.
doc/guix.texi | 458 +++---
etc/teams.scm | 10 +
gnu/bootloader.scm | 660 ++++++---
gnu/bootloader/depthcharge.scm | 153 +-
gnu/bootloader/extlinux.scm | 149 +-
gnu/bootloader/grub.scm | 1279 +++++++----------
gnu/bootloader/u-boot.scm | 505 +++----
gnu/bootloader/uki.scm | 96 ++
gnu/build/bootloader.scm | 157 +-
gnu/build/image.scm | 40 +-
gnu/build/install.scm | 16 +-
gnu/image.scm | 3 +
gnu/installer/parted.scm | 12 +-
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 71 +-
gnu/packages/bootloaders.scm | 277 ++--
gnu/packages/efi.scm | 47 +
gnu/packages/raspberry-pi.scm | 18 -
gnu/services/virtualization.scm | 11 +-
gnu/system.scm | 62 +-
gnu/system/boot.scm | 16 +-
gnu/system/examples/asus-c201.tmpl | 6 +-
gnu/system/examples/bare-bones.tmpl | 7 +-
gnu/system/examples/bare-hurd.tmpl | 4 +-
gnu/system/examples/beaglebone-black.tmpl | 6 +-
gnu/system/examples/desktop.tmpl | 4 +-
gnu/system/examples/docker-image.tmpl | 6 +-
gnu/system/examples/lightweight-desktop.tmpl | 4 +-
gnu/system/examples/plasma.tmpl | 4 +-
.../examples/raspberry-pi-64-nfs-root.tmpl | 23 +-
gnu/system/examples/raspberry-pi-64.tmpl | 18 +-
gnu/system/examples/vm-image.tmpl | 5 +-
gnu/system/hurd.scm | 4 +-
gnu/system/image.scm | 162 ++-
gnu/system/images/hurd.scm | 4 +-
gnu/system/images/novena.scm | 3 +-
.../images/orangepi-r1-plus-lts-rk3328.scm | 3 +-
gnu/system/images/pine64.scm | 3 +-
gnu/system/images/pinebook-pro.scm | 3 +-
gnu/system/images/rock64.scm | 3 +-
gnu/system/images/unmatched.scm | 3 +-
gnu/system/images/visionfive2.scm | 3 +-
gnu/system/images/wsl2.scm | 14 +-
gnu/system/install.scm | 43 +-
gnu/system/vm.scm | 11 -
gnu/tests.scm | 4 +-
gnu/tests/ganeti.scm | 4 +-
gnu/tests/image.scm | 4 +-
gnu/tests/install.scm | 80 +-
gnu/tests/nfs.scm | 4 +-
gnu/tests/reconfigure.scm | 86 +-
gnu/tests/telephony.scm | 4 +-
gnu/tests/vnc.scm | 4 +-
guix/scripts/system.scm | 162 +--
guix/scripts/system/reconfigure.scm | 159 +-
guix/ui.scm | 8 +
tests/boot-parameters.scm | 16 +-
57 files changed, 2387 insertions(+), 2535 deletions(-)
create mode 100644 gnu/bootloader/uki.scm
base-commit: 7d781027c78bdea5fdb3f1c9c9ec432b9606d2b5
--
2.45.2
^ permalink raw reply [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
` (14 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Ludovic Court??s, Mathieu Othacehe,
Simon Tournier, Tobias Geerinckx-Rice
The current implementation is broken anyway. Multiple bootloaders share
a name (including both versions of extlinux) and
bootloader-configuration data is significant to bootloader installation.
It shouldn't be just faked.
Rely on the provenance service instead, which while not always present,
should be for the vast majority of systems.
* guix/scripts/system.scm (reinstall-bootloader): Rename to...
(install-bootloader-from-provenance): ...this, and rewrite to extract
bootloader-configuration data from system provenance.
(switch-to-system-generation, process-command): Use
install-bootloader-from-provenance.
Change-Id: I5713a43ad4f9f32a129d980db06d70de16b03f27
---
guix/scripts/system.scm | 75 ++++++++++++++---------------------------
1 file changed, 25 insertions(+), 50 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0f7d864e06..bb7b5d37bf 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -88,6 +88,7 @@ (define-module (guix scripts system)
#:use-module (srfi srfi-37)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
#:use-module (rnrs bytevectors)
#:export (guix-system
read-operating-system
@@ -377,60 +378,33 @@ (define (switch-to-system-generation store spec)
(activate (string-append generation "/activate")))
(if number
(begin
- (reinstall-bootloader store number)
+ (install-bootloader-from-provenance store number)
(switch-to-generation* %system-profile number)
(unless-file-not-found (primitive-load activate)))
(leave (G_ "cannot switch to system generation '~a'~%") spec))))
-(define* (system-bootloader-name #:optional (system %system-profile))
- "Return the bootloader name stored in SYSTEM's \"parameters\" file."
- (let ((params (unless-file-not-found
- (read-boot-parameters-file system))))
- (boot-parameters-bootloader-name params)))
-
-(define (reinstall-bootloader store number)
- "Re-install bootloader for existing system profile generation NUMBER.
-STORE is an open connection to the store."
+(define (install-bootloader-from-provenance store number)
+ "Re-install an old bootloader using provenance data for system profile
+generation NUMBER with store STORE."
(let* ((generation (generation-file-name %system-profile number))
- ;; Detect the bootloader used in %system-profile.
- (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
-
- ;; Use the detected bootloader with default configuration.
- ;; It will be enough to allow the system to boot.
- (bootloader-config (bootloader-configuration
- (bootloader bootloader)))
-
- ;; Make the specified system generation the default entry.
- (chosen-alternative (generation->boot-alternative
- %system-profile number))
- (params (boot-alternative-parameters chosen-alternative))
- (locale (boot-parameters-locale params))
- (store-crypto-devices (boot-parameters-store-crypto-devices params))
- (store-directory-prefix
- (boot-parameters-store-directory-prefix params))
- (old-generations
- (delv number (reverse (generation-numbers %system-profile))))
- (previous-boot-alternatives (profile->boot-alternatives
- %system-profile old-generations))
- (entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- previous-boot-alternatives))))
- (run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object
- ((bootloader-configuration-file-generator bootloader)
- bootloader-config entries
- #:locale locale
- #:store-crypto-devices store-crypto-devices
- #:store-directory-prefix store-directory-prefix
- #:old-entries old-entries)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))))
+ (os (receive (_ os) (system-provenance generation)
+ (and=> os read-operating-system)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (numbers (delv number (reverse (generation-numbers %system-profile))))
+ (old (profile->boot-alternatives %system-profile numbers)))
+ (if os
+ (run-with-store store
+ (mlet* %store-monad
+ ((bootcfg (lower-object (operating-system-bootcfg os old)))
+ (drvs -> (list bootcfg)))
+ (mbegin %store-monad
+ (built-derivations drvs)
+ ;; Only install bootloader configuration file.
+ (install-bootloader local-eval bootloader-config bootcfg
+ #:run-installer? #f))))
+ (leave (G_ "cannot rollback to provenanceless generation '~a'~%")
+ number))))
\f
;;;
@@ -1416,7 +1390,8 @@ (define (process-command command args opts)
(x (leave (G_ "wrong number of arguments~%"))))))
(with-store* store
(delete-matching-generations store %system-profile pattern)
- (reinstall-bootloader store (generation-number %system-profile)))))
+ (install-bootloader-from-provenance store
+ (generation-number %system-profile)))))
((switch-generation)
(let ((pattern (match args
((pattern) pattern)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 02/15] gnu: Add bootloader target infastructure.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
` (13 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Lilah Tascheter, Ludovic Court??s,
Mathieu Othacehe, Simon Tournier, Tobias Geerinckx-Rice
* gnu/bootloader.scm (bootloader-target): New record.
(&target-error): New condition.
(pathcat, get-target-of-type, parent-of, unfold-pathcat, target-base?,
type-major?, ensure, ensure-target-types, ensure-majors, gbegin):
New procedures.
(define-literal, with-targets, :path, :devpath, :device,
:fs, :label, :uuid): New macros.
(bootloader-modules): Prevent mutual imports.
* guix/ui.scm (call-with-error-handling)[target-error?]:
Handle target-errors.
Change-Id: I3f07c9096dd8b91c04449b6360b3b7d21640da14
---
gnu/bootloader.scm | 212 ++++++++++++++++++++++++++++++++++++++++++++-
guix/ui.scm | 8 ++
2 files changed, 217 insertions(+), 3 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index f32e90e79d..3ddc112cc6 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -31,10 +31,11 @@ (define-module (gnu bootloader)
#:use-module (guix profiles)
#:use-module (guix records)
#:use-module (guix deprecation)
- #:use-module ((guix ui) #:select (warn-about-load-error))
#:use-module (guix diagnostics)
#:use-module (guix i18n)
+ #:use-module (guix modules)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
@@ -63,6 +64,26 @@ (define-module (gnu bootloader)
bootloader-configuration-file
bootloader-configuration-file-generator
+ <bootloader-target>
+ bootloader-target
+ bootloader-target?
+ bootloader-target-type
+ bootloader-target-expected?
+ bootloader-target-path
+ bootloader-target-offset
+ bootloader-target-device
+ bootloader-target-file-system
+ bootloader-target-label
+ bootloader-target-uuid
+
+ target-error?
+ target-error-type
+ target-error-targets
+
+ gbegin
+ :path :devpath :device :fs :label :uuid
+ with-targets
+
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
@@ -236,6 +257,191 @@ (define-record-type* <bootloader>
(configuration-file bootloader-configuration-file)
(configuration-file-generator bootloader-configuration-file-generator))
+\f
+;;;
+;;; Bootloader target record.
+;;;
+
+;; <bootloader-target> represents different kinds of targets in a normalized form.
+
+(define-record-type* <bootloader-target>
+ bootloader-target make-bootloader-target bootloader-target?
+ (type bootloader-target-type) ; symbol
+ (expected? bootloader-target-expected? (default #f)) ; bool
+
+ (path bootloader-target-path (default #f)) ; string|#f
+ (offset bootloader-target-offset (thunked) ; symbol|#f
+ (default (and (bootloader-target-path this-record)
+ (not (eq? (bootloader-target-type this-record) 'root))
+ 'root)))
+ (device bootloader-target-device (default #f)) ; string|#f
+ (file-system bootloader-target-file-system (default #f)) ; string|#f
+ (label bootloader-target-label (default #f)) ; string|#f
+ (uuid bootloader-target-uuid (default #f))) ; uuid|#f
+
+(define-condition-type &target-error &error target-error?
+ (type target-error-type)
+ (targets target-error-targets))
+
+(define (pathcat p1 p2)
+ (string-append (string-trim-right p1 #\/) "/" (string-trim p2 #\/)))
+
+(define* (get-target-of-type type targets #:optional (require? #f))
+ "Finds a target in TARGETS of type TYPE, optionally providing an error when
+not found if REQUIRE? is provided."
+ (let* ((pred (lambda (target) (eq? type (bootloader-target-type target))))
+ (candidates (filter pred targets))
+ (ret (if (pair? candidates) (car candidates) #f)))
+ (if (and require? (not ret))
+ (raise (condition
+ (&message (message (G_ "required, but not provided")))
+ (&target-error (type type) (targets targets))))
+ ret)))
+
+(define (parent-of target targets)
+ (and=> (bootloader-target-offset target)
+ (cut get-target-of-type <> targets #t)))
+
+(define (unfold-pathcat target targets)
+ (let ((quit (lambda (t) (not (and=> t bootloader-target-path)))))
+ (reduce pathcat #f
+ (unfold quit bootloader-target-path (cut parent-of <> targets) target))))
+
+(define (target-base? t)
+ (or (not t) (match-record t <bootloader-target>
+ (expected? offset device label uuid)
+ (or device label uuid (not offset) expected?))))
+
+(define (type-major? target) (memq target '(root esp disk)))
+
+(define (ensure types targets end)
+ (let* ((used-in (cute unfold end identity (cut parent-of <> targets) <>))
+ (cons-in (lambda (t) (cons t (used-in t))))
+ (ensure (map (cut get-target-of-type <> targets #t) types)))
+ (filter ->bool (apply append (map cons-in ensure)))))
+
+(define* (ensure-target-types types targets #:optional (base? #f))
+ "Ensures all TYPES are provided in TARGETS. Returns #t iff every ensured
+target and its requirements are fully provided. Errors out when a required TYPE
+isn't provided. When BASE?, only ensure path requirements up to a device."
+ (not (any bootloader-target-expected?
+ (ensure types targets (if base? target-base? not)))))
+
+(define (ensure-majors types targets)
+ "Errors out when a required TYPE isn't provided, or when use of multiple major
+targets is detected."
+ (let* ((all (map bootloader-target-type (ensure types targets target-base?)))
+ (majors (delete-duplicates (filter type-major? all) eq?)))
+ (if (< (length majors) 2) #t
+ (raise (condition (&message (message (G_ "multiple major targets used")))
+ (&target-error (type majors) (targets targets)))))))
+
+
+
+(define (gbegin . gex)
+ "Sequence provided g-expressions."
+ (case (length gex) ((0) #f) ((1) (car gex)) (else #~(begin #$@gex))))
+
+;; syntax matching on free literals breaks easily, so bind them
+(define-syntax-rule (define-literal id) (define-syntax id (syntax-rules ())))
+(define-literal :path)
+(define-literal :devpath)
+(define-literal :device)
+(define-literal :fs)
+(define-literal :label)
+(define-literal :uuid)
+
+(define-syntax with-targets
+ (cut syntax-case <> ()
+ ((_ targets-expr block ...)
+ (let* ((genvars (compose generate-temporaries iota))
+ (targets (car (genvars 1)))
+
+ (path? (cut syntax-case <> (:path) ((_ :path) #t) (_ #f)))
+ (qualified? (cut syntax-case <> (=>)
+ ((_ => spec ...) (any path? #'(spec ...)))
+ (_ #f)))
+
+ (resolve
+ (lambda (in target base)
+ (with-syntax ((target target) (base base) (targets targets))
+ (syntax-case in
+ (:path :devpath :device :fs :label :uuid)
+ ((name _) (not (identifier? #'name))
+ #`(_ (syntax-error "binds must be to identifiers" #,in)))
+ ((name :device) #'(name (bootloader-target-device base)))
+ ((name :label) #'(name (bootloader-target-label base)))
+ ((name :uuid) #'(name (bootloader-target-uuid base)))
+ ((name :fs) #'(name (bootloader-target-file-system base)))
+ ((name :path) #'(name (unfold-pathcat target targets)))
+ ((name :devpath)
+ #'(name (pathcat "/" (bootloader-target-path target))))
+ (_ #`(_ (syntax-error "invalid binding spec" #,in)))))))
+ (binds
+ (lambda (spec)
+ (syntax-case spec (=>)
+ ((type => binds ...)
+ (with-syntax (((target base) (genvars 2)) (targets targets))
+ (append
+ #`((get (lambda (t) (get-target-of-type t targets #t)))
+ (target (get type))
+ (base (if (target-base? target) target
+ (get (bootloader-target-offset target)))))
+ (map (cut resolve <> #'target #'base) #'(binds ...)))))
+ (_ #f))))
+
+ (blocks
+ (cut syntax-case <> ()
+ ((spec ... expr)
+ (let* ((specs #'(spec ...))
+ (lets (apply append (filter-map binds specs)))
+ (type (cut syntax-case <> (=>)
+ ((t => _ ...) #'t) (t #'t))))
+ (receive (full part) (partition qualified? specs)
+ #`(and (ensure-majors (list #,@(map type specs)) #,targets)
+ (ensure-target-types (list #,@(map type part))
+ #,targets #t)
+ (ensure-target-types (list #,@(map type full))
+ #,targets #f)
+ (let* #,lets expr)))))
+ (bad #'(syntax-error "malformed block" bad)))))
+ "Using the list TARGETS, evaluate and sequence each BLOCK to produce a
+gexp. BLOCK is a set of SPECs followed by an EXPR (evaluating to a gexp). Each
+SPEC denotes a type of target to guard EXPR on their existance and
+full-qualification. This procedure is linear in regards to BLOCKs.
+
+SPEC may be of the following forms:
+@itemize
+@item 'TYPE Requires TYPE to be fully present or promised. Errors otherwise.
+@item ('TYPE => (VAR COMPONENT) ...): As type, but also binds variables. TYPE's
+ COMPONENT is bound to the variable VAR as described below.
+@end itemize
+
+Available COMPONENTs are:
+@itemize
+@item :path (fully-qualified)
+@item :devpath (relative from device)
+@item :device (auto-detected from uuid and label if not user-provided)
+@item :fs
+@item :label
+@item :uuid
+@end itemize
+
+Note that installers may be called multiple times with different targets being
+fully-qualified. To ensure that targets aren't installed multiple times, make sure
+that each BLOCK ensures at least one major target, either directly or indirectly.
+Corrolarily, at most one major target should be ensured per BLOCK, under the same
+conditions. Major targets originate from disk image handling, and are currently:
+@itemize
+@item disk
+@item root
+@item esp
+@end itemize"
+ #`(let ((#,targets targets-expr))
+ (apply gbegin (filter ->bool
+ (list #,@(map blocks #'(block ...))))))))
+ (bad #'(syntax-error "must provide targets" bad))))
+
\f
;;;
;;; Bootloader configuration record.
@@ -305,10 +511,10 @@ (define (bootloader-configuration-targets config)
(define (bootloader-modules)
"Return the list of bootloader modules."
+ ;; don't provide #:warn to prevent mutual imports
(all-modules (map (lambda (entry)
`(,entry . "gnu/bootloader"))
- %load-path)
- #:warn warn-about-load-error))
+ %load-path)))
(define %bootloaders
;; The list of publically-known bootloaders.
diff --git a/guix/ui.scm b/guix/ui.scm
index 9db6f6e9d7..1c9300c9eb 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -36,6 +36,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix ui)
+ #:use-module ((gnu bootloader)
+ #:select (target-error? target-error-type target-error-targets))
#:use-module (guix i18n)
#:use-module (guix colors)
#:use-module (guix diagnostics)
@@ -857,6 +859,12 @@ (define (call-with-error-handling thunk)
(invoke-error-stop-signal c)
(cons (invoke-error-program c)
(invoke-error-arguments c))))
+ ((target-error? c)
+ (leave (G_ "bootloader-target '~a'~@[: ~a~] ~
+ among the following targets:~%~{~y~}")
+ (target-error-type c)
+ (and (message-condition? c) (condition-message c))
+ (target-error-targets c)))
((formatted-message? c)
(apply report-error
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 03/15] guix: scripts: Remove unused code.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
` (12 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Ludovic Court??s, Mathieu Othacehe,
Simon Tournier, Tobias Geerinckx-Rice
* guix/scripts/system.scm (bootloader-installer-script): Delete.
Change-Id: Ic1e0a523c814e4f1bf44b2721f5658f00066b0ab
---
guix/scripts/system.scm | 22 ----------------------
1 file changed, 22 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bb7b5d37bf..344bb74151 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -731,28 +731,6 @@ (define (maybe-suggest-running-guix-pull)
(warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%"))
(warning (G_ "Failing to do that may downgrade your system!~%"))))
-(define (bootloader-installer-script installer
- bootloader device target)
- "Return a file calling INSTALLER gexp with given BOOTLOADER, DEVICE
-and TARGET arguments."
- (scheme-file "bootloader-installer"
- (with-imported-modules '((gnu build bootloader)
- (guix build utils))
- #~(begin
- (use-modules (gnu build bootloader)
- (guix build utils)
- (ice-9 binary-ports)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (guard (c ((message-condition? c) ;XXX: i18n
- (format (current-error-port) "error: ~a~%"
- (condition-message c))
- (exit 1)))
- (#$installer #$bootloader #$device #$target)
- (info (G_ "bootloader successfully installed on '~a'~%")
- #$device))))))
-
(define (local-eval exp)
"Evaluate EXP, a G-Expression, in-place."
(mlet* %store-monad ((lowered (lower-gexp exp))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 04/15] gnu: Core bootloader changes.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (2 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
` (11 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Christopher Baines,
Efraim Flashner, Josselin Poiret, Lilah Tascheter,
Ludovic Court??s, Mathieu Othacehe, Simon Tournier,
Tobias Geerinckx-Rice, Vagrant Cascadian
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/bootloader.scm (menu-entry): Add device-subvol field.
(menu-entry->sexp, sexp->menu-entry): Support device-subvol.
(normalize-file, warn-update-targets, target-overrides, normalize,
bootloader-configuration->gexp, bootloader-configurations->gexps,
efi-arch, install-efi):
New procedures.
(bootloader): Rewrite record.
(bootloader-configuration)[target]: Remove deprecated field.
[targets]: Include sanitizer and allow multiple bootloaders.
[terminal-outputs, terminal-inputs]: Don't assume grub.
[efi-removable?, 32bit?]: New fields.
(warn-target-field-deprecation): Delete deprecation warning.
(%bootloaders): Delete variable.
(bootloader-configuration-target, bootloader-configuration-targets,
lookup-bootloader-by-name, bootloader-modules, efi-bootloader-profile,
efi-bootloader-chain): Delete procedures.
* gnu/bootloader/depthcharge.scm, gnu/bootloader/extlinux.scm,
gnu/bootloader/grub.scm, gnu/bootloader/u-boot.scm: Rewrite entirely.
* gnu/build/bootloader.scm (parse-bootnums): New variable.
(atomic-copy, in-temporary-directory, efi-bootnums): New procedures.
(install-efi-loader): Delete procedure.
(install-efi): Rewrite to support installation of any efi bootloader.
* gnu/build/image.scm (initialize-efi32-partition: Deprecate.
(initialize-efi-partitition): Only create EFI directory.
(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/image.scm (partition)[target]: New field in order to support
dynamic provision of image partitions as bootloader targets.
* gnu/installer/parted.scm (bootloader-configuration),
gnu/machine/ssh.scm (deploy-managed-host) (roll-back-managed-host):
Use new bootloader system.
* gnu/packages/bootloaders.scm (make-grub-efi-netboot): Delete
procedure.
* gnu/packages/raspberry-pi.scm (grub-efi-bootloader-chain-raspi-64):
Delete procedure. Can be recreated with a raspberry pi bootloader
combined with grub-efi.
* gnu/system.scm (convert-bootloader-field): New procedure.
(operating-system)[bootloader]: Use above sanitizer and support
multiple bootloaders.
(operating-system-bootcfg): Rename to...
(operating-system-bootmeta): ...this. Rewrite to return relavent
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.
(boot-parameters->menu-entry): Support device-subvol.
(boot-alternative->menu-entry): New procedure.
* gnu/system/image.scm (root-partition, esp-partition): Use target field.
(esp32-partition, efi32-disk-partition, efi32-raw-image-type): Deprecate.
(root-partition-index): Delete procedure.
(system-disk-image, system-iso9960-image): Support new bootloader system.
(system-disk-image)[targets]: New subprocedure.
* gnu/system/images/hurd.scm (hurd-barebones-os)[bootloader],
gnu/system/images/novena.scm (novena-barebones-os)[bootloader],
gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
(orangepi-r1-plus-lts-rk3328-barebones-os)[bootloader],
gnu/system/images/pine64.scm (pine64-barebones-os)[bootloader],
gnu/system/images/pinebook-pro.scm
(pinebook-pro-barebones-os)[bootloader],
gnu/system/images/rock64.scm (rock64-barebones-os)[bootloader],
gnu/system/images/unmatched.scm (unmatched-barebones-os)[bootloader],
gnu/system/images/visionfive2.scm
(visionfive2-barebones-os)[bootloader]: Use new target format.
* gnu/system/images/wsl2.scm (dummy-bootloader): Delete variable.
(wsl-os)[bootloader]: Don't provide field.
* gnu/system/install.scm (installation-os)[bootloader]: Use new format.
(os-with-u-boot): Delete procedure.
(embedded-installation-os)[bootloader]: Use new format.
(beaglebone-black-installation-os, a20-olinuxino-lime-installation-os,
a20-olinuxino-lime2-emmc-installation-os,
a20-olinuxino-micro-installation-os, bananapi-m2-ultra-installation-os,
firefly-rk3399-installation-os, mx6cuboxi-installation-os,
novena-installation-os, nintendo-nes-classic-edition-installation-os,
orangepi-r1-plus-lts-rk3328-installation-os, pine64-plus-installation-os,
pinebook-installation-os, rock64-installation-os,
rockpro64-installation-os, rk3399-puma-installation-os,
wandboard-installation-os): Don't guess block device.
* gnu/system/vm.scm (virtualized-operating-system): Don't provide
bootloader.
* gnu/tests/install.scm (%minimal-extlinux-os)[bootloader]: Use proper
extlinux variable.
(%btrfs-raid10-root-os): Use multiple bootloaders.
* gnu/tests/reconfigure.scm (%test-install-bootloader): Delete variable.
(run-install-bootloader-test): Delete procedure.
* 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
---
gnu/bootloader.scm | 440 +++---
gnu/bootloader/depthcharge.scm | 153 +-
gnu/bootloader/extlinux.scm | 149 +-
gnu/bootloader/grub.scm | 1279 +++++++----------
gnu/bootloader/u-boot.scm | 439 ++----
gnu/build/bootloader.scm | 157 +-
gnu/build/image.scm | 40 +-
gnu/build/install.scm | 16 +-
gnu/image.scm | 3 +
gnu/installer/parted.scm | 12 +-
gnu/machine/ssh.scm | 71 +-
gnu/packages/bootloaders.scm | 86 --
gnu/packages/raspberry-pi.scm | 18 -
gnu/system.scm | 45 +-
gnu/system/boot.scm | 8 +-
gnu/system/image.scm | 162 ++-
gnu/system/images/hurd.scm | 4 +-
gnu/system/images/novena.scm | 3 +-
.../images/orangepi-r1-plus-lts-rk3328.scm | 3 +-
gnu/system/images/pine64.scm | 3 +-
gnu/system/images/pinebook-pro.scm | 3 +-
gnu/system/images/rock64.scm | 3 +-
gnu/system/images/unmatched.scm | 3 +-
gnu/system/images/visionfive2.scm | 3 +-
gnu/system/images/wsl2.scm | 14 +-
gnu/system/install.scm | 43 +-
gnu/system/vm.scm | 11 -
gnu/tests/install.scm | 10 +-
gnu/tests/reconfigure.scm | 86 +-
guix/scripts/system.scm | 89 +-
guix/scripts/system/reconfigure.scm | 159 +-
31 files changed, 1425 insertions(+), 2090 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 3ddc112cc6..cb96b076ae 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,45 +25,53 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader)
+ #:autoload (gnu build file-systems)
+ (read-partition-label read-partition-uuid
+ find-partition-by-label find-partition-by-uuid)
+ #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
- #:use-module (guix discovery)
- #:use-module (guix gexp)
- #:use-module (guix profiles)
- #:use-module (guix records)
+ #:autoload (guix build syscalls)
+ (mounts mount-source mount-point mount-type)
#:use-module (guix deprecation)
#:use-module (guix diagnostics)
+ #:use-module (guix gexp)
#:use-module (guix i18n)
#:use-module (guix modules)
+ #:use-module (guix profiles)
+ #:use-module (guix records)
+ #:use-module (guix utils)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
+ #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (ice-9 match)
- #:export (menu-entry
+ #:export (<menu-entry>
+ menu-entry
menu-entry?
menu-entry-label
menu-entry-device
+ menu-entry-device-mount-point
+ menu-entry-device-subvol
menu-entry-linux
menu-entry-linux-arguments
menu-entry-initrd
- menu-entry-device-mount-point
menu-entry-multiboot-kernel
menu-entry-multiboot-arguments
menu-entry-multiboot-modules
menu-entry-chain-loader
+ normalize-file
menu-entry->sexp
sexp->menu-entry
bootloader
bootloader?
bootloader-name
- bootloader-package
+ bootloader-default-targets
bootloader-installer
- bootloader-disk-image-installer
- bootloader-configuration-file
- bootloader-configuration-file-generator
<bootloader-target>
bootloader-target
@@ -84,13 +93,15 @@ (define-module (gnu bootloader)
:path :devpath :device :fs :label :uuid
with-targets
+ <bootloader-configuration>
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
- bootloader-configuration-target ;deprecated
bootloader-configuration-targets
bootloader-configuration-menu-entries
bootloader-configuration-default-entry
+ bootloader-configuration-efi-removable?
+ bootloader-configuration-32bit?
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -101,10 +112,11 @@ (define-module (gnu bootloader)
bootloader-configuration-device-tree-support?
bootloader-configuration-extra-initrd
- %bootloaders
- lookup-bootloader-by-name
+ bootloader-configuration->gexp
+ bootloader-configurations->gexp
- efi-bootloader-chain))
+ efi-arch
+ install-efi))
\f
;;;
@@ -119,6 +131,8 @@ (define-record-type* <menu-entry>
(default #f))
(device-mount-point menu-entry-device-mount-point
(default #f))
+ (device-subvol menu-entry-device-subvol
+ (default #f))
(linux menu-entry-linux
(default #f))
(linux-arguments menu-entry-linux-arguments
@@ -135,6 +149,18 @@ (define-record-type* <menu-entry>
(chain-loader menu-entry-chain-loader
(default #f))) ; string, path of efi file
+(define (normalize-file entry val)
+ "Normalize a file VAL stored in a menu entry into one suitable for a
+bootloader. Realizes device-mount-point and device-subvol."
+ (match-record entry <menu-entry> (device-mount-point device-subvol)
+ #~(let* ((rel (lambda (s) (substring s (if (string-prefix? "/" s) 1 0))))
+ (file (rel #$val))
+ (subvol (and=> #$device-subvol rel))
+ (mount (and=> #$device-mount-point rel)))
+ (string-append (if subvol (string-append "/" subvol "/") "/")
+ (if (and mount (string-prefix? mount file))
+ (substring file (string-length mount)) file)))))
+
(define (report-menu-entry-error menu-entry)
(raise
(condition
@@ -162,7 +188,7 @@ (define (menu-entry->sexp entry)
`(label ,(file-system-label->string label)))
(_ device)))
(match entry
- (($ <menu-entry> label device mount-point
+ (($ <menu-entry> label device mount-point subvol
(? identity linux) linux-arguments (? identity initrd)
#f () () #f)
`(menu-entry (version 0)
@@ -171,8 +197,9 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(linux ,linux)
(linux-arguments ,linux-arguments)
- (initrd ,initrd)))
- (($ <menu-entry> label device mount-point #f () #f
+ (initrd ,initrd)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f
(? identity multiboot-kernel) multiboot-arguments
multiboot-modules #f)
`(menu-entry (version 0)
@@ -181,19 +208,23 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(multiboot-kernel ,multiboot-kernel)
(multiboot-arguments ,multiboot-arguments)
- (multiboot-modules ,multiboot-modules)))
- (($ <menu-entry> label device mount-point #f () #f #f () ()
+ (multiboot-modules ,multiboot-modules)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f #f () ()
(? identity chain-loader))
`(menu-entry (version 0)
(label ,label)
(device ,(device->sexp device))
(device-mount-point ,mount-point)
- (chain-loader ,chain-loader)))
+ (chain-loader ,chain-loader)
+ (device-subvol ,subvol)))
(_ (report-menu-entry-error entry))))
(define (sexp->menu-entry sexp)
"Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
record."
+ ;; XXX: rely on shadowing to support the match ors below
+ (define subvol #f)
(define (sexp->device device-sexp)
(match device-sexp
(('uuid type uuid-string)
@@ -206,35 +237,41 @@ (define (sexp->menu-entry sexp)
('label label) ('device device)
('device-mount-point mount-point)
('linux linux) ('linux-arguments linux-arguments)
- ('initrd initrd) _ ...)
+ ('initrd initrd)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(linux linux)
(linux-arguments linux-arguments)
(initrd initrd)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
+ ('device-mount-point mount-point) ('device-subvol subvol)
('multiboot-kernel multiboot-kernel)
('multiboot-arguments multiboot-arguments)
- ('multiboot-modules multiboot-modules) _ ...)
+ ('multiboot-modules multiboot-modules)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(multiboot-kernel multiboot-kernel)
(multiboot-arguments multiboot-arguments)
(multiboot-modules multiboot-modules)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
- ('chain-loader chain-loader) _ ...)
+ ('device-mount-point mount-point) ('device-subvol subvol)
+ ('chain-loader chain-loader)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(chain-loader chain-loader)))))
\f
@@ -247,15 +284,10 @@ (define (sexp->menu-entry sexp)
;; has to be described by this record.
(define-record-type* <bootloader>
- bootloader make-bootloader
- bootloader?
- (name bootloader-name)
- (package bootloader-package)
- (installer bootloader-installer)
- (disk-image-installer bootloader-disk-image-installer
- (default #f))
- (configuration-file bootloader-configuration-file)
- (configuration-file-generator bootloader-configuration-file-generator))
+ bootloader make-bootloader bootloader?
+ (name bootloader-name)
+ (default-targets bootloader-default-targets (default '()))
+ (installer bootloader-installer))
\f
;;;
@@ -450,28 +482,48 @@ (define-syntax with-targets
;; The <bootloader-configuration> record contains bootloader independant
;; configuration used to fill bootloader configuration file.
-(define-with-syntax-properties (warn-target-field-deprecation
- (value properties))
- (when value
- (warning (source-properties->location properties)
- (G_ "the 'target' field is deprecated, please use 'targets' \
-instead~%")))
- value)
+(define-with-syntax-properties (warn-update-targets (value properties))
+ (let ((loc (source-properties->location properties)))
+ (define update
+ (match-lambda
+ ((? bootloader-target? target) (cons #f target))
+ ((? string? s) (cons #t (if (string-prefix? "/dev" s)
+ (bootloader-target
+ (type 'disk)
+ (device s))
+ (bootloader-target
+ (type 'esp)
+ (offset 'root)
+ (path s)))))
+ (x (error loc (G_ "invalid target '~a'~%") x))))
+
+ (let* ((updated (map update (if (list? value) value (list value))))
+ (targets (map cdr updated))
+ (types (map bootloader-target-type targets)))
+ ;; XXX: should this be an error?
+ (when (any car updated)
+ (warning loc (G_ "the 'targets' field should now contain \
+<bootloader-target> records. inferring a best guess (this might break!)...~%")))
+ (when (not (eqv? (length types) (length (delete-duplicates types))))
+ (error loc (G_ "the 'targets' field may not contain duplicates~%")))
+ targets)))
(define-record-type* <bootloader-configuration>
bootloader-configuration make-bootloader-configuration
bootloader-configuration?
(bootloader
- bootloader-configuration-bootloader) ;<bootloader>
- (targets %bootloader-configuration-targets
- (default #f)) ;list of strings
- (target %bootloader-configuration-target ;deprecated
- (default #f)
- (sanitize warn-target-field-deprecation))
+ bootloader-configuration-bootloader) ;<bootloader>
+ (targets bootloader-configuration-targets
+ (default '()) ;list of strings
+ (sanitize warn-update-targets))
(menu-entries bootloader-configuration-menu-entries
(default '())) ;list of <menu-entry>
(default-entry bootloader-configuration-default-entry
(default 0)) ;integer
+ (efi-removable? bootloader-configuration-efi-removable?
+ (default #f)) ;bool
+ (32bit? bootloader-configuration-32bit?
+ (default #f)) ;bool
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
@@ -479,9 +531,9 @@ (define-record-type* <bootloader-configuration>
(theme bootloader-configuration-theme
(default #f)) ;bootloader-specific theme
(terminal-outputs bootloader-configuration-terminal-outputs
- (default '(gfxterm))) ;list of symbols
+ (default #f)) ;list of symbols | #f (default outs)
(terminal-inputs bootloader-configuration-terminal-inputs
- (default '())) ;list of symbols
+ (default #f)) ;list of symbols | #f (default ins)
(serial-unit bootloader-configuration-serial-unit
(default #f)) ;integer | #f
(serial-speed bootloader-configuration-serial-speed
@@ -491,164 +543,140 @@ (define-record-type* <bootloader-configuration>
(extra-initrd bootloader-configuration-extra-initrd
(default #f))) ;string | #f
-(define-deprecated (bootloader-configuration-target config)
- bootloader-configuration-targets
- (%bootloader-configuration-target config))
+\f
+;;;
+;;; Bootloader installation paths.
+;;;
-(define (bootloader-configuration-targets config)
- (or (%bootloader-configuration-targets config)
- ;; TODO: Remove after the deprecated 'target' field is removed.
- (list (%bootloader-configuration-target config))
- ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this
- ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f,
- ;; hence the default value of '(#f) rather than '().
- (list #f)))
+;; highest -> lowest priority
+(define (target-overrides . layers)
+ (let* ((types (fold append '()
+ (map (cute map bootloader-target-type <>) layers)))
+ (pred (lambda (type layer found)
+ (or found (get-target-of-type type layer))))
+ (find (lambda (type) (fold (cute pred type <> <>) #f layers))))
+ (filter ->bool (map find (delete-duplicates types)))))
+
+(define (normalize targets)
+ "Augments user-supplied targets with filesystem information at runtime,
+allowing users to specify a lot less information. Relatively minimal to prevent
+errors. Puts targets into a normal form, where all paths are fully specified up
+to a device offset."
+ (let* ((mass (lambda (m) `((,(mount-source m) . ,m) (,(mount-point m) . ,m))))
+ (amounts (delay (apply append (map mass (mounts)))))
+ (accessible=> (lambda (d f) (and d (access? d R_OK) (f d))))
+ (assoc-mnt (lambda (f) (lambda (v)
+ (and=> (assoc-ref (force amounts) v) f)))))
+
+ (define (scrape target)
+ (match-record target <bootloader-target>
+ (expected? path offset device label uuid file-system)
+ (if expected? target
+ (bootloader-target
+ (inherit target)
+ (device (or device (false-if-exception
+ (or (and=> uuid find-partition-by-uuid)
+ (and=> label find-partition-by-label)))
+ (and path ((assoc-mnt mount-source)
+ (unfold-pathcat target targets)))))
+ (label (or label (accessible=> device read-partition-label)))
+ (uuid (or uuid (accessible=> device read-partition-uuid)))
+ (file-system (or file-system (and=> device (assoc-mnt mount-type))))
+ (offset (and path offset))
+ (path (or path (and=> device (assoc-mnt mount-point))))))))
+
+ (define (fixuuid target)
+ (match-record target <bootloader-target> (uuid file-system)
+ (let ((type (cond ((member file-system '("vfat" "fat32") 'fat))
+ ((string=? file-system "ntfs") 'ntfs)
+ ((string=? file-system "iso9660") 'iso9660)
+ (else 'dce))))
+ (cond ((uuid? uuid) uuid)
+ ((bytevector? uuid) (bytevector->uuid uuid type))
+ ((string? uuid) (string->uuid uuid type))))))
+
+ (define (arborify target targets)
+ (let* ((up (lambda (t) (and t (parent-of t targets))))
+ (proto (unfold target-base? identity up (up target) list))
+ (chain (reverse (cons target proto))))
+ (bootloader-target
+ (inherit target)
+ (offset (and=> (car chain) bootloader-target-type))
+ (path (reduce pathcat #f (map bootloader-target-path (cdr chain)))))))
+
+ (let ((mid (map (compose fixuuid scrape) targets)))
+ (map (cut arborify <> mid) mid))))
+
+(define* (bootloader-configuration->gexp bootloader-config args #:key
+ (root-offset "/") (overrides '()))
+ "Returns a gexp to install BOOTLOADER-CONFIG to its targets, passing ARGS
+to each installer alongside the additional #:bootloader-config keyword
+arguments. Target OVERRIDES are applied and all path targets have ROOT-OFFSET
+applied. The following keyword arguments are expected in ARGS:
+@enumerate
+@item current-boot-alternative
+@item old-boot-alternatives
+@item locale (from bootmeta)
+@item store-directory-prefix (from bootmeta)
+@item store-crypto-devices (from bootmeta)
+@end enumerate"
+ (let* ((bootloader (bootloader-configuration-bootloader bootloader-config))
+ (installer (bootloader-installer bootloader))
+ (auto-targets (list (bootloader-target
+ (type 'root)
+ (path root-offset)
+ (offset #f))))
+ (targets (target-overrides
+ overrides
+ (bootloader-configuration-targets bootloader-config)
+ auto-targets
+ (bootloader-default-targets bootloader)))
+ (conf (bootloader-configuration
+ (inherit bootloader-config)
+ (targets (normalize targets)))))
+ (apply installer #:bootloader-config conf args)))
+
+(define (bootloader-configurations->gexp bootloader-configs . rest)
+ (apply gbegin (filter-map (cut apply bootloader-configuration->gexp <> rest)
+ bootloader-configs)))
\f
-;;;
-;;; Bootloaders.
+=
+;;; EFI shit
;;;
-(define (bootloader-modules)
- "Return the list of bootloader modules."
- ;; don't provide #:warn to prevent mutual imports
- (all-modules (map (lambda (entry)
- `(,entry . "gnu/bootloader"))
- %load-path)))
-
-(define %bootloaders
- ;; The list of publically-known bootloaders.
- (delay (fold-module-public-variables (lambda (obj result)
- (if (bootloader? obj)
- (cons obj result)
- result))
- '()
- (bootloader-modules))))
-
-(define (lookup-bootloader-by-name name)
- "Return the bootloader called NAME."
- (or (find (lambda (bootloader)
- (eq? name (bootloader-name bootloader)))
- (force %bootloaders))
- (leave (G_ "~a: no such bootloader~%") name)))
-
-(define (efi-bootloader-profile packages files hooks)
- "Creates a profile from the lists of PACKAGES and FILES from the store.
-This profile is meant to be used by the bootloader-installer.
-
-FILES is a list of file or directory names from the store, which will be
-symlinked into the profile. If a directory name ends with '/', then the
-directory content instead of the directory itself will be symlinked into the
-profile.
-
-FILES may contain file like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-HOOKS lists additional hook functions to modify the profile."
- (define* (efi-bootloader-profile-hook manifest #:optional system)
- (define build
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules ((guix build utils)
- #:select (mkdir-p strip-store-file-name))
- ((ice-9 ftw)
- #:select (scandir))
- ((srfi srfi-1)
- #:select (append-map every remove))
- ((srfi srfi-26)
- #:select (cut)))
- (define (symlink-to file directory transform)
- "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
- (symlink file (string-append directory "/" (transform file))))
- (define (directory-content directory)
- "Creates a list of absolute path names inside DIRECTORY."
- (map (lambda (name)
- (string-append directory name))
- (or (scandir directory (lambda (name)
- (not (member name '("." "..")))))
- '())))
- (define name-ends-with-/? (cut string-suffix? "/" <>))
- (define (name-is-store-entry? name)
- "Return #t if NAME is a direct store entry and nothing inside."
- (not (string-index (strip-store-file-name name) #\/)))
- (let* ((files '#$files)
- (directories (filter name-ends-with-/? files))
- (names-from-directories
- (append-map (lambda (directory)
- (directory-content directory))
- directories))
- (names (append names-from-directories
- (remove name-ends-with-/? files))))
- (mkdir-p #$output)
- (if (every file-exists? names)
- (begin
- (for-each (lambda (name)
- (symlink-to name #$output
- (if (name-is-store-entry? name)
- strip-store-file-name
- basename)))
- names)
- #t)
- #f)))))
-
- (gexp->derivation "efi-bootloader-profile"
- build
- #:system system
- #:local-build? #t
- #:substitutable? #f
- #:properties
- `((type . profile-hook)
- (hook . efi-bootloader-profile-hook))))
-
- (profile (content (packages->manifest packages))
- (name "efi-bootloader-profile")
- (hooks (cons efi-bootloader-profile-hook hooks))
- (locales? #f)
- (allow-collisions? #f)
- (relative-symlinks? #f)))
-
-(define* (efi-bootloader-chain final-bootloader
- #:key
- (packages '())
- (files '())
- (hooks '())
- installer
- disk-image-installer)
- "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES,
-and optional directories and files from the store given in the list of FILES.
-
-The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
-in an efi-bootloader-profile, which will be passed to the INSTALLER.
-
-FILES may contain file-like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-If a directory name in FILES ends with '/', then the directory content instead
-of the directory itself will be symlinked into the efi-bootloader-profile.
-
-The procedures in the HOOKS list can be used to further modify the bootloader
-profile. It is possible to pass a single function instead of a list.
-
-If the INSTALLER argument is used, then this gexp procedure will be called to
-install the efi-bootloader-profile. Otherwise the installer of the
-FINAL-BOOTLOADER will be called.
-
-If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
-to install the efi-bootloader-profile into a disk image. Otherwise the
-disk-image-installer of the FINAL-BOOTLOADER will be called."
- (bootloader
- (inherit final-bootloader)
- (name "efi-bootloader-chain")
- (package
- (efi-bootloader-profile (cons (bootloader-package final-bootloader)
- packages)
- files
- (if (list? hooks)
- hooks
- (list hooks))))
- (installer
- (or installer
- (bootloader-installer final-bootloader)))
- (disk-image-installer
- (or disk-image-installer
- (bootloader-disk-image-installer final-bootloader)))))
+(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
+ (32? #f))
+ "Returns the UEFI architecture name for the current target, in lowercase."
+ (cond ((target-x86-32? target) "ia32")
+ ((target-x86-64? target) (if 32? "ia32" "x64"))
+ ((target-arm32? target) "arm")
+ ((target-aarch64? target) (if 32? "arm" "aa64"))
+ ((target-riscv64? target) (if 32? "riscv32" "riscv64"))
+ (else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
+ target)))))
+
+(define (install-efi bootloader-config plan)
+ "Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
+PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
+should be in boot order. If the user selects a removable bootloader, only the
+first entry in PLAN is used."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets efi-removable? 32bit?)
+ (if efi-removable?
+ ;; Hard code the output location to a well-known path recognized by
+ ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
+ ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
+ (with-targets targets
+ (('esp => (path :path))
+ #~(let ((boot #$(string-append path "/EFI/BOOT"))
+ (arch #$(string-upcase (efi-arch #:32? 32bit?)))
+ (builder (car (car #$plan))))
+ (mkdir-p boot)
+ ;; only realize first planspec
+ (builder (string-append boot "/BOOT" arch ".EFI")))))
+ ;; normal install when not doing a removable config
+ (with-targets targets
+ (('vendir => (vendir :path) (loader :devpath) (disk :device))
+ #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm
index 0a50374bd9..ad29f5d5e4 100644
--- a/gnu/bootloader/depthcharge.scm
+++ b/gnu/bootloader/depthcharge.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,92 +18,86 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader depthcharge)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:use-module (ice-9 match)
- #:export (depthcharge-bootloader))
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
+ #:export (depthcharge-veyron-speedy-bootloader
+ depthcharge-bootloader))
-(define (signed-kernel kernel kernel-arguments initrd)
- (define builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 binary-ports)
- (rnrs bytevectors))
- (set-path-environment-variable "PATH" '("bin") (list #$dtc))
+(define* (install-depthcharge arch dtb
+ #:key bootloader-config current-boot-alternative
+ #:allow-other-keys)
+ (when (not (null? (bootloader-configuration-menu-entries bootloader-config)))
+ (raise (formatted-message
+ (G_ "extra menu-entries are not supported for depthcharge!"))))
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ;; use 'part instead of 'disk, cause we write an image directly into a
+ ;; partition instead of the extra-partition disk space
+ (('part => (disk :device))
+ (match-record (boot-alternative->menu-entry current-boot-alternative)
+ <menu-entry> (linux linux-arguments initrd)
+ #~(begin
+ (use-modules (ice-9 binary-ports) (rnrs bytevectors))
+ (set-path-environment-variable "PATH" '("bin") (list #$dtc))
- ;; TODO: These files have to be writable, so we copy them.
- ;; This can probably be fixed by using a ".its" file, just
- ;; be careful not to break initrd loading.
- (copy-file #$kernel "zImage")
- (chmod "zImage" #o755)
- (copy-file (string-append (dirname #$kernel) "/lib/dtbs/"
- "rk3288-veyron-speedy.dtb")
- "rk3288-veyron-speedy.dtb")
- (chmod "rk3288-veyron-speedy.dtb" #o644)
- (copy-file #$initrd "initrd")
- (chmod "initrd" #o644)
+ ;; TODO: These files have to be writable, so we copy them.
+ ;; This can probably be fixed by using a ".its" file, just
+ ;; be careful not to break initrd loading.
+ (copy-file #$linux "zImage")
+ (chmod "zImage" #o755)
+ (copy-file (string-append (dirname #$linux) "/lib/dtbs/" #$dtb)
+ "dtb")
+ (chmod "dtb" #o644)
+ (copy-file #$initrd "initrd")
+ (chmod "initrd" #o644)
- (invoke (string-append #$u-boot-tools "/bin/mkimage")
- "-D" "-I dts -O dtb -p 2048"
- "-f" "auto"
- "-A" "arm"
- "-O" "linux"
- "-T" "kernel"
- "-C" "None"
- "-d" "zImage"
- "-a" "0"
- "-b" "rk3288-veyron-speedy.dtb"
- "-i" "initrd"
- "image.itb")
- (call-with-output-file "bootloader.bin"
- (lambda (port)
- (put-bytevector port (make-bytevector 512 0))))
- (with-output-to-file "kernel-arguments"
- (lambda ()
- (display (string-join (list #$@kernel-arguments)))))
- (invoke (string-append #$vboot-utils "/bin/vbutil_kernel")
- "--pack" #$output
- "--version" "1"
- "--vmlinuz" "image.itb"
- "--arch" "arm"
- "--keyblock" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel.keyblock")
- "--signprivate" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel_data_key.vbprivk")
- "--config" "kernel-arguments"
- "--bootloader" "bootloader.bin"))))
- (computed-file "vmlinux.kpart" builder))
+ (invoke #+(file-append u-boot-tools "/bin/mkimage")
+ "-D" "-I dts -O dtb -p 2048"
+ "-f" "auto" ; format
+ "-A" #$arch ; architecture
+ "-O" "linux" ; os
+ "-T" "kernel" ; image type
+ "-C" "None" ; compression
+ "-d" "zImage" ; image data
+ "-a" "0" ; load address (hex)
+ "-b" "dtb" ; dtb for device
+ "-i" "initrd" ; initrd
+ "image.itb")
+ (call-with-output-file "bootloader.bin"
+ (lambda (port)
+ (put-bytevector port (make-bytevector 512 0))))
+ (call-with-output-file "kernel-arguments"
+ (lambda (port)
+ (display (string-join (list #$@linux-arguments)) port)))
+ (invoke #+(file-append vboot-utils "/bin/vbutil_kernel")
+ "--version" "1"
+ "--vmlinuz" "image.itb"
+ "--arch" #$arch
+ "--keyblock"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel.keyblock")
+ "--signprivate"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel_data_key.vbprivk")
+ "--config" "kernel-arguments"
+ "--pack" "vmlinux.kpart")
+ (write-file-on-device "vmlinux.kpart"
+ (stat:size (stat "vmlinux.kpart"))
+ #$disk 0))))))
-(define* (depthcharge-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- (match entries
- ((entry)
- (let ((kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- ;; XXX: Make this a symlink.
- (signed-kernel kernel kernel-arguments initrd)))
- (_ (error "Too many bootloader menu entries!"))))
-
-(define install-depthcharge
- #~(lambda (bootloader device mount-point)
- (let ((kpart (string-append mount-point
- "/boot/depthcharge/vmlinux.kpart")))
- (write-file-on-device kpart (stat:size (stat kpart)) device 0))))
-
-(define depthcharge-bootloader
+(define depthcharge-veyron-speedy-bootloader
(bootloader
(name 'depthcharge)
- (package #f)
- (installer install-depthcharge)
- (configuration-file "/boot/depthcharge/vmlinux.kpart")
- (configuration-file-generator depthcharge-configuration-file)))
+ (installer (cute install-depthcharge "arm" "rk3288-veyron-speedy.dtb"
+ <...>))))
+
+(define-deprecated/alias depthcharge-bootloader
+ depthcharge-veyron-speedy-bootloader)
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index d9b6d8bf8a..c3ab6f3275 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,112 +22,102 @@
(define-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:export (extlinux-bootloader
+ #:export (install-extlinux-config ; for u-boot
+ extlinux-bootloader
+ extlinux-gpt-bootloader
extlinux-bootloader-gpt))
-(define* (extlinux-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- "Return the U-Boot configuration file corresponding to CONFIG, a
-<u-boot-configuration> object, and where the store is available at STORE-FS, a
-<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
-corresponding to old generations of the system."
-
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
-
- (define with-fdtdir?
- (bootloader-configuration-device-tree-support? config))
+\f
+;;;
+;;; Config procedures.
+;;;
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- #~(format port "LABEL ~a
+(define* (install-extlinux-config #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ "Installer for the extlinux configuration file, meant to be shared by all
+bootloaders that use the format to specify boot options."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets menu-entries device-tree-support? timeout)
+ (define (menu-entry->gexp entry)
+ (match-record entry <menu-entry> (label linux linux-arguments initrd)
+ (let* ((normkern (normalize-file entry linux))
+ (fdt #~(string-append "FDTDIR" (dirname #$normkern) "/lib/dtbs")))
+ #~(format port "LABEL ~a
MENU LABEL ~a
KERNEL ~a
~a
INITRD ~a
APPEND ~a
-~%"
- #$label #$label
- #$kernel
- (if #$with-fdtdir?
- (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
- "")
- #$initrd
- (string-join (list #$@kernel-arguments)))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (let ((timeout #$(bootloader-configuration-timeout config)))
- (format port "# This file was generated from your Guix configuration. Any changes
+~%" #$label #$label #$normkern
+ #$(if device-tree-support? fdt "")
+ #$(normalize-file entry initrd)
+ (string-join (list #$@linux-arguments))))))
+
+ (let ((ents (cons (boot-alternative->menu-entry current-boot-alternative)
+ (append menu-entries
+ (map boot-alternative->menu-entry old-boot-alternatives)))))
+ (with-targets targets
+ (('extlinux => (path :path))
+ #~(begin (mkdir-p #$path)
+ (call-with-output-file #$path
+ (lambda (port)
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
# will be lost upon reconfiguration.
UI menu.c32
MENU TITLE GNU Guix Boot Options
PROMPT ~a
-TIMEOUT ~a~%"
- (if (> timeout 0) 1 0)
- ;; timeout is expressed in 1/10s of seconds.
- (* 10 timeout))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "~%"))
- #~())))))
-
- (computed-file "extlinux.conf" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-
+TIMEOUT ~a~%" ;; timeout is expressed in tenths of a second
+ #$(if (> timeout 0) 1 0) #$(* 10 timeout))
+ #$@(map menu-entry->gexp ents)))))))))
\f
-
;;;
-;;; Install procedures.
+;;; Install procedure.
;;;
(define (install-extlinux mbr)
- #~(lambda (bootloader device mount-point)
- (let ((extlinux (string-append bootloader "/sbin/extlinux"))
- (install-dir (string-append mount-point "/boot/extlinux"))
- (syslinux-dir (string-append bootloader "/share/syslinux")))
- (for-each (lambda (file)
- (install-file file install-dir))
- (find-files syslinux-dir "\\.c32$"))
- (invoke/quiet extlinux "--install" install-dir)
- (write-file-on-device (string-append syslinux-dir "/" #$mbr)
- 440 device 0))))
-
-(define install-extlinux-mbr
- (install-extlinux "mbr.bin"))
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('extlinux => (path :path))
+ #~(begin
+ #$(apply install-extlinux-config args)
+ (copy-recursively #$(file-append syslinux "/share/syslinux") #$path)
+ (invoke/quiet #+(file-append syslinux "/sbin/extlinux")
+ "--install" #$path)))
+ (('disk => (disk :device))
+ #~(write-file-on-device #$(file-append syslinux "/share/syslinux/" mbr)
+ 440 #$disk 0)))))
-(define install-extlinux-gpt
- (install-extlinux "gptmbr.bin"))
\f
-
;;;
;;; Bootloader definitions.
;;;
(define extlinux-bootloader
(bootloader
- (name 'extlinux)
- (package syslinux)
- (installer install-extlinux-mbr)
- (configuration-file "/boot/extlinux/extlinux.conf")
- (configuration-file-generator extlinux-configuration-file)))
-
-(define extlinux-bootloader-gpt
+ (name 'extlinux)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (install-extlinux "mbr.bin"))))
+
+(define extlinux-gpt-bootloader
(bootloader
- (inherit extlinux-bootloader)
- (installer install-extlinux-gpt)))
+ (inherit extlinux-bootloader)
+ (installer (install-extlinux "gptmbr.bin"))))
+
+(define-deprecated/alias extlinux-bootloader-gpt extlinux-gpt-bootloader)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..71fcc90ec7 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,24 +28,26 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader grub)
- #:use-module (guix build union)
- #:use-module (guix records)
- #:use-module (guix store)
- #:use-module (guix utils)
- #:use-module (guix gexp)
#:use-module (gnu artwork)
#:use-module (gnu bootloader)
- #:use-module (gnu system uuid)
- #:use-module (gnu system file-systems)
- #:use-module (gnu system keyboard)
- #:use-module (gnu system locale)
#:use-module (gnu packages bootloaders)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
#:autoload (gnu packages xorg) (xkeyboard-config)
+ #:use-module (gnu system boot)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system keyboard)
+ #:use-module (gnu system locale)
+ #:use-module (gnu system uuid)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (guix utils)
#:use-module (ice-9 match)
- #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
#:export (grub-theme
grub-theme?
grub-theme-image
@@ -53,54 +56,109 @@ (define-module (gnu bootloader grub)
grub-theme-color-highlight
grub-theme-gfxmode
- install-grub-efi-removable
- make-grub-efi-netboot-installer
-
+ grub.dir ; for (gnu build image) iso9660 images
grub-bootloader
+ grub-minimal-bootloader
grub-efi-bootloader
+ ;; deprecated
grub-efi-removable-bootloader
grub-efi32-bootloader
grub-efi-netboot-bootloader
- grub-efi-netboot-removable-bootloader
- grub-mkrescue-bootloader
- grub-minimal-bootloader
+ grub-efi-netboot-removable-bootloader))
- grub-configuration))
-
-;;; Commentary:
+\f
;;;
-;;; Configuration of GNU GRUB.
+;;; General utils.
;;;
-;;; Code:
-(define* (normalize-file file mount-point store-directory-prefix)
- "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
-G-expression or other lowerable object denoting a file name."
+;; in-gexp procedure to sanitize a value to be inserted into a GRUB script
+(define (sanitize str)
+ "Sanitize a value for use in a GRUB script."
+ #~(let* ((glycerin (lambda (l r) (if (pair? l) (append l r) (cons l r))))
+ (isopropyl (lambda (c) (case c ((#\\ #\$ #\") '(#\\ ,c)) (else c)))))
+ (use-modules (srfi srfi-1))
+ (list->string (fold-right glycerin '()
+ (map isopropyl (string->list #$str))))))
- (define (strip-mount-point mount-point file)
- (if mount-point
- (if (string=? mount-point "/")
- file
- #~(let ((file #$file))
- (if (string-prefix? #$mount-point file)
- (substring #$file #$(string-length mount-point))
- file)))
- file))
- (define (prepend-store-directory-prefix store-directory-prefix file)
- (if store-directory-prefix
- #~(string-append #$store-directory-prefix #$file)
- file))
- (prepend-store-directory-prefix store-directory-prefix
- (strip-mount-point mount-point file)))
+(define (grub-format type 32?)
+ (string-append
+ (cond ((string-prefix? "pc" type) "i386")
+ ((target-x86-32?) "i386")
+ ((target-x86-64?) (if 32? "i386" "x86_64"))
+ ((target-arm32?) "arm")
+ ((target-aarch64?) (if 32? "arm" "arm64"))
+ ((target-powerpc?) "powerpc")
+ ((target-riscv64?) "riscv64")
+ (else (raise (formatted-message (G_ "unrecognized target arch '~a'!")
+ (or (%current-target-system) (%current-system))))))
+ "-" type))
+(define* (search/target type targets var #:optional (port #f))
+ "Returns a gexp of a GRUB search command for target TYPE, storing the result
+in VAR. Optionally outputs to the gexp PORT instead of returning a string."
+ (define (form name val)
+ #~(format #$port "search.~a \"~a\" ~a~%" #$name #$val #$var))
+ (with-targets targets
+ ((type => (path :devpath) (device :device) (fs :fs)
+ (label :label) (uuid :uuid))
+ (cond ((member fs '("tftp" "nfs")) #~(format #$port "set ~a=tftp~%" #$var))
+ (uuid (form "fs_uuid" (uuid->string uuid)))
+ (label (form "fs_label" label))
+ (else (form "file" (sanitize path)))))))
+
+
+
+(define* (search/menu-entry device file var #:optional (port #f))
+ "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
+a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
+code to set the variable VAR. This procedure is able to handle DEVICEs
+unmounted at evaltime."
+ (match device
+ ;; Preferably refer to DEVICE by its UUID or label. This is more
+ ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
+ ((? uuid? idfk) ; calling idfk uuid here errors for some reason
+ #~(format #$port "search.fs_uuid ~a ~a~%" #$(uuid->string device) #$var))
+ ((? file-system-label? label)
+ #~(format #$port "search.fs_label \"~a\" ~a~%"
+ #$(sanitize (file-system-label->string label)) #$var))
+ ((? (lambda (device)
+ (and (string? device) (string-contains device ":/"))) nfs-uri)
+ ;; If the device is an NFS share, then we assume that the expected
+ ;; file on that device (e.g. the GRUB background image or the kernel)
+ ;; has to be loaded over the network. Otherwise we would need an
+ ;; additional device information for some local disk to look for that
+ ;; file, which we do not have.
+ ;;
+ ;; TFTP is preferred to HTTP because it is used more widely and
+ ;; specified in standards more widely--especially BOOTP/DHCPv4
+ ;; defines a TFTP server for DHCP option 66, but not HTTP.
+ ;;
+ ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
+ ;; which can contain a HTTP or TFTP URL.
+ ;;
+ ;; Note: It is assumed that the file paths are of a similar
+ ;; setup on both the TFTP server and the NFS server (it is
+ ;; not possible to search for files on TFTP).
+ ;;
+ ;; TODO: Allow HTTP.
+ #~(format #$port "set ~a=tftp~%" #$var))
+ ((or #f (? string?))
+ #~(format #$port "search.file \"~a\" ~a~%" #$(sanitize file) #$var))))
+
+
+
+\f
+;;;
+;;; Theming.
+;;;
+
(define-record-type* <grub-theme>
;; Default theme contributed by Felipe López.
- grub-theme make-grub-theme
- grub-theme?
+ grub-theme make-grub-theme grub-theme?
(image grub-theme-image
(default (file-append %artwork-repository
"/grub/GuixSD-fully-black-4-3.svg")))
@@ -113,128 +171,274 @@ (define-record-type* <grub-theme>
(gfxmode grub-theme-gfxmode
(default '("auto")))) ;list of string
+(define (grub-theme-png theme)
+ "Return the GRUB background image defined in THEME. If the suffix of the
+image file is \".svg\", then it is converted into a PNG file with the
+resolution provided in CONFIG. Returns #f if no file is provided."
+ (match-record theme <grub-theme> (image resolution)
+ (match resolution
+ (((? number? width) . (? number? height))
+ (computed-file "grub-image.png"
+ (with-imported-modules '((gnu build svg) (guix build utils))
+ (with-extensions (list guile-rsvg guile-cairo)
+ #~(begin (use-modules (gnu build svg) (guix build utils))
+ (if (png-file? #$image) (copy-file #$image #$output)
+ (svg->png #$image #$output
+ #:width #$width
+ #:height #$height)))))))
+ (_ image))))
+
+
+
\f
;;;
-;;; Background image & themes.
+;;; Core config.
+;;; GRUB architecture works by having a bootstage load up a core.img, which then
+;;; sets the root and prefix variables, allowing grub to load its main config
+;;; and modules, and then enter normal mode. On i386-pc systems a boot.img is
+;;; flashed which loads the core.img from the MBR gap, but on efi systems the
+;;; core.img is just a PE executable, able to be booted directly. We set up a
+;;; minimal core.img capable of finding the user-configured 'install target to
+;;; load its config from there.
;;;
-(define (bootloader-theme config)
- "Return user defined theme in CONFIG if defined or a default theme
-otherwise."
- (or (bootloader-configuration-theme config) (grub-theme)))
-
-(define* (image->png image #:key width height)
- "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\".
-Otherwise the picture in IMAGE is just copied."
- (computed-file "grub-image.png"
- (with-imported-modules '((gnu build svg))
- (with-extensions (list guile-rsvg guile-cairo)
- #~(if (string-suffix? ".svg" #+image)
- (begin
- (use-modules (gnu build svg))
- (svg->png #+image #$output
- #:width #$width
- #:height #$height))
- (copy-file #+image #$output))))))
-
-(define* (grub-background-image config)
- "Return the GRUB background image defined in CONFIG or #f if none was found.
-If the suffix of the image file is \".svg\", then it is converted into a PNG
-file with the resolution provided in CONFIG."
- (let* ((theme (bootloader-theme config))
- (image (grub-theme-image theme)))
- (and image
- (match (grub-theme-resolution theme)
- (((? number? width) . (? number? height))
- (image->png image #:width width #:height height))
- (_ #f)))))
-
-(define (grub-locale-directory grub)
- "Generate a directory with the locales from GRUB."
- (define builder
- #~(begin
- (use-modules (ice-9 ftw))
- (let ((locale (string-append #$grub "/share/locale"))
- (out #$output))
- (mkdir out)
- (chdir out)
- (for-each (lambda (lang)
- (let ((file (string-append locale "/" lang
- "/LC_MESSAGES/grub.mo"))
- (dest (string-append lang ".mo")))
- (when (file-exists? file)
- (copy-file file dest))))
- (scandir locale)))))
- (computed-file "grub-locales" builder))
-
-(define* (eye-candy config store-device store-mount-point
- #:key store-directory-prefix port)
- "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
-concerned with graphics mode, background images, colors, and all that.
-STORE-DEVICE designates the device holding the store, and STORE-MOUNT-POINT is
-its mount point; these are used to determine where the background image and
-fonts must be searched for. STORE-DIRECTORY-PREFIX is a directory prefix to
-prepend to any store file name."
- (define (setup-gfxterm config)
- (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
- #~(format #f "
+(define (core.cfg targets store-crypto-devices)
+ "Returns a filelike object for a core configuration file good enough to
+decrypt STORE-CRYPTO-DEVICES and boot to normal."
+ (define (crypto-device->cryptomount dev)
+ (and (uuid? dev) ; ignore non-uuids - warning given by os
+ #~(format port "cryptomount -u ~a~%"
+ ;; cryptomount only accepts UUID without the hyphen.
+ #$(string-delete #\- (uuid->string dev)))))
+
+ (and=>
+ (with-targets targets
+ (('install => (path :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ #$@(filter ->bool
+ (map crypto-device->cryptomount store-crypto-devices))
+ #$(search/target 'install targets "root" #~port)
+ (format port "set \"prefix=($root)~a\"~%" #$(sanitize path))))))
+ (cut computed-file "core.cfg" <>)))
+
+
+
+;; TODO: do we need LVM support here?
+(define* (core.img grub format #:key bootloader-config store-crypto-devices
+ #:allow-other-keys)
+ "The core image for GRUB, built for FORMAT."
+ (let* ((targets (bootloader-configuration-targets bootloader-config))
+ (bios? (string-prefix? format "pc"))
+ (efi? (string=? format "efi"))
+ (32? (bootloader-configuration-32bit? bootloader-config))
+ (cfg (core.cfg targets store-crypto-devices)))
+ (and cfg
+ (and=>
+ (with-targets targets
+ (('install => (fs :fs))
+ (let ((tftp? (or (string=? fs "tftp") (string=? fs "nfs"))))
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils) (ice-9 textual-ports)
+ (srfi srfi-1))
+ (apply invoke #$(file-append grub "/bin/grub-mkimage")
+ "--output" #$output
+ "--config" #$cfg
+ "--prefix" "none" ; we override this in cfg
+ ;; bios pxe uses pxeboot instead of diskboot - diff format
+ "--format" #$(string-append (grub-format format 32?)
+ (if (and bios? tftp?) "-pxe" ""))
+ "--compression" "auto"
+ ;; modules
+ "minicmd"
+ (append
+ ;; disk drivers
+ '#$(if bios? '("biosdisk") '())
+ ;; partmaps (TODO: detect which to use?)
+ '#$(if tftp? '() '("part_msdos" "part_gpt"))
+ ;; file systems
+ '#$(cond ((member fs '("ext2" "ext3" "ext4")) '("ext2"))
+ ((member fs "vfat" "fat32") "fat")
+ ((and tftp? efi?) "efinet")
+ ((and tftp? bios?) "pxe")
+ (else (list fs)))
+ ;; store crypto devs
+ '#$(if (any uuid? store-crypto-devices)
+ '("luks" "luks2" "cryptomount") '())
+ ;; search module that cfg uses
+ (call-with-input-file #$cfg
+ (lambda (port)
+ (let* ((str (get-string-all port))
+ (use (lambda (s) (string-contains str s))))
+ (cond ((use "search.fs_uuid") '("search_fs_uuid"))
+ ((use "search.fs_label") '("search_label"))
+ ((use "search.file") '("search_fs_file"))
+ (else '()))))))))))))
+ (cut computed-file "core.img" <>
+ #:options '(#:local-build? #t #:substitutable? #f))))))
+
+
+
+\f
+;;;
+;;; Main config.
+;;; This is what does the heavy lifting after core.img finds it.
+;;;
+
+(define (menu-entry->gexp store extra-initrd port)
+ (lambda (entry)
+ (match-record entry <menu-entry>
+ (label device linux linux-arguments initrd
+ multiboot-kernel multiboot-arguments multiboot-modules chain-loader)
+ (let ((norm (compose sanitize (cut normalize-file entry <>))))
+ #~(begin
+ (format #$port "menuentry ~s {~% " #$label)
+ #$(search/menu-entry
+ device (or linux multiboot-kernel chain-loader) "boot" port)
+ #$@(cond
+ (linux
+ (list #~(format #$port " linux \"($boot)~a\" ~a~%"
+ #$(norm linux)
+ ;; grub passes rest of the line _verbatim_
+ (string-join (list #$@linux-arguments)))
+ #~(format #$port " initrd ~a \"($boot)~a\"~%"
+ (if #$extra-initrd (string-append "($boot)\""
+ (norm #$extra-initrd) "\"")
+ "")
+ #$(norm initrd))))
+ ;; previously, this provided a (wrong) root= argument. just
+ ;; don't bother anymore. better less info than wrong info
+ (multiboot-kernel
+ (cons #~(format #$port " multiboot \"($boot)~a\" ~a~%"
+ #$(norm multiboot-kernel)
+ (string-join (list #$@multiboot-arguments)))
+ (map (lambda (mod) #~(format port " module \"($boot)~a\"~%"
+ #$(norm mod)))
+ multiboot-modules)))
+ (chain-loader
+ (list #~(format #$port " chainloader \"~a\"~%"
+ #$(norm chain-loader)))))
+ (format #$port "}~%"))))))
+
+
+
+(define* (grub.cfg #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ locale
+ store-directory-prefix
+ #:allow-other-keys)
+ "Returns a valid grub config given installer inputs. Expects locales, keymap,
+and theme image at LOCALES-TARG, KEYMAP-TARG, and IMAGE-TARG, respectively."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match keyboard-layout here cause it's bound to its struct
+ (targets menu-entries default-entry timeout extra-initrd
+ theme terminal-outputs terminal-inputs serial-unit serial-speed)
+ (let* ((entry->gexp (menu-entry->gexp store-directory-prefix
+ extra-initrd #~port))
+ (terms->str (compose string-join (cut map symbol->string <>)))
+ (colors->str (lambda (c) (format #f "~a/~a" (assoc-ref c 'fg)
+ (assoc-ref c 'bg))))
+ (outputs (or terminal-outputs '(gfxterm))) ; set default outs
+ (inputs (or terminal-inputs '())) ; set default ins
+ (theme (or theme (grub-theme))))
+ (and=>
+ (with-targets targets
+ (('install => (install :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ ;; preamble
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
+# will be lost upon reconfiguration~%")
+ #$@(filter ->bool
+ (list
+ ;; menu settings
+ (and default-entry
+ #~(format port "set default=~a~%" #$default-entry))
+ (and timeout
+ #~(format port "set timeout=~a~%" #$timeout))
+ ;; gfxterm setup
+ (and (memq 'gfxterm outputs)
+ #~(format port "\
if loadfont unicode; then
set gfxmode=~a
insmod all_video
insmod gfxterm
-fi~%"
- #$(string-join
- (grub-theme-gfxmode (bootloader-theme config))
- ";"))
- ""))
-
- (define (theme-colors type)
- (let* ((theme (bootloader-theme config))
- (colors (type theme)))
- (string-append (symbol->string (assoc-ref colors 'fg)) "/"
- (symbol->string (assoc-ref colors 'bg)))))
-
- (define image
- (normalize-file (grub-background-image config)
- store-mount-point
- store-directory-prefix))
-
- (and image
- #~(format #$port "
-# Set 'root' to the partition that contains /gnu/store.
-~a
-
-~a
-~a
-
+fi~%" #$(string-join (grub-theme-gfxmode theme) ";")))
+ ;; io
+ (and (or serial-unit serial-speed)
+ #~(format port "serial --unit=~a --speed=~a~%"
+ ;; documented defaults are unit 0 at 9600 baud.
+ #$(number->string (or serial-unit 0))
+ #$(number->string (or serial-speed 9600))))
+ (and (pair? outputs)
+ #~(format port "terminal_output ~a~%"
+ #$(terms->str outputs)))
+ (and (pair? inputs)
+ #~(format port "terminal_input ~a~%"
+ #$(terms->str inputs)))
+ ;; locale
+ (and locale
+ #~(format port "\
+set \"locale_dir=($root)~a/locales\"
+set lang=~a~%" #$(sanitize install)
+ #$(locale-definition-source
+ (locale-name->definition locale))))
+ ;; keyboard layout
+ (and (bootloader-configuration-keyboard-layout
+ bootloader-config)
+ #~(format port "\
+insmod keylayouts
+keymap \"($root)~a/keymap~%\"" #$(sanitize install)))
+ ;; theme
+ (match-record theme <grub-theme>
+ (image color-normal color-highlight)
+ (and image
+ #~(format port "\
insmod png
-if background_image ~a; then
+if background_image \"($root)~a/image.png\"; then
set color_normal=~a
set color_highlight=~a
else
set menu_color_normal=cyan/blue
- set menu_color_highlight=white/blue
-fi~%"
- #$(grub-root-search store-device image)
- #$(setup-gfxterm config)
- #$(grub-setup-io config)
+ set menu_color_highlight=whiute/blue
+fi~%" #$(sanitize install)
+ #$(colors->str color-normal)
+ #$(colors->str color-highlight))))))
+ ;; menu entries
+ #$(entry->gexp
+ (boot-alternative->menu-entry current-boot-alternative))
+ #$@(map entry->gexp menu-entries)
+ #$@(if (pair? old-boot-alternatives)
+ (append (list #~(format port "submenu ~s {~%"
+ "GNU system, old configurations..."))
+ (map (compose entry->gexp
+ boot-alternative->menu-entry)
+ old-boot-alternatives)
+ (list #~(format port "}~%"))) '())
+ (format port "
+if [ \"${grub_platform}\" == efi ]; then
+ menuentry \"Firmware setup\" {
+ fwsetup
+ }
+fi~%")))))
+ (cut computed-file "grub.cfg" <>
+ ;; Since this file is rather unique, there's no point in trying to
+ ;; substitute it.
+ #:options '(#:local-build? #t #:substitutable? #f))))))
- #$image
- #$(theme-colors grub-theme-color-normal)
- #$(theme-colors grub-theme-color-highlight))))
-\f
-;;;
-;;; Configuration file.
-;;;
-(define* (keyboard-layout-file layout
- #:key
- (grub grub))
+(define (keyboard-layout-file layout grub)
"Process the X keyboard layout description LAYOUT, a <keyboard-layout> record,
and return a file in the format for GRUB keymaps. LAYOUT must be present in
the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
- (define builder
+ (computed-file
+ (string-append "grub-keymap."
+ (string-map (match-lambda (#\, #\-) (chr chr))
+ (keyboard-layout-name layout)))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
@@ -243,670 +447,175 @@ (define* (keyboard-layout-file layout
;; (from the 'console-setup' package).
(invoke #+(file-append grub "/bin/grub-mklayout")
"-i" #+(keyboard-layout->console-keymap layout)
- "-o" #$output))))
-
- (computed-file (string-append "grub-keymap."
- (string-map (match-lambda
- (#\, #\-)
- (chr chr))
- (keyboard-layout-name layout)))
- builder))
-
-(define (grub-setup-io config)
- "Return GRUB commands to configure the input / output interfaces. The result
-is a string that can be inserted in grub.cfg."
- (let* ((symbols->string (lambda (list)
- (string-join (map symbol->string list) " ")))
- (outputs (bootloader-configuration-terminal-outputs config))
- (inputs (bootloader-configuration-terminal-inputs config))
- (unit (bootloader-configuration-serial-unit config))
- (speed (bootloader-configuration-serial-speed config))
-
- ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
- ;; as documented in GRUB manual section "Simple Configuration
- ;; Handling".
- (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
- gfxterm vga_text mda_text morse spkmodem))
- (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
- at_keyboard usb_keyboard))
-
- (io (string-append
- ;; UNIT and SPEED are arguments to the same GRUB command
- ;; ("serial"), so we process them together.
- (if (or unit speed)
- (string-append
- "serial"
- (if unit
- ;; COM ports 1 through 4
- (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
- (string-append " --unit=" (number->string unit))
- #f)
- "")
- (if speed
- (if (exact-integer? speed)
- (string-append " --speed=" (number->string speed))
- #f)
- "")
- "\n")
- "")
- (if (null? inputs)
- ""
- (string-append
- "terminal_input "
- (symbols->string
- (map
- (lambda (input)
- (if (memq input valid-inputs) input #f)) inputs))
- "\n"))
- "terminal_output "
- (symbols->string
- (map
- (lambda (output)
- (if (memq output valid-outputs) output #f)) outputs)))))
- (format #f "~a" io)))
-
-(define (grub-root-search device file)
- "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
-a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
-code."
- ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
- ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
- ;; custom menu entries. In the latter case, don't emit a 'search' command.
- (if (and (string? file) (not (string-prefix? "/" file)))
- ""
- (match device
- ;; Preferably refer to DEVICE by its UUID or label. This is more
- ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
- ((? uuid? uuid)
- (format #f "search --fs-uuid --set ~a"
- (uuid->string device)))
- ((? file-system-label? label)
- (format #f "search --label --set ~a"
- (file-system-label->string label)))
- ((? (lambda (device)
- (and (string? device) (string-contains device ":/"))) nfs-uri)
- ;; If the device is an NFS share, then we assume that the expected
- ;; file on that device (e.g. the GRUB background image or the kernel)
- ;; has to be loaded over the network. Otherwise we would need an
- ;; additional device information for some local disk to look for that
- ;; file, which we do not have.
- ;;
- ;; We explicitly set "root=(tftp)" here even though if grub.cfg
- ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
- ;; automatically anyway. The reason is if you have a system that
- ;; used to be on NFS but now is local, root would be set to local
- ;; disk. If you then selected an older system generation that is
- ;; supposed to boot from network in the Grub boot menu, Grub still
- ;; wouldn't load those files from network otherwise.
- ;;
- ;; TFTP is preferred to HTTP because it is used more widely and
- ;; specified in standards more widely--especially BOOTP/DHCPv4
- ;; defines a TFTP server for DHCP option 66, but not HTTP.
- ;;
- ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
- ;; which can contain a HTTP or TFTP URL.
- ;;
- ;; Note: It is assumed that the file paths are of a similar
- ;; setup on both the TFTP server and the NFS server (it is
- ;; not possible to search for files on TFTP).
- ;;
- ;; TODO: Allow HTTP.
- "set root=(tftp)")
- ((or #f (? string?))
- #~(format #f "search --file --set ~a" #$file)))))
-
-(define* (make-grub-configuration grub config entries
- #:key
- (locale #f)
- (system (%current-system))
- (old-entries '())
- (store-crypto-devices '())
- store-directory-prefix)
- "Return the GRUB configuration file corresponding to CONFIG, a
-<bootloader-configuration> object, and where the store is available at
-STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
-entries corresponding to old generations of the system.
-STORE-CRYPTO-DEVICES contain the UUIDs of the encrypted units that must
-be unlocked to access the store contents.
-STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
-when booting a root file system on a Btrfs subvolume."
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (linux (menu-entry-linux entry))
- (device (menu-entry-device entry))
- (device-mount-point (menu-entry-device-mount-point entry))
- (multiboot-kernel (menu-entry-multiboot-kernel entry))
- (chain-loader (menu-entry-chain-loader entry)))
- (cond
- (linux
- (let ((arguments (menu-entry-linux-arguments entry))
- (linux (normalize-file linux
- device-mount-point
- store-directory-prefix))
- (initrd (normalize-file (menu-entry-initrd entry)
- device-mount-point
- store-directory-prefix))
- (extra-initrd (bootloader-configuration-extra-initrd config)))
- ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
- ;; Use the right file names for LINUX and INITRD in case
- ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
- ;; separate partition.
-
- ;; When STORE-DIRECTORY-PREFIX is defined, prepend it the linux and
- ;; initrd paths, to allow booting from a Btrfs subvolume.
- #~(format port "menuentry ~s {
- ~a
- linux ~a ~a
- initrd ~a ~a
-}~%"
- #$label
- #$(grub-root-search device linux)
- #$linux (string-join (list #$@arguments))
- (or #$extra-initrd "")
- #$initrd)))
- (multiboot-kernel
- (let* ((kernel (menu-entry-multiboot-kernel entry))
- (arguments (menu-entry-multiboot-arguments entry))
- ;; Choose between device names as understood by Mach's built-in
- ;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
- ;; in the "noide" case).
- (disk (if (member "noide" arguments) "w" "h"))
- (modules (menu-entry-multiboot-modules entry))
- (root-index 1)) ; XXX EFI will need root-index 2
- #~(format port "
-menuentry ~s {
- multiboot ~a root=part:~a:device:~ad0~a~a
-}~%"
- #$label
- #$kernel
- #$root-index
- #$disk
- (string-join (list #$@arguments) " " 'prefix)
- (string-join (map string-join '#$modules)
- "\n module " 'prefix))))
- (chain-loader
- #~(format port "
-menuentry ~s {
- ~a
- chainloader ~a
-}~%"
- #$label
- #$(grub-root-search device chain-loader)
- #$chain-loader)))))
-
- (define (crypto-devices)
- (define (crypto-device->cryptomount dev)
- (if (uuid? dev)
- #~(format port "cryptomount -u ~a~%"
- ;; cryptomount only accepts UUID without the hypen.
- #$(string-delete #\- (uuid->string dev)))
- ;; Other type of devices aren't implemented.
- #~()))
- (let ((devices (map crypto-device->cryptomount store-crypto-devices))
- (modules #~(format port "insmod luks~%insmod luks2~%")))
- (if (null? devices)
- devices
- (cons modules devices))))
-
- (define (sugar)
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- (eye-candy config
- device
- mount-point
- #:store-directory-prefix store-directory-prefix
- #:port #~port)))
-
- (define locale-config
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- #~(let ((locale #$(and locale
- (locale-definition-source
- (locale-name->definition locale))))
- (locales #$(and locale
- (normalize-file (grub-locale-directory grub)
- mount-point
- store-directory-prefix))))
- (when locale
- (format port "\
-# Localization configuration.
-~asearch --file --set ~a/en@quot.mo
-set locale_dir=~a
-set lang=~a~%"
- ;; Skip the search if there is an image, as it has already
- ;; been performed by eye-candy and traversing the store is
- ;; an expensive operation.
- #$(if (grub-theme-image (bootloader-theme config))
- "# "
- "")
- locales
- locales
- locale)))))
-
- (define keyboard-layout-config
- (let* ((layout (bootloader-configuration-keyboard-layout config))
- (keymap* (and layout
- (keyboard-layout-file layout #:grub grub)))
- (entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry))
- (keymap (and keymap*
- (normalize-file keymap* mount-point
- store-directory-prefix))))
- #~(when #$keymap
- (format port "\
-insmod keylayouts
-keymap ~a~%" #$keymap))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (format port
- "# This file was generated from your Guix configuration. Any changes
-# will be lost upon reconfiguration.
-")
- #$@(crypto-devices)
- #$(sugar)
- #$locale-config
- #$keyboard-layout-config
- (format port "
-set default=~a
-set timeout=~a~%"
- #$(bootloader-configuration-default-entry config)
- #$(bootloader-configuration-timeout config))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "
-submenu \"GNU system, old configurations...\" {~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "}~%"))
- #~())
- (format port "
-if [ \"${grub_platform}\" == efi ]; then
- menuentry \"Firmware setup\" {
- fwsetup
- }
-fi~%"))))
+ "-o" #$output)))))
+
+
+
+(define* (grub.dir grub #:key bootloader-config locale
+ #:allow-other-keys . args)
+ "Everything what should go in GRUB's prefix, including fonts, modules,
+locales, keymap, theme image, and grub.cfg."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match for keyboard-layout: identifier bound in this scope
+ (targets theme)
+ (let* ((theme (or theme (grub-theme)))
+ (keyboard-layout (bootloader-configuration-keyboard-layout
+ bootloader-config))
+ (lang (and=> locale (compose locale-definition-source
+ locale-name->definition)))
+ (lc-mesg (and=> lang (cut file-append grub "/share/locale" <>
+ "/LC_MESSAGES/grub.mo"))))
+ (computed-file "grub.dir"
+ (with-imported-modules '((guix build utils))
+ #~(begin (use-modules (guix build utils))
+ (mkdir-p #$output)
+ (chdir #$output)
+ ;; grub files
+ (copy-recursively #$(file-append grub "/lib/grub/") #$output
+ #:copy-file symlink)
+ (mkdir "fonts")
+ (symlink #$(file-append grub "/share/grub/unicode.pf2")
+ "fonts/unicode.pf2")
+ ;; config file
+ (symlink #$(apply grub.cfg args) "grub.cfg")
+ ;; locales
+ (when (and=> #$lc-mesg file-exists?)
+ (mkdir "locales")
+ (symlink #$lc-mesg (string-append "locales/" #$lang ".mo")))
+ ;; keymap
+ #$@(filter ->bool
+ (list
+ (and keyboard-layout
+ #~(symlink #$(keyboard-layout-file keyboard-layout grub)
+ "keymap"))
+ ;; image
+ (and (grub-theme-image theme)
+ #~(copy-file #$(grub-theme-png theme) "image.png"))))))
+ #:options '(#:local-build? #t #:substitutable? #f)))))
- ;; Since this file is rather unique, there's no point in trying to
- ;; substitute it.
- (computed-file "grub.cfg" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-(define (grub-configuration-file config . args)
- (let* ((bootloader (bootloader-configuration-bootloader config))
- (grub (bootloader-package bootloader)))
- (apply make-grub-configuration grub config args)))
-
-(define (grub-efi-configuration-file . args)
- (apply make-grub-configuration grub-efi args))
-
-(define grub-cfg "/boot/grub/grub.cfg")
\f
-
;;;
-;;; Install procedures.
+;;; Installers.
;;;
-(define install-grub
- #~(lambda (bootloader device mount-point)
- (let ((grub (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot")))
- ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE
- ;; is #f, then we populate the disk-image rooted at MOUNT-POINT.
- (if device
- (begin
- ;; Tell 'grub-install' that there might be a LUKS-encrypted
- ;; /boot or root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-
- ;; Hide potentially confusing messages from the user, such as
- ;; "Installing for i386-pc platform."
- (invoke/quiet grub "--no-floppy" "--target=i386-pc"
- "--boot-directory" install-dir
- device))
- ;; When creating a disk-image, only install a font and GRUB modules.
- (let* ((fonts (string-append install-dir "/grub/fonts")))
- (mkdir-p fonts)
- (copy-file (string-append bootloader "/share/grub/unicode.pf2")
- (string-append fonts "/unicode.pf2"))
- (copy-recursively (string-append bootloader "/lib/")
- install-dir))))))
-
-(define install-grub-disk-image
- #~(lambda (bootloader root-index image)
- ;; Install GRUB on the given IMAGE. The root partition index is
- ;; ROOT-INDEX.
- (let ((grub-mkimage
- (string-append bootloader "/bin/grub-mkimage"))
- (modules '("biosdisk" "part_msdos" "fat" "ext2"))
- (grub-bios-setup
- (string-append bootloader "/sbin/grub-bios-setup"))
- (root-device (format #f "hd0,msdos~a" root-index))
- (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img"))
- (device-map "device.map"))
-
- ;; Create a minimal, standalone GRUB image that will be written
- ;; directly in the MBR-GAP (space between the end of the MBR and the
- ;; first partition).
- (apply invoke grub-mkimage
- "-O" "i386-pc"
- "-o" "core.img"
- "-p" (format #f "(~a)/boot/grub" root-device)
- modules)
-
- ;; Create a device mapping file.
- (call-with-output-file device-map
- (lambda (port)
- (format port "(hd0) ~a~%" image)))
-
- ;; Copy the default boot.img, that will be written on the MBR sector
- ;; by GRUB-BIOS-SETUP.
- (copy-file boot-img "boot.img")
-
- ;; Install both the "boot.img" and the "core.img" files on the given
- ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB
- ;; written in the MBR-GAP. GRUB configuration and missing modules will
- ;; be read from ROOT-DEVICE.
- (invoke grub-bios-setup
- "-m" device-map
- "-r" root-device
- "-d" "."
- image))))
-
-(define install-grub-efi
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi-removable
- #~(lambda (bootloader efi-dir mount-point)
- ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
- ;; NOTE: efi-dir comes from target list of booloader configuration
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--removable"
- ;; "--no-nvram"
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi32
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- (cond ((target-x86?) "--target=i386-efi")
- ((target-arm?) "--target=arm-efi"))
- "--efi-directory" target-esp)))))
-
-(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
- "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
-its files in SUBDIR and its configuration file in GRUB-CFG.
-
-As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
-installer basically copies all files from the bootloader-package (or profile)
-into the bootloader-target directory.
-
-Additionally for network booting over TFTP, two relative symlinks to the store
-and to the GRUB-CFG file are necessary. Due to this a TFTP root directory must
-not be located on a FAT file-system.
-
-If the bootloader-target does not support symlinks, then it is assumed to be a
-kind of EFI System Partition (ESP). In this case an intermediate configuration
-file is created with the help of GRUB-EFI to load the GRUB-CFG.
-
-The installer is usable for any efi-bootloader-chain, which prepares the
-bootloader-profile in a way ready for copying.
-
-The installer does not manipulate the system's 'UEFI Boot Manager'.
-
-The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
-arguments. Its job is to copy the BOOTLOADER, which must be a pre-installed
-grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
-directory TARGET for the system whose root is mounted at MOUNT-POINT.
-
-MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
-or '/' for other 'guix system' commands.
-
-Where TARGET comes from the targets argument given to the
-bootloader-configuration in:
-
-(operating-system
- (bootloader (bootloader-configuration
- (targets '(\"/boot/efi\"))
- …))
- …)
-
-TARGET is required to be an absolute directory name, usually mounted via NFS,
-and finally needs to be provided by a TFTP server as
-the TFTP root directory.
-
-Usually the installer will be used to prepare network booting over TFTP. Then
-GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
-load more files from the store like tftp://server/gnu/store/…-linux…/Image.
-
-To make this possible two symlinks are created. The first symlink points
-relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
-MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
-MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.
-
-It is important to note that these symlinks need to be relative, as the absolute
-paths on the TFTP server side are unknown.
-
-It is also important to note that both symlinks will point outside the TFTP root
-directory and that the TARGET/%store-prefix symlink makes the whole store
-accessible via TFTP. Possibly the TFTP server must be configured to allow
-accesses outside its TFTP root directory. This all may need to be considered
-for security aspects. It is advised to disable any TFTP write access!
-
-The installer can also be used to prepare booting from local storage, if the
-underlying file-system, like FAT on an EFI System Partition (ESP), does not
-support symlinks. In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
-created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file. A
-symlink to the store is not needed in this case."
- (with-imported-modules '((guix build union))
- #~(lambda (bootloader target mount-point)
- ;; In context of a disk image creation TARGET will be #f and an
- ;; installer is expected to do necessary installations on MOUNT-POINT,
- ;; which will become the root file system. If TARGET is #f, this
- ;; installer has nothing to do, as it only cares about the EFI System
- ;; Partition (ESP).
- (when target
- (use-modules ((guix build union) #:select (symlink-relative))
- (ice-9 popen)
- (ice-9 rdelim))
- (let* ((mount-point/target (string-append mount-point target "/"))
- ;; When installing Guix, it is common to mount TARGET below
- ;; MOUNT-POINT rather than the root directory.
- (bootloader-target (if (file-exists? mount-point/target)
- mount-point/target
- target))
- (store (string-append mount-point (%store-prefix)))
- (store-link (string-append bootloader-target (%store-prefix)))
- (grub-cfg (string-append mount-point #$grub-cfg))
- (grub-cfg-link (string-append bootloader-target
- #$subdir "/"
- (basename grub-cfg))))
- ;; Copy the bootloader into the bootloader-target directory.
- ;; Should we beforehand recursively delete any existing file?
- (copy-recursively bootloader bootloader-target
- #:follow-symlinks? #t
- #:log (%make-void-port "w"))
- ;; For TFTP we need to install additional relative symlinks.
- ;; If we install on an EFI System Partition (ESP) or some other FAT
- ;; file-system, then symlinks cannot be created and are not needed.
- ;; Therefore we ignore exceptions when trying.
- ;; Prepare the symlink to the grub.cfg.
- (mkdir-p (dirname grub-cfg-link))
- (false-if-exception (delete-file grub-cfg-link))
- (if (unspecified?
- (false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
- ;; Symlinks are supported.
- (begin
- ;; Prepare the symlink to the store.
- (mkdir-p (dirname store-link))
- (false-if-exception (delete-file store-link))
- (symlink-relative store store-link))
- ;; Creating symlinks does not seem to be supported. Probably
- ;; an ESP is used. Add a script to search and load the actual
- ;; grub.cfg.
- (let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
- (port (open-pipe* OPEN_READ probe "--target=fs_uuid"
- grub-cfg))
- (search-root
- (match (read-line port)
- ((? eof-object?)
- ;; There is no UUID available. As a fallback search
- ;; everywhere for the grub.cfg.
- (string-append "search --file --set " #$grub-cfg))
- (fs-uuid
- ;; The UUID to load the grub.cfg from is known.
- (string-append "search --fs-uuid --set " fs-uuid))))
- (load-grub-cfg (string-append "configfile " #$grub-cfg)))
- (close-pipe port)
- (with-output-to-file grub-cfg-link
- (lambda ()
- (display (string-join (list search-root
- load-grub-cfg)
- "\n")))))))))))
+(define* (install-grub.dir grub #:key bootloader-config
+ #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('install => (path :path))
+ #~(copy-recursively #$(apply grub.dir grub args) #$path
+ #:log (%make-void-port "w")
+ #:follow-symlinks? #t
+ #:copy-file atomic-copy))))
+
+(define (install-grub-bios grub)
+ "Returns an installer for the bios-bootable grub package GRUB."
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (gbegin (apply install-grub.dir grub args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('disk => (device :device))
+ #~(invoke #$(file-append grub "/sbin/grub-bios-setup") "-v" "-v"
+ "--directory" "/" ; can't be blank
+ "--device-map" "" ; no dev map - need to specify
+ "--boot-image"
+ #$(file-append grub "/lib/grub/i386-pc/boot.img")
+ "--core-image" #$(apply core.img grub "pc" args)
+ "--root-device" #$(string-append "hostdisk/" device)
+ #$device))))))
+
+(define* (install-grub-efi #:key bootloader-config #:allow-other-keys . args)
+ "Installs grub into the system's uefi bootloader, taking into account
+user-specified requirements for a 32-bit or fallback bootloader."
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (grub (if 32? grub-efi32 grub-efi))
+ (core (apply core.img grub "efi" args))
+ (copy #~(lambda (dest) (copy-file #$core dest))))
+ (gbegin (apply install-grub.dir grub args)
+ (install-efi bootloader-config #~`((,#$copy "grub.efi" . "GNU GRUB"))))))
+
-\f
+\f
;;;
-;;; Bootloader definitions.
+;;; Bootloaders.
;;;
-;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
-;;; is fixed. Inheriting and overwriting the field 'configuration-file' will
-;;; break 'guix system delete-generations', 'guix system switch-generation',
-;;; and 'guix system roll-back'.
+
+(define %grub-default-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))))
(define grub-bootloader
(bootloader
- (name 'grub)
- (package grub)
- (installer install-grub)
- (disk-image-installer install-grub-disk-image)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub))))
(define grub-minimal-bootloader
(bootloader
- (inherit grub-bootloader)
- (package grub-minimal)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub-minimal))))
(define grub-efi-bootloader
(bootloader
- (name 'grub-efi)
- (package grub-efi)
- (installer install-grub-efi)
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
-
-(define grub-efi-removable-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (name 'grub-efi-removable-bootloader)
- (installer install-grub-efi-removable)))
+ (name 'grub-efi)
+ (default-targets (cons (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))
+ %grub-default-targets))
+ (installer install-grub-efi)))
-(define grub-efi32-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (installer install-grub-efi32)
- (name 'grub-efi32)
- (package grub-efi32)))
-(define (make-grub-efi-netboot-bootloader name subdir)
- (bootloader
- (name name)
- (package (make-grub-efi-netboot (symbol->string name) subdir))
- (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-efi-configuration-file)))
-
-(define grub-efi-netboot-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
- "efi/Guix"))
-
-(define grub-efi-netboot-removable-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
- "efi/boot"))
-
-(define grub-mkrescue-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (package grub-hybrid)))
\f
;;;
-;;; Compatibility macros.
+;;; deprecated shit!
+;;; use the bootloader-config flags instead! or, in the case of netboot, set
+;;; your 'install (or parent thereof) target fs to be "tftp" or "nfs"
;;;
-(define-syntax grub-configuration
- (syntax-rules (grub)
- ((_ (grub package) fields ...)
- (if (eq? package grub)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...)
- (bootloader-configuration
- (bootloader grub-efi-bootloader)
- fields ...)))
- ((_ fields ...)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...))))
-
-;;; grub.scm ends here
+(define (deprecated-installer installer removable? 32?)
+ (lambda args (apply installer
+ (substitute-keyword-arguments args
+ ((#:bootloader-config conf) (bootloader-configuration
+ (inherit conf)
+ (efi-removable? removable?)
+ (32bit? 32?)))))))
+
+(define-deprecated grub-efi-removable-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #t #f))))
+
+(define-deprecated grub-efi32-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #f #t))))
+
+(define %netboot-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot")
+ (file-system "tftp"))
+ (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+
+(define-deprecated grub-efi-netboot-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)))
+
+(define-deprecated grub-efi-netboot-removable-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)
+ (installer (deprecated-installer install-grub-efi #t #f))))
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index c5437a7b63..7d3e202f8c 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Herman Rimm <herman_rimm@protonmail.com>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,12 +25,11 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader u-boot)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
+ #:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
- #:export (u-boot-bootloader
- u-boot-a20-olinuxino-lime-bootloader
+ #:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
u-boot-bananapi-m2-ultra-bootloader
@@ -53,301 +53,172 @@ (define-module (gnu bootloader u-boot)
u-boot-ts7970-q-2g-1000mhz-c-bootloader
u-boot-wandboard-bootloader))
-(define install-u-boot
- #~(lambda (bootloader root-index image)
- (if bootloader
- (error "Failed to install U-Boot"))))
+(define (make-install-u-boot firmware installers)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('extlinux (apply install-extlinux-config args))
+ (('install => (path :path)) #~(let ((path #$path) #$firmware)))
+ (('disk => (disk :device)) #~(let ((disk #$disk)) #f #$@installers)))))
+
+(define-syntax-rule (define-u-bootloader def-name package firmware
+ (file size doffset) ...)
+ "Defines a u-boot installer DEF-NAME, using u-boot PACKAGE. Installs each
+given FILE of SIZE (or #f to autodetect) to the targetted disk at OFFSET.
+FIRMWARE is ran on the u-boot firmware directory for installation of supporting
+files, with the variable path set to the dir path."
+ (define def-name
+ (bootloader
+ (name 'u-boot)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (make-install-u-boot firmware
+ (list #~(let ((fw #$(file-append package "/libexec/" file)))
+ (write-file-on-device fw
+ #$(or size #~(stat:size (stat fw)))
+ disk #$doffset)) ...))))))
+
+\f
+;;;
+;;; Bootloader definitions.
+;;;
-(define install-beaglebone-black-u-boot
+(define-u-bootloader u-boot-beaglebone-black-bootloader
+ u-boot-am335x-boneblack #f
;; http://wiki.beyondlogic.org/index.php?title=BeagleBoneBlack_Upgrading_uBoot
;; This first stage bootloader called MLO (U-Boot SPL) is expected at
;; 0x20000 by BBB ROM code. The second stage bootloader will be loaded by
;; the MLO and is expected at 0x60000. Write both first stage ("MLO") and
- ;; second stage ("u-boot.img") images, read in BOOTLOADER directory, to the
- ;; specified DEVICE.
- #~(lambda (bootloader root-index image)
- (let ((mlo (string-append bootloader "/libexec/MLO"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device mlo (* 256 512)
- image (* 256 512))
- (write-file-on-device u-boot (* 1024 512)
- image (* 768 512)))))
-
-(define install-allwinner-u-boot
- #~(lambda (bootloader root-index image)
- (let ((u-boot (string-append bootloader
- "/libexec/u-boot-sunxi-with-spl.bin")))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 8 1024)))))
-
-(define install-allwinner64-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 8 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 40 1024)))))
-
-(define install-imx-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/SPL"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 1 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 69 1024)))))
-
-(define install-orangepi-r1-plus-lts-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-puma-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 512 512)))))
-
-(define install-firefly-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rock64-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rockpro64-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-pinebook-pro-rk3399-u-boot install-rockpro64-rk3399-u-boot)
-
-(define install-u-boot-ts7970-q-2g-1000mhz-c-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.imx (string-append bootloader "/libexec/u-boot.imx"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.imx install-dir))))
-
-(define install-sifive-unmatched-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/spl/u-boot-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append
- bootloader "/libexec/spl/u-boot-spl.bin.normal.out"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-uEnv.txt
- #~(lambda (bootloader device mount-point)
- (mkdir-p (string-append mount-point "/boot"))
- (call-with-output-file (string-append mount-point "/boot/uEnv.txt")
+ ;; second stage ("u-boot.img") images to the target.
+ ("MLO" (* 256 512) (* 256 512))
+ ("u-boot.img" (* 1024 512) (* 768 512)))
+
+(define-u-bootloader u-boot-sifive-unmatched-bootloader
+ u-boot-sifive-unmatched #f
+ ("spl/u-boot-spl.bin" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+(define-u-bootloader u-boot-starfive-visionfive2-bootloader
+ u-boot-starfive-visionfive2
+ #~(begin (mkdir-p path)
+ (call-with-output-file (string-append path "/uEnv.txt")
(lambda (port)
(format port
- ;; if board SPI use vender's u-boot, will find
- ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
- ;; that users will update this u-boot, so set it.
- "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%")))))
+ ;; if board SPI use vender's u-boot, will find
+ ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
+ ;; that users will update this u-boot, so set it.
+ "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%"))))
+ ("spl/u-boot-spl.bin.normal.out" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+\f
+;;;
+;;; Allwinner bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))))
+
-(define install-qemu-riscv64-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.bin (string-append bootloader "/libexec/u-boot.bin"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.bin install-dir))))
+(define-u-bootloader-allwinner u-boot-nintendo-nes-classic-edition-bootloader
+ u-boot-nintendo-nes-classic-edition)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime-bootloader
+ u-boot-a20-olinuxino-lime)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime2-bootloader
+ u-boot-a20-olinuxino-lime2)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-micro-bootloader
+ u-boot-a20-olinuxino-micro)
+
+(define-u-bootloader-allwinner u-boot-bananapi-m2-ultra-bootloader
+ u-boot-bananapi-m2-ultra)
+
+(define-u-bootloader-allwinner u-boot-cubietruck-bootloader u-boot-cubietruck)
+
+(define-u-bootloader-allwinner u-boot-pine64-lts-bootloader u-boot-pine64-lts)
\f
+;;;
+;;; Allwinner64 bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner64 def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))
+ ("u-boot-sunxi-with-spl.fit.itb" #f (* 40 1024))))
+
+
+(define-u-bootloader-allwinner64 u-boot-pine64-plus-bootloader
+ u-boot-pine64-plus)
+
+(define-u-bootloader-allwinner64 u-boot-pinebook-bootloader u-boot-pinebook)
+\f
;;;
-;;; Bootloader definitions.
+;;; IMX bootloader definitions.
;;;
+(define-syntax-rule (define-u-bootloader-imx def-name package)
+ (define-u-bootloader def-name package #f
+ ("SPL" #f (* 8 1024))
+ ("u-boot.img" #f (* 40 1024))))
-(define u-boot-bootloader
- (bootloader
- (inherit extlinux-bootloader)
- (name 'u-boot)
- (package #f)
- (installer #f)
- (disk-image-installer install-u-boot)))
-
-(define u-boot-beaglebone-black-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-am335x-boneblack)
- (disk-image-installer install-beaglebone-black-u-boot)))
-
-(define u-boot-allwinner-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner-u-boot)))
-
-(define u-boot-allwinner64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner64-u-boot)))
-
-(define u-boot-imx-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-imx-u-boot)))
-
-(define u-boot-nintendo-nes-classic-edition-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-nintendo-nes-classic-edition)))
-
-(define u-boot-a20-olinuxino-lime-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime)))
-
-(define u-boot-a20-olinuxino-lime2-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime2)))
-
-(define u-boot-a20-olinuxino-micro-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-micro)))
-
-(define u-boot-bananapi-m2-ultra-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-bananapi-m2-ultra)))
-
-(define u-boot-cubietruck-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-cubietruck)))
-
-(define u-boot-firefly-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-firefly-rk3399)
- (disk-image-installer install-firefly-rk3399-u-boot)))
-
-(define u-boot-mx6cuboxi-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-mx6cuboxi)))
-
-(define u-boot-wandboard-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-wandboard)))
-
-(define u-boot-novena-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-novena)))
-
-(define u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-orangepi-r1-plus-lts-rk3328)
- (disk-image-installer install-orangepi-r1-plus-lts-rk3328-u-boot)))
-
-(define u-boot-pine64-plus-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pine64-plus)))
-
-(define u-boot-pine64-lts-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-pine64-lts)))
-
-(define u-boot-pinebook-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pinebook)))
-
-(define u-boot-puma-rk3399-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-puma-rk3399)
- (disk-image-installer install-puma-rk3399-u-boot)))
-
-(define u-boot-rock64-rk3328-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rock64-rk3328)
- (disk-image-installer install-rock64-rk3328-u-boot)))
-(define u-boot-rockpro64-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rockpro64-rk3399)
- (disk-image-installer install-rockpro64-rk3399-u-boot)))
+(define-u-bootloader-imx u-boot-mx6cuboxi-bootloader u-boot-mx6cuboxi)
+
+(define-u-bootloader-imx u-boot-wandboard-bootloader u-boot-wandboard)
-(define u-boot-pinebook-pro-rk3399-bootloader
+(define-u-bootloader-imx u-boot-novena-bootloader u-boot-novena)
+
+\f
+;;;
+;;; Rockchip bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-rockchip def-name package)
;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-pinebook-pro-rk3399)
- (disk-image-installer install-pinebook-pro-rk3399-u-boot)))
-
-(define u-boot-ts7970-q-2g-1000mhz-c-bootloader
- ;; This bootloader doesn't really need to be installed, as it is read from
- ;; an SPI memory chip, not the SD card. It is copied to /boot/u-boot.imx
- ;; for convenience and should be manually flashed at the U-Boot prompt.
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-ts7970-q-2g-1000mhz-c)
- (installer install-u-boot-ts7970-q-2g-1000mhz-c-u-boot)
- (disk-image-installer #f)))
-
-(define u-boot-sifive-unmatched-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-sifive-unmatched)
- (disk-image-installer install-sifive-unmatched-u-boot)))
-
-(define u-boot-starfive-visionfive2-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-starfive-visionfive2)
- (installer install-starfive-visionfive2-uEnv.txt)
- (disk-image-installer install-starfive-visionfive2-u-boot)))
-
-(define u-boot-qemu-riscv64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-qemu-riscv64)
- (installer install-qemu-riscv64-u-boot)
- (disk-image-installer #f)))
+ (define-u-bootloader def-name package #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 16384 512))))
+
+(define-u-bootloader-rockchip u-boot-firefly-rk3399-bootloader
+ u-boot-firefly-rk3399)
+
+(define-u-bootloader-rockchip u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+ u-boot-orangepi-r1-plus-lts-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rock64-rk3328-bootloader
+ u-boot-rock64-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rockpro64-rk3399-bootloader
+ u-boot-rockpro64-rk3399)
+
+(define-u-bootloader-rockchip u-boot-pinebook-pro-rk3399-bootloader
+ u-boot-pinebook-pro-rk3399)
+
+(define-u-bootloader u-boot-puma-rk3399-bootloader u-boot-puma-rk3399 #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 512 512)))
+
+\f
+;;;
+;;; Copy-only bootloader definitions.
+;;;
+
+;; These bootloaders don't really need to be installed, as they are read from
+;; an SPI memory chip or directly from the FS, not the disk.
+(define-syntax-rule (define-u-bootloader-copy def-name package file)
+ (define-u-bootloader def-name package
+ #~(install-file #$(file-append package "/libexec/" file) path)))
+
+;; user should manually install this to SPI flash
+;; TODO: write directly to SPI flash? unless wear issues are a problem.
+(define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
+ u-boot-ts7970-q-2g-1000mhz-c "u-boot.imx")
+
+(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
+ u-boot-qemu-riscv64 "u-boot.bin")
diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm
index af6063a884..b59287d759 100644
--- a/gnu/build/bootloader.scm
+++ b/gnu/build/bootloader.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,20 +21,45 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build bootloader)
+ #:autoload (guix build syscalls) (free-disk-space)
#:use-module (guix build utils)
- #:use-module (guix utils)
- #:use-module (ice-9 binary-ports)
+ #: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)
- #:export (write-file-on-device
- install-efi-loader))
+ #: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))
\f
;;;
;;; 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 block ...)
+ "Run blocks... while chdir'd into a temporary directory."
+ ;; mkdtemp under POSIX.1-2008 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 () block ...)
+ (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
@@ -56,57 +82,78 @@ (define (write-file-on-device file size device offset)
;;; EFI bootloader.
;;;
-(define* (install-efi grub grub-config esp #:key targets)
- "Write a self-contained GRUB EFI loader to the mounted ESP using
-GRUB-CONFIG.
-
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let* ((system %host-type)
- ;; Hard code the output location to a well-known path recognized by
- ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
- ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
- (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
- (efi-directory (string-append esp "/EFI/BOOT"))
- ;; Map grub target names to boot file names.
- (efi-targets (or targets
- (cond ((string-prefix? "x86_64" system)
- '("x86_64-efi" . "BOOTX64.EFI"))
- ((string-prefix? "i686" system)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((string-prefix? "armhf" system)
- '("arm-efi" . "BOOTARM.EFI"))
- ((string-prefix? "aarch64" system)
- '("arm64-efi" . "BOOTAA64.EFI"))))))
- ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
- (setenv "TMPDIR" esp)
-
- (mkdir-p efi-directory)
- (invoke grub-mkstandalone "-O" (car efi-targets)
- "-o" (string-append efi-directory "/"
- (cdr efi-targets))
- ;; Graft the configuration file onto the image.
- (string-append "boot/grub/grub.cfg=" grub-config))))
+(define parse-bootnums
+ (make-regexp "^Boot([0-9a-fA-F]+).*[^A-Za-z]File\\(([^)]+)\\)$" regexp/newline))
-(define* (install-efi-loader grub-efi esp #:key targets)
- "Install in ESP directory the given GRUB-EFI bootloader. Configure it to
-load the Grub bootloader located in the 'Guix_image' root partition.
+;; 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))))
+ (unless (zero? status)
+ (raise-exception
+ (formatted-message (G_ "efibootmgr exited with error code ~a") status)))
+ (fold-matches parse-bootnums text '()
+ (lambda (match acc)
+ (let* ((path (match:substring match 2))
+ (bootnum (match:substring match 1)))
+ (cons (cons path bootnum) acc))))))
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let ((grub-config "grub.cfg"))
- (call-with-output-file grub-config
- (lambda (port)
- ;; Create a tiny configuration file telling the embedded grub where to
- ;; load the real thing. XXX This is quite fragile, and can prevent
- ;; the image from booting when there's more than one volume with this
- ;; label present. Reproducible almost-UUIDs could reduce the risk
- ;; (not eliminate it).
- (format port
- "insmod part_msdos~@
- insmod part_gpt~@
- search --set=root --label Guix_image~@
- configfile /boot/grub/grub.cfg~%")))
- (install-efi grub-efi grub-config esp #:targets targets)
- (delete-file grub-config)))
+(define (install-efi efibootmgr vendir loader* disk plan)
+ "See 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)))))
+ (builder name) ; build to a tmp file so we can check size
+ ;; 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))
+ ;; esp 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 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!~%")))
+ ;; boot order. recall efi-bootnums to get fresh list with new installs
+ ;; 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"
+ (let ((num (cute assoc-ref (efi-bootnums efibootmgr) <>))) ; cute is eager
+ (string-join (filter-map (compose num loaderof) plan-files) ",")))))
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 49dc01c0d1..b1abc99bba 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -28,6 +28,7 @@ (define-module (gnu build image)
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
+ #:use-module (guix deprecation)
#:use-module (guix store database)
#:use-module (guix utils)
#:use-module (gnu build bootloader)
@@ -181,30 +182,13 @@ (define* (register-closure prefix closure
#:prefix prefix
#:registration-time %epoch)))))
-(define* (initialize-efi-partition root
- #:key
- grub-efi
- #:allow-other-keys)
- "Install in ROOT directory, an EFI loader using GRUB-EFI."
- (install-efi-loader grub-efi root))
-
-(define* (initialize-efi32-partition root
- #:key
- grub-efi32
- #:allow-other-keys)
- "Install in ROOT directory, an EFI 32bit loader using GRUB-EFI32."
- (install-efi-loader grub-efi32 root
- #:targets (cond ((target-x86?)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((target-arm?)
- '("arm-efi" . "BOOTARM.EFI")))))
+(define (initialize-efi-partition root . rest)
+ (mkdir-p (string-append root "/EFI")))
+
+(define-deprecated/alias initialize-efi32-partition initialize-efi-partition)
(define* (initialize-root-partition root
#:key
- bootcfg
- bootcfg-location
- bootloader-package
- bootloader-installer
(copy-closures? #t)
(deduplicate? #t)
references-graphs
@@ -251,18 +235,10 @@ (define* (initialize-root-partition root
(unless copy-closures?
(delete-file root-store)
- (rename-file tmp-store root-store)))
-
- ;; There's no point installing a bootloader if we do not populate the store.
- (when copy-closures?
- (when bootloader-installer
- (display "installing bootloader...\n")
- (bootloader-installer bootloader-package #f root))
- (when bootcfg
- (install-boot-config bootcfg bootcfg-location root))))
+ (rename-file tmp-store root-store))))
(define* (make-iso9660-image xorriso grub-mkrescue-environment
- grub bootcfg system-directory root target
+ grub grub.dir system-directory root target
#:key (volume-id "Guix_image") (volume-uuid #f)
register-closures? (references-graphs '())
(compression? #t))
@@ -321,7 +297,7 @@ (define* (make-iso9660-image xorriso grub-mkrescue-environment
(apply invoke grub-mkrescue
(string-append "--xorriso=" grub-mkrescue-sed.sh)
"-o" target
- (string-append "boot/grub/grub.cfg=" bootcfg)
+ (string-append "boot/grub=" grub.dir)
root
"--"
;; Set all timestamps to 1.
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 0aa227b4d8..6b5435f13c 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -25,8 +25,7 @@ (define-module (gnu build install)
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (install-boot-config
- evaluate-populate-directive
+ #:export (evaluate-populate-directive
populate-root-file-system
install-database-and-gc-roots
populate-single-profile-directory
@@ -42,19 +41,6 @@ (define-module (gnu build install)
;;;
;;; Code:
-(define (install-boot-config bootcfg bootcfg-location mount-point)
- "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note
-that the caller must make sure that BOOTCFG is registered as a GC root so
-that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
- (let* ((target (string-append mount-point bootcfg-location))
- (pivot (string-append target ".new")))
- (mkdir-p (dirname target))
-
- ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
- ;; work when /boot is on a separate partition. Do that atomically.
- (copy-file bootcfg pivot)
- (rename-file pivot target)))
-
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
diff --git a/gnu/image.scm b/gnu/image.scm
index 7fb06dec10..6a3251014f 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -35,6 +35,7 @@ (define-module (gnu image)
partition-label
partition-uuid
partition-flags
+ partition-target
partition-initializer
image
@@ -131,6 +132,8 @@ (define-record-type* <partition> partition make-partition
(flags partition-flags
(default '()) ;list of symbols
(sanitize validate-partition-flags))
+ (target partition-target ; bootloader target type: symbol | #f
+ (default #f))
(initializer partition-initializer
(default #false))) ;gexp | #false
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 51fa7cf9d9..83682ea539 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1454,15 +1454,19 @@ (define (root-user-partition? partition)
(define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
- (let* ((root-partition (find root-user-partition?
- user-partitions))
+ (let* ((root-partition (find root-user-partition? user-partitions))
(root-partition-disk (user-partition-disk-file-name root-partition)))
`((bootloader-configuration
,@(if (efi-installation?)
`((bootloader grub-efi-bootloader)
- (targets (list ,(default-esp-mount-point))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path ,(default-esp-mount-point))))))
`((bootloader grub-bootloader)
- (targets (list ,root-partition-disk))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ ;; TODO: we should provide a uuid or label here
+ (device ,root-partition-disk))))))
;; XXX: Assume we defined the 'keyboard-layout' field of
;; <operating-system> right above.
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 8dd8c342a0..4a9d3faee1 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -505,18 +505,15 @@ (define (deploy-managed-host machine)
(machine-ssh-session machine)
(machine-become-command machine)))
- (mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-alternatives (machine->boot-alternatives machine)))
+ (mlet %store-monad ((_ (check-deployment-sanity machine)))
;; Make sure code that check %CURRENT-SYSTEM, such as
;; %BASE-INITRD-MODULES, gets to see the right value.
(parameterize ((%current-system system)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters boot-alternatives)))
- (bootloader-configuration (operating-system-bootloader os))
- (bootcfg (operating-system-bootcfg os menu-entries)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootmeta (operating-system-bootmeta os)))
(define-syntax-rule (eval/error-handling condition handler ...)
;; Return a wrapper around EVAL such that HANDLER is evaluated if an
;; exception is raised.
@@ -548,13 +545,15 @@ (define (deploy-managed-host machine)
(inferior-exception-arguments
c)))
os)
- (install-bootloader (eval/error-handling c
- (raise (formatted-message
- (G_ "\
+ (mlet %store-monad
+ ((boot-alternatives (machine->boot-alternatives machine)))
+ (apply install-bootloader
+ (eval/error-handling c
+ (raise (formatted-message
+ (G_ "\
failed to install bootloader on '~a':~%~{~s ~}~%")
- host
- (inferior-exception-arguments c))))
- bootloader-configuration bootcfg)))))))))
+ host (inferior-exception-arguments c))))
+ bootloader-config boot-alternatives bootmeta))))))))))
\f
;;;
@@ -585,32 +584,28 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
- (_ -> (if (< (length boot-alternatives) 2)
- (raise roll-back-failure)))
- (chosen-alternative (second boot-alternatives))
- (parameters (boot-alternative-parameters chosen-alternative))
- (entries -> (list (boot-parameters->menu-entry parameters)))
- (locale -> (boot-parameters-locale parameters))
- (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
- (store-dir -> (boot-parameters-store-directory-prefix parameters))
- (old-entries -> (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (drop boot-alternatives 2))))
- (bootloader -> (operating-system-bootloader
- (machine-operating-system machine)))
- (bootcfg (lower-object
- ((bootloader-configuration-file-generator
- (bootloader-configuration-bootloader
- bootloader))
- bootloader entries
- #:locale locale
- #:store-crypto-devices crypto-dev
- #:store-directory-prefix store-dir
- #:old-entries old-entries)))
- (remote-result (machine-remote-eval machine remote-exp)))
- (when (eqv? 'error remote-result)
- (raise roll-back-failure))))
+ (mlet %store-monad ((boot-alternatives (machine->boot-alternatives machine)))
+ (when (< (length boot-alternatives) 2) (raise roll-back-failure))
+ (mlet* %store-monad ((remote-result (machine-remote-eval machine remote-exp)))
+ (mwhen (eqv? 'error remote-result)
+ (raise roll-back-failure)))
+
+ (mlet* %store-monad ((os -> (machine-operating-system machine))
+ (chosen -> (cadr boot-alternatives))
+ (alts -> (cons* chosen (car boot-alternatives)
+ (cddr boot-alternatives)))
+ (params -> (boot-alternative-parameters chosen))
+ (locale -> (boot-parameters-locale chosen))
+ (crypto-dev -> (boot-parameters-store-crypto-devices
+ chosen))
+ (store-pre -> (boot-parameters-store-directory-prefix
+ chosen)))
+ (install-bootloader (cute machine-remote-eval machine <>)
+ (operating-system-bootloader os)
+ alts
+ #:locale locale
+ #:store-crypto-devices crypto-dev
+ #:store-directory-prefix store-pre))))
\f
;;;
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 4072df50d7..12f918a123 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -498,92 +498,6 @@ (define-public grub-hybrid
basename))))
(scandir input-dir)))))))))))
-(define-public (make-grub-efi-netboot name subdir)
- "Make a grub-efi-netboot package named NAME, which will be able to boot over
-network via TFTP by accessing its files in the SUBDIR of a TFTP root directory.
-This package is also able to boot from local storage devices.
-
-A bootloader-installer basically needs to copy the package content into the
-bootloader-target directory, which will usually be the TFTP root, as
-'grub-mknetdir' will be invoked already during the package creation.
-
-Alternatively the bootloader-target directory can be a mounted EFI System
-Partition (ESP), or a similar partition with a FAT file system, for booting
-from local storage devices.
-
-The name of the GRUB EFI binary will conform to the UEFI specification for
-removable media. Depending on the system it will be e.g. bootx64.efi or
-bootaa64.efi below SUBDIR.
-
-The SUBDIR argument needs to be set to \"efi/boot\" to create a package which
-conforms to the UEFI specification for removable media.
-
-The SUBDIR argument defaults to \"efi/Guix\", as it is also the case for
-'grub-efi-bootloader'."
- (package
- (name name)
- (version (package-version grub-efi))
- ;; Source is not needed, but it cannot be omitted.
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (let* ((system (string-split (nix-system->gnu-triplet
- (or (%current-target-system)
- (%current-system)))
- #\-))
- (arch (first system))
- (boot-efi
- (match system
- ;; These are the supportend systems and the names defined by
- ;; the UEFI standard for removable media.
- (("i686" _ ...) "/bootia32.efi")
- (("x86_64" _ ...) "/bootx64.efi")
- (("arm" _ ...) "/bootarm.efi")
- (("aarch64" _ ...) "/bootaa64.efi")
- (("riscv" _ ...) "/bootriscv32.efi")
- (("riscv64" _ ...) "/bootriscv64.efi")
- ;; Other systems are not supported, although defined.
- ;; (("riscv128" _ ...) "/bootriscv128.efi")
- ;; (("ia64" _ ...) "/bootia64.efi")
- ((_ ...) #f)))
- (core-efi (string-append
- ;; This is the arch dependent file name of GRUB, e.g.
- ;; i368-efi/core.efi or arm64-efi/core.efi.
- (match arch
- ("i686" "i386")
- ("aarch64" "arm64")
- ("riscv" "riscv32")
- (_ arch))
- "-efi/core.efi")))
- (list
- #:modules '((guix build utils))
- #:builder
- #~(begin
- (use-modules (guix build utils))
- (let* ((bootloader #$(this-package-input "grub-efi"))
- (net-dir #$output)
- (sub-dir (string-append net-dir "/" #$subdir "/"))
- (boot-efi (string-append sub-dir #$boot-efi))
- (core-efi (string-append sub-dir #$core-efi)))
- ;; Install GRUB, which refers to the grub.cfg, with support for
- ;; encrypted partitions,
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
- (string-append "--net-directory=" net-dir)
- (string-append "--subdir=" #$subdir)
- ;; These modules must be pre-loaded to allow booting
- ;; from an ESP or a similar partition with a FAT
- ;; file system.
- (string-append "--modules=part_msdos part_gpt fat"))
- ;; Move GRUB's core.efi to the removable media name.
- (false-if-exception (delete-file boot-efi))
- (rename-file core-efi boot-efi))))))
- (inputs (list grub-efi))
- (synopsis (package-synopsis grub-efi))
- (description (package-description grub-efi))
- (home-page (package-home-page grub-efi))
- (license (package-license grub-efi))))
-
(define-public syslinux
(let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
(package
diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index c4f03c3ed9..66f980dd79 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -19,8 +19,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages raspberry-pi)
- #:use-module (gnu bootloader)
- #:use-module (gnu bootloader grub)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages algebra)
@@ -328,22 +326,6 @@ (define (make-raspi-bcm28-dtbs linux)
(format #f "The device-tree files for Raspberry Pi models from ~a."
(package-name linux)))))
-(define-public grub-efi-bootloader-chain-raspi-64
- ;; A bootloader capable to boot a Raspberry Pi over network via TFTP or from
- ;; a local storage like a micro SD card. It neither installs firmware nor
- ;; device-tree files for the Raspberry Pi. It just assumes them to be
- ;; existing in boot/efi in the same way that some UEFI firmware with ACPI
- ;; data is usually assumed to be existing on PCs. It creates firmware
- ;; configuration files and a bootloader-chain with U-Boot to provide an EFI
- ;; API for the final GRUB bootloader. It also serves as a blue-print to
- ;; create an a custom bootloader-chain with firmware and device-tree
- ;; packages or files.
- (efi-bootloader-chain grub-efi-netboot-removable-bootloader
- #:packages (list u-boot-rpi-arm64-efi-bin)
- #:files (list %raspi-config-txt
- %raspi-bcm27-dtb-txt
- %raspi-u-boot-bootloader-txt)))
-
(define (make-raspi-defconfig arch defconfig sha256-as-base32)
"Make for the architecture ARCH a file-like object from the DEFCONFIG file
with the hash SHA256-AS-BASE32. This object can be used as the #:defconfig
diff --git a/gnu/system.scm b/gnu/system.scm
index 4a084b2ecf..a345b52d55 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -140,10 +140,11 @@ (define-module (gnu system)
operating-system-derivation
operating-system-profile
- operating-system-bootcfg
+ operating-system-bootmeta
operating-system-etc-directory
operating-system-locale-directory
operating-system-boot-script
+ operating-system-boot-parameters
operating-system-uuid
operating-system-with-gc-roots
@@ -171,6 +172,9 @@ (define-module (gnu system)
;;;
;;; Code:
+(define (convert-bootloader-field bootloader)
+ (if (list? bootloader) bootloader (list bootloader)))
+
(define-with-syntax-properties (warn-hosts-file-field-deprecation
(value properties))
(when value
@@ -193,7 +197,9 @@ (define-record-type* <operating-system> operating-system
(default %default-kernel-arguments)) ; list of gexps/strings
(hurd operating-system-hurd
(default #f)) ; package
- (bootloader operating-system-bootloader) ; <bootloader-configuration>
+ (bootloader operating-system-bootloader ; <bootloader-configuration>
+ (default '())
+ (sanitize convert-bootloader-field))
(label operating-system-label ; string
(thunked)
(default (operating-system-default-label this-operating-system)))
@@ -1208,30 +1214,17 @@ (define (operating-system-store-file-system os)
"Return the file system that contains the store of OS."
(store-file-system (operating-system-file-systems os)))
-(define* (operating-system-bootcfg os #:optional (old-entries '()))
- "Return the bootloader configuration file for OS. Use OLD-ENTRIES,
-a list of <menu-entry>, to populate the \"old entries\" menu."
+(define (operating-system-bootmeta os)
+ "Return operating system information to be passed to the bootloader
+installers."
(let* ((file-systems (operating-system-file-systems os))
+ (store-root (btrfs-store-subvolume-file-name file-systems))
(root-fs (operating-system-root-file-system os))
- (root-device (file-system-device root-fs))
(locale (operating-system-locale os))
- (crypto-devices (operating-system-bootloader-crypto-devices os))
- (params (operating-system-boot-parameters
- os root-device
- #:system-kernel-arguments? #t))
- (entry (boot-parameters->menu-entry params))
- (bootloader-conf (operating-system-bootloader os)))
-
- (define generate-config-file
- (bootloader-configuration-file-generator
- (bootloader-configuration-bootloader bootloader-conf)))
-
- (generate-config-file bootloader-conf (list entry)
- #:old-entries old-entries
- #:locale locale
- #:store-crypto-devices crypto-devices
- #:store-directory-prefix
- (btrfs-store-subvolume-file-name file-systems))))
+ (crypto-devices (operating-system-bootloader-crypto-devices os)))
+ (list #:store-crypto-devices crypto-devices
+ #:store-directory-prefix store-root
+ #:locale locale)))
(define (operating-system-multiboot-modules os)
(if (operating-system-hurd os) (hurd-multiboot-modules os) '()))
@@ -1295,9 +1288,9 @@ (define* (operating-system-boot-parameters os root-device
(file-systems (operating-system-file-systems os))
(crypto-devices (operating-system-bootloader-crypto-devices os))
(locale (operating-system-locale os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os)))
- (bootloader-name (bootloader-name bootloader))
+ (bootloader (map bootloader-configuration-bootloader
+ (operating-system-bootloader os)))
+ (bootloader-name (map bootloader-name bootloader))
(label (operating-system-label os))
(multiboot-modules (operating-system-multiboot-modules os)))
(boot-parameters
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 833caef496..2b5302ce5f 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -81,6 +81,7 @@ (define-module (gnu system boot)
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
+ boot-alternative->menu-entry
ensure-not-/dev
system-linux-image-file-name))
@@ -171,7 +172,8 @@ (define (read-boot-parameters port)
(bootloader-name
(match (assq 'bootloader-name rest)
- ((_ args) args)
+ ((_ (args ...)) args)
+ ((_ args) (list args))
(#f 'grub))) ; for compatibility reasons.
(bootloader-menu-entries
@@ -340,6 +342,7 @@ (define (boot-parameters->menu-entry conf)
(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)
@@ -353,6 +356,9 @@ (define (boot-parameters->menu-entry conf)
(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
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index b0c96c60f0..050f5b578b 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system image)
+ #:use-module (guix deprecation)
#:use-module (guix diagnostics)
#:use-module (guix discovery)
#:use-module (guix gexp)
@@ -42,6 +44,7 @@ (define-module (gnu system image)
#:use-module (gnu services base)
#:use-module (gnu system)
#:use-module (gnu system accounts)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system linux-container)
#:use-module (gnu system uuid)
@@ -133,12 +136,10 @@ (define esp-partition
;; FAT-ness is based on file system size (16 in this case).
(file-system "vfat")
(flags '(esp))
- (initializer (gexp initialize-efi-partition))))
+ (target 'esp)
+ (initializer #~initialize-efi-partition)))
-(define esp32-partition
- (partition
- (inherit esp-partition)
- (initializer (gexp initialize-efi32-partition))))
+(define-deprecated/alias esp32-partition esp-partition)
(define root-partition
(partition
@@ -149,6 +150,7 @@ (define root-partition
;; with U-Boot.
(file-system-options (list "-O" "^metadata_csum,^64bit"))
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))
(define mbr-disk-image
@@ -173,11 +175,7 @@ (define efi-disk-image
(partition-table-type 'gpt)
(partitions (list esp-partition root-partition))))
-(define efi32-disk-image
- (image-without-os
- (format 'disk-image)
- (partition-table-type 'gpt)
- (partitions (list esp32-partition root-partition))))
+(define-deprecated/alias efi32-disk-image efi-disk-image)
(define iso9660-image
(image-without-os
@@ -238,10 +236,7 @@ (define efi-raw-image-type
(name 'efi-raw)
(constructor (cut image-with-os efi-disk-image <>))))
-(define efi32-raw-image-type
- (image-type
- (name 'efi32-raw)
- (constructor (cut image-with-os efi32-disk-image <>))))
+(define-deprecated/alias efi32-raw-image-type efi-raw-image-type)
(define qcow2-image-type
(image-type
@@ -350,10 +345,6 @@ (define (find-root-partition image)
(raise (formatted-message
(G_ "image lacks a partition with the 'boot' flag")))))
-(define (root-partition-index image)
- "Return the index of the root partition of the given IMAGE."
- (1+ (srfi-1:list-index root-partition? (image-partitions image))))
-
\f
;;
;; Disk image.
@@ -362,8 +353,8 @@ (define (root-partition-index image)
(define* (system-disk-image image
#:key
(name "disk-image")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '()))
"Return as a file-like object, the disk-image described by IMAGE. Said
@@ -380,6 +371,28 @@ (define* (system-disk-image image
(define genimage-name "image")
+ (define (targets current)
+ ;; provides list of target overrides for a given CURRENT partition, which
+ ;; may be #f for the full-disk targets.
+
+ ;; XXX: how we pass paths is v much a hack
+ (cons (bootloader-target
+ (type 'disk)
+ (device (and (not current) (string-append "images/" genimage-name)))
+ (expected? (->bool current)))
+ (map (lambda (partition)
+ (let ((current? (and current (eq? (partition-target partition)
+ (partition-target current)))))
+ (bootloader-target
+ (type (partition-target partition))
+ (expected? (not current?))
+ (path (and current? "tmp-root"))
+ (offset #f)
+ (file-system (partition-file-system partition))
+ (label (partition-label partition))
+ (uuid (partition-uuid partition)))))
+ (filter partition-target (image-partitions image)))))
+
(define (image->genimage-cfg image)
;; Return as a file-like object, the genimage configuration file
;; describing the given IMAGE.
@@ -460,7 +473,8 @@ (define* (system-disk-image image
(list dosfstools fakeroot mtools))
(else
'())))
- (image-root "tmp-root"))
+ (image-root (string-append (getcwd) "/tmp-root"))
+ (copy-closures? (not #$(image-shared-store? image))))
(sql-schema #$schema)
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
@@ -476,18 +490,13 @@ (define* (system-disk-image image
(initializer image-root
#:references-graphs '#$graph
#:deduplicate? #f
- #:copy-closures? (not
- #$(image-shared-store? image))
- #:system-directory #$os
- #:grub-efi #+grub-efi
- #:grub-efi32 #+grub-efi32
- #:bootloader-package
- #+(bootloader-package bootloader)
- #:bootloader-installer
- #+(bootloader-installer bootloader)
- #:bootcfg #$bootcfg
- #:bootcfg-location
- #$(bootloader-configuration-file bootloader))
+ #:copy-closures? copy-closures?
+ #:system-directory #$os)
+ ;; no point installing a bootloader if we don't populate store
+ (when copy-closures?
+ ;; root-offset isn't necessary - we override 'root
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets partition)))
(make-partition-image #$(partition->gexp partition)
#$output
image-root)))))
@@ -534,14 +543,6 @@ (define* (system-disk-image image
(image-partition-table-type image)))
(else "")))
- (when (and (memq (bootloader-name bootloader)
- '(grub-efi grub-efi32 grub-efi-removable-bootloader))
- (not
- (gpt-image? image)))
- (raise
- (formatted-message
- (G_ "EFI bootloader required with GPT partitioning"))))
-
(let* ((format (image-format image))
(image-type (format->image-type format))
(image-type-options (genimage-type-options image-type image))
@@ -552,13 +553,15 @@ (define* (system-disk-image image
(let ((format (@ (ice-9 format) format)))
(call-with-output-file #$output
(lambda (port)
- (format port
- "\
+ (format port "\
image ~a {
~/~a {~a}
~{~a~^~%~}
-}~%" #$genimage-name #$image-type #$image-type-options
- (list #$@partitions-config))))))))
+}~%"
+ #$genimage-name
+ #$image-type
+ #$image-type-options
+ (list #$@partitions-config))))))))
(computed-file "genimage.cfg" builder)))
(let* ((image-name (image-name image))
@@ -570,17 +573,13 @@ (define* (system-disk-image image
(builder
(with-imported-modules*
(let ((inputs '#+(list genimage coreutils findutils qemu-minimal))
- (bootloader-installer
- #+(bootloader-disk-image-installer bootloader))
(out-image (string-append "images/" #$genimage-name)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(genimage #$(image->genimage-cfg image))
- ;; Install the bootloader directly on the disk-image.
- (when bootloader-installer
- (bootloader-installer
- #+(bootloader-package bootloader)
- #$(root-partition-index image)
- out-image))
+ ;; don't install bootloader unless installing store
+ (unless #$(image-shared-store? image)
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets #f)))
(convert-disk-image out-image '#$format #$output)))))
(computed-file name builder
#:local-build? #f ;too I/O-intensive
@@ -600,8 +599,8 @@ (define (has-guix-service-type? os)
(define* (system-iso9660-image image
#:key
(name "image.iso")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '())
(grub-mkrescue-environment '()))
@@ -621,7 +620,6 @@ (define* (system-iso9660-image image
(uuid-bytevector (partition-uuid partition)))))
(let* ((os (image-operating-system image))
- (bootloader (bootloader-package bootloader))
(compression? (image-compression? image))
(substitutable? (image-substitutable? image))
(schema (local-file (search-path %load-path
@@ -629,6 +627,14 @@ (define* (system-iso9660-image image
(graph (match inputs
(((names . _) ...)
names)))
+ (config (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list (bootloader-target
+ (type 'root)
+ (path "tmp-root"))
+ (bootloader-target
+ (type 'install)
+ (path "boot/grub"))))))
(builder
(with-imported-modules*
(let* ((inputs '#$(list parted e2fsprogs dosfstools xorriso
@@ -649,10 +655,12 @@ (define* (system-iso9660-image image
#:references-graphs '#$graph
#:deduplicate? #f
#:system-directory #$os)
+
(make-iso9660-image #$xorriso
'#$grub-mkrescue-environment
- #$bootloader
- #$bootcfg
+ #$grub-hybrid
+ #$(apply grub.dir grub-hybrid
+ #:bootloader-config config bootmeta)
#$os
image-root
#$output
@@ -954,11 +962,7 @@ (define (operating-system-for-image image)
file-systems
#:volatile-root? volatile-root?
rest)))
- (bootloader (if (eq? format 'iso9660)
- (bootloader-configuration
- (inherit
- (operating-system-bootloader base-os))
- (bootloader grub-mkrescue-bootloader))
+ (bootloader (if (eq? format 'iso9660) '()
(operating-system-bootloader base-os)))
(file-systems (cons (file-system
(mount-point "/")
@@ -1007,17 +1011,28 @@ (define* (system-image image)
(image* (image-with-os* image os))
(image-format (image-format image))
(register-closures? (has-guix-service-type? os))
- (bootcfg (operating-system-bootcfg os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os))))
+ ;; force removable - images don't have efivarfs
+ (bootloader-config (map (lambda (c) (bootloader-configuration
+ (inherit c)
+ (efi-removable? #t)))
+ (operating-system-bootloader os)))
+ (alt (boot-alternative
+ (generation 1)
+ (system-path "/var/guix/profiles/system-1-link")
+ (epoch 0)
+ (parameters (operating-system-boot-parameters os
+ (partition-uuid (find-root-partition image*))
+ #:system-kernel-arguments? #t))))
+ (bootmeta (cons* #:current-boot-alternative alt
+ #:old-boot-alternatives '()
+ (operating-system-bootmeta os))))
(cond
((memq image-format '(disk-image compressed-qcow2))
(system-disk-image image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))))
+ #:inputs `(("system" ,os))))
((memq image-format '(docker))
(system-docker-image image*))
((memq image-format '(tarball))
@@ -1027,11 +1042,10 @@ (define* (system-image image)
((memq image-format '(iso9660))
(system-iso9660-image
image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))
+ #:inputs `(("system" ,os))
;; Make sure to use a mode that does no imply
;; HFS+ tree creation that may fail with:
;;
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 9b618f7dc6..8fb00a6903 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -41,9 +41,7 @@ (define-module (gnu system images hurd)
(define hurd-barebones-os
(operating-system
(inherit %hurd-default-operating-system)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 810e2bed5f..a7a1f499dd 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -39,8 +39,7 @@ (define novena-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-novena-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-novena-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm-generic)
(kernel-arguments '("console=ttymxc1,115200"))
diff --git a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
index 6ec644f113..a3dae24377 100644
--- a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
+++ b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
@@ -39,8 +39,7 @@ (define orangepi-r1-plus-lts-rk3328-barebones-os
(timezone "Europe/Amsterdam")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 457ff4345f..b166838ddd 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -41,8 +41,7 @@ (define pine64-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pine64-lts-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pine64-lts-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 3a0f3abf1f..b26adfb7b9 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -38,8 +38,7 @@ (define pinebook-pro-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pinebook-pro-rk3399-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pinebook-pro-rk3399-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index b3dcfc6193..0b243662d6 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -39,8 +39,7 @@ (define rock64-barebones-os
(timezone "Europe/Oslo")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-rock64-rk3328-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader u-boot-rock64-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/unmatched.scm b/gnu/system/images/unmatched.scm
index d40a32f184..7eb147bbab 100644
--- a/gnu/system/images/unmatched.scm
+++ b/gnu/system/images/unmatched.scm
@@ -39,8 +39,7 @@ (define unmatched-barebones-os
(timezone "Asia/Jerusalem")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-sifive-unmatched-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-sifive-unmatched-bootloader)))
(initrd-modules '())
(kernel linux-libre-riscv64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/visionfive2.scm b/gnu/system/images/visionfive2.scm
index 26f70afbc1..a1c0733692 100644
--- a/gnu/system/images/visionfive2.scm
+++ b/gnu/system/images/visionfive2.scm
@@ -62,8 +62,7 @@ (define visionfive2-barebones-os
(timezone "Etc/UTC")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-starfive-visionfive2-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-starfive-visionfive2-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "Guix_image"))
(mount-point "/")
diff --git a/gnu/system/images/wsl2.scm b/gnu/system/images/wsl2.scm
index d9aaa1a271..1501cb9a90 100644
--- a/gnu/system/images/wsl2.scm
+++ b/gnu/system/images/wsl2.scm
@@ -127,16 +127,6 @@ (define dummy-package
(description #f)
(license (fsdg-compatible "dummy"))))
-(define dummy-bootloader
- (bootloader
- (name 'dummy-bootloader)
- (package dummy-package)
- (configuration-file "/dev/null")
- (configuration-file-generator
- (lambda (. _rest)
- (plain-file "dummy-bootloader" "")))
- (installer #~(const #t))))
-
(define dummy-kernel dummy-package)
(define (dummy-initrd . _rest)
@@ -146,9 +136,7 @@ (define-public wsl-os
(operating-system
(host-name "gnu")
(timezone "Etc/UTC")
- (bootloader
- (bootloader-configuration
- (bootloader dummy-bootloader)))
+ ;; no bootloader
(kernel dummy-kernel)
(initrd dummy-initrd)
(initrd-modules '())
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 0195a0804d..e76d12e95a 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -77,8 +77,7 @@ (define-module (gnu system install)
rock64-installation-os
rockpro64-installation-os
rk3399-puma-installation-os
- wandboard-installation-os
- os-with-u-boot))
+ wandboard-installation-os))
;;; Commentary:
;;;
@@ -503,9 +502,7 @@ (define installation-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(name-service-switch %mdns-host-lookup-nss)
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader (bootloader-configuration (bootloader grub-bootloader)))
(label (string-append "GNU Guix installation "
(or (getenv "GUIX_DISPLAYED_VERSION")
(package-version guix))))
@@ -555,30 +552,14 @@ (define installation-os
%installer-disk-utilities
%base-packages))))
-(define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
- (triplet "arm-linux-gnueabihf"))
- "Given OS, amend it with the u-boot bootloader for BOARD,
-installed to BOOTLOADER-TARGET (a drive), compiled for TRIPLET.
-
-If you want a serial console, make sure to specify one in your
-operating-system's kernel-arguments (\"console=ttyS0\" or similar)."
- (operating-system (inherit os)
- (bootloader (bootloader-configuration
- (bootloader (bootloader (inherit u-boot-bootloader)
- (package (make-u-boot-package board triplet))))
- (targets (list bootloader-target))))))
-
-(define* (embedded-installation-os bootloader bootloader-target tty
- #:key (extra-modules '()))
+(define* (embedded-installation-os bootloader tty #:key (extra-modules '()))
"Return an installation os for embedded systems.
The initrd gets the extra modules EXTRA-MODULES.
A getty is provided on TTY.
The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
(operating-system
(inherit installation-os)
- (bootloader (bootloader-configuration
- (bootloader bootloader)
- (targets (list bootloader-target))))
+ (bootloader (bootloader-configuration (bootloader bootloader)))
(kernel linux-libre)
(kernel-arguments
(cons (string-append "console=" tty)
@@ -587,7 +568,6 @@ (define* (embedded-installation-os bootloader bootloader-target tty
(define beaglebone-black-installation-os
(embedded-installation-os u-boot-beaglebone-black-bootloader
- "/dev/sda"
"ttyO0"
#:extra-modules
;; This module is required to mount the sd card.
@@ -596,77 +576,62 @@ (define beaglebone-black-installation-os
(define a20-olinuxino-lime-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define a20-olinuxino-lime2-emmc-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define a20-olinuxino-micro-installation-os
(embedded-installation-os u-boot-a20-olinuxino-micro-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define bananapi-m2-ultra-installation-os
(embedded-installation-os u-boot-bananapi-m2-ultra-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define firefly-rk3399-installation-os
(embedded-installation-os u-boot-firefly-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define mx6cuboxi-installation-os
(embedded-installation-os u-boot-mx6cuboxi-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
(define novena-installation-os
(embedded-installation-os u-boot-novena-bootloader
- "/dev/mmcblk1" ; SD card storage
"ttymxc1"))
(define nintendo-nes-classic-edition-installation-os
(embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader
- "/dev/mmcblk0" ; SD card (solder it yourself)
"ttyS0"))
(define orangepi-r1-plus-lts-rk3328-installation-os
(embedded-installation-os u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pine64-plus-installation-os
(embedded-installation-os u-boot-pine64-plus-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pinebook-installation-os
(embedded-installation-os u-boot-pinebook-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define rock64-installation-os
(embedded-installation-os u-boot-rock64-rk3328-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rockpro64-installation-os
(embedded-installation-os u-boot-rockpro64-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rk3399-puma-installation-os
(embedded-installation-os u-boot-puma-rk3399-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define wandboard-installation-os
(embedded-installation-os u-boot-wandboard-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
;; Return the default os here so 'guix system' can consume it directly.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a2743453e7..be12ae6b6c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -172,17 +172,6 @@ (define* (virtualized-operating-system os
(operating-system
(inherit os)
- ;; XXX: Until we run QEMU with UEFI support (with the OVMF firmware),
- ;; force the traditional i386/BIOS method.
- ;; See <https://bugs.gnu.org/28768>.
- (bootloader (bootloader-configuration
- (inherit (operating-system-bootloader os))
- (bootloader
- (if (target-riscv64? (or target system))
- u-boot-qemu-riscv64-bootloader
- grub-bootloader))
- (targets '("/dev/vda"))))
-
(initrd (lambda (file-systems . rest)
(apply (operating-system-initrd os)
file-systems
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..18a2fc119b 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -140,7 +140,7 @@ (define-os-with-source (%minimal-extlinux-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
- (bootloader extlinux-bootloader-gpt)
+ (bootloader extlinux-gpt-bootloader)
(targets (list "/dev/vdb"))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1464,9 +1464,11 @@ (define-os-with-source (%btrfs-raid10-root-os
(host-name "hurd")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets (list "/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde"))))
+ (bootloader (map (lambda (targ)
+ (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list targ))))
+ '("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (uuid "16ff18e2-eb41-4324-8df5-80d3b53c411b"))
diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm
index bcc7645fa3..8aa5311171 100644
--- a/gnu/tests/reconfigure.scm
+++ b/gnu/tests/reconfigure.scm
@@ -30,8 +30,7 @@ (define-module (gnu tests reconfigure)
#:use-module (guix scripts system reconfigure)
#:use-module (guix store)
#:export (%test-switch-to-system
- %test-upgrade-services
- %test-install-bootloader))
+ %test-upgrade-services))
;;; Commentary:
;;;
@@ -178,83 +177,6 @@ (define* (run-upgrade-services-test)
(disable (upgrade-services-program '() '() '(dummy) '())))
(test enable disable))))
-(define* (run-install-bootloader-test)
- "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a
-bootloader's configuration file."
- (define os
- (marionette-operating-system
- (simple-operating-system)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
-
- (define vm (virtual-machine
- (operating-system os)
- (volatile? #f)))
-
- (define (test script)
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (ice-9 regex)
- (srfi srfi-1)
- (srfi srfi-64))
-
- (define marionette
- (make-marionette (list #$vm)))
-
- ;; Return the system generation paths that have GRUB menu entries.
- (define (generations-in-grub-cfg marionette)
- (let ((grub-cfg (marionette-eval
- '(begin
- (use-modules (rnrs io ports))
- (call-with-input-file "/boot/grub/grub.cfg"
- get-string-all))
- marionette)))
- (map (lambda (parameter)
- (second (string-split (match:substring parameter) #\=)))
- (list-matches "system=[^ ]*" grub-cfg))))
-
- (test-runner-current (system-test-runner #$output))
- (test-begin "install-bootloader")
-
- (test-assert "no prior menu entry for system generation"
- (not (member #$os (generations-in-grub-cfg marionette))))
-
- (test-assert "script successfully evaluated"
- (marionette-eval
- '(primitive-load #$script)
- marionette))
-
- (test-assert "menu entry created for system generation"
- (member #$os (generations-in-grub-cfg marionette)))
-
- (test-end))))
-
- (let* ((bootloader ((compose bootloader-configuration-bootloader
- operating-system-bootloader)
- os))
- ;; The typical use-case for 'install-bootloader-program' is to read
- ;; the boot parameters for the existing menu entries on the system,
- ;; parse them with 'boot-parameters->menu-entry', and pass the
- ;; results to 'operating-system-bootcfg'. However, to obtain boot
- ;; parameters, we would need to start the marionette, which we should
- ;; ideally avoid doing outside of the 'test' G-Expression. Thus, we
- ;; generate a bootloader configuration for the script as if there
- ;; were no existing menu entries. In the grand scheme of things, this
- ;; matters little -- these tests should not make assertions about the
- ;; behavior of 'operating-system-bootcfg'.
- (bootcfg (operating-system-bootcfg os '()))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (gexp->derivation
- "install-bootloader"
- ;; Due to the read-only nature of the virtual machines used in the system
- ;; test suite, the bootloader installer script is omitted. 'grub-install'
- ;; would attempt to write directly to the virtual disk if the
- ;; installation script were run.
- (test
- (install-bootloader-program #f #f #f bootcfg bootcfg-file '(#f) "/")))))
-
-
(define %test-switch-to-system
(system-test
(name "switch-to-system")
@@ -267,9 +189,3 @@ (define %test-upgrade-services
(description "Upgrade the Shepherd by unloading obsolete services and
loading new services.")
(value (run-upgrade-services-test))))
-
-(define %test-install-bootloader
- (system-test
- (name "install-bootloader")
- (description "Install a bootloader and its configuration file.")
- (value (run-install-bootloader-test))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 344bb74151..aba637f6e3 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -209,7 +209,7 @@ (define* (copy-closure item target
(define* (install os-drv target
#:key (log-port (current-output-port))
- install-bootloader? bootloader bootcfg)
+ install-bootloader? bootloaders bootmeta)
"Copy the closure of BOOTCFG, which includes the output of OS-DRV, to
directory TARGET. TARGET must be an absolute directory name since that's what
'register-path' expects.
@@ -247,24 +247,27 @@ (define* (install os-drv target
(chmod target #o755)
(let ((os-dir (derivation->output-path os-drv))
(format (lift format %store-monad))
- (populate (lift2 populate-root-file-system %store-monad)))
-
- (mlet %store-monad ((bootcfg (lower-object bootcfg)))
- (mbegin %store-monad
- ;; Copy the closure of BOOTCFG, which includes OS-DIR,
- ;; eventual background image and so on.
- (maybe-copy (derivation->output-path bootcfg))
-
- ;; Create a bunch of additional files.
- (format log-port "populating '~a'...~%" target)
- (populate os-dir target)
-
+ (populate (lift2 populate-root-file-system %store-monad))
+ (profile (string-append target "/var/guix/profiles/system")))
+
+ (mbegin %store-monad
+ ;; Create a bunch of system files.
+ (format log-port "populating '~a'...~%" target)
+ (populate os-dir target)
+
+ ;; Copy the bootloader's closure, which includes OS-DIR,
+ ;; eventual background image and so on.
+ (mlet* %store-monad
+ ((alt -> (generation->boot-alternative profile 1))
+ (inst (apply install-bootloader local-eval bootloaders
+ (list alt) #:dry-run (not install-bootloader?)
+ #:root-offset target bootmeta)))
+ (maybe-copy (derivation->output-path inst)))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target target)
(return
(info (G_ "bootloader successfully installed on~{ ~a~}~%")
- (bootloader-configuration-targets bootloader))))))))
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))))
\f
;;;
@@ -389,20 +392,13 @@ (define (install-bootloader-from-provenance store number)
(let* ((generation (generation-file-name %system-profile number))
(os (receive (_ os) (system-provenance generation)
(and=> os read-operating-system)))
- (bootloader-config (operating-system-bootloader os))
- (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (new (generation->boot-alternative %system-profile number))
(numbers (delv number (reverse (generation-numbers %system-profile))))
(old (profile->boot-alternatives %system-profile numbers)))
(if os
(run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object (operating-system-bootcfg os old)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))
+ (apply install-bootloader local-eval (operating-system-bootloader os)
+ (cons new old) (operating-system-bootmeta os)))
(leave (G_ "cannot rollback to provenanceless generation '~a'~%")
number))))
@@ -489,7 +485,8 @@ (define* (display-system-generation number
(format #t (G_ " canonical file name: ~a~%") (readlink* generation))
;; TRANSLATORS: Please preserve the two-space indentation.
(format #t (G_ " label: ~a~%") label)
- (format #t (G_ " bootloader: ~a~%") bootloader-name)
+ (format #t (G_ " bootloader: ~a~%")
+ (string-join (map symbol->string bootloader-name)))
;; TRANSLATORS: The '~[', '~;', and '~]' sequences in this string must
;; be preserved. They denote conditionals, such that the result will
@@ -775,18 +772,11 @@ (define* (perform-action action image
(define os
(image-operating-system image))
- (define bootloader
+ (define bootloaders
(operating-system-bootloader os))
- (define bootcfg
- (and (memq action '(init reconfigure))
- (operating-system-bootcfg
- os
- (if (eq? action 'init)
- '()
- (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (profile->boot-alternatives)))))))
+ (define bootmeta
+ (operating-system-bootmeta os))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
@@ -817,10 +807,7 @@ (define* (perform-action action image
;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root.
;; See <http://bugs.gnu.org/21068>.
- (drvs (mapm/accumulate-builds lower-object
- (if (memq action '(init reconfigure))
- (list sys bootcfg)
- (list sys))))
+ (drvs (mapm/accumulate-builds lower-object (list sys)))
(% (if derivations-only?
(return (for-each (compose println derivation-file-name)
drvs))
@@ -838,12 +825,16 @@ (define* (perform-action action image
(format #t (G_ "activating system...~%"))
(mbegin %store-monad
(switch-to-system local-eval os)
+ (apply install-bootloader local-eval bootloaders
+ (profile->boot-alternatives)
+ #:dry-run? (not install-bootloader?)
+ (if target (cons* #:root-offset target bootmeta) bootmeta))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target (or target "/"))
(return
(info (G_ "bootloader successfully installed on '~a'~%")
- (bootloader-configuration-targets bootloader))))
+ (map bootloader-target-path
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))
(with-shepherd-error-handling
(upgrade-shepherd-services local-eval os)
(return (format #t (G_ "\
@@ -857,8 +848,8 @@ (define* (perform-action action image
target)
(install sys (canonicalize-path target)
#:install-bootloader? install-bootloader?
- #:bootloader bootloader
- #:bootcfg bootcfg))
+ #:bootloaders bootloaders
+ #:bootmeta bootmeta))
(else
;; All we had to do was to build SYS and maybe register an
;; indirect GC root.
@@ -1254,11 +1245,7 @@ (define (process-action action args opts)
(G_ "image lacks an operating-system")))))
(target-file (match args
((first second) second)
- (_ #f)))
- (bootloader-targets
- (and bootloader?
- (bootloader-configuration-targets
- (operating-system-bootloader os)))))
+ (_ #f))))
(define (graph-backend)
(lookup-backend (assoc-ref opts 'graph-backend)))
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 604ba08fee..8add639e6a 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -209,101 +210,83 @@ (define* (upgrade-shepherd-services eval os)
;;; Bootloader configuration.
;;;
-(define (install-bootloader-program installer disk-installer
- bootloader-package bootcfg
- bootcfg-file devices target)
+(define (install-bootloader-program configs offset chosen-alt old-alts locale
+ store-crypto-devices store-directory-prefix)
"Return an executable store item that, upon being evaluated, will install
BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICES, a list of file system
devices, at TARGET, a mount point, and subsequently run INSTALLER from
BOOTLOADER-PACKAGE."
(program-file
- "install-bootloader.scm"
- (with-extensions (list guile-gcrypt)
- (with-imported-modules `(,@(source-module-closure
- '((gnu build bootloader)
- (gnu build install)
- (guix store)
- (guix utils))
- #:select? not-config?)
- ((guix config) => ,(make-config.scm)))
- #~(begin
- (use-modules (gnu build bootloader)
- (gnu build install)
- (guix build utils)
- (guix store)
- (guix utils)
- (ice-9 binary-ports)
- (ice-9 match)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (let* ((gc-root (string-append #$target %gc-roots-directory "/bootcfg"))
- (new-gc-root (string-append gc-root ".new")))
- ;; #$bootcfg has dependencies.
- ;; The bootloader magically loads the configuration from
- ;; (string-append #$target #$bootcfg-file) (for example
- ;; "/boot/grub/grub.cfg").
- ;; If we didn't do something special, the garbage collector
- ;; would remove the dependencies of #$bootcfg.
- ;; Register #$bootcfg as a GC root.
- ;; Preserve the previous activation's garbage collector root
- ;; until the bootloader installer has run, so that a failure in
- ;; the bootloader's installer script doesn't leave the user with
- ;; a broken installation.
- (switch-symlinks new-gc-root #$bootcfg)
- (install-boot-config #$bootcfg #$bootcfg-file #$target)
- (when (or #$installer #$disk-installer)
- (catch #t
- (lambda ()
- ;; The bootloader might not support installation on a
- ;; mounted directory using the BOOTLOADER-INSTALLER
- ;; procedure. In that case, fallback to installing the
- ;; bootloader directly on DEVICES using the
- ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
- (if #$installer
- (for-each (lambda (device)
- (#$installer #$bootloader-package device
- #$target))
- '#$devices)
- (for-each (lambda (device)
- (#$disk-installer #$bootloader-package
- 0 device))
- '#$devices)))
- (lambda args
- (delete-file new-gc-root)
- (match args
- (('%exception exception) ;Guile 3 SRFI-34 or similar
- (raise-exception exception))
- ((key . args)
- (apply throw key args))))))
- ;; We are sure that the installation of the bootloader
- ;; succeeded, so we can replace the old GC root by the new
- ;; GC root now.
- (rename-file new-gc-root gc-root)))))))
+ "install-bootloader.scm"
+ ;; three sources of boot entries: bootloader-configuration-menu-entries,
+ ;; current-boot-alternative, and old-boot-alternatives.
+ (let ((args (list #:current-boot-alternative chosen-alt
+ #:old-boot-alternatives old-alts
+ #:locale locale
+ #:store-directory-prefix store-directory-prefix
+ #:store-crypto-devices store-crypto-devices)))
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules
+ `(,@(source-module-closure '((gnu build bootloader)
+ (gnu build install)
+ (guix store)
+ (guix utils))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (gnu build bootloader)
+ (gnu build install)
+ (guix build utils)
+ (guix store)
+ (guix utils)
+ (ice-9 binary-ports)
+ (ice-9 match)
+ (srfi srfi-34)
+ (srfi srfi-35))
+ ;; bootloader-installer is passed an additional #:target argument
+ ;; denoting the specific target currently being installed to.
+ ;; bootloaders should determine when to fully reinstall themselves.
+ #$(bootloader-configurations->gexp configs args
+ #:root-offset offset)))))))
-(define* (install-bootloader eval configuration bootcfg
- #:key
- (run-installer? #t)
- (target "/"))
+(define* (install-bootloader eval configs alts #:key locale
+ store-crypto-devices store-directory-prefix
+ (root-offset "/") (dry-run? #f))
"Using EVAL, a monadic procedure taking a single G-Expression as an argument,
-configure the bootloader on TARGET such that OS will be booted by default and
-additional configurations specified by MENU-ENTRIES can be selected."
- (let* ((bootloader (bootloader-configuration-bootloader configuration))
- (installer (and run-installer?
- (bootloader-installer bootloader)))
- (disk-installer (and run-installer?
- (bootloader-disk-image-installer bootloader)))
- (package (bootloader-package bootloader))
- (devices (bootloader-configuration-targets configuration))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
- (primitive-load #$(install-bootloader-program installer
- disk-installer
- package
- bootcfg
- bootcfg-file
- devices
- target))))))
+configure the bootloader with bootloader-configuration CONFIG such that
+ALTS may be selected, with the first element being the default. If QUICK? only
+the bootloader config is reinstalled. Returns the config installer drv."
+ (mlet* %store-monad
+ ((program (lower-object
+ (install-bootloader-program configs root-offset
+ (car alts) (cdr alts) locale
+ store-crypto-devices store-directory-prefix))))
+ (mbegin %store-monad
+ (eval
+ (with-imported-modules `(,@(source-module-closure '((guix build utils)
+ (guix store))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (guix build utils) (guix store))
+ (parameterize ((current-warning-port (%make-void-port "w")))
+ (let* ((gc-root (string-append
+ #$root-offset %gc-roots-directory "/bootcfg"))
+ (new-gc-root (string-append gc-root ".new")))
+ ;; since the installers are gexps directly included, we add
+ ;; the installer runner as a gc root. this should make sure
+ ;; no bootloader files get gc'd. only remove the old one on
+ ;; success.
+ ;; XXX: is this still necessary?
+ (switch-symlinks new-gc-root #$program)
+ (dynamic-wind (const #t)
+ (lambda ()
+ (unless #$dry-run? (primitive-load #$program))
+ (rename-file new-gc-root gc-root))
+ (lambda () ; delete new root if failed
+ (when (file-exists? new-gc-root)
+ (delete-file new-gc-root)))))))))
+ (return program))))
\f
;;;
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 05/15] gnu: system: Remove useless boot parameters.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (3 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
` (10 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov
* gnu/system.scm (operating-system-boot-parameters,
operating-system-boot-parameters-file): Delete
bootloader-menu-entries.
* gnu/system/boot.scm (boot-parameters)[bootloader-menu-entries]: Delete
fields.
(read-boot-parameters): Don't read bootloader-menu-entries.
* tests/boot-parameters.scm (%grub-boot-parameters,
test-read-boot-parameters, test-read-boot-parameters): Don't include
bootloader-menu-entries.
("read, bootloader-menu-entries, default value"): Delete test.
Change-Id: I46d9cff4604dbfcf654b0820fdb77e72aecffbb4
---
gnu/system.scm | 7 -------
gnu/system/boot.scm | 8 --------
tests/boot-parameters.scm | 14 ++------------
3 files changed, 2 insertions(+), 27 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index a345b52d55..66c1a80733 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1304,8 +1304,6 @@ (define* (operating-system-boot-parameters os root-device
(initrd initrd)
(multiboot-modules multiboot-modules)
(bootloader-name bootloader-name)
- (bootloader-menu-entries
- (bootloader-configuration-menu-entries (operating-system-bootloader os)))
(locale locale)
(store-device (ensure-not-/dev (file-system-device store)))
(store-directory-prefix (btrfs-store-subvolume-file-name file-systems))
@@ -1347,11 +1345,6 @@ (define* (operating-system-boot-parameters-file os)
#$(boot-parameters-multiboot-modules params)))
#~())
(bootloader-name #$(boot-parameters-bootloader-name params))
- (bootloader-menu-entries
- #$(map menu-entry->sexp
- (or (and=> (operating-system-bootloader os)
- bootloader-configuration-menu-entries)
- '())))
(locale #$(boot-parameters-locale params))
(store
(device
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 2b5302ce5f..4d89827ced 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -54,7 +54,6 @@ (define-module (gnu system boot)
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
@@ -113,8 +112,6 @@ (define-record-type* <boot-parameters>
;; 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)
@@ -176,11 +173,6 @@ (define (read-boot-parameters port)
((_ args) (list 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))
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 2e7976aa6c..f214de360d 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -64,7 +64,6 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
@@ -107,7 +106,6 @@ (define* (test-read-boot-parameters
#:key
(version %boot-parameters-version)
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(label %default-label)
(root-device (quote-uuid %default-root-device))
(kernel %default-kernel)
@@ -127,7 +125,7 @@ (define* (test-read-boot-parameters
(cond ((eq? 'false val) (format #false fmt #false))
(val (format #false fmt val))
(else "")))
- (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a~a)"
+ (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a)"
(sexp-or-nothing " (version ~S)" version)
(sexp-or-nothing " (label ~S)" label)
(sexp-or-nothing " (root-device ~S)" root-device)
@@ -145,9 +143,7 @@ (define* (test-read-boot-parameters
store-crypto-devices))
"")
(sexp-or-nothing " (locale ~S)" locale)
- (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)
- (sexp-or-nothing " (bootloader-menu-entries ~S)"
- bootloader-menu-entries)))
+ (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)))
(let ((str (generate-boot-parameters)))
(call-with-input-string str read-boot-parameters)))
@@ -170,7 +166,6 @@ (define* (test-read-boot-parameters
(test-assert "read, construction, optional fields"
(and (test-read-boot-parameters #:bootloader-name #false)
- (test-read-boot-parameters #:bootloader-menu-entries #false)
(test-read-boot-parameters #:kernel-arguments #false)
(test-read-boot-parameters #:with-store #false)
(test-read-boot-parameters #:store-device #false)
@@ -223,11 +218,6 @@ (define* (test-read-boot-parameters
(boot-parameters-bootloader-name
(test-read-boot-parameters #:bootloader-name #false)))
-(test-eq "read, bootloader-menu-entries, default value"
- '()
- (boot-parameters-bootloader-menu-entries
- (test-read-boot-parameters #:bootloader-menu-entries #false)))
-
(test-eq "read, kernel-arguments, default value"
'()
(boot-parameters-kernel-arguments
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 06/15] gnu: bootloader: Add raspberry pi bootloader.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (4 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
` (9 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Efraim Flashner,
Lilah Tascheter, Vagrant Cascadian
Less adding and more making it an actual bootloader rather than some
weirdly specified packages.
* gnu/bootloader/u-boot.scm (rpi-config, install-rpi): New procedures.
(define-u-bootloader-rpi): New macro.
(u-boot-rpi-2-bootloader, u-boot-rpi-3-bootloader,
u-boot-rpi-4-bootloader, u-boot-rpi-bootloader): New variables.
* gnu/packages/bootloaders.scm (make-u-boot-bin-package): Delete
procedure.
(%u-boot-rpi-efi-description, %u-boot-rpi-efi-description-32-bit,
u-boot-rpi-2-efi, u-boot-rpi-3-32b-efi, u-boot-rpi-4-32b-efi,
u-boot-rpi-arm64-efi, u-boot-rpi-2-bin, u-boot-rpi-3_32b-bin,
u-boot-rpi-4_32b-bin, u-boot-rpi-arm64-bin, u-boot-rpi-2-efi-bin,
u-boot-rpi-3-32b-efi-bin, u-boot-rpi-4-32b-efi-bin,
u-boot-rpi-arm64-efi-bin): Delete variables.
Change-Id: I5139a0b00ec89189e8e7c84e06a7a3b7240259cd
---
gnu/bootloader/u-boot.scm | 66 ++++++++++++++++++++++++-
gnu/packages/bootloaders.scm | 94 +++---------------------------------
2 files changed, 71 insertions(+), 89 deletions(-)
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 7d3e202f8c..e8dfe9b3a2 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -28,7 +28,10 @@ (define-module (gnu bootloader u-boot)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages raspberry-pi)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix utils)
#:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
@@ -51,7 +54,11 @@ (define-module (gnu bootloader u-boot)
u-boot-qemu-riscv64-bootloader
u-boot-starfive-visionfive2-bootloader
u-boot-ts7970-q-2g-1000mhz-c-bootloader
- u-boot-wandboard-bootloader))
+ u-boot-wandboard-bootloader
+ u-boot-rpi-2-bootloader
+ u-boot-rpi-3-bootloader
+ u-boot-rpi-4-bootloader
+ u-boot-rpi-bootloader))
(define (make-install-u-boot firmware installers)
(lambda* (#:key bootloader-config #:allow-other-keys . args)
@@ -222,3 +229,60 @@ (define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
u-boot-qemu-riscv64 "u-boot.bin")
+
+\f
+;;;
+;;; RasPi bootloader definitions.
+;;;
+
+(define (rpi-config 32?)
+ ;; allows a user-specified custom.txt
+ (plain-file "config.txt"
+ (format #f
+ "arm_64bit=~a~%enable_uart=1~%kernel=u-boot.bin~%include custom.txt~%"
+ (if (or 32? (not (target-64bit?))) "0" "1"))))
+
+(define (install-rpi u-boot-32 u-boot-64)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('install (apply install-extlinux-config args))
+ (('firmware => (firmware :path))
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (use-32? (or 32? (not (target-64bit?)) (not u-boot-64))))
+ #~(begin
+ (atomic-copy #$(file-append (if use-32? u-boot-32 u-boot-64)
+ "/libexec/u-boot.bin")
+ (string-append #$firmware "/u-boot.bin"))
+ (atomic-copy #$(rpi-config use-32?)
+ (string-append #$firmware "/config.txt"))))))))
+
+(define-syntax-rule (define-u-bootloader-rpi def-name u-boot-32 u-boot-64)
+ (define def-name
+ (bootloader (name 'u-boot)
+ (default-targets
+ (list (bootloader-target (type 'install)
+ (offset 'firmware)
+ (path "extlinux"))
+ (bootloader-target (type 'firmware)
+ (offset 'root)
+ (path "boot"))))
+ (installer (install-rpi u-boot-32 u-boot-64)))))
+
+
+;; These neither install firmware nor device-tree files for the Raspberry Pi.
+;; They just assume them to be existing in 'install in the same way that some
+;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
+;; They can be used with either extlinux or as UEFI firmware (alongside, eg,
+;; GRUB).
+(define-u-bootloader-rpi u-boot-rpi-2-bootloader
+ u-boot-rpi-2 #f)
+
+(define-u-bootloader-rpi u-boot-rpi-3-bootloader
+ u-boot-rpi-3-32b u-boot-rpi-arm64)
+
+(define-u-bootloader-rpi u-boot-rpi-4-bootloader
+ u-boot-rpi-4-32b u-boot-rpi-arm64)
+
+;; Usable for any 64-bit raspberry pi.
+(define-u-bootloader-rpi u-boot-rpi-bootloader
+ #f u-boot-rpi-arm64)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 12f918a123..e78602379d 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -1409,40 +1409,8 @@ (define-public u-boot-pinebook-pro-rk3399
(modify-inputs (package-inputs base)
(append arm-trusted-firmware-rk3399))))))
-(define*-public (make-u-boot-bin-package u-boot-package
- #:key
- (u-boot-bin "u-boot.bin"))
- "Return a package with a single U-BOOT-BIN file from the U-BOOT-PACKAGE.
-The package name will be that of the U-BOOT package suffixed with \"-bin\"."
- (package
- (name (string-append (package-name u-boot-package) "-bin"))
- (version (package-version u-boot-package))
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (list
- #:builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils))
- (mkdir #$output)
- (symlink (search-input-file %build-inputs
- (string-append "libexec/" #$u-boot-bin))
- (string-append #$output "/" #$u-boot-bin))))))
- (inputs (list u-boot-package))
- (home-page (package-home-page u-boot-package))
- (synopsis (package-synopsis u-boot-package))
- (description (string-append
- (package-description u-boot-package)
- "\n\n"
- (format #f
- "This package only contains the file ~a."
- u-boot-bin)))
- (license (package-license u-boot-package))))
-
-(define-public %u-boot-rpi-efi-configs
- '("CONFIG_OF_EMBED"
- "CONFIG_OF_BOARD=y"))
+;; get dtbs from firmware to support dtoverlays
+(define-public %u-boot-rpi-configs '("CONFIG_OF_EMBED" "CONFIG_OF_BOARD=y"))
(define %u-boot-rpi-description-32-bit
"This is a 32-bit build of U-Boot.")
@@ -1451,76 +1419,26 @@ (define %u-boot-rpi-description-64-bit
"This is a common 64-bit build of U-Boot for all 64-bit capable Raspberry Pi
variants.")
-(define %u-boot-rpi-efi-description
- "It allows network booting and uses the device-tree from the firmware,
-allowing the usage of overlays. It can act as an EFI firmware for the
-grub-efi-netboot-removable-bootloader.")
-
-(define %u-boot-rpi-efi-description-32-bit
- (string-append %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-32-bit))
-
(define-public u-boot-rpi-2
(make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-3-32b
(make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-4-32b
(make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-arm64
(make-u-boot-package "rpi_arm64" "aarch64-linux-gnu"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-64-bit))
-(define-public u-boot-rpi-2-efi
- (make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-3-32b-efi
- (make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-4-32b-efi
- (make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-arm64-efi
- (make-u-boot-package "rpi_arm64""aarch64-linux-gnu"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description (string-append
- %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-64-bit)))
-
-(define-public u-boot-rpi-2-bin (make-u-boot-bin-package u-boot-rpi-2))
-
-(define-public u-boot-rpi-3_32b-bin (make-u-boot-bin-package u-boot-rpi-3-32b))
-
-(define-public u-boot-rpi-4_32b-bin (make-u-boot-bin-package u-boot-rpi-4-32b))
-
-(define-public u-boot-rpi-arm64-bin (make-u-boot-bin-package u-boot-rpi-arm64))
-
-(define-public u-boot-rpi-2-efi-bin (make-u-boot-bin-package u-boot-rpi-2-efi))
-
-(define-public u-boot-rpi-3-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-3-32b-efi))
-
-(define-public u-boot-rpi-4-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-4-32b-efi))
-
-(define-public u-boot-rpi-arm64-efi-bin
- (make-u-boot-bin-package u-boot-rpi-arm64-efi))
-
(define u-boot-ts-mx6
;; There is no release; use the latest commit of the
;; 'imx_v2015.04_3.14.52_1.1.0_ga' branch.
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 07/15] gnu: system: Fix bootloader crypto device recognition.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (5 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
` (8 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov
* gnu/system.scm (operating-system-bootloader-crypto-devices): Check for
luks-device-mapping-with-options in addition to luks-device-mapping.
Change-Id: Iafc9afe608640b97083c4d559c9240846330472a
---
gnu/system.scm | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 66c1a80733..093c8fa350 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -400,10 +400,12 @@ (define operating-system-bootloader-crypto-devices
(mlambdaq (os) ;to avoid duplicated output
"Return the sources of the LUKS mapped devices specified by UUID."
;; XXX: Device ordering is important, we trust the returned one.
- (let* ((luks-devices (filter (lambda (m)
- (eq? luks-device-mapping
- (mapped-device-type m)))
- (operating-system-boot-mapped-devices os)))
+ ;; Check against the close-luks-device procedure to get both maptypes
+ (let* ((close (mapped-device-kind-close luks-device-mapping))
+ (luks? (lambda (m) (let ((t (mapped-device-type m)))
+ (eq? (mapped-device-kind-close t) close))))
+ (luks-devices (filter luks?
+ (operating-system-boot-mapped-devices os)))
(uuid-crypto-devices non-uuid-crypto-devices
(partition (compose uuid? mapped-device-source)
luks-devices)))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 08/15] gnu: packages: Add pesign.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (6 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
` (7 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov
* gnu/packages/efi.scm (pesign): New variable.
Change-Id: I00fcc679d9514c85d508183b9ec7e121e0a814db
---
gnu/packages/efi.scm | 47 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 47 insertions(+)
diff --git a/gnu/packages/efi.scm b/gnu/packages/efi.scm
index 499745eba1..417b70d91b 100644
--- a/gnu/packages/efi.scm
+++ b/gnu/packages/efi.scm
@@ -24,8 +24,10 @@ (define-module (gnu packages efi)
#:use-module (gnu packages bash)
#:use-module (gnu packages linux)
#:use-module (gnu packages man)
+ #:use-module (gnu packages nss)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages popt)
#:use-module (gnu packages tls)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
@@ -153,6 +155,51 @@ (define-public sbsigntools
(home-page "https://git.kernel.org/pub/scm/linux/kernel/git/jejb/sbsigntools.git/")
(license license:gpl3+)))
+(define-public pesign
+ (package
+ (name "pesign")
+ (version "116")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/rhboot/pesign")
+ (commit version)))
+ (snippet #~(substitute* "Make.defaults"
+ (("pkg-config-ccldflags") "pkg-config-ldflags")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "0fnqfiivj46bha4hsnwiqy8vq8b4i3w2dig0h9h2k4j7yq7r5qvj"))))
+ (build-system gnu-build-system)
+ (arguments
+ (list #:tests? #f
+ #:modules '((guix build gnu-build-system)
+ (guix build utils)
+ (ice-9 match))
+ #:phases #~(modify-phases %standard-phases (delete 'configure))
+ #:make-flags
+ (let ((system (%current-system)) (target (%current-target-system)))
+ (define (arch s) (match (string-split s #\-)
+ (("i386" _ ...) "ia32")
+ (("i486" _ ...) "ia32")
+ (("i586" _ ...) "ia32")
+ (("i686" _ ...) "ia32")
+ ((x _ ...) x)))
+ #~(list "prefix=/" "libdir=/lib/"
+ (string-append "DESTDIR=" #$output)
+ (string-append "HOSTARCH=" #$(arch system))
+ (string-append "ARCH=" #$(arch (or target system)))
+ (string-append "CROSS_COMPILE="
+ #$@(if target (list target "-gcc") '()))))))
+ (inputs (list efivar nspr nss popt `(,util-linux "lib")))
+ (native-inputs (list mandoc pkg-config))
+ (synopsis "PE-COFF binary signing tools")
+ (description "Supports EFI keygen and subsequent signing of PE-COFF
+binaries. Contains the tools authvar, efikeygen, pesigcheck, pesign,
+pesign-client, and pesum.")
+ (home-page "https://github.com/rhboot/pesign")
+ (license license:gpl2+)))
+
(define-public efitools
(package
(name "efitools")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 09/15] gnu: packages: Add ukify.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (7 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
` (6 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Efraim Flashner,
Vagrant Cascadian
* gnu/packages/bootloaders.scm
(systemd-version,systemd-source,ukify): New variables.
Change-Id: Icde59b7266529c8002331ff0375e0a35af3a2add
---
gnu/packages/bootloaders.scm | 54 ++++++++++++++++++++++++++++++++++++
1 file changed, 54 insertions(+)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index e78602379d..04bb1b06f0 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -20,6 +20,7 @@
;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Herman Rimm <herman@rimm.ee>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,6 +48,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages disk)
+ #:use-module (gnu packages efi)
#:use-module (gnu packages firmware)
#:use-module (gnu packages flex)
#:use-module (gnu packages fontutils)
@@ -73,11 +75,13 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages valgrind)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages xorg)
+ #:use-module (gnu packages python-crypto)
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz)
#:use-module (guix build-system gnu)
#:use-module (guix build-system meson)
#:use-module (guix build-system pyproject)
+ #:use-module (guix build-system python)
#:use-module (guix build-system trivial)
#:use-module (guix download)
#:use-module (guix gexp)
@@ -573,6 +577,56 @@ (define-public syslinux
;; Also contains:
license:expat license:isc license:zlib)))))
+(define systemd-version "255")
+(define systemd-source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/systemd/systemd")
+ (commit (string-append "v" systemd-version))))
+ (file-name (git-file-name "systemd" systemd-version))
+ (snippet #~(substitute* "src/ukify/ukify.py" ; remove after python 3.11
+ (("datetime\\.UTC") "datetime.timezone.utc")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+
+(define-public ukify
+ (package
+ (name "ukify")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system python-build-system)
+ (arguments
+ (list #:phases
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key inputs #:allow-other-keys)
+ (define (get-tool tool)
+ (search-input-file inputs (string-append "bin/" tool)))
+
+ (substitute* "src/ukify/ukify.py" ; hardcode tool paths
+ (("(find_tool\\(')(readelf|sbsign|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',"))
+ (("('name': ')(sbverify|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',")))))
+ (delete 'check)
+ (replace 'install
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let* ((bin (string-append #$output "/bin"))
+ (file (string-append bin "/ukify")))
+ (mkdir-p bin)
+ (copy-file "src/ukify/ukify.py" file)))))))
+ (inputs
+ (list binutils pesign python-cryptography python-pefile sbsigntools))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI tool")
+ (description "@command{ukify} joins together a UKI stub, linux kernel, initrd,
+kernel arguments, and optional secure boot signatures into a single, UEFI-bootable
+image.")
+ (license license:lgpl2.1+)))
+
(define-public dtc
(package
(name "dtc")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 10/15] gnu: packages: Add systemd-stub.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (8 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
` (5 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Efraim Flashner,
Lilah Tascheter, Vagrant Cascadian
* gnu/bootloader.scm (%efi-supported-systems, lazy-efibootmgr): New variable.
(install-efi): Use lazy-efibootmgr.
* gnu/packages/bootloaders.scm (systemd-stub): New variable.
Change-Id: I974bad9ff7a52f736286d05de53f7c5ccb60b9d6
---
gnu/bootloader.scm | 13 +++++++++--
gnu/packages/bootloaders.scm | 43 ++++++++++++++++++++++++++++++++++++
2 files changed, 54 insertions(+), 2 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index cb96b076ae..bc1eb74ae9 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -28,7 +28,6 @@ (define-module (gnu bootloader)
#:autoload (gnu build file-systems)
(read-partition-label read-partition-uuid
find-partition-by-label find-partition-by-uuid)
- #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:autoload (guix build syscalls)
@@ -115,6 +114,7 @@ (define-module (gnu bootloader)
bootloader-configuration->gexp
bootloader-configurations->gexp
+ %efi-supported-systems
efi-arch
install-efi))
@@ -645,6 +645,11 @@ (define (bootloader-configurations->gexp bootloader-configs . rest)
;;; EFI shit
;;;
+;; systems currently supported by efi-arch. should be used for packages relying
+;; on it.
+(define %efi-supported-systems
+ '("i686-linux" "x86_64-linux" "armhf-linux" "aarch64-linux" "riscv64-linux"))
+
(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
(32? #f))
"Returns the UEFI architecture name for the current target, in lowercase."
@@ -656,6 +661,10 @@ (define* (efi-arch #:key (target (or (%current-target-system) (%current-system))
(else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
target)))))
+(define (lazy-efibootmgr)
+ "Lazy-loaded efibootmgr package, in order to prevent circular refs."
+ (module-ref (resolve-interface '(gnu packages linux)) 'efibootmgr))
+
(define (install-efi bootloader-config plan)
"Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
@@ -678,5 +687,5 @@ (define (install-efi bootloader-config plan)
;; normal install when not doing a removable config
(with-targets targets
(('vendir => (vendir :path) (loader :devpath) (disk :device))
- #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #~(install-efi #+(file-append (lazy-efibootmgr) "/sbin/efibootmgr")
#$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 04bb1b06f0..2bc04059d2 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -38,6 +38,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages bootloaders)
+ #:use-module (gnu bootloader)
#:use-module (gnu packages)
#:use-module (gnu packages assembly)
#:use-module (gnu packages base)
@@ -54,6 +55,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gcc)
#:use-module (gnu packages gettext)
+ #:use-module (gnu packages gperf)
#:use-module (gnu packages linux)
#:use-module (gnu packages llvm)
#:use-module (gnu packages man)
@@ -592,6 +594,47 @@ (define systemd-source
(base32
"1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+(define-public systemd-stub
+ (package
+ (name "systemd-stub")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system meson-build-system)
+ (arguments
+ (list #:configure-flags
+ #~(list "-Dmode=release" "-Defi=true" "-Dsbat-distro=guix"
+ "-Dsbat-distro-generation=1" ; package revision!
+ "-Dsbat-distro-summary=Guix System"
+ "-Dsbat-distro-url=https://guix.gnu.org"
+ #$(string-append "-Dsbat-distro-pkgname="
+ (package-name this-package))
+ #$(string-append "-Dsbat-distro-version="
+ (package-version this-package)))
+ #:phases
+ ;; TODO: 32bit support
+ (let* ((stub (string-append
+ "src/boot/efi/linux" (efi-arch) ".efi.stub")))
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key parallel-build? #:allow-other-keys)
+ (invoke "ninja" #$stub
+ "-j" (if parallel-build?
+ (number->string (parallel-job-count)) "1"))))
+ (replace 'install
+ (lambda _
+ (let ((libexec (string-append #$output "/libexec")))
+ (install-file #$stub libexec))))
+ (delete 'check)))))
+ (supported-systems %efi-supported-systems)
+ (inputs (list libcap python-pyelftools `(,util-linux "lib")))
+ (native-inputs (list gperf pkg-config python-3 python-jinja2))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI stub")
+ (description "Simple UEFI boot stub that loads a conjoined kernel image and
+supporting data to their proper locations, before chainloading to the kernel.
+Supports measured and/or verified boot environments.")
+ (license license:lgpl2.1+)))
+
(define-public ukify
(package
(name "ukify")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 11/15] gnu: bootloaders: Add uki-efi-bootloader.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (9 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
` (4 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Lilah Tascheter
* gnu/bootloader.scm (<bootloader-configuration>): New keypair field.
* gnu/bootloader/uki.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add bootloader/uki.scm.
Change-Id: I2097da9f3dd35137b3419f6d0545de26d53cb6da
---
gnu/bootloader.scm | 3 ++
gnu/bootloader/uki.scm | 96 ++++++++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 100 insertions(+)
create mode 100644 gnu/bootloader/uki.scm
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index bc1eb74ae9..a83d057bda 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -101,6 +101,7 @@ (define-module (gnu bootloader)
bootloader-configuration-default-entry
bootloader-configuration-efi-removable?
bootloader-configuration-32bit?
+ bootloader-configuration-keypair
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -524,6 +525,8 @@ (define-record-type* <bootloader-configuration>
(default #f)) ;bool
(32bit? bootloader-configuration-32bit?
(default #f)) ;bool
+ (keypair bootloader-configuration-keypair
+ (default #f)) ;(cert . priv) pair
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
diff --git a/gnu/bootloader/uki.scm b/gnu/bootloader/uki.scm
new file mode 100644
index 0000000000..4871dbe037
--- /dev/null
+++ b/gnu/bootloader/uki.scm
@@ -0,0 +1,96 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; 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 bootloader uki)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages efi)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu system boot)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:export (uki-efi-bootloader))
+
+;; TODO: support 32bit/mixed-mode UEFI.
+;; https://github.com/systemd/systemd/issues/17056 may be relevant
+(define bootcfg->menu-entry->builder
+ (match-record-lambda <bootloader-configuration> (32bit? theme keypair)
+ (match-record-lambda <menu-entry>
+ (label linux linux-arguments initrd chain-loader)
+ ;; support chainloader in order to allow arbitrary signed EFI binaries
+ (cond
+ ((and chain-loader keypair)
+ #~(lambda (dest)
+ (invoke/quiet #+(sbsigntools "/bin/sbsign")
+ "--cert" #$(car keypair) "--key" #$(cdr keypair)
+ "--output" dest #$chain-loader)
+ (invoke/quiet #+(sbsigntools "/bin/sbverify")
+ "--cert" #$(car keypair) dest)))
+ (chain-loader #~(lambda (dest) (copy-file #$chain-loader dest)))
+ (linux
+ (let* ((arch (efi-arch #:32? 32bit?))
+ (stub (file-append systemd-stub
+ "/libexec/linux" arch ".efi.stub")))
+ #~(lambda (dest)
+ (invoke/quiet #+(file-append ukify "/bin/ukify")
+ "build" "--output" dest
+ "--linux" #$linux "--initrd" #$initrd
+ "--cmdline" (string-join (list #$@linux-arguments))
+ "--os-release" #$label "--stub" #$stub "--efi-arch" #$arch
+ #$@(if theme #~("--splash" #$theme) '())
+ #$@(if keypair #~("--secureboot-certificate" #$(car keypair)
+ "--secureboot-private-key" #$(cdr keypair))
+ '())))))
+ (else (leave (G_ "uki-efi-bootloader doesn't support multiboot")))))))
+
+;; we cannot use guix's build system to make UKI images for two reasons:
+;; 1. signing is necessarily non-reproducable, especially since keys should not
+;; be in the store, or else risk being publically accessible.
+;; 2. menu-entries may reference files which do not exist in the store.
+(define* (install-uki #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ (define* (menu-entry->plan entry num #:optional (prefix "menu-entry"))
+ #~(cons* #$((bootcfg->menu-entry->builder bootloader-config) entry)
+ #$(string-append prefix "-" (number->string num) ".efi")
+ #$(menu-entry-label entry)))
+
+ (define (boot-alternative->plan alt)
+ (menu-entry->plan (boot-alternative->menu-entry alt)
+ (boot-alternative-generation alt)
+ "generation"))
+
+ (install-efi bootloader-config
+ (let ((entries (bootloader-configuration-menu-entries bootloader-config)))
+ #~(list #$(boot-alternative->plan current-boot-alternative)
+ #$@(map menu-entry->plan entries (iota (length entries)))
+ #$@(map boot-alternative->plan old-boot-alternatives)))))
+
+
+
+(define uki-efi-bootloader
+ (bootloader
+ (name 'uki-efi)
+ (default-targets (list (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+ (installer install-uki)))
diff --git a/gnu/local.mk b/gnu/local.mk
index 8375e13709..32ed753ee2 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -93,6 +93,7 @@ GNU_SYSTEM_MODULES = \
%D%/bootloader/extlinux.scm \
%D%/bootloader/u-boot.scm \
%D%/bootloader/depthcharge.scm \
+ %D%/bootloader/uki.scm \
%D%/ci.scm \
%D%/compression.scm \
%D%/home.scm \
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 12/15] gnu: system: Update examples.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (10 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
` (3 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Florian Pelz,
Ludovic Court??s, Matthew Trzcinski, Maxim Cournoyer
* gnu/system/examples/asus-c201.tmpl (bootloader): Use new depthcharge
bootloader name scheme and update to new target system.
* gnu/system/examples/bare-bones.tmpl (bootloader),
gnu/system/examples/bare-hurd.tmpl (bootloader),
gnu/system/examples/beaglebone-black.tmpl (bootloader),
gnu/system/examples/desktop.tmpl (bootloader),
gnu/system/examples/lightweight-desktop.tmpl (bootloader),
gnu/system/examples/plasma.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64-nfs-root.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64.tmpl (bootloader): Use new target system.
* gnu/system/examples/docker-image.tmpl (bootloader): Delete.
* gnu/system/examples/vm-image.tmpl (bootloader): Use auto image target.
Change-Id: I3675f17ae9cd94cff99328762600fb4e491bc9f2
---
gnu/system/examples/asus-c201.tmpl | 6 +++--
gnu/system/examples/bare-bones.tmpl | 7 ++++--
gnu/system/examples/bare-hurd.tmpl | 4 +++-
gnu/system/examples/beaglebone-black.tmpl | 6 +++--
gnu/system/examples/desktop.tmpl | 4 +++-
gnu/system/examples/docker-image.tmpl | 6 ++---
gnu/system/examples/lightweight-desktop.tmpl | 4 +++-
gnu/system/examples/plasma.tmpl | 4 +++-
.../examples/raspberry-pi-64-nfs-root.tmpl | 23 ++++++++++++-------
gnu/system/examples/raspberry-pi-64.tmpl | 18 ++++++++-------
gnu/system/examples/vm-image.tmpl | 5 ++--
11 files changed, 54 insertions(+), 33 deletions(-)
diff --git a/gnu/system/examples/asus-c201.tmpl b/gnu/system/examples/asus-c201.tmpl
index 019111c167..eec185eebf 100644
--- a/gnu/system/examples/asus-c201.tmpl
+++ b/gnu/system/examples/asus-c201.tmpl
@@ -14,8 +14,10 @@
;; Assuming /dev/mmcblk0p1 is the kernel partition, and
;; "my-root" is the label of the target root file system.
(bootloader (bootloader-configuration
- (bootloader depthcharge-bootloader)
- (targets '("/dev/mmcblk0p1"))))
+ (bootloader depthcharge-veyron-speedy-bootloader)
+ (targets (list (bootloader-target
+ (type 'part)
+ (device "/dev/mmcblk0p1"))))))
;; The ASUS C201PA requires a very particular kernel to boot,
;; as well as the following arguments.
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index 7b6a4b09b0..9eed05f2e0 100644
--- a/gnu/system/examples/bare-bones.tmpl
+++ b/gnu/system/examples/bare-bones.tmpl
@@ -13,10 +13,13 @@
;; Boot in "legacy" BIOS mode, assuming /dev/sdX is the
;; target hard disk, and "my-root" is the label of the target
- ;; root file system.
+ ;; root file system. If you're just building an image, the
+ ;; 'targets' field may be omitted.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
;; It's fitting to support the equally bare bones ‘-nographic’
;; QEMU option, which also nicely sidesteps forcing QWERTY.
(kernel-arguments (list "console=ttyS0,115200"))
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 463c7ee798..8dd700cd9d 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -32,7 +32,9 @@
(inherit %hurd-default-operating-system)
(bootloader (bootloader-configuration
(bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl
index 18bbb2723c..99963ef2fe 100644
--- a/gnu/system/examples/beaglebone-black.tmpl
+++ b/gnu/system/examples/beaglebone-black.tmpl
@@ -11,11 +11,13 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
- ;; Assuming /dev/mmcblk1 is the eMMC, and "my-root" is
+ ;; Assuming /dev/mmcblk1 is the eMMC. and "my-root" is
;; the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader u-boot-beaglebone-black-bootloader)
- (targets '("/dev/mmcblk1"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/mmcblk1"))))))
;; This module is required to mount the SD card.
(initrd-modules (cons "omap_hsmmc" %base-initrd-modules))
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index 2d65f22294..30dbdeea31 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -20,7 +20,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout)))
;; Specify a mapped device for the encrypted root partition.
diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl
index 7123917af4..6d3114a0bc 100644
--- a/gnu/system/examples/docker-image.tmpl
+++ b/gnu/system/examples/docker-image.tmpl
@@ -9,6 +9,8 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
+ ;; Bootloader can be left blank!
+
;; This is where user accounts are specified. The "root" account is
;; implicit, and is initially created with the empty password.
(users (cons (user-account
@@ -34,10 +36,6 @@
;; similar services for us.
;; This will be ignored.
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("does-not-matter"))))
- ;; This will be ignored, too.
(file-systems (list (file-system
(device "does-not-matter")
(mount-point "/")
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index c061284ba8..0964238cb0 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -17,7 +17,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))
;; Assume the target root file system is labelled "my-root",
;; and the EFI System Partition has UUID 1234-ABCD.
diff --git a/gnu/system/examples/plasma.tmpl b/gnu/system/examples/plasma.tmpl
index c3850ffe37..a81916ffe9 100644
--- a/gnu/system/examples/plasma.tmpl
+++ b/gnu/system/examples/plasma.tmpl
@@ -15,7 +15,9 @@
;; is the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device "my-root")
diff --git a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
index 1baca02491..85476854f3 100644
--- a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
+++ b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
@@ -25,14 +25,21 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi")))))
+ (bootloader-configuration
+ (bootloader grub-efi-bootloader)
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel-arguments '("ip=dhcp"))
(kernel (customize-linux #:linux linux-libre-arm64-generic
#:extra-version "arm64-generic-netboot"
diff --git a/gnu/system/examples/raspberry-pi-64.tmpl b/gnu/system/examples/raspberry-pi-64.tmpl
index 414d8ac7a5..d5b90b9705 100644
--- a/gnu/system/examples/raspberry-pi-64.tmpl
+++ b/gnu/system/examples/raspberry-pi-64.tmpl
@@ -24,14 +24,16 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel (customize-linux #:linux linux-libre-arm64-generic
;; It is possible to use a specific defconfig
;; file, for example the "bcmrpi3_defconfig" with
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index 589de493b1..050c0bb971 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -38,11 +38,10 @@ accounts.\x1b[0m
(firmware '())
- ;; Below we assume /dev/vda is the VM's hard disk.
- ;; Adjust as needed.
+ ;; Images automatically get the 'root, 'esp, and 'disk targets configured as
+ ;; needed.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 13/15] doc: Update bootloader documentation.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (11 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
` (2 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Florian Pelz,
Ludovic Court??s, Matthew Trzcinski, Maxim Cournoyer
* doc/guix.texi
(Manual Installation)[Proceeding with the Installation]: Offload
target reference.
(System Installation)[Building the Installation Image]: Use beaglebone
as the example, and don't reference deleted variables.
(System Configuration)[Using the Configuration System]: Update
example.
[operating-system Reference]<bootloader>: Can use multiple
bootloaders.
[Keyboard Layout]: Update example.
[Bootloader Configuration]<bootloader>: Update documentation for all
bootloaders, and add new ones. Document new fields efi-removable?,
32bit?, and keypair. Update terminal-outputs and terminal-outputs to
not be GRUB-specific.
<bootloader-target>: New record.
<menu-entry>: Remove now-unsupported GRUB specifics in linux. Move
device documentation and add some for device-mount-point and
device-subvol. Fix typo in multiboot-arguments. Document chain-loader
for arbitrary bootloaders.
[Invoking guix system]<switch-generation>: Bootloaders are now
reinstalled.
<image> Other bootloaders may be used.
[Invoking guix deploy]: Update template.
(Creating System Images)[image Reference]<partition Reference>: Add
target field.
[Instantiate an Image]: Update examples and update formatting.
<efi32-disk-image, efi32-raw-image-type>: Delete.
[image-type Reference]<pinebook-pro-image-type, rock64-image-type>:
Reword slightly.
Change-Id: I45ac9d5ad3cb491c693e9a4b2f0b44b527478ee7
---
doc/guix.texi | 458 +++++++++++++++++++++++++++++---------------------
1 file changed, 262 insertions(+), 196 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 41814042f5..b5f35a9066 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2516,12 +2516,9 @@ Proceeding with the Installation
Make sure the @code{bootloader-configuration} form refers to the targets
you want to install GRUB on. It should mention @code{grub-bootloader}
if you are installing GRUB in the legacy way, or
-@code{grub-efi-bootloader} for newer UEFI systems. For legacy systems,
-the @code{targets} field contain the names of the devices, like
-@code{(list "/dev/sda")}; for UEFI systems it names the paths to mounted
-EFI partitions, like @code{(list "/boot/efi")}; do make sure the paths
-are currently mounted and a @code{file-system} entry is specified in
-your configuration.
+@code{grub-efi-bootloader} for newer UEFI systems.
+@xref{Bootloader Configuration} for information on how to format the
+@code{targets} field.
@item
Be sure that your file system labels match the value of their respective
@@ -2653,11 +2650,13 @@ Building the Installation Image
includes the bootloader, specifically:
@example
-guix system image --system=armhf-linux -e '((@@ (gnu system install) os-with-u-boot) (@@ (gnu system install) installation-os) "A20-OLinuXino-Lime2")'
+guix system image --system=armhf-linux -e '(@ (gnu system install) beaglebone-black-installation-os)'
@end example
-@code{A20-OLinuXino-Lime2} is the name of the board. If you specify an invalid
-board, a list of possible boards will be printed.
+@code{beaglebone-black} is the name of the board. Similar
+@code{installation-os} variables exist for most other supported boards.
+Otherwise, you can use @code{embedded-installation-os}, passing it a u-boot
+bootloader and the desired console tty.
@c *********************************************************************
@@ -17229,7 +17228,9 @@ Using the Configuration System
@lisp
(bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi")))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi")))))
@end lisp
@xref{Bootloader Configuration}, for more information on the available
@@ -17535,8 +17536,10 @@ operating-system Reference
List of strings or gexps representing additional arguments to pass on
the command-line of the kernel---e.g., @code{("console=ttyS0")}.
-@item @code{bootloader}
-The system bootloader configuration object. @xref{Bootloader Configuration}.
+@item @code{bootloader} (default: '())
+The system bootloader configuration object. Can either be a single
+@code{bootloader-configuration} or a list of them, to install multiple or no
+bootloaders. @xref{Bootloader Configuration}.
@item @code{label}
This is the label (a string) as it appears in the bootloader's menu entry.
@@ -18731,7 +18734,9 @@ Keyboard Layout
(keyboard-layout (keyboard-layout "tr")) ;for the console
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout))) ;for GRUB
(services (cons (set-xorg-configuration
(xorg-configuration ;for Xorg
@@ -42119,132 +42124,124 @@ Bootloader Configuration
@cindex EFI, bootloader
@cindex UEFI, bootloader
@cindex BIOS, bootloader
-The bootloader to use, as a @code{bootloader} object. For now
-@code{grub-bootloader}, @code{grub-efi-bootloader},
-@code{grub-efi-removable-bootloader}, @code{grub-efi-netboot-bootloader},
-@code{grub-efi-netboot-removable-bootloader}, @code{extlinux-bootloader}
-and @code{u-boot-bootloader} are supported.
+The bootloader to use, as a @code{bootloader} object. Available bootloaders, in
+addition to what target types they require, are as follows:
-@cindex ARM, bootloaders
-@cindex AArch64, bootloaders
-Available bootloaders are described in @code{(gnu bootloader @dots{})}
-modules. In particular, @code{(gnu bootloader u-boot)} contains definitions
-of bootloaders for a wide range of ARM and AArch64 systems, using the
-@uref{https://www.denx.de/wiki/U-Boot/, U-Boot bootloader}.
+@itemize
+@vindex depthcharge-veyron-speedy-bootloader
+@item @code{depthcharge-veyron-speedy-bootloader}
+For the Asus C201. Requires a @code{'part} target, denoting the partition to
+install the kernel blob as a @code{device}, @code{label}, or @code{uuid}.
@vindex grub-bootloader
-@code{grub-bootloader} allows you to boot in particular Intel-based machines
-in ``legacy'' BIOS mode.
+@item @code{grub-bootloader}
+GRUB2 for BIOS systems. Requires a @code{'disk} target providing either a
+@code{device}, @code{label}, or @code{uuid}. If root is mounted over NFS, it
+will load its files and the Guix System over
+@acronym{PXE, Preboot eXecution Environment}.
+
+@vindex grub-minimal-bootloader
+@item @code{grub-minimal-bootloader}
+As above, but using a minimal build of GRUB.
@vindex grub-efi-bootloader
-@code{grub-efi-bootloader} allows to boot on modern systems using the
-@dfn{Unified Extensible Firmware Interface} (UEFI). This is what you should
-use if the installation image contains a @file{/sys/firmware/efi} directory
-when you boot it on your system.
-
-@vindex grub-efi-removable-bootloader
-@code{grub-efi-removable-bootloader} allows you to boot your system from
-removable media by writing the GRUB file to the UEFI-specification location of
-@file{/EFI/BOOT/BOOTX64.efi} of the boot directory, usually @file{/boot/efi}.
-This is also useful for some UEFI firmwares that ``forget'' their configuration
-from their non-volatile storage. Like @code{grub-efi-bootloader}, this can only
-be used if the @file{/sys/firmware/efi} directory is available.
+@item @code{grub-efi-bootloader}
+GRUB2 for "modern" systems using the @dfn{Unified Extensible Firmware Interface}
+(UEFI). Requires an @code{'esp} target providing a @code{path} to the mount
+point of the EFI System Partition. If root is mounted over NFS, it will load
+its files and the Guix System over a
+@acronym{TFTP, Trivial File Transfer Protocol} server as configured over
+@acronym{DHCP, Dynamic Host Configuration Protocol} as per PXE.
+
+@vindex extlinux-bootloader
+@item @code{extlinux-bootloader}
+Extlinux for "legacy" BIOS systems. Requires a @code{'disk} target providing
+either a @code{device}, @code{label}, or @code{uuid}.
+
+@vindex extlinux-gpt-bootloader
+@item @code{extlinux-gpt-bootloader}
+As above, but for systems using the GPT instead of MBR partition table.
+
+@cindex Secure Boot, UEFI
+@vindex uki-efi-bootloader
+@item @code{uki-efi-bootloader}
+Makes and installs UKI images for UEFI systems. Requires an @code{'esp} target
+providing a @code{path} to the mount point of the EFI System Partition. Not all
+system generations may be available with this option, as UKI images contain the
+entire kernel and initramfs, and ESPs tend to be small.
+
+Full disk encryption with @code{uki-efi-bootloader} only requires a single
+password entry with fast decryption, in contrast to GRUB2 requiring a second
+password entry with slow, LUKS1-only decryption.
+
+This is the only bootloader to currently support UEFI secure boot, when
+configured as below.
-@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
-@end quotation
+@cindex ARM, bootloaders
+@cindex AArch64, bootloaders
+@vindex u-boot-a20-olinuxino-lime-bootloader
+@vindex u-boot-a20-olinuxino-lime2-bootloader
+@vindex u-boot-a20-olinuxino-micro-bootloader
+@vindex u-boot-bananapi-m2-ultra-bootloader
+@vindex u-boot-beaglebone-black-bootloader
+@vindex u-boot-cubietruck-bootloader
+@vindex u-boot-firefly-rk3399-bootloader
+@vindex u-boot-mx6cuboxi-bootloader
+@vindex u-boot-nintendo-nes-classic-edition-bootloader
+@vindex u-boot-novena-bootloader
+@vindex u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+@vindex u-boot-pine64-plus-bootloader
+@vindex u-boot-pine64-lts-bootloader
+@vindex u-boot-pinebook-bootloader
+@vindex u-boot-pinebook-pro-rk3399-bootloader
+@vindex u-boot-puma-rk3399-bootloader
+@vindex u-boot-rock64-rk3328-bootloader
+@vindex u-boot-rockpro64-rk3399-bootloader
+@vindex u-boot-sifive-unmatched-bootloader
+@vindex u-boot-qemu-riscv64-bootloader
+@vindex u-boot-starfive-visionfive2-bootloader
+@vindex u-boot-ts7970-q-2g-1000mhz-c-bootloader
+@vindex u-boot-wandboard-bootloader
+@vindex u-boot-rpi-2-bootloader
+@vindex u-boot-rpi-3-bootloader
+@vindex u-boot-rpi-4-bootloader
+@vindex u-boot-rpi-bootloader
+@item U-Boot
+U-Boot has individual bootloaders @code{u-boot-board-bootloader} for each
+of the following @code{board}s: @code{a20-olinuxino-lime},
+@code{a20-olinuxino-lime2}, @code{a20-olinuxino-micro},
+@code{bananapi-m2-ultra}, @code{beaglebone-black}, @code{cubietruck},
+@code{firefly-rk3399}, @code{mx6cuboxi}, @code{nintendo-nes-classic-edition},
+@code{novena}, @code{orangepi-r1-plus-lts-rk3328}, @code{pine64-plus},
+@code{pine64-lts}, @code{pinebook}, @code{pinebook-pro-rk3399},
+@code{puma-rk3399}, @code{rock64-rk3328}, @code{rockpro64-rk3399},
+@code{rpi-2}, @code{rpi-3}, @code{rpi-4}, @code{rpi}, @code{sifive-unmatched},
+@code{ts7970-q-2g-1000mhz-c}, @code{qemu-riscv64}, and @code{wandboard}.
+
+Each of these requires a @code{'disk} target providing either a @code{device},
+@code{label}, or @code{uuid}, except for @code{ts7970-q-2g-1000mhz-c} and
+@code{qemu-riscv64}, in which the bootloader just copies U-Boot to
+@file{/boot/u-boot.imx} or @file{/boot/u-boot.bin}, respectively. You should
+then manually flash it to the SPI flash at the U-Boot prompt.
+
+By default Guix configures U-Boot to boot using a generated extlinux config, but
+U-Boot does support loading UEFI bootloaders, if you want to combine it with
+another.
+@end itemize
-@vindex grub-efi-netboot-bootloader
-@code{grub-efi-netboot-bootloader} allows you to boot your system over network
-through TFTP@. In combination with an NFS root file system this allows you to
-build a diskless Guix system.
-
-The installation of the @code{grub-efi-netboot-bootloader} generates the
-content of the TFTP root directory at @code{targets} (@pxref{Bootloader
-Configuration, @code{targets}}) below the sub-directory @file{efi/Guix}, to be
-served by a TFTP server. You may want to mount your TFTP server directories
-onto the @code{targets} to move the required files to the TFTP server
-automatically during installation.
-
-If you plan to use an NFS root file system as well (actually if you mount the
-store from an NFS share), then the TFTP server needs to serve the file
-@file{/boot/grub/grub.cfg} and other files from the store (like GRUBs background
-image, the kernel (@pxref{operating-system Reference, @code{kernel}}) and the
-initrd (@pxref{operating-system Reference, @code{initrd}})), too. All these
-files from the store will be accessed by GRUB through TFTP with their normal
-store path, for example as
-@file{tftp://tftp-server/gnu/store/…-initrd/initrd.cpio.gz}.
-
-Two symlinks are created to make this possible. For each target in the
-@code{targets} field, the first symlink is
-@samp{target}@file{/efi/Guix/boot/grub/grub.cfg} pointing to
-@file{../../../boot/grub/grub.cfg}, where @samp{target} may be
-@file{/boot}. In this case the link is not leaving the served TFTP root
-directory, but otherwise it does. The second link is
-@samp{target}@file{/gnu/store} and points to @file{../gnu/store}. This
-link is leaving the served TFTP root directory.
-
-The assumption behind all this is that you have an NFS server exporting
-the root file system for your Guix system, and additionally a TFTP
-server exporting your @code{targets} directories—usually a single
-@file{/boot}—from that same root file system for your Guix system. In
-this constellation the symlinks will work.
-
-For other constellations you will have to program your own bootloader
-installer, which then takes care to make necessary files from the store
-accessible through TFTP, for example by copying them into the TFTP root
-directory for your @code{targets}.
-
-It is important to note that symlinks pointing outside the TFTP root directory
-may need to be allowed in the configuration of your TFTP server. Further the
-store link exposes the whole store through TFTP@. Both points need to be
-considered carefully for security aspects. It is advised to disable any TFTP
-write access!
-
-Please note, that this bootloader will not modify the ‘UEFI Boot Manager’ of
-the system.
-
-Beside the @code{grub-efi-netboot-bootloader}, the already mentioned TFTP and
-NFS servers, you also need a properly configured DHCP server to make the booting
-over netboot possible. For all this we can currently only recommend you to look
-for instructions about @acronym{PXE, Preboot eXecution Environment}.
-
-If a local EFI System Partition (ESP) or a similar partition with a FAT
-file system is mounted in @code{targets}, then symlinks cannot be
-created. In this case everything will be prepared for booting from
-local storage, matching the behavior of @code{grub-efi-bootloader}, with
-the difference that all GRUB binaries are copied to @code{targets},
-necessary for booting over the network.
-
-@vindex grub-efi-netboot-removable-bootloader
-@code{grub-efi-netboot-removable-bootloader} is identical to
-@code{grub-efi-netboot-bootloader} with the exception that the
-sub-directory @file{efi/boot} will be used instead of @file{efi/Guix} to
-comply with the UEFI specification for removable media.
+@item @code{targets}
+This is a list of @code{bootloader-target} (see below) structures denoting
+where the bootloader should install itself. Interpretation of specific target
+types and target requirements depend on the specific @code{bootloader} used.
@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
+Bootloaders have a set of default targets, that can interact with user-specified
+targets. For UEFI bootloaders using the @code{'esp} target, this typically
+includes a @code{'vendir} target. If you configure multiple UEFI bootloaders,
+you should set different @code{'vendir} target @code{path}s for each, each
+@code{offset} from @code{'esp}.
@end quotation
-@item @code{targets}
-This is a list of strings denoting the targets onto which to install the
-bootloader.
-
-The interpretation of targets depends on the bootloader in question.
-For @code{grub-bootloader}, for example, they should be device names
-understood by the bootloader @command{installer} command, such as
-@code{/dev/sda} or @code{(hd0)} (@pxref{Invoking grub-install,,, grub,
-GNU GRUB Manual}). For @code{grub-efi-bootloader} and
-@code{grub-efi-removable-bootloader} they should be mount
-points of the EFI file system, usually @file{/boot/efi}. For
-@code{grub-efi-netboot-bootloader}, @code{targets} should be the mount
-points corresponding to TFTP root directories served by your TFTP
-server.
-
@item @code{menu-entries} (default: @code{'()})
A possibly empty list of @code{menu-entry} objects (see below), denoting
entries to appear in the bootloader menu, in addition to the current
@@ -42254,6 +42251,29 @@ Bootloader Configuration
The index of the default boot menu entry. Index 0 is for the entry of the
current system.
+@item @code{efi-removable?} (default: @var{#f})
+Used by all UEFI bootloaders to determine whether they should be installed to
+the UEFI standard fallback bootloader path (on x86_64,
+@file{/EFI/BOOT/BOOTX64.EFI}). This allows it to be booted from removable media
+or otherwise in cases where the system has not been booted from UEFI already.
+
+@quotation Warning
+This will override any other bootloaders installed to the same path!
+@end quotation
+
+@item @code{32bit?} (default: @var{#f})
+Some 64-bit systems require their bootloaders to be 32-bit, including some early
+UEFI systems and some Raspberry Pis. If that is the case, and the bootloader
+supports it, setting this option will force the bootloader to install as if it
+were on a 32-bit system.
+
+@item @code{keypair} (default: @var{#f})
+Designates a keypair to be used by bootloaders that support some kind of
+cryptographic signature, such as UEFI Secure Boot. This must be a pair
+@code{'(cert . priv)} of paths to the public key (@code{cert}) and private key
+(@code{priv}). The keys these paths point to should be owned by root with 600
+permissions for security purposes.
+
@item @code{timeout} (default: @code{5})
The number of seconds to wait for keyboard input before booting. Set to
0 to boot immediately, and to -1 to wait indefinitely.
@@ -42276,19 +42296,20 @@ Bootloader Configuration
is provided, some bootloaders might use a default theme, that's true
for GRUB.
-@item @code{terminal-outputs} (default: @code{'(gfxterm)})
+@item @code{terminal-outputs} (default: @var{#f})
The output terminals used for the bootloader boot menu, as a list of
-symbols. GRUB accepts the values: @code{console}, @code{serial},
-@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text},
-@code{mda_text}, @code{morse}, and @code{pkmodem}. This field
-corresponds to the GRUB variable @code{GRUB_TERMINAL_OUTPUT} (@pxref{Simple
-configuration,,, grub,GNU GRUB manual}).
-
-@item @code{terminal-inputs} (default: @code{'()})
+symbols. When @var{#f}, the default is used. For GRUB this is @code{gfxterm}.
+GRUB accepts the values: @code{console}, @code{serial}, @code{serial_@{0-3@}},
+@code{gfxterm}, @code{vga_text}, @code{mda_text}, @code{morse}, and
+@code{pkmodem}. This field corresponds to the GRUB variable
+@code{GRUB_TERMINAL_OUTPUT}
+(@pxref{Simple configuration,,, grub,GNU GRUB manual}).
+
+@item @code{terminal-inputs} (default: @var{#f})
The input terminals used for the bootloader boot menu, as a list of
-symbols. For GRUB, the default is the native platform terminal as
-determined at run-time. GRUB accepts the values: @code{console},
-@code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
+symbols. When @var{#f}, the default is used. For GRUB, this is the native
+platform terminal as determined at run-time. GRUB accepts the values:
+@code{console}, @code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
@code{usb_keyboard}. This field corresponds to the GRUB variable
@code{GRUB_TERMINAL_INPUT} (@pxref{Simple configuration,,, grub,GNU GRUB
manual}).
@@ -42364,6 +42385,53 @@ Bootloader Configuration
@end deftp
+@vindex bootloader-target
+Configuring bootloader targets uses a specialized record designed for clarity
+and to abstract the varying user-supplied paths bootloaders may need. Only the
+@code{type} field is required; Guix will attempt to extrapolate as needed from
+what information you provide, though at least one of @code{path}, @code{device},
+@code{label}, or @code{uuid} is required to do so.
+
+@deftp {Data Type} bootloader-target
+The type of a target as used in @code{bootloader-configuration}.
+
+@table @asis
+
+@item @code{type}
+What target this record is describing. Must be a symbol, for example @code{'esp}
+or @code{'disk}.
+
+@item @code{path} (default: @var{#f})
+@code{path} denotes a string path, usually interpreted by the bootloader to
+signify a mount point (such as in the case of @code{'esp}). This value is
+automatically offset from the target denoted by @code{offset}, even if the path
+given is absolute. This allows for bootloaders to know what device or partition
+a @code{path} is actually stored on, and how to locate it.
+
+@item @code{offset} (default: @code{'root} when @code{path}, otherwise @var{#f})
+All @code{path} values, even if absolute, are automatically offset from another.
+@code{offset} is a symbol denoting which target type the path should be offset
+from. This allows for bootloaders to know what device or partition a
+@code{path} is actually stored on, and how to locate it.
+
+For most setups, you don't need to deal with this.
+
+@item @code{device} (default: @var{#f})
+@itemx @code{label} (default: @var{#f})
+@itemx @code{uuid} (default: @var{#f})
+These all work as a way of defining some kind of physical device or partition.
+@code{uuid} (taking a @code{uuid} record) and @code{label} (taking a string) are
+vastly preferred over device (a string denoting a filesystem path to a block
+device), as block device names are inconsistant and unrecognized at boot-time.
+
+@item @code{file-system} (default: @var{#f})
+A string denoting a file system type, as used in @ref{File Systems}. Unless
+your filesystem isn't being detected properly, or is unmounted at bootloader
+install-time, you shouldn't need to specify this.
+
+@end table
+@end deftp
+
@cindex dual boot
@cindex boot menu
Should you want to list additional boot menu entries @i{via} the
@@ -42375,6 +42443,8 @@ Bootloader Configuration
@lisp
(menu-entry
(label "The Other Distro")
+ (device (file-system-label "boot"))
+ (device-mount-point "/boot")
(linux "/boot/old/vmlinux-2.6.32")
(linux-arguments '("root=/dev/sda2"))
(initrd "/boot/old/initrd"))
@@ -42390,6 +42460,28 @@ Bootloader Configuration
@item @code{label}
The label to show in the menu---e.g., @code{"GNU"}.
+@item @code{device} (default: @var{#f})
+The device where any files specified below are to be found--eg, for GRUB,
+@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
+
+This may be a file system label (a string), a file system UUID (a
+bytevector, @pxref{File Systems}), or @code{#f}, in which case
+the bootloader will search the device containing the file specified by
+the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
+must @emph{not} be an OS device name such as @file{/dev/sda1}.
+
+@item @code{device-mount-point} (default: @var{#f})
+This is where @code{device} is mounted onto your file system. If provided, it
+allows for you to specify full paths for provided files, which will be
+automatically realized into paths local to their device.
+
+This is not necessary if specified files are already referring to files local to
+@code{device}, including if they're on your root filesystem.
+
+@item @code{device-subvol} (default: @var{#f})
+This is a btrfs subvolume name, useful in case you wish to access files from a
+btrfs subvolume on a device. @xref{Btrfs file system}.
+
@item @code{linux} (default: @code{#f})
The Linux kernel image to boot, for example:
@@ -42397,17 +42489,6 @@ Bootloader Configuration
(file-append linux-libre "/bzImage")
@end lisp
-For GRUB, it is also possible to specify a device explicitly in the
-file path using GRUB's device naming convention (@pxref{Naming
-convention,,, grub, GNU GRUB manual}), for example:
-
-@example
-"(hd0,msdos1)/boot/vmlinuz"
-@end example
-
-If the device is specified explicitly as above, then the @code{device}
-field is ignored entirely.
-
@item @code{linux-arguments} (default: @code{'()})
The list of extra Linux kernel command-line arguments---e.g.,
@code{'("console=ttyS0")}.
@@ -42416,16 +42497,6 @@ Bootloader Configuration
A G-Expression or string denoting the file name of the initial RAM disk
to use (@pxref{G-Expressions}).
-@item @code{device} (default: @code{#f})
-The device where the kernel and initrd are to be found---i.e., for GRUB,
-@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
-
-This may be a file system label (a string), a file system UUID (a
-bytevector, @pxref{File Systems}), or @code{#f}, in which case
-the bootloader will search the device containing the file specified by
-the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
-must @emph{not} be an OS device name such as @file{/dev/sda1}.
-
@item @code{multiboot-kernel} (default: @code{#f})
The kernel to boot in Multiboot-mode (@pxref{multiboot,,, grub, GNU GRUB
manual}). When this field is set, a Multiboot menu-entry is generated.
@@ -42448,7 +42519,7 @@ Bootloader Configuration
To use the new and still experimental
@uref{https://darnassus.sceen.net/~hurd-web/rump_kernel/, rumpdisk
user-level disk driver} instead of GNU@tie{}Mach's in-kernel IDE driver,
-set @code{kernel-arguments} to:
+set @code{multiboot-arguments} to:
@lisp
'("noide")
@@ -42471,10 +42542,11 @@ Bootloader Configuration
@end lisp
@item @code{chain-loader} (default: @code{#f})
-A string that can be accepted by @code{grub}'s @code{chainloader}
-directive. This has no effect if either @code{linux} or
-@code{multiboot-kernel} fields are specified. The following is an
-example of chainloading a different GNU/Linux system.
+Varies slightly depending on bootloader. For @code{grub}, this is anything that
+the @code{chainloader} directive can accept
+(@pxref{Chain-loading,,, grub, GNU GRUB manual}). For @code{uki-efi}, this is
+any efi binary to be installed alongside the system. The following is an example
+of chainloading a different GNU/Linux system.
@lisp
(bootloader
@@ -42682,10 +42754,6 @@ Invoking guix system
supported by the bootloader being used. The next time the system
boots, it will use the specified system generation.
-The bootloader itself is not being reinstalled when using this
-command. Thus, the installed bootloader is used with an updated
-configuration file.
-
The target generation can be specified explicitly by its generation
number. For example, the following invocation would switch to system
generation 7:
@@ -42706,11 +42774,10 @@ Invoking guix system
@end example
Currently, the effect of invoking this action is @emph{only} to switch
-the system profile to an existing generation and rearrange the
-bootloader menu entries. To actually start using the target system
-generation, you must reboot after running this action. In the future,
-it will be updated to do the same things as @command{reconfigure},
-like activating and deactivating services.
+the system profile to an existing generation and reinstall the bootloader. To
+actually start using the target system generation, you must reboot after
+running this action. In the future, it will be updated to do the same things
+as @command{reconfigure}, like activating and deactivating services.
This action will fail if the specified generation does not exist.
@@ -42886,11 +42953,9 @@ Invoking guix system
When using the @code{qcow2} image type, the returned image is in qcow2
format, which the QEMU emulator can efficiently use. @xref{Running Guix
in a VM}, for more information on how to run the image in a virtual
-machine. The @code{grub-bootloader} bootloader is always used
-independently of what is declared in the @code{operating-system} file
-passed as argument. This is to make it easier to work with QEMU, which
-uses the SeaBIOS BIOS by default, expecting a bootloader to be installed
-in the Master Boot Record (MBR).
+machine. Currently, QEMU as packaged in Guix does not have UEFI support,
+so you should select a bootloader for BIOS systems in your
+@code{operating-system} configuration.
@cindex docker-image, creating docker images
When using the @code{docker} image type, a Docker image is produced.
@@ -43208,7 +43273,6 @@ Invoking guix deploy
;; forwarded to the host's loopback interface.
(use-service-modules networking ssh)
-(use-package-modules bootloaders)
(define %system
(operating-system
@@ -43216,7 +43280,9 @@ Invoking guix deploy
(timezone "Etc/UTC")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sda"))))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
@@ -47800,6 +47866,12 @@ partition Reference
this flag set, usually the root one. The @code{'esp} flag identifies a
UEFI System Partition.
+@item @code{target} (default: @var{#f})
+If provided, this partition provides itself as a bootloader target
+(@pxref{Bootloader Configuration}). Most commonly, this is used to provide the
+@code{'root} and @code{'esp} targets, with the root partition and EFI System
+Partition, respectively, though this can provide any target necessary.
+
@item @code{initializer} (default: @code{#false})
The partition initializer procedure as a gexp. This procedure is called
to populate a partition. If no initializer is passed, the
@@ -47848,6 +47920,7 @@ Instantiate an Image
(label "GNU-ESP")
(file-system "vfat")
(flags '(esp))
+ (target 'esp)
(initializer (gexp initialize-efi-partition)))
(partition
(size (* 50 MiB))
@@ -47864,14 +47937,15 @@ Instantiate an Image
(label root-label)
(file-system "ext4")
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))))
@end lisp
-Note that the first and third partitions use generic initializers
-procedures, initialize-efi-partition and initialize-root-partition
-respectively. The initialize-efi-partition installs a GRUB EFI loader
-that is loading the GRUB bootloader located in the root partition. The
-initialize-root-partition instantiates a complete system as defined by
+Note that the first and third partitions use generic initializer
+procedures, @code{initialize-efi-partition} and @code{initialize-root-partition}
+respectively. @code{initialize-efi-partition} simply creates the directory
+structure for an EFI bootloader to install itself to.
+@code{initialize-root-partition} instantiates a complete system as defined by
the @code{%simple-os} operating-system.
You can now run:
@@ -47929,10 +48003,6 @@ Instantiate an Image
@code{i686} machines, supporting BIOS or UEFI booting.
@end defvar
-@defvar efi32-disk-image
-Same as @code{efi-disk-image} but with a 32 bits EFI partition.
-@end defvar
-
@defvar iso9660-image
An ISO-9660 image composed of a single bootable partition. This image
can also be used on most @code{x86_64} and @code{i686} machines.
@@ -48023,10 +48093,6 @@ image-type Reference
Build an image based on the @code{efi-disk-image} image.
@end defvar
-@defvar efi32-raw-image-type
-Build an image based on the @code{efi32-disk-image} image.
-@end defvar
-
@defvar qcow2-image-type
Build an image based on the @code{mbr-disk-image} image but with the
@code{compressed-qcow2} image format.
@@ -48054,14 +48120,14 @@ image-type Reference
@defvar pinebook-pro-image-type
Build an image that is targeting the Pinebook Pro machine. The MBR
image contains a single partition starting at a @code{9MiB} offset. The
-@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader will be
+@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader can be
installed in this gap.
@end defvar
@defvar rock64-image-type
Build an image that is targeting the Rock64 machine. The MBR image
contains a single partition starting at a @code{16MiB} offset. The
-@code{u-boot-rock64-rk3328-bootloader} bootloader will be installed in
+@code{u-boot-rock64-rk3328-bootloader} bootloader can be installed in
this gap.
@end defvar
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 14/15] gnu: tests: Update tests to new targets system.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (12 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 18:06 ` [bug#72457] [PATCH v2 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
2024-08-04 19:52 ` [bug#72457] [PATCH v2 00/15] Rewrite bootloader subsystem Sergey Trofimov
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov, Maxim Cournoyer
* gnu/services/virtualization.scm
(%virtual-build-machine-operating-system): Remove bootloader.
(%hurd-vm-operating-system): Remove targets.
* gnu/system/hurd.scm (%hurd-default-operating-system): Remove targets.
* gnu/tests.scm (%simple-os), gnu/tests/ganeti.scm (%ganeti-os),
gnu/tests/image.scm (%simple-efi-os),
gnu/tests/install.scm (%minimal-os, %minimal-extlinux-os,
%minimal-os-on-vda, %separate-home-os, %separate-store-os, %raid-root-os,
%encrypted-root-os, %lvm-separate-home-os, %encrypted-home-os,
%encrypted-home-os-key-file, %encrypted-root-not-boot-os,
%btrfs-root-os-source, %btrfs-raid-root-os-source,
%btrfs-root-on-subvolume-os, %btrfs-raid10-root-os, %jfs-root-os,
%f2fs-root-os, %xfs-root-os), gnu/tests/nfs.scm (%base-os),
gnu/tests/telephony.scm (make-jami-os), gnu/tests/vnc.scm (%xvnc-os):
Update bootloader targets.
Change-Id: I3d66a839a9b2a73b8b65946950728b1e0155ca1e
---
gnu/services/virtualization.scm | 11 ++---
gnu/system/hurd.scm | 4 +-
gnu/tests.scm | 4 +-
gnu/tests/ganeti.scm | 4 +-
gnu/tests/image.scm | 4 +-
gnu/tests/install.scm | 72 ++++++++++++++++++++++++---------
gnu/tests/nfs.scm | 4 +-
gnu/tests/telephony.scm | 4 +-
gnu/tests/vnc.scm | 4 +-
tests/boot-parameters.scm | 2 +-
10 files changed, 77 insertions(+), 36 deletions(-)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index d87e494348..f698532a94 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1191,17 +1191,13 @@ (define %minimal-vm-syslog-config
(define %virtual-build-machine-operating-system
(operating-system
(host-name "build-machine")
-
(locale "en_US.utf8")
(locale-definitions
;; Save space by providing only one locale.
(list (locale-definition (name "en_US.utf8")
(source "en_US")
(charset "UTF-8"))))
-
- (bootloader (bootloader-configuration ;unused
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/null"))))
+ ;; no bootloader
(file-systems (cons (file-system ;unused
(mount-point "/")
(device "none")
@@ -1624,9 +1620,8 @@ (define %hurd-vm-operating-system
(host-name "childhurd")
(timezone "Europe/Amsterdam")
(bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))
- (timeout 0)))
+ (bootloader grub-minimal-bootloader)
+ (timeout 0)))
(packages (cons* gdb-minimal
(operating-system-packages
%hurd-default-operating-system)))
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index cbe0081382..af04e82485 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -119,9 +119,7 @@ (define %hurd-default-operating-system
(kernel %hurd-default-operating-system-kernel)
(kernel-arguments '())
(hurd hurd)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(initrd #f)
(initrd-modules '())
(firmware '())
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 5ff9db82fc..f46ccf5174 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -237,7 +237,9 @@ (define %simple-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device"/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
index 29eb354044..789879b26f 100644
--- a/gnu/tests/ganeti.scm
+++ b/gnu/tests/ganeti.scm
@@ -40,7 +40,9 @@ (define %ganeti-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/image.scm b/gnu/tests/image.scm
index be6852cae0..8d960cf7b8 100644
--- a/gnu/tests/image.scm
+++ b/gnu/tests/image.scm
@@ -55,7 +55,9 @@ (define %simple-efi-os
(inherit %simple-os)
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))))
;; An MBR disk image with a single ext4 partition.
(define i1
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 18a2fc119b..d67a71f12e 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -103,7 +103,9 @@ (define-os-with-source (%minimal-os %minimal-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -141,7 +143,9 @@ (define-os-with-source (%minimal-extlinux-os
(bootloader (bootloader-configuration
(bootloader extlinux-gpt-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -434,7 +438,9 @@ (define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -510,7 +516,9 @@ (define-os-with-source (%separate-home-os %separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "my-root"))
@@ -565,7 +573,9 @@ (define-os-with-source (%separate-store-os %separate-store-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "root-fs"))
@@ -642,7 +652,9 @@ (define-os-with-source (%raid-root-os %raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
;; Add a kernel module for RAID-1 (aka. "mirror").
@@ -725,7 +737,9 @@ (define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -858,7 +872,9 @@ (define-os-with-source (%lvm-separate-home-os %lvm-separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(mapped-devices (list (mapped-device
@@ -943,7 +959,9 @@ (define-os-with-source (%encrypted-home-os %encrypted-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -1070,7 +1088,9 @@ (define-os-with-source (%encrypted-home-os-key-file
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))
(extra-initrd "/key-file.cpio")))
(kernel-arguments '("console=ttyS0"))
@@ -1130,7 +1150,9 @@ (define-os-with-source (%encrypted-root-not-boot-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(mapped-devices (list (mapped-device
(source
@@ -1232,7 +1254,9 @@ (define-os-with-source (%btrfs-root-os %btrfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1306,7 +1330,9 @@ (define-os-with-source (%btrfs-raid-root-os %btrfs-raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1374,7 +1400,9 @@ (define-os-with-source (%btrfs-root-on-subvolume-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "btrfs-pool"))
@@ -1467,7 +1495,9 @@ (define-os-with-source (%btrfs-raid10-root-os
(bootloader (map (lambda (targ)
(bootloader-configuration
(bootloader grub-bootloader)
- (targets (list targ))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device targ))))))
'("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
@@ -1577,7 +1607,9 @@ (define-os-with-source (%jfs-root-os %jfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1650,7 +1682,9 @@ (define-os-with-source (%f2fs-root-os %f2fs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1723,7 +1757,9 @@ (define-os-with-source (%xfs-root-os %xfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 0d9972e0e9..2f97126df7 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -51,7 +51,9 @@ (define %base-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems %base-file-systems)
(users %base-user-accounts)
(packages (cons*
diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index f03ea963f7..ee858d9c91 100644
--- a/gnu/tests/telephony.scm
+++ b/gnu/tests/telephony.scm
@@ -90,7 +90,9 @@ (define* (make-jami-os #:key provisioning? partial?)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/vnc.scm b/gnu/tests/vnc.scm
index ab1c2749f3..cba9c565e0 100644
--- a/gnu/tests/vnc.scm
+++ b/gnu/tests/vnc.scm
@@ -51,7 +51,9 @@ (define %xvnc-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index f214de360d..f343dbdfdb 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -63,7 +63,7 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
- (bootloader-name 'grub)
+ (bootloader-name '(grub))
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 15/15] teams: Add bootloading team.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (13 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
@ 2024-08-04 18:06 ` Lilah Tascheter via Guix-patches
2024-08-04 19:52 ` [bug#72457] [PATCH v2 00/15] Rewrite bootloader subsystem Sergey Trofimov
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 18:06 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Tomas Volf, Sergey Trofimov
Might as well, to help ease the transition.
* etc/teams.scm (bootloaders): New team.
(Lilah Tascheter): Create add to above.
Change-Id: I63620f4e3151bb8e3d0bdf619fc70501af6397a0
---
etc/teams.scm | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/etc/teams.scm b/etc/teams.scm
index 408ebbf3d9..d9af4ad7bb 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -328,6 +328,12 @@ (define-team embedded
#:scope (list "gnu/packages/bootloaders.scm"
"gnu/packages/firmware.scm")))
+(define-team bootloaders
+ (team 'bootloaders
+ #:name "Bootloaders"
+ #:scope (list "gnu/bootloader.scm"
+ (make-regexp* "^gnu/bootloader/"))))
+
(define-team rust
(team 'rust
#:name "Rust"
@@ -746,6 +752,10 @@ (define-member (person "Nicolas Goaziou"
"guix@nicolasgoaziou.fr")
tex)
+(define-member (person "Lilah Tascheter"
+ "lilah@lunabee.space")
+ bootloaders)
+
\f
(define (find-team name)
(or (hash-ref %teams (string->symbol name))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v2 00/15] Rewrite bootloader subsystem.
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
` (14 preceding siblings ...)
2024-08-04 18:06 ` [bug#72457] [PATCH v2 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
@ 2024-08-04 19:52 ` Sergey Trofimov
15 siblings, 0 replies; 95+ messages in thread
From: Sergey Trofimov @ 2024-08-04 19:52 UTC (permalink / raw)
To: Lilah Tascheter; +Cc: 72457, Tomas Volf
Lilah Tascheter <lilah@lunabee.space> writes:
> Thanks you two! This patch series should fix those issues; feel free to
> double-check though :)
>
I've found a couple typos, although fixing these doesn't make it work
for me. I get an error in fixuuid.
--8<---------------cut here---------------start------------->8---
In unknown file:
2 (string=? #f "ntfs")
In ice-9/boot-9.scm:
1685:16 1 (raise-exception _ #:continuable? _)
1685:16 0 (raise-exception _ #:continuable? _)
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
In procedure string=: Wrong type argument in position 1 (expecting string): #f
--8<---------------cut here---------------end--------------->8---
Here is a patch for the typos.
--8<---------------cut here---------------start------------->8---
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index a83d057bda..70b4c02447 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -584,13 +584,13 @@ (define (normalize targets)
(unfold-pathcat target targets)))))
(label (or label (accessible=> device read-partition-label)))
(uuid (or uuid (accessible=> device read-partition-uuid)))
- (file-system (or file-system (and=> device (assoc-mnt
mount-type))))
+ (file-system (or file-system (and=> device (assoc-mnt
mount-point))))
(offset (and path offset))
(path (or path (and=> device (assoc-mnt mount-point))))))))
(define (fixuuid target)
(match-record target <bootloader-target> (uuid file-system)
- (let ((type (cond ((member file-system '("vfat" "fat32") 'fat))
+ (let ((type (cond ((member file-system '("vfat" "fat32")) 'fat)
((string=? file-system "ntfs") 'ntfs)
((string=? file-system "iso9660") 'iso9660)
(else 'dce))))
--8<---------------cut here---------------end--------------->8---
^ permalink raw reply related [flat|nested] 95+ messages in thread
* [bug#72457] [PATCH v3 00/15] Rewrite bootloader subsystem.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (16 preceding siblings ...)
2024-08-04 18:05 ` [bug#72457] [PATCH v2 " Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
` (15 more replies)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (3 subsequent siblings)
21 siblings, 16 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
Goddamnit, alright, how's this?
And thanks for the patch :) though, the file-system bit there is supposed to be
mount-type. The file-system field holds the filesystem type; path holds
mountpoint.
Lilah Tascheter (15):
guix: scripts: Rewrite reinstall-bootloader to use provenance data.
gnu: Add bootloader target infastructure.
guix: scripts: Remove unused code.
gnu: Core bootloader changes.
gnu: system: Remove useless boot parameters.
gnu: bootloader: Add raspberry pi bootloader.
gnu: system: Fix bootloader crypto device recognition.
gnu: packages: Add pesign.
gnu: packages: Add ukify.
gnu: packages: Add systemd-stub.
gnu: bootloaders: Add uki-efi-bootloader.
gnu: system: Update examples.
doc: Update bootloader documentation.
gnu: tests: Update tests to new targets system.
teams: Add bootloading team.
doc/guix.texi | 458 +++---
etc/teams.scm | 10 +
gnu/bootloader.scm | 662 ++++++---
gnu/bootloader/depthcharge.scm | 153 +-
gnu/bootloader/extlinux.scm | 149 +-
gnu/bootloader/grub.scm | 1279 +++++++----------
gnu/bootloader/u-boot.scm | 505 +++----
gnu/bootloader/uki.scm | 96 ++
gnu/build/bootloader.scm | 157 +-
gnu/build/image.scm | 40 +-
gnu/build/install.scm | 16 +-
gnu/image.scm | 3 +
gnu/installer/parted.scm | 12 +-
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 71 +-
gnu/packages/bootloaders.scm | 277 ++--
gnu/packages/efi.scm | 47 +
gnu/packages/raspberry-pi.scm | 18 -
gnu/services/virtualization.scm | 11 +-
gnu/system.scm | 62 +-
gnu/system/boot.scm | 16 +-
gnu/system/examples/asus-c201.tmpl | 6 +-
gnu/system/examples/bare-bones.tmpl | 7 +-
gnu/system/examples/bare-hurd.tmpl | 4 +-
gnu/system/examples/beaglebone-black.tmpl | 6 +-
gnu/system/examples/desktop.tmpl | 4 +-
gnu/system/examples/docker-image.tmpl | 6 +-
gnu/system/examples/lightweight-desktop.tmpl | 4 +-
gnu/system/examples/plasma.tmpl | 4 +-
.../examples/raspberry-pi-64-nfs-root.tmpl | 23 +-
gnu/system/examples/raspberry-pi-64.tmpl | 18 +-
gnu/system/examples/vm-image.tmpl | 5 +-
gnu/system/hurd.scm | 4 +-
gnu/system/image.scm | 162 ++-
gnu/system/images/hurd.scm | 4 +-
gnu/system/images/novena.scm | 3 +-
.../images/orangepi-r1-plus-lts-rk3328.scm | 3 +-
gnu/system/images/pine64.scm | 3 +-
gnu/system/images/pinebook-pro.scm | 3 +-
gnu/system/images/rock64.scm | 3 +-
gnu/system/images/unmatched.scm | 3 +-
gnu/system/images/visionfive2.scm | 3 +-
gnu/system/images/wsl2.scm | 14 +-
gnu/system/install.scm | 43 +-
gnu/system/vm.scm | 11 -
gnu/tests.scm | 4 +-
gnu/tests/ganeti.scm | 4 +-
gnu/tests/image.scm | 4 +-
gnu/tests/install.scm | 80 +-
gnu/tests/nfs.scm | 4 +-
gnu/tests/reconfigure.scm | 86 +-
gnu/tests/telephony.scm | 4 +-
gnu/tests/vnc.scm | 4 +-
guix/scripts/system.scm | 162 +--
guix/scripts/system/reconfigure.scm | 159 +-
guix/ui.scm | 8 +
tests/boot-parameters.scm | 16 +-
57 files changed, 2389 insertions(+), 2535 deletions(-)
create mode 100644 gnu/bootloader/uki.scm
base-commit: 7d781027c78bdea5fdb3f1c9c9ec432b9606d2b5
--
2.45.2
^ permalink raw reply [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
` (14 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Ludovic Court??s, Mathieu Othacehe,
Simon Tournier, Tobias Geerinckx-Rice
The current implementation is broken anyway. Multiple bootloaders share
a name (including both versions of extlinux) and
bootloader-configuration data is significant to bootloader installation.
It shouldn't be just faked.
Rely on the provenance service instead, which while not always present,
should be for the vast majority of systems.
* guix/scripts/system.scm (reinstall-bootloader): Rename to...
(install-bootloader-from-provenance): ...this, and rewrite to extract
bootloader-configuration data from system provenance.
(switch-to-system-generation, process-command): Use
install-bootloader-from-provenance.
Change-Id: I5713a43ad4f9f32a129d980db06d70de16b03f27
---
guix/scripts/system.scm | 75 ++++++++++++++---------------------------
1 file changed, 25 insertions(+), 50 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0f7d864e06..bb7b5d37bf 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -88,6 +88,7 @@ (define-module (guix scripts system)
#:use-module (srfi srfi-37)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
#:use-module (rnrs bytevectors)
#:export (guix-system
read-operating-system
@@ -377,60 +378,33 @@ (define (switch-to-system-generation store spec)
(activate (string-append generation "/activate")))
(if number
(begin
- (reinstall-bootloader store number)
+ (install-bootloader-from-provenance store number)
(switch-to-generation* %system-profile number)
(unless-file-not-found (primitive-load activate)))
(leave (G_ "cannot switch to system generation '~a'~%") spec))))
-(define* (system-bootloader-name #:optional (system %system-profile))
- "Return the bootloader name stored in SYSTEM's \"parameters\" file."
- (let ((params (unless-file-not-found
- (read-boot-parameters-file system))))
- (boot-parameters-bootloader-name params)))
-
-(define (reinstall-bootloader store number)
- "Re-install bootloader for existing system profile generation NUMBER.
-STORE is an open connection to the store."
+(define (install-bootloader-from-provenance store number)
+ "Re-install an old bootloader using provenance data for system profile
+generation NUMBER with store STORE."
(let* ((generation (generation-file-name %system-profile number))
- ;; Detect the bootloader used in %system-profile.
- (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
-
- ;; Use the detected bootloader with default configuration.
- ;; It will be enough to allow the system to boot.
- (bootloader-config (bootloader-configuration
- (bootloader bootloader)))
-
- ;; Make the specified system generation the default entry.
- (chosen-alternative (generation->boot-alternative
- %system-profile number))
- (params (boot-alternative-parameters chosen-alternative))
- (locale (boot-parameters-locale params))
- (store-crypto-devices (boot-parameters-store-crypto-devices params))
- (store-directory-prefix
- (boot-parameters-store-directory-prefix params))
- (old-generations
- (delv number (reverse (generation-numbers %system-profile))))
- (previous-boot-alternatives (profile->boot-alternatives
- %system-profile old-generations))
- (entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- previous-boot-alternatives))))
- (run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object
- ((bootloader-configuration-file-generator bootloader)
- bootloader-config entries
- #:locale locale
- #:store-crypto-devices store-crypto-devices
- #:store-directory-prefix store-directory-prefix
- #:old-entries old-entries)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))))
+ (os (receive (_ os) (system-provenance generation)
+ (and=> os read-operating-system)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (numbers (delv number (reverse (generation-numbers %system-profile))))
+ (old (profile->boot-alternatives %system-profile numbers)))
+ (if os
+ (run-with-store store
+ (mlet* %store-monad
+ ((bootcfg (lower-object (operating-system-bootcfg os old)))
+ (drvs -> (list bootcfg)))
+ (mbegin %store-monad
+ (built-derivations drvs)
+ ;; Only install bootloader configuration file.
+ (install-bootloader local-eval bootloader-config bootcfg
+ #:run-installer? #f))))
+ (leave (G_ "cannot rollback to provenanceless generation '~a'~%")
+ number))))
\f
;;;
@@ -1416,7 +1390,8 @@ (define (process-command command args opts)
(x (leave (G_ "wrong number of arguments~%"))))))
(with-store* store
(delete-matching-generations store %system-profile pattern)
- (reinstall-bootloader store (generation-number %system-profile)))))
+ (install-bootloader-from-provenance store
+ (generation-number %system-profile)))))
((switch-generation)
(let ((pattern (match args
((pattern) pattern)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 02/15] gnu: Add bootloader target infastructure.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
` (13 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Lilah Tascheter, Ludovic Court??s,
Mathieu Othacehe, Simon Tournier, Tobias Geerinckx-Rice
* gnu/bootloader.scm (bootloader-target): New record.
(&target-error): New condition.
(pathcat, get-target-of-type, parent-of, unfold-pathcat, target-base?,
type-major?, ensure, ensure-target-types, ensure-majors, gbegin):
New procedures.
(define-literal, with-targets, :path, :devpath, :device,
:fs, :label, :uuid): New macros.
(bootloader-modules): Prevent mutual imports.
* guix/ui.scm (call-with-error-handling)[target-error?]:
Handle target-errors.
Change-Id: I3f07c9096dd8b91c04449b6360b3b7d21640da14
---
gnu/bootloader.scm | 212 ++++++++++++++++++++++++++++++++++++++++++++-
guix/ui.scm | 8 ++
2 files changed, 217 insertions(+), 3 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index f32e90e79d..3ddc112cc6 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -31,10 +31,11 @@ (define-module (gnu bootloader)
#:use-module (guix profiles)
#:use-module (guix records)
#:use-module (guix deprecation)
- #:use-module ((guix ui) #:select (warn-about-load-error))
#:use-module (guix diagnostics)
#:use-module (guix i18n)
+ #:use-module (guix modules)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
@@ -63,6 +64,26 @@ (define-module (gnu bootloader)
bootloader-configuration-file
bootloader-configuration-file-generator
+ <bootloader-target>
+ bootloader-target
+ bootloader-target?
+ bootloader-target-type
+ bootloader-target-expected?
+ bootloader-target-path
+ bootloader-target-offset
+ bootloader-target-device
+ bootloader-target-file-system
+ bootloader-target-label
+ bootloader-target-uuid
+
+ target-error?
+ target-error-type
+ target-error-targets
+
+ gbegin
+ :path :devpath :device :fs :label :uuid
+ with-targets
+
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
@@ -236,6 +257,191 @@ (define-record-type* <bootloader>
(configuration-file bootloader-configuration-file)
(configuration-file-generator bootloader-configuration-file-generator))
+\f
+;;;
+;;; Bootloader target record.
+;;;
+
+;; <bootloader-target> represents different kinds of targets in a normalized form.
+
+(define-record-type* <bootloader-target>
+ bootloader-target make-bootloader-target bootloader-target?
+ (type bootloader-target-type) ; symbol
+ (expected? bootloader-target-expected? (default #f)) ; bool
+
+ (path bootloader-target-path (default #f)) ; string|#f
+ (offset bootloader-target-offset (thunked) ; symbol|#f
+ (default (and (bootloader-target-path this-record)
+ (not (eq? (bootloader-target-type this-record) 'root))
+ 'root)))
+ (device bootloader-target-device (default #f)) ; string|#f
+ (file-system bootloader-target-file-system (default #f)) ; string|#f
+ (label bootloader-target-label (default #f)) ; string|#f
+ (uuid bootloader-target-uuid (default #f))) ; uuid|#f
+
+(define-condition-type &target-error &error target-error?
+ (type target-error-type)
+ (targets target-error-targets))
+
+(define (pathcat p1 p2)
+ (string-append (string-trim-right p1 #\/) "/" (string-trim p2 #\/)))
+
+(define* (get-target-of-type type targets #:optional (require? #f))
+ "Finds a target in TARGETS of type TYPE, optionally providing an error when
+not found if REQUIRE? is provided."
+ (let* ((pred (lambda (target) (eq? type (bootloader-target-type target))))
+ (candidates (filter pred targets))
+ (ret (if (pair? candidates) (car candidates) #f)))
+ (if (and require? (not ret))
+ (raise (condition
+ (&message (message (G_ "required, but not provided")))
+ (&target-error (type type) (targets targets))))
+ ret)))
+
+(define (parent-of target targets)
+ (and=> (bootloader-target-offset target)
+ (cut get-target-of-type <> targets #t)))
+
+(define (unfold-pathcat target targets)
+ (let ((quit (lambda (t) (not (and=> t bootloader-target-path)))))
+ (reduce pathcat #f
+ (unfold quit bootloader-target-path (cut parent-of <> targets) target))))
+
+(define (target-base? t)
+ (or (not t) (match-record t <bootloader-target>
+ (expected? offset device label uuid)
+ (or device label uuid (not offset) expected?))))
+
+(define (type-major? target) (memq target '(root esp disk)))
+
+(define (ensure types targets end)
+ (let* ((used-in (cute unfold end identity (cut parent-of <> targets) <>))
+ (cons-in (lambda (t) (cons t (used-in t))))
+ (ensure (map (cut get-target-of-type <> targets #t) types)))
+ (filter ->bool (apply append (map cons-in ensure)))))
+
+(define* (ensure-target-types types targets #:optional (base? #f))
+ "Ensures all TYPES are provided in TARGETS. Returns #t iff every ensured
+target and its requirements are fully provided. Errors out when a required TYPE
+isn't provided. When BASE?, only ensure path requirements up to a device."
+ (not (any bootloader-target-expected?
+ (ensure types targets (if base? target-base? not)))))
+
+(define (ensure-majors types targets)
+ "Errors out when a required TYPE isn't provided, or when use of multiple major
+targets is detected."
+ (let* ((all (map bootloader-target-type (ensure types targets target-base?)))
+ (majors (delete-duplicates (filter type-major? all) eq?)))
+ (if (< (length majors) 2) #t
+ (raise (condition (&message (message (G_ "multiple major targets used")))
+ (&target-error (type majors) (targets targets)))))))
+
+
+
+(define (gbegin . gex)
+ "Sequence provided g-expressions."
+ (case (length gex) ((0) #f) ((1) (car gex)) (else #~(begin #$@gex))))
+
+;; syntax matching on free literals breaks easily, so bind them
+(define-syntax-rule (define-literal id) (define-syntax id (syntax-rules ())))
+(define-literal :path)
+(define-literal :devpath)
+(define-literal :device)
+(define-literal :fs)
+(define-literal :label)
+(define-literal :uuid)
+
+(define-syntax with-targets
+ (cut syntax-case <> ()
+ ((_ targets-expr block ...)
+ (let* ((genvars (compose generate-temporaries iota))
+ (targets (car (genvars 1)))
+
+ (path? (cut syntax-case <> (:path) ((_ :path) #t) (_ #f)))
+ (qualified? (cut syntax-case <> (=>)
+ ((_ => spec ...) (any path? #'(spec ...)))
+ (_ #f)))
+
+ (resolve
+ (lambda (in target base)
+ (with-syntax ((target target) (base base) (targets targets))
+ (syntax-case in
+ (:path :devpath :device :fs :label :uuid)
+ ((name _) (not (identifier? #'name))
+ #`(_ (syntax-error "binds must be to identifiers" #,in)))
+ ((name :device) #'(name (bootloader-target-device base)))
+ ((name :label) #'(name (bootloader-target-label base)))
+ ((name :uuid) #'(name (bootloader-target-uuid base)))
+ ((name :fs) #'(name (bootloader-target-file-system base)))
+ ((name :path) #'(name (unfold-pathcat target targets)))
+ ((name :devpath)
+ #'(name (pathcat "/" (bootloader-target-path target))))
+ (_ #`(_ (syntax-error "invalid binding spec" #,in)))))))
+ (binds
+ (lambda (spec)
+ (syntax-case spec (=>)
+ ((type => binds ...)
+ (with-syntax (((target base) (genvars 2)) (targets targets))
+ (append
+ #`((get (lambda (t) (get-target-of-type t targets #t)))
+ (target (get type))
+ (base (if (target-base? target) target
+ (get (bootloader-target-offset target)))))
+ (map (cut resolve <> #'target #'base) #'(binds ...)))))
+ (_ #f))))
+
+ (blocks
+ (cut syntax-case <> ()
+ ((spec ... expr)
+ (let* ((specs #'(spec ...))
+ (lets (apply append (filter-map binds specs)))
+ (type (cut syntax-case <> (=>)
+ ((t => _ ...) #'t) (t #'t))))
+ (receive (full part) (partition qualified? specs)
+ #`(and (ensure-majors (list #,@(map type specs)) #,targets)
+ (ensure-target-types (list #,@(map type part))
+ #,targets #t)
+ (ensure-target-types (list #,@(map type full))
+ #,targets #f)
+ (let* #,lets expr)))))
+ (bad #'(syntax-error "malformed block" bad)))))
+ "Using the list TARGETS, evaluate and sequence each BLOCK to produce a
+gexp. BLOCK is a set of SPECs followed by an EXPR (evaluating to a gexp). Each
+SPEC denotes a type of target to guard EXPR on their existance and
+full-qualification. This procedure is linear in regards to BLOCKs.
+
+SPEC may be of the following forms:
+@itemize
+@item 'TYPE Requires TYPE to be fully present or promised. Errors otherwise.
+@item ('TYPE => (VAR COMPONENT) ...): As type, but also binds variables. TYPE's
+ COMPONENT is bound to the variable VAR as described below.
+@end itemize
+
+Available COMPONENTs are:
+@itemize
+@item :path (fully-qualified)
+@item :devpath (relative from device)
+@item :device (auto-detected from uuid and label if not user-provided)
+@item :fs
+@item :label
+@item :uuid
+@end itemize
+
+Note that installers may be called multiple times with different targets being
+fully-qualified. To ensure that targets aren't installed multiple times, make sure
+that each BLOCK ensures at least one major target, either directly or indirectly.
+Corrolarily, at most one major target should be ensured per BLOCK, under the same
+conditions. Major targets originate from disk image handling, and are currently:
+@itemize
+@item disk
+@item root
+@item esp
+@end itemize"
+ #`(let ((#,targets targets-expr))
+ (apply gbegin (filter ->bool
+ (list #,@(map blocks #'(block ...))))))))
+ (bad #'(syntax-error "must provide targets" bad))))
+
\f
;;;
;;; Bootloader configuration record.
@@ -305,10 +511,10 @@ (define (bootloader-configuration-targets config)
(define (bootloader-modules)
"Return the list of bootloader modules."
+ ;; don't provide #:warn to prevent mutual imports
(all-modules (map (lambda (entry)
`(,entry . "gnu/bootloader"))
- %load-path)
- #:warn warn-about-load-error))
+ %load-path)))
(define %bootloaders
;; The list of publically-known bootloaders.
diff --git a/guix/ui.scm b/guix/ui.scm
index 9db6f6e9d7..1c9300c9eb 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -36,6 +36,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix ui)
+ #:use-module ((gnu bootloader)
+ #:select (target-error? target-error-type target-error-targets))
#:use-module (guix i18n)
#:use-module (guix colors)
#:use-module (guix diagnostics)
@@ -857,6 +859,12 @@ (define (call-with-error-handling thunk)
(invoke-error-stop-signal c)
(cons (invoke-error-program c)
(invoke-error-arguments c))))
+ ((target-error? c)
+ (leave (G_ "bootloader-target '~a'~@[: ~a~] ~
+ among the following targets:~%~{~y~}")
+ (target-error-type c)
+ (and (message-condition? c) (condition-message c))
+ (target-error-targets c)))
((formatted-message? c)
(apply report-error
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 03/15] guix: scripts: Remove unused code.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
` (12 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Ludovic Court??s, Mathieu Othacehe,
Simon Tournier, Tobias Geerinckx-Rice
* guix/scripts/system.scm (bootloader-installer-script): Delete.
Change-Id: Ic1e0a523c814e4f1bf44b2721f5658f00066b0ab
---
guix/scripts/system.scm | 22 ----------------------
1 file changed, 22 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bb7b5d37bf..344bb74151 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -731,28 +731,6 @@ (define (maybe-suggest-running-guix-pull)
(warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%"))
(warning (G_ "Failing to do that may downgrade your system!~%"))))
-(define (bootloader-installer-script installer
- bootloader device target)
- "Return a file calling INSTALLER gexp with given BOOTLOADER, DEVICE
-and TARGET arguments."
- (scheme-file "bootloader-installer"
- (with-imported-modules '((gnu build bootloader)
- (guix build utils))
- #~(begin
- (use-modules (gnu build bootloader)
- (guix build utils)
- (ice-9 binary-ports)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (guard (c ((message-condition? c) ;XXX: i18n
- (format (current-error-port) "error: ~a~%"
- (condition-message c))
- (exit 1)))
- (#$installer #$bootloader #$device #$target)
- (info (G_ "bootloader successfully installed on '~a'~%")
- #$device))))))
-
(define (local-eval exp)
"Evaluate EXP, a G-Expression, in-place."
(mlet* %store-monad ((lowered (lower-gexp exp))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 04/15] gnu: Core bootloader changes.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (2 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
` (11 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Efraim Flashner, Josselin Poiret, Lilah Tascheter,
Ludovic Court??s, Mathieu Othacehe, Simon Tournier,
Tobias Geerinckx-Rice, Vagrant Cascadian
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/bootloader.scm (menu-entry): Add device-subvol field.
(menu-entry->sexp, sexp->menu-entry): Support device-subvol.
(normalize-file, warn-update-targets, target-overrides, normalize,
bootloader-configuration->gexp, bootloader-configurations->gexps,
efi-arch, install-efi):
New procedures.
(bootloader): Rewrite record.
(bootloader-configuration)[target]: Remove deprecated field.
[targets]: Include sanitizer and allow multiple bootloaders.
[terminal-outputs, terminal-inputs]: Don't assume grub.
[efi-removable?, 32bit?]: New fields.
(warn-target-field-deprecation): Delete deprecation warning.
(%bootloaders): Delete variable.
(bootloader-configuration-target, bootloader-configuration-targets,
lookup-bootloader-by-name, bootloader-modules, efi-bootloader-profile,
efi-bootloader-chain): Delete procedures.
* gnu/bootloader/depthcharge.scm, gnu/bootloader/extlinux.scm,
gnu/bootloader/grub.scm, gnu/bootloader/u-boot.scm: Rewrite entirely.
* gnu/build/bootloader.scm (parse-bootnums): New variable.
(atomic-copy, in-temporary-directory, efi-bootnums): New procedures.
(install-efi-loader): Delete procedure.
(install-efi): Rewrite to support installation of any efi bootloader.
* gnu/build/image.scm (initialize-efi32-partition: Deprecate.
(initialize-efi-partitition): Only create EFI directory.
(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/image.scm (partition)[target]: New field in order to support
dynamic provision of image partitions as bootloader targets.
* gnu/installer/parted.scm (bootloader-configuration),
gnu/machine/ssh.scm (deploy-managed-host) (roll-back-managed-host):
Use new bootloader system.
* gnu/packages/bootloaders.scm (make-grub-efi-netboot): Delete
procedure.
* gnu/packages/raspberry-pi.scm (grub-efi-bootloader-chain-raspi-64):
Delete procedure. Can be recreated with a raspberry pi bootloader
combined with grub-efi.
* gnu/system.scm (convert-bootloader-field): New procedure.
(operating-system)[bootloader]: Use above sanitizer and support
multiple bootloaders.
(operating-system-bootcfg): Rename to...
(operating-system-bootmeta): ...this. Rewrite to return relavent
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.
(boot-parameters->menu-entry): Support device-subvol.
(boot-alternative->menu-entry): New procedure.
* gnu/system/image.scm (root-partition, esp-partition): Use target field.
(esp32-partition, efi32-disk-partition, efi32-raw-image-type): Deprecate.
(root-partition-index): Delete procedure.
(system-disk-image, system-iso9960-image): Support new bootloader system.
(system-disk-image)[targets]: New subprocedure.
* gnu/system/images/hurd.scm (hurd-barebones-os)[bootloader],
gnu/system/images/novena.scm (novena-barebones-os)[bootloader],
gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
(orangepi-r1-plus-lts-rk3328-barebones-os)[bootloader],
gnu/system/images/pine64.scm (pine64-barebones-os)[bootloader],
gnu/system/images/pinebook-pro.scm
(pinebook-pro-barebones-os)[bootloader],
gnu/system/images/rock64.scm (rock64-barebones-os)[bootloader],
gnu/system/images/unmatched.scm (unmatched-barebones-os)[bootloader],
gnu/system/images/visionfive2.scm
(visionfive2-barebones-os)[bootloader]: Use new target format.
* gnu/system/images/wsl2.scm (dummy-bootloader): Delete variable.
(wsl-os)[bootloader]: Don't provide field.
* gnu/system/install.scm (installation-os)[bootloader]: Use new format.
(os-with-u-boot): Delete procedure.
(embedded-installation-os)[bootloader]: Use new format.
(beaglebone-black-installation-os, a20-olinuxino-lime-installation-os,
a20-olinuxino-lime2-emmc-installation-os,
a20-olinuxino-micro-installation-os, bananapi-m2-ultra-installation-os,
firefly-rk3399-installation-os, mx6cuboxi-installation-os,
novena-installation-os, nintendo-nes-classic-edition-installation-os,
orangepi-r1-plus-lts-rk3328-installation-os, pine64-plus-installation-os,
pinebook-installation-os, rock64-installation-os,
rockpro64-installation-os, rk3399-puma-installation-os,
wandboard-installation-os): Don't guess block device.
* gnu/system/vm.scm (virtualized-operating-system): Don't provide
bootloader.
* gnu/tests/install.scm (%minimal-extlinux-os)[bootloader]: Use proper
extlinux variable.
(%btrfs-raid10-root-os): Use multiple bootloaders.
* gnu/tests/reconfigure.scm (%test-install-bootloader): Delete variable.
(run-install-bootloader-test): Delete procedure.
* 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
---
gnu/bootloader.scm | 442 +++---
gnu/bootloader/depthcharge.scm | 153 +-
gnu/bootloader/extlinux.scm | 149 +-
gnu/bootloader/grub.scm | 1279 +++++++----------
gnu/bootloader/u-boot.scm | 439 ++----
gnu/build/bootloader.scm | 157 +-
gnu/build/image.scm | 40 +-
gnu/build/install.scm | 16 +-
gnu/image.scm | 3 +
gnu/installer/parted.scm | 12 +-
gnu/machine/ssh.scm | 71 +-
gnu/packages/bootloaders.scm | 86 --
gnu/packages/raspberry-pi.scm | 18 -
gnu/system.scm | 45 +-
gnu/system/boot.scm | 8 +-
gnu/system/image.scm | 162 ++-
gnu/system/images/hurd.scm | 4 +-
gnu/system/images/novena.scm | 3 +-
.../images/orangepi-r1-plus-lts-rk3328.scm | 3 +-
gnu/system/images/pine64.scm | 3 +-
gnu/system/images/pinebook-pro.scm | 3 +-
gnu/system/images/rock64.scm | 3 +-
gnu/system/images/unmatched.scm | 3 +-
gnu/system/images/visionfive2.scm | 3 +-
gnu/system/images/wsl2.scm | 14 +-
gnu/system/install.scm | 43 +-
gnu/system/vm.scm | 11 -
gnu/tests/install.scm | 10 +-
gnu/tests/reconfigure.scm | 86 +-
guix/scripts/system.scm | 89 +-
guix/scripts/system/reconfigure.scm | 159 +-
31 files changed, 1427 insertions(+), 2090 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 3ddc112cc6..f855671e82 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,45 +25,53 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader)
+ #:autoload (gnu build file-systems)
+ (read-partition-label read-partition-uuid
+ find-partition-by-label find-partition-by-uuid)
+ #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
- #:use-module (guix discovery)
- #:use-module (guix gexp)
- #:use-module (guix profiles)
- #:use-module (guix records)
+ #:autoload (guix build syscalls)
+ (mounts mount-source mount-point mount-type)
#:use-module (guix deprecation)
#:use-module (guix diagnostics)
+ #:use-module (guix gexp)
#:use-module (guix i18n)
#:use-module (guix modules)
+ #:use-module (guix profiles)
+ #:use-module (guix records)
+ #:use-module (guix utils)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
+ #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (ice-9 match)
- #:export (menu-entry
+ #:export (<menu-entry>
+ menu-entry
menu-entry?
menu-entry-label
menu-entry-device
+ menu-entry-device-mount-point
+ menu-entry-device-subvol
menu-entry-linux
menu-entry-linux-arguments
menu-entry-initrd
- menu-entry-device-mount-point
menu-entry-multiboot-kernel
menu-entry-multiboot-arguments
menu-entry-multiboot-modules
menu-entry-chain-loader
+ normalize-file
menu-entry->sexp
sexp->menu-entry
bootloader
bootloader?
bootloader-name
- bootloader-package
+ bootloader-default-targets
bootloader-installer
- bootloader-disk-image-installer
- bootloader-configuration-file
- bootloader-configuration-file-generator
<bootloader-target>
bootloader-target
@@ -84,13 +93,15 @@ (define-module (gnu bootloader)
:path :devpath :device :fs :label :uuid
with-targets
+ <bootloader-configuration>
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
- bootloader-configuration-target ;deprecated
bootloader-configuration-targets
bootloader-configuration-menu-entries
bootloader-configuration-default-entry
+ bootloader-configuration-efi-removable?
+ bootloader-configuration-32bit?
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -101,10 +112,11 @@ (define-module (gnu bootloader)
bootloader-configuration-device-tree-support?
bootloader-configuration-extra-initrd
- %bootloaders
- lookup-bootloader-by-name
+ bootloader-configuration->gexp
+ bootloader-configurations->gexp
- efi-bootloader-chain))
+ efi-arch
+ install-efi))
\f
;;;
@@ -119,6 +131,8 @@ (define-record-type* <menu-entry>
(default #f))
(device-mount-point menu-entry-device-mount-point
(default #f))
+ (device-subvol menu-entry-device-subvol
+ (default #f))
(linux menu-entry-linux
(default #f))
(linux-arguments menu-entry-linux-arguments
@@ -135,6 +149,18 @@ (define-record-type* <menu-entry>
(chain-loader menu-entry-chain-loader
(default #f))) ; string, path of efi file
+(define (normalize-file entry val)
+ "Normalize a file VAL stored in a menu entry into one suitable for a
+bootloader. Realizes device-mount-point and device-subvol."
+ (match-record entry <menu-entry> (device-mount-point device-subvol)
+ #~(let* ((rel (lambda (s) (substring s (if (string-prefix? "/" s) 1 0))))
+ (file (rel #$val))
+ (subvol (and=> #$device-subvol rel))
+ (mount (and=> #$device-mount-point rel)))
+ (string-append (if subvol (string-append "/" subvol "/") "/")
+ (if (and mount (string-prefix? mount file))
+ (substring file (string-length mount)) file)))))
+
(define (report-menu-entry-error menu-entry)
(raise
(condition
@@ -162,7 +188,7 @@ (define (menu-entry->sexp entry)
`(label ,(file-system-label->string label)))
(_ device)))
(match entry
- (($ <menu-entry> label device mount-point
+ (($ <menu-entry> label device mount-point subvol
(? identity linux) linux-arguments (? identity initrd)
#f () () #f)
`(menu-entry (version 0)
@@ -171,8 +197,9 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(linux ,linux)
(linux-arguments ,linux-arguments)
- (initrd ,initrd)))
- (($ <menu-entry> label device mount-point #f () #f
+ (initrd ,initrd)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f
(? identity multiboot-kernel) multiboot-arguments
multiboot-modules #f)
`(menu-entry (version 0)
@@ -181,19 +208,23 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(multiboot-kernel ,multiboot-kernel)
(multiboot-arguments ,multiboot-arguments)
- (multiboot-modules ,multiboot-modules)))
- (($ <menu-entry> label device mount-point #f () #f #f () ()
+ (multiboot-modules ,multiboot-modules)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f #f () ()
(? identity chain-loader))
`(menu-entry (version 0)
(label ,label)
(device ,(device->sexp device))
(device-mount-point ,mount-point)
- (chain-loader ,chain-loader)))
+ (chain-loader ,chain-loader)
+ (device-subvol ,subvol)))
(_ (report-menu-entry-error entry))))
(define (sexp->menu-entry sexp)
"Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
record."
+ ;; XXX: rely on shadowing to support the match ors below
+ (define subvol #f)
(define (sexp->device device-sexp)
(match device-sexp
(('uuid type uuid-string)
@@ -206,35 +237,41 @@ (define (sexp->menu-entry sexp)
('label label) ('device device)
('device-mount-point mount-point)
('linux linux) ('linux-arguments linux-arguments)
- ('initrd initrd) _ ...)
+ ('initrd initrd)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(linux linux)
(linux-arguments linux-arguments)
(initrd initrd)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
+ ('device-mount-point mount-point) ('device-subvol subvol)
('multiboot-kernel multiboot-kernel)
('multiboot-arguments multiboot-arguments)
- ('multiboot-modules multiboot-modules) _ ...)
+ ('multiboot-modules multiboot-modules)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(multiboot-kernel multiboot-kernel)
(multiboot-arguments multiboot-arguments)
(multiboot-modules multiboot-modules)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
- ('chain-loader chain-loader) _ ...)
+ ('device-mount-point mount-point) ('device-subvol subvol)
+ ('chain-loader chain-loader)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(chain-loader chain-loader)))))
\f
@@ -247,15 +284,10 @@ (define (sexp->menu-entry sexp)
;; has to be described by this record.
(define-record-type* <bootloader>
- bootloader make-bootloader
- bootloader?
- (name bootloader-name)
- (package bootloader-package)
- (installer bootloader-installer)
- (disk-image-installer bootloader-disk-image-installer
- (default #f))
- (configuration-file bootloader-configuration-file)
- (configuration-file-generator bootloader-configuration-file-generator))
+ bootloader make-bootloader bootloader?
+ (name bootloader-name)
+ (default-targets bootloader-default-targets (default '()))
+ (installer bootloader-installer))
\f
;;;
@@ -450,28 +482,48 @@ (define-syntax with-targets
;; The <bootloader-configuration> record contains bootloader independant
;; configuration used to fill bootloader configuration file.
-(define-with-syntax-properties (warn-target-field-deprecation
- (value properties))
- (when value
- (warning (source-properties->location properties)
- (G_ "the 'target' field is deprecated, please use 'targets' \
-instead~%")))
- value)
+(define-with-syntax-properties (warn-update-targets (value properties))
+ (let ((loc (source-properties->location properties)))
+ (define update
+ (match-lambda
+ ((? bootloader-target? target) (cons #f target))
+ ((? string? s) (cons #t (if (string-prefix? "/dev" s)
+ (bootloader-target
+ (type 'disk)
+ (device s))
+ (bootloader-target
+ (type 'esp)
+ (offset 'root)
+ (path s)))))
+ (x (error loc (G_ "invalid target '~a'~%") x))))
+
+ (let* ((updated (map update (if (list? value) value (list value))))
+ (targets (map cdr updated))
+ (types (map bootloader-target-type targets)))
+ ;; XXX: should this be an error?
+ (when (any car updated)
+ (warning loc (G_ "the 'targets' field should now contain \
+<bootloader-target> records. inferring a best guess (this might break!)...~%")))
+ (when (not (eqv? (length types) (length (delete-duplicates types))))
+ (error loc (G_ "the 'targets' field may not contain duplicates~%")))
+ targets)))
(define-record-type* <bootloader-configuration>
bootloader-configuration make-bootloader-configuration
bootloader-configuration?
(bootloader
- bootloader-configuration-bootloader) ;<bootloader>
- (targets %bootloader-configuration-targets
- (default #f)) ;list of strings
- (target %bootloader-configuration-target ;deprecated
- (default #f)
- (sanitize warn-target-field-deprecation))
+ bootloader-configuration-bootloader) ;<bootloader>
+ (targets bootloader-configuration-targets
+ (default '()) ;list of strings
+ (sanitize warn-update-targets))
(menu-entries bootloader-configuration-menu-entries
(default '())) ;list of <menu-entry>
(default-entry bootloader-configuration-default-entry
(default 0)) ;integer
+ (efi-removable? bootloader-configuration-efi-removable?
+ (default #f)) ;bool
+ (32bit? bootloader-configuration-32bit?
+ (default #f)) ;bool
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
@@ -479,9 +531,9 @@ (define-record-type* <bootloader-configuration>
(theme bootloader-configuration-theme
(default #f)) ;bootloader-specific theme
(terminal-outputs bootloader-configuration-terminal-outputs
- (default '(gfxterm))) ;list of symbols
+ (default #f)) ;list of symbols | #f (default outs)
(terminal-inputs bootloader-configuration-terminal-inputs
- (default '())) ;list of symbols
+ (default #f)) ;list of symbols | #f (default ins)
(serial-unit bootloader-configuration-serial-unit
(default #f)) ;integer | #f
(serial-speed bootloader-configuration-serial-speed
@@ -491,164 +543,142 @@ (define-record-type* <bootloader-configuration>
(extra-initrd bootloader-configuration-extra-initrd
(default #f))) ;string | #f
-(define-deprecated (bootloader-configuration-target config)
- bootloader-configuration-targets
- (%bootloader-configuration-target config))
+\f
+;;;
+;;; Bootloader installation paths.
+;;;
-(define (bootloader-configuration-targets config)
- (or (%bootloader-configuration-targets config)
- ;; TODO: Remove after the deprecated 'target' field is removed.
- (list (%bootloader-configuration-target config))
- ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this
- ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f,
- ;; hence the default value of '(#f) rather than '().
- (list #f)))
+;; highest -> lowest priority
+(define (target-overrides . layers)
+ (let* ((types (fold append '()
+ (map (cute map bootloader-target-type <>) layers)))
+ (pred (lambda (type layer found)
+ (or found (get-target-of-type type layer))))
+ (find (lambda (type) (fold (cute pred type <> <>) #f layers))))
+ (filter ->bool (map find (delete-duplicates types)))))
+
+(define (normalize targets)
+ "Augments user-supplied targets with filesystem information at runtime,
+allowing users to specify a lot less information. Relatively minimal to prevent
+errors. Puts targets into a normal form, where all paths are fully specified up
+to a device offset."
+ (let* ((mass (lambda (m) `((,(mount-source m) . ,m) (,(mount-point m) . ,m))))
+ (amounts (delay (apply append (map mass (mounts)))))
+ (accessible=> (lambda (d f) (and d (access? d R_OK) (f d))))
+ (assoc-mnt (lambda (f) (lambda (v)
+ (and=> (assoc-ref (force amounts) v) f)))))
+
+ (define (scrape target)
+ (match-record target <bootloader-target>
+ (expected? path offset device label uuid file-system)
+ (if expected? target
+ (bootloader-target
+ (inherit target)
+ (device (or device (false-if-exception
+ (or (and=> uuid find-partition-by-uuid)
+ (and=> label find-partition-by-label)))
+ (and path ((assoc-mnt mount-source)
+ (unfold-pathcat target targets)))))
+ (label (or label (accessible=> device read-partition-label)))
+ (uuid (or uuid (accessible=> device read-partition-uuid)))
+ (file-system (or file-system (and=> device (assoc-mnt mount-type))))
+ (offset (and path offset))
+ (path (or path (and=> device (assoc-mnt mount-point))))))))
+
+ (define (fixuuid target)
+ (match-record target <bootloader-target> (uuid file-system)
+ (let ((type (cond ((not file-system) 'dce)
+ ((member file-system '("vfat" "fat32")) 'fat)
+ ((string=? file-system "ntfs") 'ntfs)
+ ((string=? file-system "iso9660") 'iso9660)
+ (else 'dce))))
+ (cond ((uuid? uuid) uuid)
+ ((bytevector? uuid) (bytevector->uuid uuid type))
+ ((string? uuid) (string->uuid uuid type))
+ (else #f)))))
+
+ (define (arborify target targets)
+ (let* ((up (lambda (t) (and t (parent-of t targets))))
+ (proto (unfold target-base? identity up (up target) list))
+ (chain (reverse (cons target proto))))
+ (bootloader-target
+ (inherit target)
+ (offset (and=> (car chain) bootloader-target-type))
+ (path (reduce pathcat #f (map bootloader-target-path (cdr chain)))))))
+
+ (let ((mid (map (compose fixuuid scrape) targets)))
+ (map (cut arborify <> mid) mid))))
+
+(define* (bootloader-configuration->gexp bootloader-config args #:key
+ (root-offset "/") (overrides '()))
+ "Returns a gexp to install BOOTLOADER-CONFIG to its targets, passing ARGS
+to each installer alongside the additional #:bootloader-config keyword
+arguments. Target OVERRIDES are applied and all path targets have ROOT-OFFSET
+applied. The following keyword arguments are expected in ARGS:
+@enumerate
+@item current-boot-alternative
+@item old-boot-alternatives
+@item locale (from bootmeta)
+@item store-directory-prefix (from bootmeta)
+@item store-crypto-devices (from bootmeta)
+@end enumerate"
+ (let* ((bootloader (bootloader-configuration-bootloader bootloader-config))
+ (installer (bootloader-installer bootloader))
+ (auto-targets (list (bootloader-target
+ (type 'root)
+ (path root-offset)
+ (offset #f))))
+ (targets (target-overrides
+ overrides
+ (bootloader-configuration-targets bootloader-config)
+ auto-targets
+ (bootloader-default-targets bootloader)))
+ (conf (bootloader-configuration
+ (inherit bootloader-config)
+ (targets (normalize targets)))))
+ (apply installer #:bootloader-config conf args)))
+
+(define (bootloader-configurations->gexp bootloader-configs . rest)
+ (apply gbegin (filter-map (cut apply bootloader-configuration->gexp <> rest)
+ bootloader-configs)))
\f
-;;;
-;;; Bootloaders.
+=
+;;; EFI shit
;;;
-(define (bootloader-modules)
- "Return the list of bootloader modules."
- ;; don't provide #:warn to prevent mutual imports
- (all-modules (map (lambda (entry)
- `(,entry . "gnu/bootloader"))
- %load-path)))
-
-(define %bootloaders
- ;; The list of publically-known bootloaders.
- (delay (fold-module-public-variables (lambda (obj result)
- (if (bootloader? obj)
- (cons obj result)
- result))
- '()
- (bootloader-modules))))
-
-(define (lookup-bootloader-by-name name)
- "Return the bootloader called NAME."
- (or (find (lambda (bootloader)
- (eq? name (bootloader-name bootloader)))
- (force %bootloaders))
- (leave (G_ "~a: no such bootloader~%") name)))
-
-(define (efi-bootloader-profile packages files hooks)
- "Creates a profile from the lists of PACKAGES and FILES from the store.
-This profile is meant to be used by the bootloader-installer.
-
-FILES is a list of file or directory names from the store, which will be
-symlinked into the profile. If a directory name ends with '/', then the
-directory content instead of the directory itself will be symlinked into the
-profile.
-
-FILES may contain file like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-HOOKS lists additional hook functions to modify the profile."
- (define* (efi-bootloader-profile-hook manifest #:optional system)
- (define build
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules ((guix build utils)
- #:select (mkdir-p strip-store-file-name))
- ((ice-9 ftw)
- #:select (scandir))
- ((srfi srfi-1)
- #:select (append-map every remove))
- ((srfi srfi-26)
- #:select (cut)))
- (define (symlink-to file directory transform)
- "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
- (symlink file (string-append directory "/" (transform file))))
- (define (directory-content directory)
- "Creates a list of absolute path names inside DIRECTORY."
- (map (lambda (name)
- (string-append directory name))
- (or (scandir directory (lambda (name)
- (not (member name '("." "..")))))
- '())))
- (define name-ends-with-/? (cut string-suffix? "/" <>))
- (define (name-is-store-entry? name)
- "Return #t if NAME is a direct store entry and nothing inside."
- (not (string-index (strip-store-file-name name) #\/)))
- (let* ((files '#$files)
- (directories (filter name-ends-with-/? files))
- (names-from-directories
- (append-map (lambda (directory)
- (directory-content directory))
- directories))
- (names (append names-from-directories
- (remove name-ends-with-/? files))))
- (mkdir-p #$output)
- (if (every file-exists? names)
- (begin
- (for-each (lambda (name)
- (symlink-to name #$output
- (if (name-is-store-entry? name)
- strip-store-file-name
- basename)))
- names)
- #t)
- #f)))))
-
- (gexp->derivation "efi-bootloader-profile"
- build
- #:system system
- #:local-build? #t
- #:substitutable? #f
- #:properties
- `((type . profile-hook)
- (hook . efi-bootloader-profile-hook))))
-
- (profile (content (packages->manifest packages))
- (name "efi-bootloader-profile")
- (hooks (cons efi-bootloader-profile-hook hooks))
- (locales? #f)
- (allow-collisions? #f)
- (relative-symlinks? #f)))
-
-(define* (efi-bootloader-chain final-bootloader
- #:key
- (packages '())
- (files '())
- (hooks '())
- installer
- disk-image-installer)
- "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES,
-and optional directories and files from the store given in the list of FILES.
-
-The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
-in an efi-bootloader-profile, which will be passed to the INSTALLER.
-
-FILES may contain file-like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-If a directory name in FILES ends with '/', then the directory content instead
-of the directory itself will be symlinked into the efi-bootloader-profile.
-
-The procedures in the HOOKS list can be used to further modify the bootloader
-profile. It is possible to pass a single function instead of a list.
-
-If the INSTALLER argument is used, then this gexp procedure will be called to
-install the efi-bootloader-profile. Otherwise the installer of the
-FINAL-BOOTLOADER will be called.
-
-If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
-to install the efi-bootloader-profile into a disk image. Otherwise the
-disk-image-installer of the FINAL-BOOTLOADER will be called."
- (bootloader
- (inherit final-bootloader)
- (name "efi-bootloader-chain")
- (package
- (efi-bootloader-profile (cons (bootloader-package final-bootloader)
- packages)
- files
- (if (list? hooks)
- hooks
- (list hooks))))
- (installer
- (or installer
- (bootloader-installer final-bootloader)))
- (disk-image-installer
- (or disk-image-installer
- (bootloader-disk-image-installer final-bootloader)))))
+(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
+ (32? #f))
+ "Returns the UEFI architecture name for the current target, in lowercase."
+ (cond ((target-x86-32? target) "ia32")
+ ((target-x86-64? target) (if 32? "ia32" "x64"))
+ ((target-arm32? target) "arm")
+ ((target-aarch64? target) (if 32? "arm" "aa64"))
+ ((target-riscv64? target) (if 32? "riscv32" "riscv64"))
+ (else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
+ target)))))
+
+(define (install-efi bootloader-config plan)
+ "Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
+PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
+should be in boot order. If the user selects a removable bootloader, only the
+first entry in PLAN is used."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets efi-removable? 32bit?)
+ (if efi-removable?
+ ;; Hard code the output location to a well-known path recognized by
+ ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
+ ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
+ (with-targets targets
+ (('esp => (path :path))
+ #~(let ((boot #$(string-append path "/EFI/BOOT"))
+ (arch #$(string-upcase (efi-arch #:32? 32bit?)))
+ (builder (car (car #$plan))))
+ (mkdir-p boot)
+ ;; only realize first planspec
+ (builder (string-append boot "/BOOT" arch ".EFI")))))
+ ;; normal install when not doing a removable config
+ (with-targets targets
+ (('vendir => (vendir :path) (loader :devpath) (disk :device))
+ #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm
index 0a50374bd9..ad29f5d5e4 100644
--- a/gnu/bootloader/depthcharge.scm
+++ b/gnu/bootloader/depthcharge.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,92 +18,86 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader depthcharge)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:use-module (ice-9 match)
- #:export (depthcharge-bootloader))
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
+ #:export (depthcharge-veyron-speedy-bootloader
+ depthcharge-bootloader))
-(define (signed-kernel kernel kernel-arguments initrd)
- (define builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 binary-ports)
- (rnrs bytevectors))
- (set-path-environment-variable "PATH" '("bin") (list #$dtc))
+(define* (install-depthcharge arch dtb
+ #:key bootloader-config current-boot-alternative
+ #:allow-other-keys)
+ (when (not (null? (bootloader-configuration-menu-entries bootloader-config)))
+ (raise (formatted-message
+ (G_ "extra menu-entries are not supported for depthcharge!"))))
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ;; use 'part instead of 'disk, cause we write an image directly into a
+ ;; partition instead of the extra-partition disk space
+ (('part => (disk :device))
+ (match-record (boot-alternative->menu-entry current-boot-alternative)
+ <menu-entry> (linux linux-arguments initrd)
+ #~(begin
+ (use-modules (ice-9 binary-ports) (rnrs bytevectors))
+ (set-path-environment-variable "PATH" '("bin") (list #$dtc))
- ;; TODO: These files have to be writable, so we copy them.
- ;; This can probably be fixed by using a ".its" file, just
- ;; be careful not to break initrd loading.
- (copy-file #$kernel "zImage")
- (chmod "zImage" #o755)
- (copy-file (string-append (dirname #$kernel) "/lib/dtbs/"
- "rk3288-veyron-speedy.dtb")
- "rk3288-veyron-speedy.dtb")
- (chmod "rk3288-veyron-speedy.dtb" #o644)
- (copy-file #$initrd "initrd")
- (chmod "initrd" #o644)
+ ;; TODO: These files have to be writable, so we copy them.
+ ;; This can probably be fixed by using a ".its" file, just
+ ;; be careful not to break initrd loading.
+ (copy-file #$linux "zImage")
+ (chmod "zImage" #o755)
+ (copy-file (string-append (dirname #$linux) "/lib/dtbs/" #$dtb)
+ "dtb")
+ (chmod "dtb" #o644)
+ (copy-file #$initrd "initrd")
+ (chmod "initrd" #o644)
- (invoke (string-append #$u-boot-tools "/bin/mkimage")
- "-D" "-I dts -O dtb -p 2048"
- "-f" "auto"
- "-A" "arm"
- "-O" "linux"
- "-T" "kernel"
- "-C" "None"
- "-d" "zImage"
- "-a" "0"
- "-b" "rk3288-veyron-speedy.dtb"
- "-i" "initrd"
- "image.itb")
- (call-with-output-file "bootloader.bin"
- (lambda (port)
- (put-bytevector port (make-bytevector 512 0))))
- (with-output-to-file "kernel-arguments"
- (lambda ()
- (display (string-join (list #$@kernel-arguments)))))
- (invoke (string-append #$vboot-utils "/bin/vbutil_kernel")
- "--pack" #$output
- "--version" "1"
- "--vmlinuz" "image.itb"
- "--arch" "arm"
- "--keyblock" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel.keyblock")
- "--signprivate" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel_data_key.vbprivk")
- "--config" "kernel-arguments"
- "--bootloader" "bootloader.bin"))))
- (computed-file "vmlinux.kpart" builder))
+ (invoke #+(file-append u-boot-tools "/bin/mkimage")
+ "-D" "-I dts -O dtb -p 2048"
+ "-f" "auto" ; format
+ "-A" #$arch ; architecture
+ "-O" "linux" ; os
+ "-T" "kernel" ; image type
+ "-C" "None" ; compression
+ "-d" "zImage" ; image data
+ "-a" "0" ; load address (hex)
+ "-b" "dtb" ; dtb for device
+ "-i" "initrd" ; initrd
+ "image.itb")
+ (call-with-output-file "bootloader.bin"
+ (lambda (port)
+ (put-bytevector port (make-bytevector 512 0))))
+ (call-with-output-file "kernel-arguments"
+ (lambda (port)
+ (display (string-join (list #$@linux-arguments)) port)))
+ (invoke #+(file-append vboot-utils "/bin/vbutil_kernel")
+ "--version" "1"
+ "--vmlinuz" "image.itb"
+ "--arch" #$arch
+ "--keyblock"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel.keyblock")
+ "--signprivate"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel_data_key.vbprivk")
+ "--config" "kernel-arguments"
+ "--pack" "vmlinux.kpart")
+ (write-file-on-device "vmlinux.kpart"
+ (stat:size (stat "vmlinux.kpart"))
+ #$disk 0))))))
-(define* (depthcharge-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- (match entries
- ((entry)
- (let ((kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- ;; XXX: Make this a symlink.
- (signed-kernel kernel kernel-arguments initrd)))
- (_ (error "Too many bootloader menu entries!"))))
-
-(define install-depthcharge
- #~(lambda (bootloader device mount-point)
- (let ((kpart (string-append mount-point
- "/boot/depthcharge/vmlinux.kpart")))
- (write-file-on-device kpart (stat:size (stat kpart)) device 0))))
-
-(define depthcharge-bootloader
+(define depthcharge-veyron-speedy-bootloader
(bootloader
(name 'depthcharge)
- (package #f)
- (installer install-depthcharge)
- (configuration-file "/boot/depthcharge/vmlinux.kpart")
- (configuration-file-generator depthcharge-configuration-file)))
+ (installer (cute install-depthcharge "arm" "rk3288-veyron-speedy.dtb"
+ <...>))))
+
+(define-deprecated/alias depthcharge-bootloader
+ depthcharge-veyron-speedy-bootloader)
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index d9b6d8bf8a..c3ab6f3275 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,112 +22,102 @@
(define-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:export (extlinux-bootloader
+ #:export (install-extlinux-config ; for u-boot
+ extlinux-bootloader
+ extlinux-gpt-bootloader
extlinux-bootloader-gpt))
-(define* (extlinux-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- "Return the U-Boot configuration file corresponding to CONFIG, a
-<u-boot-configuration> object, and where the store is available at STORE-FS, a
-<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
-corresponding to old generations of the system."
-
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
-
- (define with-fdtdir?
- (bootloader-configuration-device-tree-support? config))
+\f
+;;;
+;;; Config procedures.
+;;;
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- #~(format port "LABEL ~a
+(define* (install-extlinux-config #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ "Installer for the extlinux configuration file, meant to be shared by all
+bootloaders that use the format to specify boot options."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets menu-entries device-tree-support? timeout)
+ (define (menu-entry->gexp entry)
+ (match-record entry <menu-entry> (label linux linux-arguments initrd)
+ (let* ((normkern (normalize-file entry linux))
+ (fdt #~(string-append "FDTDIR" (dirname #$normkern) "/lib/dtbs")))
+ #~(format port "LABEL ~a
MENU LABEL ~a
KERNEL ~a
~a
INITRD ~a
APPEND ~a
-~%"
- #$label #$label
- #$kernel
- (if #$with-fdtdir?
- (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
- "")
- #$initrd
- (string-join (list #$@kernel-arguments)))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (let ((timeout #$(bootloader-configuration-timeout config)))
- (format port "# This file was generated from your Guix configuration. Any changes
+~%" #$label #$label #$normkern
+ #$(if device-tree-support? fdt "")
+ #$(normalize-file entry initrd)
+ (string-join (list #$@linux-arguments))))))
+
+ (let ((ents (cons (boot-alternative->menu-entry current-boot-alternative)
+ (append menu-entries
+ (map boot-alternative->menu-entry old-boot-alternatives)))))
+ (with-targets targets
+ (('extlinux => (path :path))
+ #~(begin (mkdir-p #$path)
+ (call-with-output-file #$path
+ (lambda (port)
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
# will be lost upon reconfiguration.
UI menu.c32
MENU TITLE GNU Guix Boot Options
PROMPT ~a
-TIMEOUT ~a~%"
- (if (> timeout 0) 1 0)
- ;; timeout is expressed in 1/10s of seconds.
- (* 10 timeout))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "~%"))
- #~())))))
-
- (computed-file "extlinux.conf" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-
+TIMEOUT ~a~%" ;; timeout is expressed in tenths of a second
+ #$(if (> timeout 0) 1 0) #$(* 10 timeout))
+ #$@(map menu-entry->gexp ents)))))))))
\f
-
;;;
-;;; Install procedures.
+;;; Install procedure.
;;;
(define (install-extlinux mbr)
- #~(lambda (bootloader device mount-point)
- (let ((extlinux (string-append bootloader "/sbin/extlinux"))
- (install-dir (string-append mount-point "/boot/extlinux"))
- (syslinux-dir (string-append bootloader "/share/syslinux")))
- (for-each (lambda (file)
- (install-file file install-dir))
- (find-files syslinux-dir "\\.c32$"))
- (invoke/quiet extlinux "--install" install-dir)
- (write-file-on-device (string-append syslinux-dir "/" #$mbr)
- 440 device 0))))
-
-(define install-extlinux-mbr
- (install-extlinux "mbr.bin"))
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('extlinux => (path :path))
+ #~(begin
+ #$(apply install-extlinux-config args)
+ (copy-recursively #$(file-append syslinux "/share/syslinux") #$path)
+ (invoke/quiet #+(file-append syslinux "/sbin/extlinux")
+ "--install" #$path)))
+ (('disk => (disk :device))
+ #~(write-file-on-device #$(file-append syslinux "/share/syslinux/" mbr)
+ 440 #$disk 0)))))
-(define install-extlinux-gpt
- (install-extlinux "gptmbr.bin"))
\f
-
;;;
;;; Bootloader definitions.
;;;
(define extlinux-bootloader
(bootloader
- (name 'extlinux)
- (package syslinux)
- (installer install-extlinux-mbr)
- (configuration-file "/boot/extlinux/extlinux.conf")
- (configuration-file-generator extlinux-configuration-file)))
-
-(define extlinux-bootloader-gpt
+ (name 'extlinux)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (install-extlinux "mbr.bin"))))
+
+(define extlinux-gpt-bootloader
(bootloader
- (inherit extlinux-bootloader)
- (installer install-extlinux-gpt)))
+ (inherit extlinux-bootloader)
+ (installer (install-extlinux "gptmbr.bin"))))
+
+(define-deprecated/alias extlinux-bootloader-gpt extlinux-gpt-bootloader)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..71fcc90ec7 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,24 +28,26 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader grub)
- #:use-module (guix build union)
- #:use-module (guix records)
- #:use-module (guix store)
- #:use-module (guix utils)
- #:use-module (guix gexp)
#:use-module (gnu artwork)
#:use-module (gnu bootloader)
- #:use-module (gnu system uuid)
- #:use-module (gnu system file-systems)
- #:use-module (gnu system keyboard)
- #:use-module (gnu system locale)
#:use-module (gnu packages bootloaders)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
#:autoload (gnu packages xorg) (xkeyboard-config)
+ #:use-module (gnu system boot)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system keyboard)
+ #:use-module (gnu system locale)
+ #:use-module (gnu system uuid)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (guix utils)
#:use-module (ice-9 match)
- #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
#:export (grub-theme
grub-theme?
grub-theme-image
@@ -53,54 +56,109 @@ (define-module (gnu bootloader grub)
grub-theme-color-highlight
grub-theme-gfxmode
- install-grub-efi-removable
- make-grub-efi-netboot-installer
-
+ grub.dir ; for (gnu build image) iso9660 images
grub-bootloader
+ grub-minimal-bootloader
grub-efi-bootloader
+ ;; deprecated
grub-efi-removable-bootloader
grub-efi32-bootloader
grub-efi-netboot-bootloader
- grub-efi-netboot-removable-bootloader
- grub-mkrescue-bootloader
- grub-minimal-bootloader
+ grub-efi-netboot-removable-bootloader))
- grub-configuration))
-
-;;; Commentary:
+\f
;;;
-;;; Configuration of GNU GRUB.
+;;; General utils.
;;;
-;;; Code:
-(define* (normalize-file file mount-point store-directory-prefix)
- "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
-G-expression or other lowerable object denoting a file name."
+;; in-gexp procedure to sanitize a value to be inserted into a GRUB script
+(define (sanitize str)
+ "Sanitize a value for use in a GRUB script."
+ #~(let* ((glycerin (lambda (l r) (if (pair? l) (append l r) (cons l r))))
+ (isopropyl (lambda (c) (case c ((#\\ #\$ #\") '(#\\ ,c)) (else c)))))
+ (use-modules (srfi srfi-1))
+ (list->string (fold-right glycerin '()
+ (map isopropyl (string->list #$str))))))
- (define (strip-mount-point mount-point file)
- (if mount-point
- (if (string=? mount-point "/")
- file
- #~(let ((file #$file))
- (if (string-prefix? #$mount-point file)
- (substring #$file #$(string-length mount-point))
- file)))
- file))
- (define (prepend-store-directory-prefix store-directory-prefix file)
- (if store-directory-prefix
- #~(string-append #$store-directory-prefix #$file)
- file))
- (prepend-store-directory-prefix store-directory-prefix
- (strip-mount-point mount-point file)))
+(define (grub-format type 32?)
+ (string-append
+ (cond ((string-prefix? "pc" type) "i386")
+ ((target-x86-32?) "i386")
+ ((target-x86-64?) (if 32? "i386" "x86_64"))
+ ((target-arm32?) "arm")
+ ((target-aarch64?) (if 32? "arm" "arm64"))
+ ((target-powerpc?) "powerpc")
+ ((target-riscv64?) "riscv64")
+ (else (raise (formatted-message (G_ "unrecognized target arch '~a'!")
+ (or (%current-target-system) (%current-system))))))
+ "-" type))
+(define* (search/target type targets var #:optional (port #f))
+ "Returns a gexp of a GRUB search command for target TYPE, storing the result
+in VAR. Optionally outputs to the gexp PORT instead of returning a string."
+ (define (form name val)
+ #~(format #$port "search.~a \"~a\" ~a~%" #$name #$val #$var))
+ (with-targets targets
+ ((type => (path :devpath) (device :device) (fs :fs)
+ (label :label) (uuid :uuid))
+ (cond ((member fs '("tftp" "nfs")) #~(format #$port "set ~a=tftp~%" #$var))
+ (uuid (form "fs_uuid" (uuid->string uuid)))
+ (label (form "fs_label" label))
+ (else (form "file" (sanitize path)))))))
+
+
+
+(define* (search/menu-entry device file var #:optional (port #f))
+ "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
+a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
+code to set the variable VAR. This procedure is able to handle DEVICEs
+unmounted at evaltime."
+ (match device
+ ;; Preferably refer to DEVICE by its UUID or label. This is more
+ ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
+ ((? uuid? idfk) ; calling idfk uuid here errors for some reason
+ #~(format #$port "search.fs_uuid ~a ~a~%" #$(uuid->string device) #$var))
+ ((? file-system-label? label)
+ #~(format #$port "search.fs_label \"~a\" ~a~%"
+ #$(sanitize (file-system-label->string label)) #$var))
+ ((? (lambda (device)
+ (and (string? device) (string-contains device ":/"))) nfs-uri)
+ ;; If the device is an NFS share, then we assume that the expected
+ ;; file on that device (e.g. the GRUB background image or the kernel)
+ ;; has to be loaded over the network. Otherwise we would need an
+ ;; additional device information for some local disk to look for that
+ ;; file, which we do not have.
+ ;;
+ ;; TFTP is preferred to HTTP because it is used more widely and
+ ;; specified in standards more widely--especially BOOTP/DHCPv4
+ ;; defines a TFTP server for DHCP option 66, but not HTTP.
+ ;;
+ ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
+ ;; which can contain a HTTP or TFTP URL.
+ ;;
+ ;; Note: It is assumed that the file paths are of a similar
+ ;; setup on both the TFTP server and the NFS server (it is
+ ;; not possible to search for files on TFTP).
+ ;;
+ ;; TODO: Allow HTTP.
+ #~(format #$port "set ~a=tftp~%" #$var))
+ ((or #f (? string?))
+ #~(format #$port "search.file \"~a\" ~a~%" #$(sanitize file) #$var))))
+
+
+
+\f
+;;;
+;;; Theming.
+;;;
+
(define-record-type* <grub-theme>
;; Default theme contributed by Felipe López.
- grub-theme make-grub-theme
- grub-theme?
+ grub-theme make-grub-theme grub-theme?
(image grub-theme-image
(default (file-append %artwork-repository
"/grub/GuixSD-fully-black-4-3.svg")))
@@ -113,128 +171,274 @@ (define-record-type* <grub-theme>
(gfxmode grub-theme-gfxmode
(default '("auto")))) ;list of string
+(define (grub-theme-png theme)
+ "Return the GRUB background image defined in THEME. If the suffix of the
+image file is \".svg\", then it is converted into a PNG file with the
+resolution provided in CONFIG. Returns #f if no file is provided."
+ (match-record theme <grub-theme> (image resolution)
+ (match resolution
+ (((? number? width) . (? number? height))
+ (computed-file "grub-image.png"
+ (with-imported-modules '((gnu build svg) (guix build utils))
+ (with-extensions (list guile-rsvg guile-cairo)
+ #~(begin (use-modules (gnu build svg) (guix build utils))
+ (if (png-file? #$image) (copy-file #$image #$output)
+ (svg->png #$image #$output
+ #:width #$width
+ #:height #$height)))))))
+ (_ image))))
+
+
+
\f
;;;
-;;; Background image & themes.
+;;; Core config.
+;;; GRUB architecture works by having a bootstage load up a core.img, which then
+;;; sets the root and prefix variables, allowing grub to load its main config
+;;; and modules, and then enter normal mode. On i386-pc systems a boot.img is
+;;; flashed which loads the core.img from the MBR gap, but on efi systems the
+;;; core.img is just a PE executable, able to be booted directly. We set up a
+;;; minimal core.img capable of finding the user-configured 'install target to
+;;; load its config from there.
;;;
-(define (bootloader-theme config)
- "Return user defined theme in CONFIG if defined or a default theme
-otherwise."
- (or (bootloader-configuration-theme config) (grub-theme)))
-
-(define* (image->png image #:key width height)
- "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\".
-Otherwise the picture in IMAGE is just copied."
- (computed-file "grub-image.png"
- (with-imported-modules '((gnu build svg))
- (with-extensions (list guile-rsvg guile-cairo)
- #~(if (string-suffix? ".svg" #+image)
- (begin
- (use-modules (gnu build svg))
- (svg->png #+image #$output
- #:width #$width
- #:height #$height))
- (copy-file #+image #$output))))))
-
-(define* (grub-background-image config)
- "Return the GRUB background image defined in CONFIG or #f if none was found.
-If the suffix of the image file is \".svg\", then it is converted into a PNG
-file with the resolution provided in CONFIG."
- (let* ((theme (bootloader-theme config))
- (image (grub-theme-image theme)))
- (and image
- (match (grub-theme-resolution theme)
- (((? number? width) . (? number? height))
- (image->png image #:width width #:height height))
- (_ #f)))))
-
-(define (grub-locale-directory grub)
- "Generate a directory with the locales from GRUB."
- (define builder
- #~(begin
- (use-modules (ice-9 ftw))
- (let ((locale (string-append #$grub "/share/locale"))
- (out #$output))
- (mkdir out)
- (chdir out)
- (for-each (lambda (lang)
- (let ((file (string-append locale "/" lang
- "/LC_MESSAGES/grub.mo"))
- (dest (string-append lang ".mo")))
- (when (file-exists? file)
- (copy-file file dest))))
- (scandir locale)))))
- (computed-file "grub-locales" builder))
-
-(define* (eye-candy config store-device store-mount-point
- #:key store-directory-prefix port)
- "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
-concerned with graphics mode, background images, colors, and all that.
-STORE-DEVICE designates the device holding the store, and STORE-MOUNT-POINT is
-its mount point; these are used to determine where the background image and
-fonts must be searched for. STORE-DIRECTORY-PREFIX is a directory prefix to
-prepend to any store file name."
- (define (setup-gfxterm config)
- (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
- #~(format #f "
+(define (core.cfg targets store-crypto-devices)
+ "Returns a filelike object for a core configuration file good enough to
+decrypt STORE-CRYPTO-DEVICES and boot to normal."
+ (define (crypto-device->cryptomount dev)
+ (and (uuid? dev) ; ignore non-uuids - warning given by os
+ #~(format port "cryptomount -u ~a~%"
+ ;; cryptomount only accepts UUID without the hyphen.
+ #$(string-delete #\- (uuid->string dev)))))
+
+ (and=>
+ (with-targets targets
+ (('install => (path :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ #$@(filter ->bool
+ (map crypto-device->cryptomount store-crypto-devices))
+ #$(search/target 'install targets "root" #~port)
+ (format port "set \"prefix=($root)~a\"~%" #$(sanitize path))))))
+ (cut computed-file "core.cfg" <>)))
+
+
+
+;; TODO: do we need LVM support here?
+(define* (core.img grub format #:key bootloader-config store-crypto-devices
+ #:allow-other-keys)
+ "The core image for GRUB, built for FORMAT."
+ (let* ((targets (bootloader-configuration-targets bootloader-config))
+ (bios? (string-prefix? format "pc"))
+ (efi? (string=? format "efi"))
+ (32? (bootloader-configuration-32bit? bootloader-config))
+ (cfg (core.cfg targets store-crypto-devices)))
+ (and cfg
+ (and=>
+ (with-targets targets
+ (('install => (fs :fs))
+ (let ((tftp? (or (string=? fs "tftp") (string=? fs "nfs"))))
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils) (ice-9 textual-ports)
+ (srfi srfi-1))
+ (apply invoke #$(file-append grub "/bin/grub-mkimage")
+ "--output" #$output
+ "--config" #$cfg
+ "--prefix" "none" ; we override this in cfg
+ ;; bios pxe uses pxeboot instead of diskboot - diff format
+ "--format" #$(string-append (grub-format format 32?)
+ (if (and bios? tftp?) "-pxe" ""))
+ "--compression" "auto"
+ ;; modules
+ "minicmd"
+ (append
+ ;; disk drivers
+ '#$(if bios? '("biosdisk") '())
+ ;; partmaps (TODO: detect which to use?)
+ '#$(if tftp? '() '("part_msdos" "part_gpt"))
+ ;; file systems
+ '#$(cond ((member fs '("ext2" "ext3" "ext4")) '("ext2"))
+ ((member fs "vfat" "fat32") "fat")
+ ((and tftp? efi?) "efinet")
+ ((and tftp? bios?) "pxe")
+ (else (list fs)))
+ ;; store crypto devs
+ '#$(if (any uuid? store-crypto-devices)
+ '("luks" "luks2" "cryptomount") '())
+ ;; search module that cfg uses
+ (call-with-input-file #$cfg
+ (lambda (port)
+ (let* ((str (get-string-all port))
+ (use (lambda (s) (string-contains str s))))
+ (cond ((use "search.fs_uuid") '("search_fs_uuid"))
+ ((use "search.fs_label") '("search_label"))
+ ((use "search.file") '("search_fs_file"))
+ (else '()))))))))))))
+ (cut computed-file "core.img" <>
+ #:options '(#:local-build? #t #:substitutable? #f))))))
+
+
+
+\f
+;;;
+;;; Main config.
+;;; This is what does the heavy lifting after core.img finds it.
+;;;
+
+(define (menu-entry->gexp store extra-initrd port)
+ (lambda (entry)
+ (match-record entry <menu-entry>
+ (label device linux linux-arguments initrd
+ multiboot-kernel multiboot-arguments multiboot-modules chain-loader)
+ (let ((norm (compose sanitize (cut normalize-file entry <>))))
+ #~(begin
+ (format #$port "menuentry ~s {~% " #$label)
+ #$(search/menu-entry
+ device (or linux multiboot-kernel chain-loader) "boot" port)
+ #$@(cond
+ (linux
+ (list #~(format #$port " linux \"($boot)~a\" ~a~%"
+ #$(norm linux)
+ ;; grub passes rest of the line _verbatim_
+ (string-join (list #$@linux-arguments)))
+ #~(format #$port " initrd ~a \"($boot)~a\"~%"
+ (if #$extra-initrd (string-append "($boot)\""
+ (norm #$extra-initrd) "\"")
+ "")
+ #$(norm initrd))))
+ ;; previously, this provided a (wrong) root= argument. just
+ ;; don't bother anymore. better less info than wrong info
+ (multiboot-kernel
+ (cons #~(format #$port " multiboot \"($boot)~a\" ~a~%"
+ #$(norm multiboot-kernel)
+ (string-join (list #$@multiboot-arguments)))
+ (map (lambda (mod) #~(format port " module \"($boot)~a\"~%"
+ #$(norm mod)))
+ multiboot-modules)))
+ (chain-loader
+ (list #~(format #$port " chainloader \"~a\"~%"
+ #$(norm chain-loader)))))
+ (format #$port "}~%"))))))
+
+
+
+(define* (grub.cfg #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ locale
+ store-directory-prefix
+ #:allow-other-keys)
+ "Returns a valid grub config given installer inputs. Expects locales, keymap,
+and theme image at LOCALES-TARG, KEYMAP-TARG, and IMAGE-TARG, respectively."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match keyboard-layout here cause it's bound to its struct
+ (targets menu-entries default-entry timeout extra-initrd
+ theme terminal-outputs terminal-inputs serial-unit serial-speed)
+ (let* ((entry->gexp (menu-entry->gexp store-directory-prefix
+ extra-initrd #~port))
+ (terms->str (compose string-join (cut map symbol->string <>)))
+ (colors->str (lambda (c) (format #f "~a/~a" (assoc-ref c 'fg)
+ (assoc-ref c 'bg))))
+ (outputs (or terminal-outputs '(gfxterm))) ; set default outs
+ (inputs (or terminal-inputs '())) ; set default ins
+ (theme (or theme (grub-theme))))
+ (and=>
+ (with-targets targets
+ (('install => (install :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ ;; preamble
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
+# will be lost upon reconfiguration~%")
+ #$@(filter ->bool
+ (list
+ ;; menu settings
+ (and default-entry
+ #~(format port "set default=~a~%" #$default-entry))
+ (and timeout
+ #~(format port "set timeout=~a~%" #$timeout))
+ ;; gfxterm setup
+ (and (memq 'gfxterm outputs)
+ #~(format port "\
if loadfont unicode; then
set gfxmode=~a
insmod all_video
insmod gfxterm
-fi~%"
- #$(string-join
- (grub-theme-gfxmode (bootloader-theme config))
- ";"))
- ""))
-
- (define (theme-colors type)
- (let* ((theme (bootloader-theme config))
- (colors (type theme)))
- (string-append (symbol->string (assoc-ref colors 'fg)) "/"
- (symbol->string (assoc-ref colors 'bg)))))
-
- (define image
- (normalize-file (grub-background-image config)
- store-mount-point
- store-directory-prefix))
-
- (and image
- #~(format #$port "
-# Set 'root' to the partition that contains /gnu/store.
-~a
-
-~a
-~a
-
+fi~%" #$(string-join (grub-theme-gfxmode theme) ";")))
+ ;; io
+ (and (or serial-unit serial-speed)
+ #~(format port "serial --unit=~a --speed=~a~%"
+ ;; documented defaults are unit 0 at 9600 baud.
+ #$(number->string (or serial-unit 0))
+ #$(number->string (or serial-speed 9600))))
+ (and (pair? outputs)
+ #~(format port "terminal_output ~a~%"
+ #$(terms->str outputs)))
+ (and (pair? inputs)
+ #~(format port "terminal_input ~a~%"
+ #$(terms->str inputs)))
+ ;; locale
+ (and locale
+ #~(format port "\
+set \"locale_dir=($root)~a/locales\"
+set lang=~a~%" #$(sanitize install)
+ #$(locale-definition-source
+ (locale-name->definition locale))))
+ ;; keyboard layout
+ (and (bootloader-configuration-keyboard-layout
+ bootloader-config)
+ #~(format port "\
+insmod keylayouts
+keymap \"($root)~a/keymap~%\"" #$(sanitize install)))
+ ;; theme
+ (match-record theme <grub-theme>
+ (image color-normal color-highlight)
+ (and image
+ #~(format port "\
insmod png
-if background_image ~a; then
+if background_image \"($root)~a/image.png\"; then
set color_normal=~a
set color_highlight=~a
else
set menu_color_normal=cyan/blue
- set menu_color_highlight=white/blue
-fi~%"
- #$(grub-root-search store-device image)
- #$(setup-gfxterm config)
- #$(grub-setup-io config)
+ set menu_color_highlight=whiute/blue
+fi~%" #$(sanitize install)
+ #$(colors->str color-normal)
+ #$(colors->str color-highlight))))))
+ ;; menu entries
+ #$(entry->gexp
+ (boot-alternative->menu-entry current-boot-alternative))
+ #$@(map entry->gexp menu-entries)
+ #$@(if (pair? old-boot-alternatives)
+ (append (list #~(format port "submenu ~s {~%"
+ "GNU system, old configurations..."))
+ (map (compose entry->gexp
+ boot-alternative->menu-entry)
+ old-boot-alternatives)
+ (list #~(format port "}~%"))) '())
+ (format port "
+if [ \"${grub_platform}\" == efi ]; then
+ menuentry \"Firmware setup\" {
+ fwsetup
+ }
+fi~%")))))
+ (cut computed-file "grub.cfg" <>
+ ;; Since this file is rather unique, there's no point in trying to
+ ;; substitute it.
+ #:options '(#:local-build? #t #:substitutable? #f))))))
- #$image
- #$(theme-colors grub-theme-color-normal)
- #$(theme-colors grub-theme-color-highlight))))
-\f
-;;;
-;;; Configuration file.
-;;;
-(define* (keyboard-layout-file layout
- #:key
- (grub grub))
+(define (keyboard-layout-file layout grub)
"Process the X keyboard layout description LAYOUT, a <keyboard-layout> record,
and return a file in the format for GRUB keymaps. LAYOUT must be present in
the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
- (define builder
+ (computed-file
+ (string-append "grub-keymap."
+ (string-map (match-lambda (#\, #\-) (chr chr))
+ (keyboard-layout-name layout)))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
@@ -243,670 +447,175 @@ (define* (keyboard-layout-file layout
;; (from the 'console-setup' package).
(invoke #+(file-append grub "/bin/grub-mklayout")
"-i" #+(keyboard-layout->console-keymap layout)
- "-o" #$output))))
-
- (computed-file (string-append "grub-keymap."
- (string-map (match-lambda
- (#\, #\-)
- (chr chr))
- (keyboard-layout-name layout)))
- builder))
-
-(define (grub-setup-io config)
- "Return GRUB commands to configure the input / output interfaces. The result
-is a string that can be inserted in grub.cfg."
- (let* ((symbols->string (lambda (list)
- (string-join (map symbol->string list) " ")))
- (outputs (bootloader-configuration-terminal-outputs config))
- (inputs (bootloader-configuration-terminal-inputs config))
- (unit (bootloader-configuration-serial-unit config))
- (speed (bootloader-configuration-serial-speed config))
-
- ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
- ;; as documented in GRUB manual section "Simple Configuration
- ;; Handling".
- (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
- gfxterm vga_text mda_text morse spkmodem))
- (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
- at_keyboard usb_keyboard))
-
- (io (string-append
- ;; UNIT and SPEED are arguments to the same GRUB command
- ;; ("serial"), so we process them together.
- (if (or unit speed)
- (string-append
- "serial"
- (if unit
- ;; COM ports 1 through 4
- (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
- (string-append " --unit=" (number->string unit))
- #f)
- "")
- (if speed
- (if (exact-integer? speed)
- (string-append " --speed=" (number->string speed))
- #f)
- "")
- "\n")
- "")
- (if (null? inputs)
- ""
- (string-append
- "terminal_input "
- (symbols->string
- (map
- (lambda (input)
- (if (memq input valid-inputs) input #f)) inputs))
- "\n"))
- "terminal_output "
- (symbols->string
- (map
- (lambda (output)
- (if (memq output valid-outputs) output #f)) outputs)))))
- (format #f "~a" io)))
-
-(define (grub-root-search device file)
- "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
-a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
-code."
- ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
- ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
- ;; custom menu entries. In the latter case, don't emit a 'search' command.
- (if (and (string? file) (not (string-prefix? "/" file)))
- ""
- (match device
- ;; Preferably refer to DEVICE by its UUID or label. This is more
- ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
- ((? uuid? uuid)
- (format #f "search --fs-uuid --set ~a"
- (uuid->string device)))
- ((? file-system-label? label)
- (format #f "search --label --set ~a"
- (file-system-label->string label)))
- ((? (lambda (device)
- (and (string? device) (string-contains device ":/"))) nfs-uri)
- ;; If the device is an NFS share, then we assume that the expected
- ;; file on that device (e.g. the GRUB background image or the kernel)
- ;; has to be loaded over the network. Otherwise we would need an
- ;; additional device information for some local disk to look for that
- ;; file, which we do not have.
- ;;
- ;; We explicitly set "root=(tftp)" here even though if grub.cfg
- ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
- ;; automatically anyway. The reason is if you have a system that
- ;; used to be on NFS but now is local, root would be set to local
- ;; disk. If you then selected an older system generation that is
- ;; supposed to boot from network in the Grub boot menu, Grub still
- ;; wouldn't load those files from network otherwise.
- ;;
- ;; TFTP is preferred to HTTP because it is used more widely and
- ;; specified in standards more widely--especially BOOTP/DHCPv4
- ;; defines a TFTP server for DHCP option 66, but not HTTP.
- ;;
- ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
- ;; which can contain a HTTP or TFTP URL.
- ;;
- ;; Note: It is assumed that the file paths are of a similar
- ;; setup on both the TFTP server and the NFS server (it is
- ;; not possible to search for files on TFTP).
- ;;
- ;; TODO: Allow HTTP.
- "set root=(tftp)")
- ((or #f (? string?))
- #~(format #f "search --file --set ~a" #$file)))))
-
-(define* (make-grub-configuration grub config entries
- #:key
- (locale #f)
- (system (%current-system))
- (old-entries '())
- (store-crypto-devices '())
- store-directory-prefix)
- "Return the GRUB configuration file corresponding to CONFIG, a
-<bootloader-configuration> object, and where the store is available at
-STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
-entries corresponding to old generations of the system.
-STORE-CRYPTO-DEVICES contain the UUIDs of the encrypted units that must
-be unlocked to access the store contents.
-STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
-when booting a root file system on a Btrfs subvolume."
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (linux (menu-entry-linux entry))
- (device (menu-entry-device entry))
- (device-mount-point (menu-entry-device-mount-point entry))
- (multiboot-kernel (menu-entry-multiboot-kernel entry))
- (chain-loader (menu-entry-chain-loader entry)))
- (cond
- (linux
- (let ((arguments (menu-entry-linux-arguments entry))
- (linux (normalize-file linux
- device-mount-point
- store-directory-prefix))
- (initrd (normalize-file (menu-entry-initrd entry)
- device-mount-point
- store-directory-prefix))
- (extra-initrd (bootloader-configuration-extra-initrd config)))
- ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
- ;; Use the right file names for LINUX and INITRD in case
- ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
- ;; separate partition.
-
- ;; When STORE-DIRECTORY-PREFIX is defined, prepend it the linux and
- ;; initrd paths, to allow booting from a Btrfs subvolume.
- #~(format port "menuentry ~s {
- ~a
- linux ~a ~a
- initrd ~a ~a
-}~%"
- #$label
- #$(grub-root-search device linux)
- #$linux (string-join (list #$@arguments))
- (or #$extra-initrd "")
- #$initrd)))
- (multiboot-kernel
- (let* ((kernel (menu-entry-multiboot-kernel entry))
- (arguments (menu-entry-multiboot-arguments entry))
- ;; Choose between device names as understood by Mach's built-in
- ;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
- ;; in the "noide" case).
- (disk (if (member "noide" arguments) "w" "h"))
- (modules (menu-entry-multiboot-modules entry))
- (root-index 1)) ; XXX EFI will need root-index 2
- #~(format port "
-menuentry ~s {
- multiboot ~a root=part:~a:device:~ad0~a~a
-}~%"
- #$label
- #$kernel
- #$root-index
- #$disk
- (string-join (list #$@arguments) " " 'prefix)
- (string-join (map string-join '#$modules)
- "\n module " 'prefix))))
- (chain-loader
- #~(format port "
-menuentry ~s {
- ~a
- chainloader ~a
-}~%"
- #$label
- #$(grub-root-search device chain-loader)
- #$chain-loader)))))
-
- (define (crypto-devices)
- (define (crypto-device->cryptomount dev)
- (if (uuid? dev)
- #~(format port "cryptomount -u ~a~%"
- ;; cryptomount only accepts UUID without the hypen.
- #$(string-delete #\- (uuid->string dev)))
- ;; Other type of devices aren't implemented.
- #~()))
- (let ((devices (map crypto-device->cryptomount store-crypto-devices))
- (modules #~(format port "insmod luks~%insmod luks2~%")))
- (if (null? devices)
- devices
- (cons modules devices))))
-
- (define (sugar)
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- (eye-candy config
- device
- mount-point
- #:store-directory-prefix store-directory-prefix
- #:port #~port)))
-
- (define locale-config
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- #~(let ((locale #$(and locale
- (locale-definition-source
- (locale-name->definition locale))))
- (locales #$(and locale
- (normalize-file (grub-locale-directory grub)
- mount-point
- store-directory-prefix))))
- (when locale
- (format port "\
-# Localization configuration.
-~asearch --file --set ~a/en@quot.mo
-set locale_dir=~a
-set lang=~a~%"
- ;; Skip the search if there is an image, as it has already
- ;; been performed by eye-candy and traversing the store is
- ;; an expensive operation.
- #$(if (grub-theme-image (bootloader-theme config))
- "# "
- "")
- locales
- locales
- locale)))))
-
- (define keyboard-layout-config
- (let* ((layout (bootloader-configuration-keyboard-layout config))
- (keymap* (and layout
- (keyboard-layout-file layout #:grub grub)))
- (entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry))
- (keymap (and keymap*
- (normalize-file keymap* mount-point
- store-directory-prefix))))
- #~(when #$keymap
- (format port "\
-insmod keylayouts
-keymap ~a~%" #$keymap))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (format port
- "# This file was generated from your Guix configuration. Any changes
-# will be lost upon reconfiguration.
-")
- #$@(crypto-devices)
- #$(sugar)
- #$locale-config
- #$keyboard-layout-config
- (format port "
-set default=~a
-set timeout=~a~%"
- #$(bootloader-configuration-default-entry config)
- #$(bootloader-configuration-timeout config))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "
-submenu \"GNU system, old configurations...\" {~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "}~%"))
- #~())
- (format port "
-if [ \"${grub_platform}\" == efi ]; then
- menuentry \"Firmware setup\" {
- fwsetup
- }
-fi~%"))))
+ "-o" #$output)))))
+
+
+
+(define* (grub.dir grub #:key bootloader-config locale
+ #:allow-other-keys . args)
+ "Everything what should go in GRUB's prefix, including fonts, modules,
+locales, keymap, theme image, and grub.cfg."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match for keyboard-layout: identifier bound in this scope
+ (targets theme)
+ (let* ((theme (or theme (grub-theme)))
+ (keyboard-layout (bootloader-configuration-keyboard-layout
+ bootloader-config))
+ (lang (and=> locale (compose locale-definition-source
+ locale-name->definition)))
+ (lc-mesg (and=> lang (cut file-append grub "/share/locale" <>
+ "/LC_MESSAGES/grub.mo"))))
+ (computed-file "grub.dir"
+ (with-imported-modules '((guix build utils))
+ #~(begin (use-modules (guix build utils))
+ (mkdir-p #$output)
+ (chdir #$output)
+ ;; grub files
+ (copy-recursively #$(file-append grub "/lib/grub/") #$output
+ #:copy-file symlink)
+ (mkdir "fonts")
+ (symlink #$(file-append grub "/share/grub/unicode.pf2")
+ "fonts/unicode.pf2")
+ ;; config file
+ (symlink #$(apply grub.cfg args) "grub.cfg")
+ ;; locales
+ (when (and=> #$lc-mesg file-exists?)
+ (mkdir "locales")
+ (symlink #$lc-mesg (string-append "locales/" #$lang ".mo")))
+ ;; keymap
+ #$@(filter ->bool
+ (list
+ (and keyboard-layout
+ #~(symlink #$(keyboard-layout-file keyboard-layout grub)
+ "keymap"))
+ ;; image
+ (and (grub-theme-image theme)
+ #~(copy-file #$(grub-theme-png theme) "image.png"))))))
+ #:options '(#:local-build? #t #:substitutable? #f)))))
- ;; Since this file is rather unique, there's no point in trying to
- ;; substitute it.
- (computed-file "grub.cfg" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-(define (grub-configuration-file config . args)
- (let* ((bootloader (bootloader-configuration-bootloader config))
- (grub (bootloader-package bootloader)))
- (apply make-grub-configuration grub config args)))
-
-(define (grub-efi-configuration-file . args)
- (apply make-grub-configuration grub-efi args))
-
-(define grub-cfg "/boot/grub/grub.cfg")
\f
-
;;;
-;;; Install procedures.
+;;; Installers.
;;;
-(define install-grub
- #~(lambda (bootloader device mount-point)
- (let ((grub (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot")))
- ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE
- ;; is #f, then we populate the disk-image rooted at MOUNT-POINT.
- (if device
- (begin
- ;; Tell 'grub-install' that there might be a LUKS-encrypted
- ;; /boot or root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-
- ;; Hide potentially confusing messages from the user, such as
- ;; "Installing for i386-pc platform."
- (invoke/quiet grub "--no-floppy" "--target=i386-pc"
- "--boot-directory" install-dir
- device))
- ;; When creating a disk-image, only install a font and GRUB modules.
- (let* ((fonts (string-append install-dir "/grub/fonts")))
- (mkdir-p fonts)
- (copy-file (string-append bootloader "/share/grub/unicode.pf2")
- (string-append fonts "/unicode.pf2"))
- (copy-recursively (string-append bootloader "/lib/")
- install-dir))))))
-
-(define install-grub-disk-image
- #~(lambda (bootloader root-index image)
- ;; Install GRUB on the given IMAGE. The root partition index is
- ;; ROOT-INDEX.
- (let ((grub-mkimage
- (string-append bootloader "/bin/grub-mkimage"))
- (modules '("biosdisk" "part_msdos" "fat" "ext2"))
- (grub-bios-setup
- (string-append bootloader "/sbin/grub-bios-setup"))
- (root-device (format #f "hd0,msdos~a" root-index))
- (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img"))
- (device-map "device.map"))
-
- ;; Create a minimal, standalone GRUB image that will be written
- ;; directly in the MBR-GAP (space between the end of the MBR and the
- ;; first partition).
- (apply invoke grub-mkimage
- "-O" "i386-pc"
- "-o" "core.img"
- "-p" (format #f "(~a)/boot/grub" root-device)
- modules)
-
- ;; Create a device mapping file.
- (call-with-output-file device-map
- (lambda (port)
- (format port "(hd0) ~a~%" image)))
-
- ;; Copy the default boot.img, that will be written on the MBR sector
- ;; by GRUB-BIOS-SETUP.
- (copy-file boot-img "boot.img")
-
- ;; Install both the "boot.img" and the "core.img" files on the given
- ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB
- ;; written in the MBR-GAP. GRUB configuration and missing modules will
- ;; be read from ROOT-DEVICE.
- (invoke grub-bios-setup
- "-m" device-map
- "-r" root-device
- "-d" "."
- image))))
-
-(define install-grub-efi
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi-removable
- #~(lambda (bootloader efi-dir mount-point)
- ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
- ;; NOTE: efi-dir comes from target list of booloader configuration
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--removable"
- ;; "--no-nvram"
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi32
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- (cond ((target-x86?) "--target=i386-efi")
- ((target-arm?) "--target=arm-efi"))
- "--efi-directory" target-esp)))))
-
-(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
- "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
-its files in SUBDIR and its configuration file in GRUB-CFG.
-
-As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
-installer basically copies all files from the bootloader-package (or profile)
-into the bootloader-target directory.
-
-Additionally for network booting over TFTP, two relative symlinks to the store
-and to the GRUB-CFG file are necessary. Due to this a TFTP root directory must
-not be located on a FAT file-system.
-
-If the bootloader-target does not support symlinks, then it is assumed to be a
-kind of EFI System Partition (ESP). In this case an intermediate configuration
-file is created with the help of GRUB-EFI to load the GRUB-CFG.
-
-The installer is usable for any efi-bootloader-chain, which prepares the
-bootloader-profile in a way ready for copying.
-
-The installer does not manipulate the system's 'UEFI Boot Manager'.
-
-The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
-arguments. Its job is to copy the BOOTLOADER, which must be a pre-installed
-grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
-directory TARGET for the system whose root is mounted at MOUNT-POINT.
-
-MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
-or '/' for other 'guix system' commands.
-
-Where TARGET comes from the targets argument given to the
-bootloader-configuration in:
-
-(operating-system
- (bootloader (bootloader-configuration
- (targets '(\"/boot/efi\"))
- …))
- …)
-
-TARGET is required to be an absolute directory name, usually mounted via NFS,
-and finally needs to be provided by a TFTP server as
-the TFTP root directory.
-
-Usually the installer will be used to prepare network booting over TFTP. Then
-GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
-load more files from the store like tftp://server/gnu/store/…-linux…/Image.
-
-To make this possible two symlinks are created. The first symlink points
-relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
-MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
-MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.
-
-It is important to note that these symlinks need to be relative, as the absolute
-paths on the TFTP server side are unknown.
-
-It is also important to note that both symlinks will point outside the TFTP root
-directory and that the TARGET/%store-prefix symlink makes the whole store
-accessible via TFTP. Possibly the TFTP server must be configured to allow
-accesses outside its TFTP root directory. This all may need to be considered
-for security aspects. It is advised to disable any TFTP write access!
-
-The installer can also be used to prepare booting from local storage, if the
-underlying file-system, like FAT on an EFI System Partition (ESP), does not
-support symlinks. In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
-created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file. A
-symlink to the store is not needed in this case."
- (with-imported-modules '((guix build union))
- #~(lambda (bootloader target mount-point)
- ;; In context of a disk image creation TARGET will be #f and an
- ;; installer is expected to do necessary installations on MOUNT-POINT,
- ;; which will become the root file system. If TARGET is #f, this
- ;; installer has nothing to do, as it only cares about the EFI System
- ;; Partition (ESP).
- (when target
- (use-modules ((guix build union) #:select (symlink-relative))
- (ice-9 popen)
- (ice-9 rdelim))
- (let* ((mount-point/target (string-append mount-point target "/"))
- ;; When installing Guix, it is common to mount TARGET below
- ;; MOUNT-POINT rather than the root directory.
- (bootloader-target (if (file-exists? mount-point/target)
- mount-point/target
- target))
- (store (string-append mount-point (%store-prefix)))
- (store-link (string-append bootloader-target (%store-prefix)))
- (grub-cfg (string-append mount-point #$grub-cfg))
- (grub-cfg-link (string-append bootloader-target
- #$subdir "/"
- (basename grub-cfg))))
- ;; Copy the bootloader into the bootloader-target directory.
- ;; Should we beforehand recursively delete any existing file?
- (copy-recursively bootloader bootloader-target
- #:follow-symlinks? #t
- #:log (%make-void-port "w"))
- ;; For TFTP we need to install additional relative symlinks.
- ;; If we install on an EFI System Partition (ESP) or some other FAT
- ;; file-system, then symlinks cannot be created and are not needed.
- ;; Therefore we ignore exceptions when trying.
- ;; Prepare the symlink to the grub.cfg.
- (mkdir-p (dirname grub-cfg-link))
- (false-if-exception (delete-file grub-cfg-link))
- (if (unspecified?
- (false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
- ;; Symlinks are supported.
- (begin
- ;; Prepare the symlink to the store.
- (mkdir-p (dirname store-link))
- (false-if-exception (delete-file store-link))
- (symlink-relative store store-link))
- ;; Creating symlinks does not seem to be supported. Probably
- ;; an ESP is used. Add a script to search and load the actual
- ;; grub.cfg.
- (let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
- (port (open-pipe* OPEN_READ probe "--target=fs_uuid"
- grub-cfg))
- (search-root
- (match (read-line port)
- ((? eof-object?)
- ;; There is no UUID available. As a fallback search
- ;; everywhere for the grub.cfg.
- (string-append "search --file --set " #$grub-cfg))
- (fs-uuid
- ;; The UUID to load the grub.cfg from is known.
- (string-append "search --fs-uuid --set " fs-uuid))))
- (load-grub-cfg (string-append "configfile " #$grub-cfg)))
- (close-pipe port)
- (with-output-to-file grub-cfg-link
- (lambda ()
- (display (string-join (list search-root
- load-grub-cfg)
- "\n")))))))))))
+(define* (install-grub.dir grub #:key bootloader-config
+ #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('install => (path :path))
+ #~(copy-recursively #$(apply grub.dir grub args) #$path
+ #:log (%make-void-port "w")
+ #:follow-symlinks? #t
+ #:copy-file atomic-copy))))
+
+(define (install-grub-bios grub)
+ "Returns an installer for the bios-bootable grub package GRUB."
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (gbegin (apply install-grub.dir grub args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('disk => (device :device))
+ #~(invoke #$(file-append grub "/sbin/grub-bios-setup") "-v" "-v"
+ "--directory" "/" ; can't be blank
+ "--device-map" "" ; no dev map - need to specify
+ "--boot-image"
+ #$(file-append grub "/lib/grub/i386-pc/boot.img")
+ "--core-image" #$(apply core.img grub "pc" args)
+ "--root-device" #$(string-append "hostdisk/" device)
+ #$device))))))
+
+(define* (install-grub-efi #:key bootloader-config #:allow-other-keys . args)
+ "Installs grub into the system's uefi bootloader, taking into account
+user-specified requirements for a 32-bit or fallback bootloader."
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (grub (if 32? grub-efi32 grub-efi))
+ (core (apply core.img grub "efi" args))
+ (copy #~(lambda (dest) (copy-file #$core dest))))
+ (gbegin (apply install-grub.dir grub args)
+ (install-efi bootloader-config #~`((,#$copy "grub.efi" . "GNU GRUB"))))))
+
-\f
+\f
;;;
-;;; Bootloader definitions.
+;;; Bootloaders.
;;;
-;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
-;;; is fixed. Inheriting and overwriting the field 'configuration-file' will
-;;; break 'guix system delete-generations', 'guix system switch-generation',
-;;; and 'guix system roll-back'.
+
+(define %grub-default-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))))
(define grub-bootloader
(bootloader
- (name 'grub)
- (package grub)
- (installer install-grub)
- (disk-image-installer install-grub-disk-image)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub))))
(define grub-minimal-bootloader
(bootloader
- (inherit grub-bootloader)
- (package grub-minimal)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub-minimal))))
(define grub-efi-bootloader
(bootloader
- (name 'grub-efi)
- (package grub-efi)
- (installer install-grub-efi)
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
-
-(define grub-efi-removable-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (name 'grub-efi-removable-bootloader)
- (installer install-grub-efi-removable)))
+ (name 'grub-efi)
+ (default-targets (cons (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))
+ %grub-default-targets))
+ (installer install-grub-efi)))
-(define grub-efi32-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (installer install-grub-efi32)
- (name 'grub-efi32)
- (package grub-efi32)))
-(define (make-grub-efi-netboot-bootloader name subdir)
- (bootloader
- (name name)
- (package (make-grub-efi-netboot (symbol->string name) subdir))
- (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-efi-configuration-file)))
-
-(define grub-efi-netboot-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
- "efi/Guix"))
-
-(define grub-efi-netboot-removable-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
- "efi/boot"))
-
-(define grub-mkrescue-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (package grub-hybrid)))
\f
;;;
-;;; Compatibility macros.
+;;; deprecated shit!
+;;; use the bootloader-config flags instead! or, in the case of netboot, set
+;;; your 'install (or parent thereof) target fs to be "tftp" or "nfs"
;;;
-(define-syntax grub-configuration
- (syntax-rules (grub)
- ((_ (grub package) fields ...)
- (if (eq? package grub)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...)
- (bootloader-configuration
- (bootloader grub-efi-bootloader)
- fields ...)))
- ((_ fields ...)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...))))
-
-;;; grub.scm ends here
+(define (deprecated-installer installer removable? 32?)
+ (lambda args (apply installer
+ (substitute-keyword-arguments args
+ ((#:bootloader-config conf) (bootloader-configuration
+ (inherit conf)
+ (efi-removable? removable?)
+ (32bit? 32?)))))))
+
+(define-deprecated grub-efi-removable-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #t #f))))
+
+(define-deprecated grub-efi32-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #f #t))))
+
+(define %netboot-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot")
+ (file-system "tftp"))
+ (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+
+(define-deprecated grub-efi-netboot-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)))
+
+(define-deprecated grub-efi-netboot-removable-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)
+ (installer (deprecated-installer install-grub-efi #t #f))))
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index c5437a7b63..7d3e202f8c 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Herman Rimm <herman_rimm@protonmail.com>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,12 +25,11 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader u-boot)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
+ #:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
- #:export (u-boot-bootloader
- u-boot-a20-olinuxino-lime-bootloader
+ #:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
u-boot-bananapi-m2-ultra-bootloader
@@ -53,301 +53,172 @@ (define-module (gnu bootloader u-boot)
u-boot-ts7970-q-2g-1000mhz-c-bootloader
u-boot-wandboard-bootloader))
-(define install-u-boot
- #~(lambda (bootloader root-index image)
- (if bootloader
- (error "Failed to install U-Boot"))))
+(define (make-install-u-boot firmware installers)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('extlinux (apply install-extlinux-config args))
+ (('install => (path :path)) #~(let ((path #$path) #$firmware)))
+ (('disk => (disk :device)) #~(let ((disk #$disk)) #f #$@installers)))))
+
+(define-syntax-rule (define-u-bootloader def-name package firmware
+ (file size doffset) ...)
+ "Defines a u-boot installer DEF-NAME, using u-boot PACKAGE. Installs each
+given FILE of SIZE (or #f to autodetect) to the targetted disk at OFFSET.
+FIRMWARE is ran on the u-boot firmware directory for installation of supporting
+files, with the variable path set to the dir path."
+ (define def-name
+ (bootloader
+ (name 'u-boot)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (make-install-u-boot firmware
+ (list #~(let ((fw #$(file-append package "/libexec/" file)))
+ (write-file-on-device fw
+ #$(or size #~(stat:size (stat fw)))
+ disk #$doffset)) ...))))))
+
+\f
+;;;
+;;; Bootloader definitions.
+;;;
-(define install-beaglebone-black-u-boot
+(define-u-bootloader u-boot-beaglebone-black-bootloader
+ u-boot-am335x-boneblack #f
;; http://wiki.beyondlogic.org/index.php?title=BeagleBoneBlack_Upgrading_uBoot
;; This first stage bootloader called MLO (U-Boot SPL) is expected at
;; 0x20000 by BBB ROM code. The second stage bootloader will be loaded by
;; the MLO and is expected at 0x60000. Write both first stage ("MLO") and
- ;; second stage ("u-boot.img") images, read in BOOTLOADER directory, to the
- ;; specified DEVICE.
- #~(lambda (bootloader root-index image)
- (let ((mlo (string-append bootloader "/libexec/MLO"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device mlo (* 256 512)
- image (* 256 512))
- (write-file-on-device u-boot (* 1024 512)
- image (* 768 512)))))
-
-(define install-allwinner-u-boot
- #~(lambda (bootloader root-index image)
- (let ((u-boot (string-append bootloader
- "/libexec/u-boot-sunxi-with-spl.bin")))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 8 1024)))))
-
-(define install-allwinner64-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 8 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 40 1024)))))
-
-(define install-imx-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/SPL"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 1 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 69 1024)))))
-
-(define install-orangepi-r1-plus-lts-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-puma-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 512 512)))))
-
-(define install-firefly-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rock64-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rockpro64-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-pinebook-pro-rk3399-u-boot install-rockpro64-rk3399-u-boot)
-
-(define install-u-boot-ts7970-q-2g-1000mhz-c-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.imx (string-append bootloader "/libexec/u-boot.imx"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.imx install-dir))))
-
-(define install-sifive-unmatched-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/spl/u-boot-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append
- bootloader "/libexec/spl/u-boot-spl.bin.normal.out"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-uEnv.txt
- #~(lambda (bootloader device mount-point)
- (mkdir-p (string-append mount-point "/boot"))
- (call-with-output-file (string-append mount-point "/boot/uEnv.txt")
+ ;; second stage ("u-boot.img") images to the target.
+ ("MLO" (* 256 512) (* 256 512))
+ ("u-boot.img" (* 1024 512) (* 768 512)))
+
+(define-u-bootloader u-boot-sifive-unmatched-bootloader
+ u-boot-sifive-unmatched #f
+ ("spl/u-boot-spl.bin" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+(define-u-bootloader u-boot-starfive-visionfive2-bootloader
+ u-boot-starfive-visionfive2
+ #~(begin (mkdir-p path)
+ (call-with-output-file (string-append path "/uEnv.txt")
(lambda (port)
(format port
- ;; if board SPI use vender's u-boot, will find
- ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
- ;; that users will update this u-boot, so set it.
- "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%")))))
+ ;; if board SPI use vender's u-boot, will find
+ ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
+ ;; that users will update this u-boot, so set it.
+ "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%"))))
+ ("spl/u-boot-spl.bin.normal.out" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+\f
+;;;
+;;; Allwinner bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))))
+
-(define install-qemu-riscv64-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.bin (string-append bootloader "/libexec/u-boot.bin"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.bin install-dir))))
+(define-u-bootloader-allwinner u-boot-nintendo-nes-classic-edition-bootloader
+ u-boot-nintendo-nes-classic-edition)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime-bootloader
+ u-boot-a20-olinuxino-lime)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime2-bootloader
+ u-boot-a20-olinuxino-lime2)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-micro-bootloader
+ u-boot-a20-olinuxino-micro)
+
+(define-u-bootloader-allwinner u-boot-bananapi-m2-ultra-bootloader
+ u-boot-bananapi-m2-ultra)
+
+(define-u-bootloader-allwinner u-boot-cubietruck-bootloader u-boot-cubietruck)
+
+(define-u-bootloader-allwinner u-boot-pine64-lts-bootloader u-boot-pine64-lts)
\f
+;;;
+;;; Allwinner64 bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner64 def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))
+ ("u-boot-sunxi-with-spl.fit.itb" #f (* 40 1024))))
+
+
+(define-u-bootloader-allwinner64 u-boot-pine64-plus-bootloader
+ u-boot-pine64-plus)
+
+(define-u-bootloader-allwinner64 u-boot-pinebook-bootloader u-boot-pinebook)
+\f
;;;
-;;; Bootloader definitions.
+;;; IMX bootloader definitions.
;;;
+(define-syntax-rule (define-u-bootloader-imx def-name package)
+ (define-u-bootloader def-name package #f
+ ("SPL" #f (* 8 1024))
+ ("u-boot.img" #f (* 40 1024))))
-(define u-boot-bootloader
- (bootloader
- (inherit extlinux-bootloader)
- (name 'u-boot)
- (package #f)
- (installer #f)
- (disk-image-installer install-u-boot)))
-
-(define u-boot-beaglebone-black-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-am335x-boneblack)
- (disk-image-installer install-beaglebone-black-u-boot)))
-
-(define u-boot-allwinner-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner-u-boot)))
-
-(define u-boot-allwinner64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner64-u-boot)))
-
-(define u-boot-imx-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-imx-u-boot)))
-
-(define u-boot-nintendo-nes-classic-edition-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-nintendo-nes-classic-edition)))
-
-(define u-boot-a20-olinuxino-lime-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime)))
-
-(define u-boot-a20-olinuxino-lime2-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime2)))
-
-(define u-boot-a20-olinuxino-micro-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-micro)))
-
-(define u-boot-bananapi-m2-ultra-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-bananapi-m2-ultra)))
-
-(define u-boot-cubietruck-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-cubietruck)))
-
-(define u-boot-firefly-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-firefly-rk3399)
- (disk-image-installer install-firefly-rk3399-u-boot)))
-
-(define u-boot-mx6cuboxi-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-mx6cuboxi)))
-
-(define u-boot-wandboard-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-wandboard)))
-
-(define u-boot-novena-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-novena)))
-
-(define u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-orangepi-r1-plus-lts-rk3328)
- (disk-image-installer install-orangepi-r1-plus-lts-rk3328-u-boot)))
-
-(define u-boot-pine64-plus-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pine64-plus)))
-
-(define u-boot-pine64-lts-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-pine64-lts)))
-
-(define u-boot-pinebook-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pinebook)))
-
-(define u-boot-puma-rk3399-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-puma-rk3399)
- (disk-image-installer install-puma-rk3399-u-boot)))
-
-(define u-boot-rock64-rk3328-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rock64-rk3328)
- (disk-image-installer install-rock64-rk3328-u-boot)))
-(define u-boot-rockpro64-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rockpro64-rk3399)
- (disk-image-installer install-rockpro64-rk3399-u-boot)))
+(define-u-bootloader-imx u-boot-mx6cuboxi-bootloader u-boot-mx6cuboxi)
+
+(define-u-bootloader-imx u-boot-wandboard-bootloader u-boot-wandboard)
-(define u-boot-pinebook-pro-rk3399-bootloader
+(define-u-bootloader-imx u-boot-novena-bootloader u-boot-novena)
+
+\f
+;;;
+;;; Rockchip bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-rockchip def-name package)
;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-pinebook-pro-rk3399)
- (disk-image-installer install-pinebook-pro-rk3399-u-boot)))
-
-(define u-boot-ts7970-q-2g-1000mhz-c-bootloader
- ;; This bootloader doesn't really need to be installed, as it is read from
- ;; an SPI memory chip, not the SD card. It is copied to /boot/u-boot.imx
- ;; for convenience and should be manually flashed at the U-Boot prompt.
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-ts7970-q-2g-1000mhz-c)
- (installer install-u-boot-ts7970-q-2g-1000mhz-c-u-boot)
- (disk-image-installer #f)))
-
-(define u-boot-sifive-unmatched-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-sifive-unmatched)
- (disk-image-installer install-sifive-unmatched-u-boot)))
-
-(define u-boot-starfive-visionfive2-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-starfive-visionfive2)
- (installer install-starfive-visionfive2-uEnv.txt)
- (disk-image-installer install-starfive-visionfive2-u-boot)))
-
-(define u-boot-qemu-riscv64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-qemu-riscv64)
- (installer install-qemu-riscv64-u-boot)
- (disk-image-installer #f)))
+ (define-u-bootloader def-name package #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 16384 512))))
+
+(define-u-bootloader-rockchip u-boot-firefly-rk3399-bootloader
+ u-boot-firefly-rk3399)
+
+(define-u-bootloader-rockchip u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+ u-boot-orangepi-r1-plus-lts-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rock64-rk3328-bootloader
+ u-boot-rock64-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rockpro64-rk3399-bootloader
+ u-boot-rockpro64-rk3399)
+
+(define-u-bootloader-rockchip u-boot-pinebook-pro-rk3399-bootloader
+ u-boot-pinebook-pro-rk3399)
+
+(define-u-bootloader u-boot-puma-rk3399-bootloader u-boot-puma-rk3399 #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 512 512)))
+
+\f
+;;;
+;;; Copy-only bootloader definitions.
+;;;
+
+;; These bootloaders don't really need to be installed, as they are read from
+;; an SPI memory chip or directly from the FS, not the disk.
+(define-syntax-rule (define-u-bootloader-copy def-name package file)
+ (define-u-bootloader def-name package
+ #~(install-file #$(file-append package "/libexec/" file) path)))
+
+;; user should manually install this to SPI flash
+;; TODO: write directly to SPI flash? unless wear issues are a problem.
+(define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
+ u-boot-ts7970-q-2g-1000mhz-c "u-boot.imx")
+
+(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
+ u-boot-qemu-riscv64 "u-boot.bin")
diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm
index af6063a884..b59287d759 100644
--- a/gnu/build/bootloader.scm
+++ b/gnu/build/bootloader.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,20 +21,45 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build bootloader)
+ #:autoload (guix build syscalls) (free-disk-space)
#:use-module (guix build utils)
- #:use-module (guix utils)
- #:use-module (ice-9 binary-ports)
+ #: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)
- #:export (write-file-on-device
- install-efi-loader))
+ #: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))
\f
;;;
;;; 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 block ...)
+ "Run blocks... while chdir'd into a temporary directory."
+ ;; mkdtemp under POSIX.1-2008 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 () block ...)
+ (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
@@ -56,57 +82,78 @@ (define (write-file-on-device file size device offset)
;;; EFI bootloader.
;;;
-(define* (install-efi grub grub-config esp #:key targets)
- "Write a self-contained GRUB EFI loader to the mounted ESP using
-GRUB-CONFIG.
-
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let* ((system %host-type)
- ;; Hard code the output location to a well-known path recognized by
- ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
- ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
- (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
- (efi-directory (string-append esp "/EFI/BOOT"))
- ;; Map grub target names to boot file names.
- (efi-targets (or targets
- (cond ((string-prefix? "x86_64" system)
- '("x86_64-efi" . "BOOTX64.EFI"))
- ((string-prefix? "i686" system)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((string-prefix? "armhf" system)
- '("arm-efi" . "BOOTARM.EFI"))
- ((string-prefix? "aarch64" system)
- '("arm64-efi" . "BOOTAA64.EFI"))))))
- ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
- (setenv "TMPDIR" esp)
-
- (mkdir-p efi-directory)
- (invoke grub-mkstandalone "-O" (car efi-targets)
- "-o" (string-append efi-directory "/"
- (cdr efi-targets))
- ;; Graft the configuration file onto the image.
- (string-append "boot/grub/grub.cfg=" grub-config))))
+(define parse-bootnums
+ (make-regexp "^Boot([0-9a-fA-F]+).*[^A-Za-z]File\\(([^)]+)\\)$" regexp/newline))
-(define* (install-efi-loader grub-efi esp #:key targets)
- "Install in ESP directory the given GRUB-EFI bootloader. Configure it to
-load the Grub bootloader located in the 'Guix_image' root partition.
+;; 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))))
+ (unless (zero? status)
+ (raise-exception
+ (formatted-message (G_ "efibootmgr exited with error code ~a") status)))
+ (fold-matches parse-bootnums text '()
+ (lambda (match acc)
+ (let* ((path (match:substring match 2))
+ (bootnum (match:substring match 1)))
+ (cons (cons path bootnum) acc))))))
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let ((grub-config "grub.cfg"))
- (call-with-output-file grub-config
- (lambda (port)
- ;; Create a tiny configuration file telling the embedded grub where to
- ;; load the real thing. XXX This is quite fragile, and can prevent
- ;; the image from booting when there's more than one volume with this
- ;; label present. Reproducible almost-UUIDs could reduce the risk
- ;; (not eliminate it).
- (format port
- "insmod part_msdos~@
- insmod part_gpt~@
- search --set=root --label Guix_image~@
- configfile /boot/grub/grub.cfg~%")))
- (install-efi grub-efi grub-config esp #:targets targets)
- (delete-file grub-config)))
+(define (install-efi efibootmgr vendir loader* disk plan)
+ "See 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)))))
+ (builder name) ; build to a tmp file so we can check size
+ ;; 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))
+ ;; esp 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 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!~%")))
+ ;; boot order. recall efi-bootnums to get fresh list with new installs
+ ;; 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"
+ (let ((num (cute assoc-ref (efi-bootnums efibootmgr) <>))) ; cute is eager
+ (string-join (filter-map (compose num loaderof) plan-files) ",")))))
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 49dc01c0d1..b1abc99bba 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -28,6 +28,7 @@ (define-module (gnu build image)
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
+ #:use-module (guix deprecation)
#:use-module (guix store database)
#:use-module (guix utils)
#:use-module (gnu build bootloader)
@@ -181,30 +182,13 @@ (define* (register-closure prefix closure
#:prefix prefix
#:registration-time %epoch)))))
-(define* (initialize-efi-partition root
- #:key
- grub-efi
- #:allow-other-keys)
- "Install in ROOT directory, an EFI loader using GRUB-EFI."
- (install-efi-loader grub-efi root))
-
-(define* (initialize-efi32-partition root
- #:key
- grub-efi32
- #:allow-other-keys)
- "Install in ROOT directory, an EFI 32bit loader using GRUB-EFI32."
- (install-efi-loader grub-efi32 root
- #:targets (cond ((target-x86?)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((target-arm?)
- '("arm-efi" . "BOOTARM.EFI")))))
+(define (initialize-efi-partition root . rest)
+ (mkdir-p (string-append root "/EFI")))
+
+(define-deprecated/alias initialize-efi32-partition initialize-efi-partition)
(define* (initialize-root-partition root
#:key
- bootcfg
- bootcfg-location
- bootloader-package
- bootloader-installer
(copy-closures? #t)
(deduplicate? #t)
references-graphs
@@ -251,18 +235,10 @@ (define* (initialize-root-partition root
(unless copy-closures?
(delete-file root-store)
- (rename-file tmp-store root-store)))
-
- ;; There's no point installing a bootloader if we do not populate the store.
- (when copy-closures?
- (when bootloader-installer
- (display "installing bootloader...\n")
- (bootloader-installer bootloader-package #f root))
- (when bootcfg
- (install-boot-config bootcfg bootcfg-location root))))
+ (rename-file tmp-store root-store))))
(define* (make-iso9660-image xorriso grub-mkrescue-environment
- grub bootcfg system-directory root target
+ grub grub.dir system-directory root target
#:key (volume-id "Guix_image") (volume-uuid #f)
register-closures? (references-graphs '())
(compression? #t))
@@ -321,7 +297,7 @@ (define* (make-iso9660-image xorriso grub-mkrescue-environment
(apply invoke grub-mkrescue
(string-append "--xorriso=" grub-mkrescue-sed.sh)
"-o" target
- (string-append "boot/grub/grub.cfg=" bootcfg)
+ (string-append "boot/grub=" grub.dir)
root
"--"
;; Set all timestamps to 1.
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 0aa227b4d8..6b5435f13c 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -25,8 +25,7 @@ (define-module (gnu build install)
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (install-boot-config
- evaluate-populate-directive
+ #:export (evaluate-populate-directive
populate-root-file-system
install-database-and-gc-roots
populate-single-profile-directory
@@ -42,19 +41,6 @@ (define-module (gnu build install)
;;;
;;; Code:
-(define (install-boot-config bootcfg bootcfg-location mount-point)
- "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note
-that the caller must make sure that BOOTCFG is registered as a GC root so
-that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
- (let* ((target (string-append mount-point bootcfg-location))
- (pivot (string-append target ".new")))
- (mkdir-p (dirname target))
-
- ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
- ;; work when /boot is on a separate partition. Do that atomically.
- (copy-file bootcfg pivot)
- (rename-file pivot target)))
-
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
diff --git a/gnu/image.scm b/gnu/image.scm
index 7fb06dec10..6a3251014f 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -35,6 +35,7 @@ (define-module (gnu image)
partition-label
partition-uuid
partition-flags
+ partition-target
partition-initializer
image
@@ -131,6 +132,8 @@ (define-record-type* <partition> partition make-partition
(flags partition-flags
(default '()) ;list of symbols
(sanitize validate-partition-flags))
+ (target partition-target ; bootloader target type: symbol | #f
+ (default #f))
(initializer partition-initializer
(default #false))) ;gexp | #false
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 51fa7cf9d9..83682ea539 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1454,15 +1454,19 @@ (define (root-user-partition? partition)
(define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
- (let* ((root-partition (find root-user-partition?
- user-partitions))
+ (let* ((root-partition (find root-user-partition? user-partitions))
(root-partition-disk (user-partition-disk-file-name root-partition)))
`((bootloader-configuration
,@(if (efi-installation?)
`((bootloader grub-efi-bootloader)
- (targets (list ,(default-esp-mount-point))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path ,(default-esp-mount-point))))))
`((bootloader grub-bootloader)
- (targets (list ,root-partition-disk))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ ;; TODO: we should provide a uuid or label here
+ (device ,root-partition-disk))))))
;; XXX: Assume we defined the 'keyboard-layout' field of
;; <operating-system> right above.
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 8dd8c342a0..4a9d3faee1 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -505,18 +505,15 @@ (define (deploy-managed-host machine)
(machine-ssh-session machine)
(machine-become-command machine)))
- (mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-alternatives (machine->boot-alternatives machine)))
+ (mlet %store-monad ((_ (check-deployment-sanity machine)))
;; Make sure code that check %CURRENT-SYSTEM, such as
;; %BASE-INITRD-MODULES, gets to see the right value.
(parameterize ((%current-system system)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters boot-alternatives)))
- (bootloader-configuration (operating-system-bootloader os))
- (bootcfg (operating-system-bootcfg os menu-entries)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootmeta (operating-system-bootmeta os)))
(define-syntax-rule (eval/error-handling condition handler ...)
;; Return a wrapper around EVAL such that HANDLER is evaluated if an
;; exception is raised.
@@ -548,13 +545,15 @@ (define (deploy-managed-host machine)
(inferior-exception-arguments
c)))
os)
- (install-bootloader (eval/error-handling c
- (raise (formatted-message
- (G_ "\
+ (mlet %store-monad
+ ((boot-alternatives (machine->boot-alternatives machine)))
+ (apply install-bootloader
+ (eval/error-handling c
+ (raise (formatted-message
+ (G_ "\
failed to install bootloader on '~a':~%~{~s ~}~%")
- host
- (inferior-exception-arguments c))))
- bootloader-configuration bootcfg)))))))))
+ host (inferior-exception-arguments c))))
+ bootloader-config boot-alternatives bootmeta))))))))))
\f
;;;
@@ -585,32 +584,28 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
- (_ -> (if (< (length boot-alternatives) 2)
- (raise roll-back-failure)))
- (chosen-alternative (second boot-alternatives))
- (parameters (boot-alternative-parameters chosen-alternative))
- (entries -> (list (boot-parameters->menu-entry parameters)))
- (locale -> (boot-parameters-locale parameters))
- (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
- (store-dir -> (boot-parameters-store-directory-prefix parameters))
- (old-entries -> (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (drop boot-alternatives 2))))
- (bootloader -> (operating-system-bootloader
- (machine-operating-system machine)))
- (bootcfg (lower-object
- ((bootloader-configuration-file-generator
- (bootloader-configuration-bootloader
- bootloader))
- bootloader entries
- #:locale locale
- #:store-crypto-devices crypto-dev
- #:store-directory-prefix store-dir
- #:old-entries old-entries)))
- (remote-result (machine-remote-eval machine remote-exp)))
- (when (eqv? 'error remote-result)
- (raise roll-back-failure))))
+ (mlet %store-monad ((boot-alternatives (machine->boot-alternatives machine)))
+ (when (< (length boot-alternatives) 2) (raise roll-back-failure))
+ (mlet* %store-monad ((remote-result (machine-remote-eval machine remote-exp)))
+ (mwhen (eqv? 'error remote-result)
+ (raise roll-back-failure)))
+
+ (mlet* %store-monad ((os -> (machine-operating-system machine))
+ (chosen -> (cadr boot-alternatives))
+ (alts -> (cons* chosen (car boot-alternatives)
+ (cddr boot-alternatives)))
+ (params -> (boot-alternative-parameters chosen))
+ (locale -> (boot-parameters-locale chosen))
+ (crypto-dev -> (boot-parameters-store-crypto-devices
+ chosen))
+ (store-pre -> (boot-parameters-store-directory-prefix
+ chosen)))
+ (install-bootloader (cute machine-remote-eval machine <>)
+ (operating-system-bootloader os)
+ alts
+ #:locale locale
+ #:store-crypto-devices crypto-dev
+ #:store-directory-prefix store-pre))))
\f
;;;
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 4072df50d7..12f918a123 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -498,92 +498,6 @@ (define-public grub-hybrid
basename))))
(scandir input-dir)))))))))))
-(define-public (make-grub-efi-netboot name subdir)
- "Make a grub-efi-netboot package named NAME, which will be able to boot over
-network via TFTP by accessing its files in the SUBDIR of a TFTP root directory.
-This package is also able to boot from local storage devices.
-
-A bootloader-installer basically needs to copy the package content into the
-bootloader-target directory, which will usually be the TFTP root, as
-'grub-mknetdir' will be invoked already during the package creation.
-
-Alternatively the bootloader-target directory can be a mounted EFI System
-Partition (ESP), or a similar partition with a FAT file system, for booting
-from local storage devices.
-
-The name of the GRUB EFI binary will conform to the UEFI specification for
-removable media. Depending on the system it will be e.g. bootx64.efi or
-bootaa64.efi below SUBDIR.
-
-The SUBDIR argument needs to be set to \"efi/boot\" to create a package which
-conforms to the UEFI specification for removable media.
-
-The SUBDIR argument defaults to \"efi/Guix\", as it is also the case for
-'grub-efi-bootloader'."
- (package
- (name name)
- (version (package-version grub-efi))
- ;; Source is not needed, but it cannot be omitted.
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (let* ((system (string-split (nix-system->gnu-triplet
- (or (%current-target-system)
- (%current-system)))
- #\-))
- (arch (first system))
- (boot-efi
- (match system
- ;; These are the supportend systems and the names defined by
- ;; the UEFI standard for removable media.
- (("i686" _ ...) "/bootia32.efi")
- (("x86_64" _ ...) "/bootx64.efi")
- (("arm" _ ...) "/bootarm.efi")
- (("aarch64" _ ...) "/bootaa64.efi")
- (("riscv" _ ...) "/bootriscv32.efi")
- (("riscv64" _ ...) "/bootriscv64.efi")
- ;; Other systems are not supported, although defined.
- ;; (("riscv128" _ ...) "/bootriscv128.efi")
- ;; (("ia64" _ ...) "/bootia64.efi")
- ((_ ...) #f)))
- (core-efi (string-append
- ;; This is the arch dependent file name of GRUB, e.g.
- ;; i368-efi/core.efi or arm64-efi/core.efi.
- (match arch
- ("i686" "i386")
- ("aarch64" "arm64")
- ("riscv" "riscv32")
- (_ arch))
- "-efi/core.efi")))
- (list
- #:modules '((guix build utils))
- #:builder
- #~(begin
- (use-modules (guix build utils))
- (let* ((bootloader #$(this-package-input "grub-efi"))
- (net-dir #$output)
- (sub-dir (string-append net-dir "/" #$subdir "/"))
- (boot-efi (string-append sub-dir #$boot-efi))
- (core-efi (string-append sub-dir #$core-efi)))
- ;; Install GRUB, which refers to the grub.cfg, with support for
- ;; encrypted partitions,
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
- (string-append "--net-directory=" net-dir)
- (string-append "--subdir=" #$subdir)
- ;; These modules must be pre-loaded to allow booting
- ;; from an ESP or a similar partition with a FAT
- ;; file system.
- (string-append "--modules=part_msdos part_gpt fat"))
- ;; Move GRUB's core.efi to the removable media name.
- (false-if-exception (delete-file boot-efi))
- (rename-file core-efi boot-efi))))))
- (inputs (list grub-efi))
- (synopsis (package-synopsis grub-efi))
- (description (package-description grub-efi))
- (home-page (package-home-page grub-efi))
- (license (package-license grub-efi))))
-
(define-public syslinux
(let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
(package
diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index c4f03c3ed9..66f980dd79 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -19,8 +19,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages raspberry-pi)
- #:use-module (gnu bootloader)
- #:use-module (gnu bootloader grub)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages algebra)
@@ -328,22 +326,6 @@ (define (make-raspi-bcm28-dtbs linux)
(format #f "The device-tree files for Raspberry Pi models from ~a."
(package-name linux)))))
-(define-public grub-efi-bootloader-chain-raspi-64
- ;; A bootloader capable to boot a Raspberry Pi over network via TFTP or from
- ;; a local storage like a micro SD card. It neither installs firmware nor
- ;; device-tree files for the Raspberry Pi. It just assumes them to be
- ;; existing in boot/efi in the same way that some UEFI firmware with ACPI
- ;; data is usually assumed to be existing on PCs. It creates firmware
- ;; configuration files and a bootloader-chain with U-Boot to provide an EFI
- ;; API for the final GRUB bootloader. It also serves as a blue-print to
- ;; create an a custom bootloader-chain with firmware and device-tree
- ;; packages or files.
- (efi-bootloader-chain grub-efi-netboot-removable-bootloader
- #:packages (list u-boot-rpi-arm64-efi-bin)
- #:files (list %raspi-config-txt
- %raspi-bcm27-dtb-txt
- %raspi-u-boot-bootloader-txt)))
-
(define (make-raspi-defconfig arch defconfig sha256-as-base32)
"Make for the architecture ARCH a file-like object from the DEFCONFIG file
with the hash SHA256-AS-BASE32. This object can be used as the #:defconfig
diff --git a/gnu/system.scm b/gnu/system.scm
index 4a084b2ecf..a345b52d55 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -140,10 +140,11 @@ (define-module (gnu system)
operating-system-derivation
operating-system-profile
- operating-system-bootcfg
+ operating-system-bootmeta
operating-system-etc-directory
operating-system-locale-directory
operating-system-boot-script
+ operating-system-boot-parameters
operating-system-uuid
operating-system-with-gc-roots
@@ -171,6 +172,9 @@ (define-module (gnu system)
;;;
;;; Code:
+(define (convert-bootloader-field bootloader)
+ (if (list? bootloader) bootloader (list bootloader)))
+
(define-with-syntax-properties (warn-hosts-file-field-deprecation
(value properties))
(when value
@@ -193,7 +197,9 @@ (define-record-type* <operating-system> operating-system
(default %default-kernel-arguments)) ; list of gexps/strings
(hurd operating-system-hurd
(default #f)) ; package
- (bootloader operating-system-bootloader) ; <bootloader-configuration>
+ (bootloader operating-system-bootloader ; <bootloader-configuration>
+ (default '())
+ (sanitize convert-bootloader-field))
(label operating-system-label ; string
(thunked)
(default (operating-system-default-label this-operating-system)))
@@ -1208,30 +1214,17 @@ (define (operating-system-store-file-system os)
"Return the file system that contains the store of OS."
(store-file-system (operating-system-file-systems os)))
-(define* (operating-system-bootcfg os #:optional (old-entries '()))
- "Return the bootloader configuration file for OS. Use OLD-ENTRIES,
-a list of <menu-entry>, to populate the \"old entries\" menu."
+(define (operating-system-bootmeta os)
+ "Return operating system information to be passed to the bootloader
+installers."
(let* ((file-systems (operating-system-file-systems os))
+ (store-root (btrfs-store-subvolume-file-name file-systems))
(root-fs (operating-system-root-file-system os))
- (root-device (file-system-device root-fs))
(locale (operating-system-locale os))
- (crypto-devices (operating-system-bootloader-crypto-devices os))
- (params (operating-system-boot-parameters
- os root-device
- #:system-kernel-arguments? #t))
- (entry (boot-parameters->menu-entry params))
- (bootloader-conf (operating-system-bootloader os)))
-
- (define generate-config-file
- (bootloader-configuration-file-generator
- (bootloader-configuration-bootloader bootloader-conf)))
-
- (generate-config-file bootloader-conf (list entry)
- #:old-entries old-entries
- #:locale locale
- #:store-crypto-devices crypto-devices
- #:store-directory-prefix
- (btrfs-store-subvolume-file-name file-systems))))
+ (crypto-devices (operating-system-bootloader-crypto-devices os)))
+ (list #:store-crypto-devices crypto-devices
+ #:store-directory-prefix store-root
+ #:locale locale)))
(define (operating-system-multiboot-modules os)
(if (operating-system-hurd os) (hurd-multiboot-modules os) '()))
@@ -1295,9 +1288,9 @@ (define* (operating-system-boot-parameters os root-device
(file-systems (operating-system-file-systems os))
(crypto-devices (operating-system-bootloader-crypto-devices os))
(locale (operating-system-locale os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os)))
- (bootloader-name (bootloader-name bootloader))
+ (bootloader (map bootloader-configuration-bootloader
+ (operating-system-bootloader os)))
+ (bootloader-name (map bootloader-name bootloader))
(label (operating-system-label os))
(multiboot-modules (operating-system-multiboot-modules os)))
(boot-parameters
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 833caef496..2b5302ce5f 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -81,6 +81,7 @@ (define-module (gnu system boot)
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
+ boot-alternative->menu-entry
ensure-not-/dev
system-linux-image-file-name))
@@ -171,7 +172,8 @@ (define (read-boot-parameters port)
(bootloader-name
(match (assq 'bootloader-name rest)
- ((_ args) args)
+ ((_ (args ...)) args)
+ ((_ args) (list args))
(#f 'grub))) ; for compatibility reasons.
(bootloader-menu-entries
@@ -340,6 +342,7 @@ (define (boot-parameters->menu-entry conf)
(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)
@@ -353,6 +356,9 @@ (define (boot-parameters->menu-entry conf)
(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
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index b0c96c60f0..050f5b578b 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system image)
+ #:use-module (guix deprecation)
#:use-module (guix diagnostics)
#:use-module (guix discovery)
#:use-module (guix gexp)
@@ -42,6 +44,7 @@ (define-module (gnu system image)
#:use-module (gnu services base)
#:use-module (gnu system)
#:use-module (gnu system accounts)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system linux-container)
#:use-module (gnu system uuid)
@@ -133,12 +136,10 @@ (define esp-partition
;; FAT-ness is based on file system size (16 in this case).
(file-system "vfat")
(flags '(esp))
- (initializer (gexp initialize-efi-partition))))
+ (target 'esp)
+ (initializer #~initialize-efi-partition)))
-(define esp32-partition
- (partition
- (inherit esp-partition)
- (initializer (gexp initialize-efi32-partition))))
+(define-deprecated/alias esp32-partition esp-partition)
(define root-partition
(partition
@@ -149,6 +150,7 @@ (define root-partition
;; with U-Boot.
(file-system-options (list "-O" "^metadata_csum,^64bit"))
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))
(define mbr-disk-image
@@ -173,11 +175,7 @@ (define efi-disk-image
(partition-table-type 'gpt)
(partitions (list esp-partition root-partition))))
-(define efi32-disk-image
- (image-without-os
- (format 'disk-image)
- (partition-table-type 'gpt)
- (partitions (list esp32-partition root-partition))))
+(define-deprecated/alias efi32-disk-image efi-disk-image)
(define iso9660-image
(image-without-os
@@ -238,10 +236,7 @@ (define efi-raw-image-type
(name 'efi-raw)
(constructor (cut image-with-os efi-disk-image <>))))
-(define efi32-raw-image-type
- (image-type
- (name 'efi32-raw)
- (constructor (cut image-with-os efi32-disk-image <>))))
+(define-deprecated/alias efi32-raw-image-type efi-raw-image-type)
(define qcow2-image-type
(image-type
@@ -350,10 +345,6 @@ (define (find-root-partition image)
(raise (formatted-message
(G_ "image lacks a partition with the 'boot' flag")))))
-(define (root-partition-index image)
- "Return the index of the root partition of the given IMAGE."
- (1+ (srfi-1:list-index root-partition? (image-partitions image))))
-
\f
;;
;; Disk image.
@@ -362,8 +353,8 @@ (define (root-partition-index image)
(define* (system-disk-image image
#:key
(name "disk-image")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '()))
"Return as a file-like object, the disk-image described by IMAGE. Said
@@ -380,6 +371,28 @@ (define* (system-disk-image image
(define genimage-name "image")
+ (define (targets current)
+ ;; provides list of target overrides for a given CURRENT partition, which
+ ;; may be #f for the full-disk targets.
+
+ ;; XXX: how we pass paths is v much a hack
+ (cons (bootloader-target
+ (type 'disk)
+ (device (and (not current) (string-append "images/" genimage-name)))
+ (expected? (->bool current)))
+ (map (lambda (partition)
+ (let ((current? (and current (eq? (partition-target partition)
+ (partition-target current)))))
+ (bootloader-target
+ (type (partition-target partition))
+ (expected? (not current?))
+ (path (and current? "tmp-root"))
+ (offset #f)
+ (file-system (partition-file-system partition))
+ (label (partition-label partition))
+ (uuid (partition-uuid partition)))))
+ (filter partition-target (image-partitions image)))))
+
(define (image->genimage-cfg image)
;; Return as a file-like object, the genimage configuration file
;; describing the given IMAGE.
@@ -460,7 +473,8 @@ (define* (system-disk-image image
(list dosfstools fakeroot mtools))
(else
'())))
- (image-root "tmp-root"))
+ (image-root (string-append (getcwd) "/tmp-root"))
+ (copy-closures? (not #$(image-shared-store? image))))
(sql-schema #$schema)
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
@@ -476,18 +490,13 @@ (define* (system-disk-image image
(initializer image-root
#:references-graphs '#$graph
#:deduplicate? #f
- #:copy-closures? (not
- #$(image-shared-store? image))
- #:system-directory #$os
- #:grub-efi #+grub-efi
- #:grub-efi32 #+grub-efi32
- #:bootloader-package
- #+(bootloader-package bootloader)
- #:bootloader-installer
- #+(bootloader-installer bootloader)
- #:bootcfg #$bootcfg
- #:bootcfg-location
- #$(bootloader-configuration-file bootloader))
+ #:copy-closures? copy-closures?
+ #:system-directory #$os)
+ ;; no point installing a bootloader if we don't populate store
+ (when copy-closures?
+ ;; root-offset isn't necessary - we override 'root
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets partition)))
(make-partition-image #$(partition->gexp partition)
#$output
image-root)))))
@@ -534,14 +543,6 @@ (define* (system-disk-image image
(image-partition-table-type image)))
(else "")))
- (when (and (memq (bootloader-name bootloader)
- '(grub-efi grub-efi32 grub-efi-removable-bootloader))
- (not
- (gpt-image? image)))
- (raise
- (formatted-message
- (G_ "EFI bootloader required with GPT partitioning"))))
-
(let* ((format (image-format image))
(image-type (format->image-type format))
(image-type-options (genimage-type-options image-type image))
@@ -552,13 +553,15 @@ (define* (system-disk-image image
(let ((format (@ (ice-9 format) format)))
(call-with-output-file #$output
(lambda (port)
- (format port
- "\
+ (format port "\
image ~a {
~/~a {~a}
~{~a~^~%~}
-}~%" #$genimage-name #$image-type #$image-type-options
- (list #$@partitions-config))))))))
+}~%"
+ #$genimage-name
+ #$image-type
+ #$image-type-options
+ (list #$@partitions-config))))))))
(computed-file "genimage.cfg" builder)))
(let* ((image-name (image-name image))
@@ -570,17 +573,13 @@ (define* (system-disk-image image
(builder
(with-imported-modules*
(let ((inputs '#+(list genimage coreutils findutils qemu-minimal))
- (bootloader-installer
- #+(bootloader-disk-image-installer bootloader))
(out-image (string-append "images/" #$genimage-name)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(genimage #$(image->genimage-cfg image))
- ;; Install the bootloader directly on the disk-image.
- (when bootloader-installer
- (bootloader-installer
- #+(bootloader-package bootloader)
- #$(root-partition-index image)
- out-image))
+ ;; don't install bootloader unless installing store
+ (unless #$(image-shared-store? image)
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets #f)))
(convert-disk-image out-image '#$format #$output)))))
(computed-file name builder
#:local-build? #f ;too I/O-intensive
@@ -600,8 +599,8 @@ (define (has-guix-service-type? os)
(define* (system-iso9660-image image
#:key
(name "image.iso")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '())
(grub-mkrescue-environment '()))
@@ -621,7 +620,6 @@ (define* (system-iso9660-image image
(uuid-bytevector (partition-uuid partition)))))
(let* ((os (image-operating-system image))
- (bootloader (bootloader-package bootloader))
(compression? (image-compression? image))
(substitutable? (image-substitutable? image))
(schema (local-file (search-path %load-path
@@ -629,6 +627,14 @@ (define* (system-iso9660-image image
(graph (match inputs
(((names . _) ...)
names)))
+ (config (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list (bootloader-target
+ (type 'root)
+ (path "tmp-root"))
+ (bootloader-target
+ (type 'install)
+ (path "boot/grub"))))))
(builder
(with-imported-modules*
(let* ((inputs '#$(list parted e2fsprogs dosfstools xorriso
@@ -649,10 +655,12 @@ (define* (system-iso9660-image image
#:references-graphs '#$graph
#:deduplicate? #f
#:system-directory #$os)
+
(make-iso9660-image #$xorriso
'#$grub-mkrescue-environment
- #$bootloader
- #$bootcfg
+ #$grub-hybrid
+ #$(apply grub.dir grub-hybrid
+ #:bootloader-config config bootmeta)
#$os
image-root
#$output
@@ -954,11 +962,7 @@ (define (operating-system-for-image image)
file-systems
#:volatile-root? volatile-root?
rest)))
- (bootloader (if (eq? format 'iso9660)
- (bootloader-configuration
- (inherit
- (operating-system-bootloader base-os))
- (bootloader grub-mkrescue-bootloader))
+ (bootloader (if (eq? format 'iso9660) '()
(operating-system-bootloader base-os)))
(file-systems (cons (file-system
(mount-point "/")
@@ -1007,17 +1011,28 @@ (define* (system-image image)
(image* (image-with-os* image os))
(image-format (image-format image))
(register-closures? (has-guix-service-type? os))
- (bootcfg (operating-system-bootcfg os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os))))
+ ;; force removable - images don't have efivarfs
+ (bootloader-config (map (lambda (c) (bootloader-configuration
+ (inherit c)
+ (efi-removable? #t)))
+ (operating-system-bootloader os)))
+ (alt (boot-alternative
+ (generation 1)
+ (system-path "/var/guix/profiles/system-1-link")
+ (epoch 0)
+ (parameters (operating-system-boot-parameters os
+ (partition-uuid (find-root-partition image*))
+ #:system-kernel-arguments? #t))))
+ (bootmeta (cons* #:current-boot-alternative alt
+ #:old-boot-alternatives '()
+ (operating-system-bootmeta os))))
(cond
((memq image-format '(disk-image compressed-qcow2))
(system-disk-image image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))))
+ #:inputs `(("system" ,os))))
((memq image-format '(docker))
(system-docker-image image*))
((memq image-format '(tarball))
@@ -1027,11 +1042,10 @@ (define* (system-image image)
((memq image-format '(iso9660))
(system-iso9660-image
image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))
+ #:inputs `(("system" ,os))
;; Make sure to use a mode that does no imply
;; HFS+ tree creation that may fail with:
;;
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 9b618f7dc6..8fb00a6903 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -41,9 +41,7 @@ (define-module (gnu system images hurd)
(define hurd-barebones-os
(operating-system
(inherit %hurd-default-operating-system)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 810e2bed5f..a7a1f499dd 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -39,8 +39,7 @@ (define novena-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-novena-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-novena-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm-generic)
(kernel-arguments '("console=ttymxc1,115200"))
diff --git a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
index 6ec644f113..a3dae24377 100644
--- a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
+++ b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
@@ -39,8 +39,7 @@ (define orangepi-r1-plus-lts-rk3328-barebones-os
(timezone "Europe/Amsterdam")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 457ff4345f..b166838ddd 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -41,8 +41,7 @@ (define pine64-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pine64-lts-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pine64-lts-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 3a0f3abf1f..b26adfb7b9 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -38,8 +38,7 @@ (define pinebook-pro-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pinebook-pro-rk3399-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pinebook-pro-rk3399-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index b3dcfc6193..0b243662d6 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -39,8 +39,7 @@ (define rock64-barebones-os
(timezone "Europe/Oslo")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-rock64-rk3328-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader u-boot-rock64-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/unmatched.scm b/gnu/system/images/unmatched.scm
index d40a32f184..7eb147bbab 100644
--- a/gnu/system/images/unmatched.scm
+++ b/gnu/system/images/unmatched.scm
@@ -39,8 +39,7 @@ (define unmatched-barebones-os
(timezone "Asia/Jerusalem")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-sifive-unmatched-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-sifive-unmatched-bootloader)))
(initrd-modules '())
(kernel linux-libre-riscv64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/visionfive2.scm b/gnu/system/images/visionfive2.scm
index 26f70afbc1..a1c0733692 100644
--- a/gnu/system/images/visionfive2.scm
+++ b/gnu/system/images/visionfive2.scm
@@ -62,8 +62,7 @@ (define visionfive2-barebones-os
(timezone "Etc/UTC")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-starfive-visionfive2-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-starfive-visionfive2-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "Guix_image"))
(mount-point "/")
diff --git a/gnu/system/images/wsl2.scm b/gnu/system/images/wsl2.scm
index d9aaa1a271..1501cb9a90 100644
--- a/gnu/system/images/wsl2.scm
+++ b/gnu/system/images/wsl2.scm
@@ -127,16 +127,6 @@ (define dummy-package
(description #f)
(license (fsdg-compatible "dummy"))))
-(define dummy-bootloader
- (bootloader
- (name 'dummy-bootloader)
- (package dummy-package)
- (configuration-file "/dev/null")
- (configuration-file-generator
- (lambda (. _rest)
- (plain-file "dummy-bootloader" "")))
- (installer #~(const #t))))
-
(define dummy-kernel dummy-package)
(define (dummy-initrd . _rest)
@@ -146,9 +136,7 @@ (define-public wsl-os
(operating-system
(host-name "gnu")
(timezone "Etc/UTC")
- (bootloader
- (bootloader-configuration
- (bootloader dummy-bootloader)))
+ ;; no bootloader
(kernel dummy-kernel)
(initrd dummy-initrd)
(initrd-modules '())
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 0195a0804d..e76d12e95a 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -77,8 +77,7 @@ (define-module (gnu system install)
rock64-installation-os
rockpro64-installation-os
rk3399-puma-installation-os
- wandboard-installation-os
- os-with-u-boot))
+ wandboard-installation-os))
;;; Commentary:
;;;
@@ -503,9 +502,7 @@ (define installation-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(name-service-switch %mdns-host-lookup-nss)
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader (bootloader-configuration (bootloader grub-bootloader)))
(label (string-append "GNU Guix installation "
(or (getenv "GUIX_DISPLAYED_VERSION")
(package-version guix))))
@@ -555,30 +552,14 @@ (define installation-os
%installer-disk-utilities
%base-packages))))
-(define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
- (triplet "arm-linux-gnueabihf"))
- "Given OS, amend it with the u-boot bootloader for BOARD,
-installed to BOOTLOADER-TARGET (a drive), compiled for TRIPLET.
-
-If you want a serial console, make sure to specify one in your
-operating-system's kernel-arguments (\"console=ttyS0\" or similar)."
- (operating-system (inherit os)
- (bootloader (bootloader-configuration
- (bootloader (bootloader (inherit u-boot-bootloader)
- (package (make-u-boot-package board triplet))))
- (targets (list bootloader-target))))))
-
-(define* (embedded-installation-os bootloader bootloader-target tty
- #:key (extra-modules '()))
+(define* (embedded-installation-os bootloader tty #:key (extra-modules '()))
"Return an installation os for embedded systems.
The initrd gets the extra modules EXTRA-MODULES.
A getty is provided on TTY.
The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
(operating-system
(inherit installation-os)
- (bootloader (bootloader-configuration
- (bootloader bootloader)
- (targets (list bootloader-target))))
+ (bootloader (bootloader-configuration (bootloader bootloader)))
(kernel linux-libre)
(kernel-arguments
(cons (string-append "console=" tty)
@@ -587,7 +568,6 @@ (define* (embedded-installation-os bootloader bootloader-target tty
(define beaglebone-black-installation-os
(embedded-installation-os u-boot-beaglebone-black-bootloader
- "/dev/sda"
"ttyO0"
#:extra-modules
;; This module is required to mount the sd card.
@@ -596,77 +576,62 @@ (define beaglebone-black-installation-os
(define a20-olinuxino-lime-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define a20-olinuxino-lime2-emmc-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define a20-olinuxino-micro-installation-os
(embedded-installation-os u-boot-a20-olinuxino-micro-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define bananapi-m2-ultra-installation-os
(embedded-installation-os u-boot-bananapi-m2-ultra-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define firefly-rk3399-installation-os
(embedded-installation-os u-boot-firefly-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define mx6cuboxi-installation-os
(embedded-installation-os u-boot-mx6cuboxi-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
(define novena-installation-os
(embedded-installation-os u-boot-novena-bootloader
- "/dev/mmcblk1" ; SD card storage
"ttymxc1"))
(define nintendo-nes-classic-edition-installation-os
(embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader
- "/dev/mmcblk0" ; SD card (solder it yourself)
"ttyS0"))
(define orangepi-r1-plus-lts-rk3328-installation-os
(embedded-installation-os u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pine64-plus-installation-os
(embedded-installation-os u-boot-pine64-plus-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pinebook-installation-os
(embedded-installation-os u-boot-pinebook-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define rock64-installation-os
(embedded-installation-os u-boot-rock64-rk3328-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rockpro64-installation-os
(embedded-installation-os u-boot-rockpro64-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rk3399-puma-installation-os
(embedded-installation-os u-boot-puma-rk3399-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define wandboard-installation-os
(embedded-installation-os u-boot-wandboard-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
;; Return the default os here so 'guix system' can consume it directly.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a2743453e7..be12ae6b6c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -172,17 +172,6 @@ (define* (virtualized-operating-system os
(operating-system
(inherit os)
- ;; XXX: Until we run QEMU with UEFI support (with the OVMF firmware),
- ;; force the traditional i386/BIOS method.
- ;; See <https://bugs.gnu.org/28768>.
- (bootloader (bootloader-configuration
- (inherit (operating-system-bootloader os))
- (bootloader
- (if (target-riscv64? (or target system))
- u-boot-qemu-riscv64-bootloader
- grub-bootloader))
- (targets '("/dev/vda"))))
-
(initrd (lambda (file-systems . rest)
(apply (operating-system-initrd os)
file-systems
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..18a2fc119b 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -140,7 +140,7 @@ (define-os-with-source (%minimal-extlinux-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
- (bootloader extlinux-bootloader-gpt)
+ (bootloader extlinux-gpt-bootloader)
(targets (list "/dev/vdb"))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1464,9 +1464,11 @@ (define-os-with-source (%btrfs-raid10-root-os
(host-name "hurd")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets (list "/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde"))))
+ (bootloader (map (lambda (targ)
+ (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list targ))))
+ '("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (uuid "16ff18e2-eb41-4324-8df5-80d3b53c411b"))
diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm
index bcc7645fa3..8aa5311171 100644
--- a/gnu/tests/reconfigure.scm
+++ b/gnu/tests/reconfigure.scm
@@ -30,8 +30,7 @@ (define-module (gnu tests reconfigure)
#:use-module (guix scripts system reconfigure)
#:use-module (guix store)
#:export (%test-switch-to-system
- %test-upgrade-services
- %test-install-bootloader))
+ %test-upgrade-services))
;;; Commentary:
;;;
@@ -178,83 +177,6 @@ (define* (run-upgrade-services-test)
(disable (upgrade-services-program '() '() '(dummy) '())))
(test enable disable))))
-(define* (run-install-bootloader-test)
- "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a
-bootloader's configuration file."
- (define os
- (marionette-operating-system
- (simple-operating-system)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
-
- (define vm (virtual-machine
- (operating-system os)
- (volatile? #f)))
-
- (define (test script)
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (ice-9 regex)
- (srfi srfi-1)
- (srfi srfi-64))
-
- (define marionette
- (make-marionette (list #$vm)))
-
- ;; Return the system generation paths that have GRUB menu entries.
- (define (generations-in-grub-cfg marionette)
- (let ((grub-cfg (marionette-eval
- '(begin
- (use-modules (rnrs io ports))
- (call-with-input-file "/boot/grub/grub.cfg"
- get-string-all))
- marionette)))
- (map (lambda (parameter)
- (second (string-split (match:substring parameter) #\=)))
- (list-matches "system=[^ ]*" grub-cfg))))
-
- (test-runner-current (system-test-runner #$output))
- (test-begin "install-bootloader")
-
- (test-assert "no prior menu entry for system generation"
- (not (member #$os (generations-in-grub-cfg marionette))))
-
- (test-assert "script successfully evaluated"
- (marionette-eval
- '(primitive-load #$script)
- marionette))
-
- (test-assert "menu entry created for system generation"
- (member #$os (generations-in-grub-cfg marionette)))
-
- (test-end))))
-
- (let* ((bootloader ((compose bootloader-configuration-bootloader
- operating-system-bootloader)
- os))
- ;; The typical use-case for 'install-bootloader-program' is to read
- ;; the boot parameters for the existing menu entries on the system,
- ;; parse them with 'boot-parameters->menu-entry', and pass the
- ;; results to 'operating-system-bootcfg'. However, to obtain boot
- ;; parameters, we would need to start the marionette, which we should
- ;; ideally avoid doing outside of the 'test' G-Expression. Thus, we
- ;; generate a bootloader configuration for the script as if there
- ;; were no existing menu entries. In the grand scheme of things, this
- ;; matters little -- these tests should not make assertions about the
- ;; behavior of 'operating-system-bootcfg'.
- (bootcfg (operating-system-bootcfg os '()))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (gexp->derivation
- "install-bootloader"
- ;; Due to the read-only nature of the virtual machines used in the system
- ;; test suite, the bootloader installer script is omitted. 'grub-install'
- ;; would attempt to write directly to the virtual disk if the
- ;; installation script were run.
- (test
- (install-bootloader-program #f #f #f bootcfg bootcfg-file '(#f) "/")))))
-
-
(define %test-switch-to-system
(system-test
(name "switch-to-system")
@@ -267,9 +189,3 @@ (define %test-upgrade-services
(description "Upgrade the Shepherd by unloading obsolete services and
loading new services.")
(value (run-upgrade-services-test))))
-
-(define %test-install-bootloader
- (system-test
- (name "install-bootloader")
- (description "Install a bootloader and its configuration file.")
- (value (run-install-bootloader-test))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 344bb74151..aba637f6e3 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -209,7 +209,7 @@ (define* (copy-closure item target
(define* (install os-drv target
#:key (log-port (current-output-port))
- install-bootloader? bootloader bootcfg)
+ install-bootloader? bootloaders bootmeta)
"Copy the closure of BOOTCFG, which includes the output of OS-DRV, to
directory TARGET. TARGET must be an absolute directory name since that's what
'register-path' expects.
@@ -247,24 +247,27 @@ (define* (install os-drv target
(chmod target #o755)
(let ((os-dir (derivation->output-path os-drv))
(format (lift format %store-monad))
- (populate (lift2 populate-root-file-system %store-monad)))
-
- (mlet %store-monad ((bootcfg (lower-object bootcfg)))
- (mbegin %store-monad
- ;; Copy the closure of BOOTCFG, which includes OS-DIR,
- ;; eventual background image and so on.
- (maybe-copy (derivation->output-path bootcfg))
-
- ;; Create a bunch of additional files.
- (format log-port "populating '~a'...~%" target)
- (populate os-dir target)
-
+ (populate (lift2 populate-root-file-system %store-monad))
+ (profile (string-append target "/var/guix/profiles/system")))
+
+ (mbegin %store-monad
+ ;; Create a bunch of system files.
+ (format log-port "populating '~a'...~%" target)
+ (populate os-dir target)
+
+ ;; Copy the bootloader's closure, which includes OS-DIR,
+ ;; eventual background image and so on.
+ (mlet* %store-monad
+ ((alt -> (generation->boot-alternative profile 1))
+ (inst (apply install-bootloader local-eval bootloaders
+ (list alt) #:dry-run (not install-bootloader?)
+ #:root-offset target bootmeta)))
+ (maybe-copy (derivation->output-path inst)))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target target)
(return
(info (G_ "bootloader successfully installed on~{ ~a~}~%")
- (bootloader-configuration-targets bootloader))))))))
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))))
\f
;;;
@@ -389,20 +392,13 @@ (define (install-bootloader-from-provenance store number)
(let* ((generation (generation-file-name %system-profile number))
(os (receive (_ os) (system-provenance generation)
(and=> os read-operating-system)))
- (bootloader-config (operating-system-bootloader os))
- (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (new (generation->boot-alternative %system-profile number))
(numbers (delv number (reverse (generation-numbers %system-profile))))
(old (profile->boot-alternatives %system-profile numbers)))
(if os
(run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object (operating-system-bootcfg os old)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))
+ (apply install-bootloader local-eval (operating-system-bootloader os)
+ (cons new old) (operating-system-bootmeta os)))
(leave (G_ "cannot rollback to provenanceless generation '~a'~%")
number))))
@@ -489,7 +485,8 @@ (define* (display-system-generation number
(format #t (G_ " canonical file name: ~a~%") (readlink* generation))
;; TRANSLATORS: Please preserve the two-space indentation.
(format #t (G_ " label: ~a~%") label)
- (format #t (G_ " bootloader: ~a~%") bootloader-name)
+ (format #t (G_ " bootloader: ~a~%")
+ (string-join (map symbol->string bootloader-name)))
;; TRANSLATORS: The '~[', '~;', and '~]' sequences in this string must
;; be preserved. They denote conditionals, such that the result will
@@ -775,18 +772,11 @@ (define* (perform-action action image
(define os
(image-operating-system image))
- (define bootloader
+ (define bootloaders
(operating-system-bootloader os))
- (define bootcfg
- (and (memq action '(init reconfigure))
- (operating-system-bootcfg
- os
- (if (eq? action 'init)
- '()
- (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (profile->boot-alternatives)))))))
+ (define bootmeta
+ (operating-system-bootmeta os))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
@@ -817,10 +807,7 @@ (define* (perform-action action image
;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root.
;; See <http://bugs.gnu.org/21068>.
- (drvs (mapm/accumulate-builds lower-object
- (if (memq action '(init reconfigure))
- (list sys bootcfg)
- (list sys))))
+ (drvs (mapm/accumulate-builds lower-object (list sys)))
(% (if derivations-only?
(return (for-each (compose println derivation-file-name)
drvs))
@@ -838,12 +825,16 @@ (define* (perform-action action image
(format #t (G_ "activating system...~%"))
(mbegin %store-monad
(switch-to-system local-eval os)
+ (apply install-bootloader local-eval bootloaders
+ (profile->boot-alternatives)
+ #:dry-run? (not install-bootloader?)
+ (if target (cons* #:root-offset target bootmeta) bootmeta))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target (or target "/"))
(return
(info (G_ "bootloader successfully installed on '~a'~%")
- (bootloader-configuration-targets bootloader))))
+ (map bootloader-target-path
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))
(with-shepherd-error-handling
(upgrade-shepherd-services local-eval os)
(return (format #t (G_ "\
@@ -857,8 +848,8 @@ (define* (perform-action action image
target)
(install sys (canonicalize-path target)
#:install-bootloader? install-bootloader?
- #:bootloader bootloader
- #:bootcfg bootcfg))
+ #:bootloaders bootloaders
+ #:bootmeta bootmeta))
(else
;; All we had to do was to build SYS and maybe register an
;; indirect GC root.
@@ -1254,11 +1245,7 @@ (define (process-action action args opts)
(G_ "image lacks an operating-system")))))
(target-file (match args
((first second) second)
- (_ #f)))
- (bootloader-targets
- (and bootloader?
- (bootloader-configuration-targets
- (operating-system-bootloader os)))))
+ (_ #f))))
(define (graph-backend)
(lookup-backend (assoc-ref opts 'graph-backend)))
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 604ba08fee..8add639e6a 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -209,101 +210,83 @@ (define* (upgrade-shepherd-services eval os)
;;; Bootloader configuration.
;;;
-(define (install-bootloader-program installer disk-installer
- bootloader-package bootcfg
- bootcfg-file devices target)
+(define (install-bootloader-program configs offset chosen-alt old-alts locale
+ store-crypto-devices store-directory-prefix)
"Return an executable store item that, upon being evaluated, will install
BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICES, a list of file system
devices, at TARGET, a mount point, and subsequently run INSTALLER from
BOOTLOADER-PACKAGE."
(program-file
- "install-bootloader.scm"
- (with-extensions (list guile-gcrypt)
- (with-imported-modules `(,@(source-module-closure
- '((gnu build bootloader)
- (gnu build install)
- (guix store)
- (guix utils))
- #:select? not-config?)
- ((guix config) => ,(make-config.scm)))
- #~(begin
- (use-modules (gnu build bootloader)
- (gnu build install)
- (guix build utils)
- (guix store)
- (guix utils)
- (ice-9 binary-ports)
- (ice-9 match)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (let* ((gc-root (string-append #$target %gc-roots-directory "/bootcfg"))
- (new-gc-root (string-append gc-root ".new")))
- ;; #$bootcfg has dependencies.
- ;; The bootloader magically loads the configuration from
- ;; (string-append #$target #$bootcfg-file) (for example
- ;; "/boot/grub/grub.cfg").
- ;; If we didn't do something special, the garbage collector
- ;; would remove the dependencies of #$bootcfg.
- ;; Register #$bootcfg as a GC root.
- ;; Preserve the previous activation's garbage collector root
- ;; until the bootloader installer has run, so that a failure in
- ;; the bootloader's installer script doesn't leave the user with
- ;; a broken installation.
- (switch-symlinks new-gc-root #$bootcfg)
- (install-boot-config #$bootcfg #$bootcfg-file #$target)
- (when (or #$installer #$disk-installer)
- (catch #t
- (lambda ()
- ;; The bootloader might not support installation on a
- ;; mounted directory using the BOOTLOADER-INSTALLER
- ;; procedure. In that case, fallback to installing the
- ;; bootloader directly on DEVICES using the
- ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
- (if #$installer
- (for-each (lambda (device)
- (#$installer #$bootloader-package device
- #$target))
- '#$devices)
- (for-each (lambda (device)
- (#$disk-installer #$bootloader-package
- 0 device))
- '#$devices)))
- (lambda args
- (delete-file new-gc-root)
- (match args
- (('%exception exception) ;Guile 3 SRFI-34 or similar
- (raise-exception exception))
- ((key . args)
- (apply throw key args))))))
- ;; We are sure that the installation of the bootloader
- ;; succeeded, so we can replace the old GC root by the new
- ;; GC root now.
- (rename-file new-gc-root gc-root)))))))
+ "install-bootloader.scm"
+ ;; three sources of boot entries: bootloader-configuration-menu-entries,
+ ;; current-boot-alternative, and old-boot-alternatives.
+ (let ((args (list #:current-boot-alternative chosen-alt
+ #:old-boot-alternatives old-alts
+ #:locale locale
+ #:store-directory-prefix store-directory-prefix
+ #:store-crypto-devices store-crypto-devices)))
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules
+ `(,@(source-module-closure '((gnu build bootloader)
+ (gnu build install)
+ (guix store)
+ (guix utils))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (gnu build bootloader)
+ (gnu build install)
+ (guix build utils)
+ (guix store)
+ (guix utils)
+ (ice-9 binary-ports)
+ (ice-9 match)
+ (srfi srfi-34)
+ (srfi srfi-35))
+ ;; bootloader-installer is passed an additional #:target argument
+ ;; denoting the specific target currently being installed to.
+ ;; bootloaders should determine when to fully reinstall themselves.
+ #$(bootloader-configurations->gexp configs args
+ #:root-offset offset)))))))
-(define* (install-bootloader eval configuration bootcfg
- #:key
- (run-installer? #t)
- (target "/"))
+(define* (install-bootloader eval configs alts #:key locale
+ store-crypto-devices store-directory-prefix
+ (root-offset "/") (dry-run? #f))
"Using EVAL, a monadic procedure taking a single G-Expression as an argument,
-configure the bootloader on TARGET such that OS will be booted by default and
-additional configurations specified by MENU-ENTRIES can be selected."
- (let* ((bootloader (bootloader-configuration-bootloader configuration))
- (installer (and run-installer?
- (bootloader-installer bootloader)))
- (disk-installer (and run-installer?
- (bootloader-disk-image-installer bootloader)))
- (package (bootloader-package bootloader))
- (devices (bootloader-configuration-targets configuration))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
- (primitive-load #$(install-bootloader-program installer
- disk-installer
- package
- bootcfg
- bootcfg-file
- devices
- target))))))
+configure the bootloader with bootloader-configuration CONFIG such that
+ALTS may be selected, with the first element being the default. If QUICK? only
+the bootloader config is reinstalled. Returns the config installer drv."
+ (mlet* %store-monad
+ ((program (lower-object
+ (install-bootloader-program configs root-offset
+ (car alts) (cdr alts) locale
+ store-crypto-devices store-directory-prefix))))
+ (mbegin %store-monad
+ (eval
+ (with-imported-modules `(,@(source-module-closure '((guix build utils)
+ (guix store))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (guix build utils) (guix store))
+ (parameterize ((current-warning-port (%make-void-port "w")))
+ (let* ((gc-root (string-append
+ #$root-offset %gc-roots-directory "/bootcfg"))
+ (new-gc-root (string-append gc-root ".new")))
+ ;; since the installers are gexps directly included, we add
+ ;; the installer runner as a gc root. this should make sure
+ ;; no bootloader files get gc'd. only remove the old one on
+ ;; success.
+ ;; XXX: is this still necessary?
+ (switch-symlinks new-gc-root #$program)
+ (dynamic-wind (const #t)
+ (lambda ()
+ (unless #$dry-run? (primitive-load #$program))
+ (rename-file new-gc-root gc-root))
+ (lambda () ; delete new root if failed
+ (when (file-exists? new-gc-root)
+ (delete-file new-gc-root)))))))))
+ (return program))))
\f
;;;
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 05/15] gnu: system: Remove useless boot parameters.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (3 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
` (10 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
* gnu/system.scm (operating-system-boot-parameters,
operating-system-boot-parameters-file): Delete
bootloader-menu-entries.
* gnu/system/boot.scm (boot-parameters)[bootloader-menu-entries]: Delete
fields.
(read-boot-parameters): Don't read bootloader-menu-entries.
* tests/boot-parameters.scm (%grub-boot-parameters,
test-read-boot-parameters, test-read-boot-parameters): Don't include
bootloader-menu-entries.
("read, bootloader-menu-entries, default value"): Delete test.
Change-Id: I46d9cff4604dbfcf654b0820fdb77e72aecffbb4
---
gnu/system.scm | 7 -------
gnu/system/boot.scm | 8 --------
tests/boot-parameters.scm | 14 ++------------
3 files changed, 2 insertions(+), 27 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index a345b52d55..66c1a80733 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1304,8 +1304,6 @@ (define* (operating-system-boot-parameters os root-device
(initrd initrd)
(multiboot-modules multiboot-modules)
(bootloader-name bootloader-name)
- (bootloader-menu-entries
- (bootloader-configuration-menu-entries (operating-system-bootloader os)))
(locale locale)
(store-device (ensure-not-/dev (file-system-device store)))
(store-directory-prefix (btrfs-store-subvolume-file-name file-systems))
@@ -1347,11 +1345,6 @@ (define* (operating-system-boot-parameters-file os)
#$(boot-parameters-multiboot-modules params)))
#~())
(bootloader-name #$(boot-parameters-bootloader-name params))
- (bootloader-menu-entries
- #$(map menu-entry->sexp
- (or (and=> (operating-system-bootloader os)
- bootloader-configuration-menu-entries)
- '())))
(locale #$(boot-parameters-locale params))
(store
(device
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 2b5302ce5f..4d89827ced 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -54,7 +54,6 @@ (define-module (gnu system boot)
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
@@ -113,8 +112,6 @@ (define-record-type* <boot-parameters>
;; 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)
@@ -176,11 +173,6 @@ (define (read-boot-parameters port)
((_ args) (list 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))
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 2e7976aa6c..f214de360d 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -64,7 +64,6 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
@@ -107,7 +106,6 @@ (define* (test-read-boot-parameters
#:key
(version %boot-parameters-version)
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(label %default-label)
(root-device (quote-uuid %default-root-device))
(kernel %default-kernel)
@@ -127,7 +125,7 @@ (define* (test-read-boot-parameters
(cond ((eq? 'false val) (format #false fmt #false))
(val (format #false fmt val))
(else "")))
- (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a~a)"
+ (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a)"
(sexp-or-nothing " (version ~S)" version)
(sexp-or-nothing " (label ~S)" label)
(sexp-or-nothing " (root-device ~S)" root-device)
@@ -145,9 +143,7 @@ (define* (test-read-boot-parameters
store-crypto-devices))
"")
(sexp-or-nothing " (locale ~S)" locale)
- (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)
- (sexp-or-nothing " (bootloader-menu-entries ~S)"
- bootloader-menu-entries)))
+ (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)))
(let ((str (generate-boot-parameters)))
(call-with-input-string str read-boot-parameters)))
@@ -170,7 +166,6 @@ (define* (test-read-boot-parameters
(test-assert "read, construction, optional fields"
(and (test-read-boot-parameters #:bootloader-name #false)
- (test-read-boot-parameters #:bootloader-menu-entries #false)
(test-read-boot-parameters #:kernel-arguments #false)
(test-read-boot-parameters #:with-store #false)
(test-read-boot-parameters #:store-device #false)
@@ -223,11 +218,6 @@ (define* (test-read-boot-parameters
(boot-parameters-bootloader-name
(test-read-boot-parameters #:bootloader-name #false)))
-(test-eq "read, bootloader-menu-entries, default value"
- '()
- (boot-parameters-bootloader-menu-entries
- (test-read-boot-parameters #:bootloader-menu-entries #false)))
-
(test-eq "read, kernel-arguments, default value"
'()
(boot-parameters-kernel-arguments
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 06/15] gnu: bootloader: Add raspberry pi bootloader.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (4 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
` (9 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Efraim Flashner,
Lilah Tascheter, Vagrant Cascadian
Less adding and more making it an actual bootloader rather than some
weirdly specified packages.
* gnu/bootloader/u-boot.scm (rpi-config, install-rpi): New procedures.
(define-u-bootloader-rpi): New macro.
(u-boot-rpi-2-bootloader, u-boot-rpi-3-bootloader,
u-boot-rpi-4-bootloader, u-boot-rpi-bootloader): New variables.
* gnu/packages/bootloaders.scm (make-u-boot-bin-package): Delete
procedure.
(%u-boot-rpi-efi-description, %u-boot-rpi-efi-description-32-bit,
u-boot-rpi-2-efi, u-boot-rpi-3-32b-efi, u-boot-rpi-4-32b-efi,
u-boot-rpi-arm64-efi, u-boot-rpi-2-bin, u-boot-rpi-3_32b-bin,
u-boot-rpi-4_32b-bin, u-boot-rpi-arm64-bin, u-boot-rpi-2-efi-bin,
u-boot-rpi-3-32b-efi-bin, u-boot-rpi-4-32b-efi-bin,
u-boot-rpi-arm64-efi-bin): Delete variables.
Change-Id: I5139a0b00ec89189e8e7c84e06a7a3b7240259cd
---
gnu/bootloader/u-boot.scm | 66 ++++++++++++++++++++++++-
gnu/packages/bootloaders.scm | 94 +++---------------------------------
2 files changed, 71 insertions(+), 89 deletions(-)
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 7d3e202f8c..e8dfe9b3a2 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -28,7 +28,10 @@ (define-module (gnu bootloader u-boot)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages raspberry-pi)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix utils)
#:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
@@ -51,7 +54,11 @@ (define-module (gnu bootloader u-boot)
u-boot-qemu-riscv64-bootloader
u-boot-starfive-visionfive2-bootloader
u-boot-ts7970-q-2g-1000mhz-c-bootloader
- u-boot-wandboard-bootloader))
+ u-boot-wandboard-bootloader
+ u-boot-rpi-2-bootloader
+ u-boot-rpi-3-bootloader
+ u-boot-rpi-4-bootloader
+ u-boot-rpi-bootloader))
(define (make-install-u-boot firmware installers)
(lambda* (#:key bootloader-config #:allow-other-keys . args)
@@ -222,3 +229,60 @@ (define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
u-boot-qemu-riscv64 "u-boot.bin")
+
+\f
+;;;
+;;; RasPi bootloader definitions.
+;;;
+
+(define (rpi-config 32?)
+ ;; allows a user-specified custom.txt
+ (plain-file "config.txt"
+ (format #f
+ "arm_64bit=~a~%enable_uart=1~%kernel=u-boot.bin~%include custom.txt~%"
+ (if (or 32? (not (target-64bit?))) "0" "1"))))
+
+(define (install-rpi u-boot-32 u-boot-64)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('install (apply install-extlinux-config args))
+ (('firmware => (firmware :path))
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (use-32? (or 32? (not (target-64bit?)) (not u-boot-64))))
+ #~(begin
+ (atomic-copy #$(file-append (if use-32? u-boot-32 u-boot-64)
+ "/libexec/u-boot.bin")
+ (string-append #$firmware "/u-boot.bin"))
+ (atomic-copy #$(rpi-config use-32?)
+ (string-append #$firmware "/config.txt"))))))))
+
+(define-syntax-rule (define-u-bootloader-rpi def-name u-boot-32 u-boot-64)
+ (define def-name
+ (bootloader (name 'u-boot)
+ (default-targets
+ (list (bootloader-target (type 'install)
+ (offset 'firmware)
+ (path "extlinux"))
+ (bootloader-target (type 'firmware)
+ (offset 'root)
+ (path "boot"))))
+ (installer (install-rpi u-boot-32 u-boot-64)))))
+
+
+;; These neither install firmware nor device-tree files for the Raspberry Pi.
+;; They just assume them to be existing in 'install in the same way that some
+;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
+;; They can be used with either extlinux or as UEFI firmware (alongside, eg,
+;; GRUB).
+(define-u-bootloader-rpi u-boot-rpi-2-bootloader
+ u-boot-rpi-2 #f)
+
+(define-u-bootloader-rpi u-boot-rpi-3-bootloader
+ u-boot-rpi-3-32b u-boot-rpi-arm64)
+
+(define-u-bootloader-rpi u-boot-rpi-4-bootloader
+ u-boot-rpi-4-32b u-boot-rpi-arm64)
+
+;; Usable for any 64-bit raspberry pi.
+(define-u-bootloader-rpi u-boot-rpi-bootloader
+ #f u-boot-rpi-arm64)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 12f918a123..e78602379d 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -1409,40 +1409,8 @@ (define-public u-boot-pinebook-pro-rk3399
(modify-inputs (package-inputs base)
(append arm-trusted-firmware-rk3399))))))
-(define*-public (make-u-boot-bin-package u-boot-package
- #:key
- (u-boot-bin "u-boot.bin"))
- "Return a package with a single U-BOOT-BIN file from the U-BOOT-PACKAGE.
-The package name will be that of the U-BOOT package suffixed with \"-bin\"."
- (package
- (name (string-append (package-name u-boot-package) "-bin"))
- (version (package-version u-boot-package))
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (list
- #:builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils))
- (mkdir #$output)
- (symlink (search-input-file %build-inputs
- (string-append "libexec/" #$u-boot-bin))
- (string-append #$output "/" #$u-boot-bin))))))
- (inputs (list u-boot-package))
- (home-page (package-home-page u-boot-package))
- (synopsis (package-synopsis u-boot-package))
- (description (string-append
- (package-description u-boot-package)
- "\n\n"
- (format #f
- "This package only contains the file ~a."
- u-boot-bin)))
- (license (package-license u-boot-package))))
-
-(define-public %u-boot-rpi-efi-configs
- '("CONFIG_OF_EMBED"
- "CONFIG_OF_BOARD=y"))
+;; get dtbs from firmware to support dtoverlays
+(define-public %u-boot-rpi-configs '("CONFIG_OF_EMBED" "CONFIG_OF_BOARD=y"))
(define %u-boot-rpi-description-32-bit
"This is a 32-bit build of U-Boot.")
@@ -1451,76 +1419,26 @@ (define %u-boot-rpi-description-64-bit
"This is a common 64-bit build of U-Boot for all 64-bit capable Raspberry Pi
variants.")
-(define %u-boot-rpi-efi-description
- "It allows network booting and uses the device-tree from the firmware,
-allowing the usage of overlays. It can act as an EFI firmware for the
-grub-efi-netboot-removable-bootloader.")
-
-(define %u-boot-rpi-efi-description-32-bit
- (string-append %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-32-bit))
-
(define-public u-boot-rpi-2
(make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-3-32b
(make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-4-32b
(make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-arm64
(make-u-boot-package "rpi_arm64" "aarch64-linux-gnu"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-64-bit))
-(define-public u-boot-rpi-2-efi
- (make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-3-32b-efi
- (make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-4-32b-efi
- (make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-arm64-efi
- (make-u-boot-package "rpi_arm64""aarch64-linux-gnu"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description (string-append
- %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-64-bit)))
-
-(define-public u-boot-rpi-2-bin (make-u-boot-bin-package u-boot-rpi-2))
-
-(define-public u-boot-rpi-3_32b-bin (make-u-boot-bin-package u-boot-rpi-3-32b))
-
-(define-public u-boot-rpi-4_32b-bin (make-u-boot-bin-package u-boot-rpi-4-32b))
-
-(define-public u-boot-rpi-arm64-bin (make-u-boot-bin-package u-boot-rpi-arm64))
-
-(define-public u-boot-rpi-2-efi-bin (make-u-boot-bin-package u-boot-rpi-2-efi))
-
-(define-public u-boot-rpi-3-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-3-32b-efi))
-
-(define-public u-boot-rpi-4-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-4-32b-efi))
-
-(define-public u-boot-rpi-arm64-efi-bin
- (make-u-boot-bin-package u-boot-rpi-arm64-efi))
-
(define u-boot-ts-mx6
;; There is no release; use the latest commit of the
;; 'imx_v2015.04_3.14.52_1.1.0_ga' branch.
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 07/15] gnu: system: Fix bootloader crypto device recognition.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (5 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
` (8 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
* gnu/system.scm (operating-system-bootloader-crypto-devices): Check for
luks-device-mapping-with-options in addition to luks-device-mapping.
Change-Id: Iafc9afe608640b97083c4d559c9240846330472a
---
gnu/system.scm | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 66c1a80733..093c8fa350 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -400,10 +400,12 @@ (define operating-system-bootloader-crypto-devices
(mlambdaq (os) ;to avoid duplicated output
"Return the sources of the LUKS mapped devices specified by UUID."
;; XXX: Device ordering is important, we trust the returned one.
- (let* ((luks-devices (filter (lambda (m)
- (eq? luks-device-mapping
- (mapped-device-type m)))
- (operating-system-boot-mapped-devices os)))
+ ;; Check against the close-luks-device procedure to get both maptypes
+ (let* ((close (mapped-device-kind-close luks-device-mapping))
+ (luks? (lambda (m) (let ((t (mapped-device-type m)))
+ (eq? (mapped-device-kind-close t) close))))
+ (luks-devices (filter luks?
+ (operating-system-boot-mapped-devices os)))
(uuid-crypto-devices non-uuid-crypto-devices
(partition (compose uuid? mapped-device-source)
luks-devices)))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 08/15] gnu: packages: Add pesign.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (6 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
` (7 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
* gnu/packages/efi.scm (pesign): New variable.
Change-Id: I00fcc679d9514c85d508183b9ec7e121e0a814db
---
gnu/packages/efi.scm | 47 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 47 insertions(+)
diff --git a/gnu/packages/efi.scm b/gnu/packages/efi.scm
index 499745eba1..417b70d91b 100644
--- a/gnu/packages/efi.scm
+++ b/gnu/packages/efi.scm
@@ -24,8 +24,10 @@ (define-module (gnu packages efi)
#:use-module (gnu packages bash)
#:use-module (gnu packages linux)
#:use-module (gnu packages man)
+ #:use-module (gnu packages nss)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages popt)
#:use-module (gnu packages tls)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
@@ -153,6 +155,51 @@ (define-public sbsigntools
(home-page "https://git.kernel.org/pub/scm/linux/kernel/git/jejb/sbsigntools.git/")
(license license:gpl3+)))
+(define-public pesign
+ (package
+ (name "pesign")
+ (version "116")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/rhboot/pesign")
+ (commit version)))
+ (snippet #~(substitute* "Make.defaults"
+ (("pkg-config-ccldflags") "pkg-config-ldflags")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "0fnqfiivj46bha4hsnwiqy8vq8b4i3w2dig0h9h2k4j7yq7r5qvj"))))
+ (build-system gnu-build-system)
+ (arguments
+ (list #:tests? #f
+ #:modules '((guix build gnu-build-system)
+ (guix build utils)
+ (ice-9 match))
+ #:phases #~(modify-phases %standard-phases (delete 'configure))
+ #:make-flags
+ (let ((system (%current-system)) (target (%current-target-system)))
+ (define (arch s) (match (string-split s #\-)
+ (("i386" _ ...) "ia32")
+ (("i486" _ ...) "ia32")
+ (("i586" _ ...) "ia32")
+ (("i686" _ ...) "ia32")
+ ((x _ ...) x)))
+ #~(list "prefix=/" "libdir=/lib/"
+ (string-append "DESTDIR=" #$output)
+ (string-append "HOSTARCH=" #$(arch system))
+ (string-append "ARCH=" #$(arch (or target system)))
+ (string-append "CROSS_COMPILE="
+ #$@(if target (list target "-gcc") '()))))))
+ (inputs (list efivar nspr nss popt `(,util-linux "lib")))
+ (native-inputs (list mandoc pkg-config))
+ (synopsis "PE-COFF binary signing tools")
+ (description "Supports EFI keygen and subsequent signing of PE-COFF
+binaries. Contains the tools authvar, efikeygen, pesigcheck, pesign,
+pesign-client, and pesum.")
+ (home-page "https://github.com/rhboot/pesign")
+ (license license:gpl2+)))
+
(define-public efitools
(package
(name "efitools")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 09/15] gnu: packages: Add ukify.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (7 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
` (6 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov, Efraim Flashner,
Vagrant Cascadian
* gnu/packages/bootloaders.scm
(systemd-version,systemd-source,ukify): New variables.
Change-Id: Icde59b7266529c8002331ff0375e0a35af3a2add
---
gnu/packages/bootloaders.scm | 54 ++++++++++++++++++++++++++++++++++++
1 file changed, 54 insertions(+)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index e78602379d..04bb1b06f0 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -20,6 +20,7 @@
;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Herman Rimm <herman@rimm.ee>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,6 +48,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages disk)
+ #:use-module (gnu packages efi)
#:use-module (gnu packages firmware)
#:use-module (gnu packages flex)
#:use-module (gnu packages fontutils)
@@ -73,11 +75,13 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages valgrind)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages xorg)
+ #:use-module (gnu packages python-crypto)
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz)
#:use-module (guix build-system gnu)
#:use-module (guix build-system meson)
#:use-module (guix build-system pyproject)
+ #:use-module (guix build-system python)
#:use-module (guix build-system trivial)
#:use-module (guix download)
#:use-module (guix gexp)
@@ -573,6 +577,56 @@ (define-public syslinux
;; Also contains:
license:expat license:isc license:zlib)))))
+(define systemd-version "255")
+(define systemd-source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/systemd/systemd")
+ (commit (string-append "v" systemd-version))))
+ (file-name (git-file-name "systemd" systemd-version))
+ (snippet #~(substitute* "src/ukify/ukify.py" ; remove after python 3.11
+ (("datetime\\.UTC") "datetime.timezone.utc")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+
+(define-public ukify
+ (package
+ (name "ukify")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system python-build-system)
+ (arguments
+ (list #:phases
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key inputs #:allow-other-keys)
+ (define (get-tool tool)
+ (search-input-file inputs (string-append "bin/" tool)))
+
+ (substitute* "src/ukify/ukify.py" ; hardcode tool paths
+ (("(find_tool\\(')(readelf|sbsign|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',"))
+ (("('name': ')(sbverify|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',")))))
+ (delete 'check)
+ (replace 'install
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let* ((bin (string-append #$output "/bin"))
+ (file (string-append bin "/ukify")))
+ (mkdir-p bin)
+ (copy-file "src/ukify/ukify.py" file)))))))
+ (inputs
+ (list binutils pesign python-cryptography python-pefile sbsigntools))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI tool")
+ (description "@command{ukify} joins together a UKI stub, linux kernel, initrd,
+kernel arguments, and optional secure boot signatures into a single, UEFI-bootable
+image.")
+ (license license:lgpl2.1+)))
+
(define-public dtc
(package
(name "dtc")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 10/15] gnu: packages: Add systemd-stub.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (8 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
` (5 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Efraim Flashner,
Lilah Tascheter, Vagrant Cascadian
* gnu/bootloader.scm (%efi-supported-systems, lazy-efibootmgr): New variable.
(install-efi): Use lazy-efibootmgr.
* gnu/packages/bootloaders.scm (systemd-stub): New variable.
Change-Id: I974bad9ff7a52f736286d05de53f7c5ccb60b9d6
---
gnu/bootloader.scm | 13 +++++++++--
gnu/packages/bootloaders.scm | 43 ++++++++++++++++++++++++++++++++++++
2 files changed, 54 insertions(+), 2 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index f855671e82..6d1ecd9f00 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -28,7 +28,6 @@ (define-module (gnu bootloader)
#:autoload (gnu build file-systems)
(read-partition-label read-partition-uuid
find-partition-by-label find-partition-by-uuid)
- #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:autoload (guix build syscalls)
@@ -115,6 +114,7 @@ (define-module (gnu bootloader)
bootloader-configuration->gexp
bootloader-configurations->gexp
+ %efi-supported-systems
efi-arch
install-efi))
@@ -647,6 +647,11 @@ (define (bootloader-configurations->gexp bootloader-configs . rest)
;;; EFI shit
;;;
+;; systems currently supported by efi-arch. should be used for packages relying
+;; on it.
+(define %efi-supported-systems
+ '("i686-linux" "x86_64-linux" "armhf-linux" "aarch64-linux" "riscv64-linux"))
+
(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
(32? #f))
"Returns the UEFI architecture name for the current target, in lowercase."
@@ -658,6 +663,10 @@ (define* (efi-arch #:key (target (or (%current-target-system) (%current-system))
(else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
target)))))
+(define (lazy-efibootmgr)
+ "Lazy-loaded efibootmgr package, in order to prevent circular refs."
+ (module-ref (resolve-interface '(gnu packages linux)) 'efibootmgr))
+
(define (install-efi bootloader-config plan)
"Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
@@ -680,5 +689,5 @@ (define (install-efi bootloader-config plan)
;; normal install when not doing a removable config
(with-targets targets
(('vendir => (vendir :path) (loader :devpath) (disk :device))
- #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #~(install-efi #+(file-append (lazy-efibootmgr) "/sbin/efibootmgr")
#$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 04bb1b06f0..2bc04059d2 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -38,6 +38,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages bootloaders)
+ #:use-module (gnu bootloader)
#:use-module (gnu packages)
#:use-module (gnu packages assembly)
#:use-module (gnu packages base)
@@ -54,6 +55,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gcc)
#:use-module (gnu packages gettext)
+ #:use-module (gnu packages gperf)
#:use-module (gnu packages linux)
#:use-module (gnu packages llvm)
#:use-module (gnu packages man)
@@ -592,6 +594,47 @@ (define systemd-source
(base32
"1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+(define-public systemd-stub
+ (package
+ (name "systemd-stub")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system meson-build-system)
+ (arguments
+ (list #:configure-flags
+ #~(list "-Dmode=release" "-Defi=true" "-Dsbat-distro=guix"
+ "-Dsbat-distro-generation=1" ; package revision!
+ "-Dsbat-distro-summary=Guix System"
+ "-Dsbat-distro-url=https://guix.gnu.org"
+ #$(string-append "-Dsbat-distro-pkgname="
+ (package-name this-package))
+ #$(string-append "-Dsbat-distro-version="
+ (package-version this-package)))
+ #:phases
+ ;; TODO: 32bit support
+ (let* ((stub (string-append
+ "src/boot/efi/linux" (efi-arch) ".efi.stub")))
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key parallel-build? #:allow-other-keys)
+ (invoke "ninja" #$stub
+ "-j" (if parallel-build?
+ (number->string (parallel-job-count)) "1"))))
+ (replace 'install
+ (lambda _
+ (let ((libexec (string-append #$output "/libexec")))
+ (install-file #$stub libexec))))
+ (delete 'check)))))
+ (supported-systems %efi-supported-systems)
+ (inputs (list libcap python-pyelftools `(,util-linux "lib")))
+ (native-inputs (list gperf pkg-config python-3 python-jinja2))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI stub")
+ (description "Simple UEFI boot stub that loads a conjoined kernel image and
+supporting data to their proper locations, before chainloading to the kernel.
+Supports measured and/or verified boot environments.")
+ (license license:lgpl2.1+)))
+
(define-public ukify
(package
(name "ukify")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 11/15] gnu: bootloaders: Add uki-efi-bootloader.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (9 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
` (4 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov, Lilah Tascheter
* gnu/bootloader.scm (<bootloader-configuration>): New keypair field.
* gnu/bootloader/uki.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add bootloader/uki.scm.
Change-Id: I2097da9f3dd35137b3419f6d0545de26d53cb6da
---
gnu/bootloader.scm | 3 ++
gnu/bootloader/uki.scm | 96 ++++++++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 100 insertions(+)
create mode 100644 gnu/bootloader/uki.scm
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 6d1ecd9f00..b8116339ab 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -101,6 +101,7 @@ (define-module (gnu bootloader)
bootloader-configuration-default-entry
bootloader-configuration-efi-removable?
bootloader-configuration-32bit?
+ bootloader-configuration-keypair
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -524,6 +525,8 @@ (define-record-type* <bootloader-configuration>
(default #f)) ;bool
(32bit? bootloader-configuration-32bit?
(default #f)) ;bool
+ (keypair bootloader-configuration-keypair
+ (default #f)) ;(cert . priv) pair
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
diff --git a/gnu/bootloader/uki.scm b/gnu/bootloader/uki.scm
new file mode 100644
index 0000000000..4871dbe037
--- /dev/null
+++ b/gnu/bootloader/uki.scm
@@ -0,0 +1,96 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; 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 bootloader uki)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages efi)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu system boot)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:export (uki-efi-bootloader))
+
+;; TODO: support 32bit/mixed-mode UEFI.
+;; https://github.com/systemd/systemd/issues/17056 may be relevant
+(define bootcfg->menu-entry->builder
+ (match-record-lambda <bootloader-configuration> (32bit? theme keypair)
+ (match-record-lambda <menu-entry>
+ (label linux linux-arguments initrd chain-loader)
+ ;; support chainloader in order to allow arbitrary signed EFI binaries
+ (cond
+ ((and chain-loader keypair)
+ #~(lambda (dest)
+ (invoke/quiet #+(sbsigntools "/bin/sbsign")
+ "--cert" #$(car keypair) "--key" #$(cdr keypair)
+ "--output" dest #$chain-loader)
+ (invoke/quiet #+(sbsigntools "/bin/sbverify")
+ "--cert" #$(car keypair) dest)))
+ (chain-loader #~(lambda (dest) (copy-file #$chain-loader dest)))
+ (linux
+ (let* ((arch (efi-arch #:32? 32bit?))
+ (stub (file-append systemd-stub
+ "/libexec/linux" arch ".efi.stub")))
+ #~(lambda (dest)
+ (invoke/quiet #+(file-append ukify "/bin/ukify")
+ "build" "--output" dest
+ "--linux" #$linux "--initrd" #$initrd
+ "--cmdline" (string-join (list #$@linux-arguments))
+ "--os-release" #$label "--stub" #$stub "--efi-arch" #$arch
+ #$@(if theme #~("--splash" #$theme) '())
+ #$@(if keypair #~("--secureboot-certificate" #$(car keypair)
+ "--secureboot-private-key" #$(cdr keypair))
+ '())))))
+ (else (leave (G_ "uki-efi-bootloader doesn't support multiboot")))))))
+
+;; we cannot use guix's build system to make UKI images for two reasons:
+;; 1. signing is necessarily non-reproducable, especially since keys should not
+;; be in the store, or else risk being publically accessible.
+;; 2. menu-entries may reference files which do not exist in the store.
+(define* (install-uki #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ (define* (menu-entry->plan entry num #:optional (prefix "menu-entry"))
+ #~(cons* #$((bootcfg->menu-entry->builder bootloader-config) entry)
+ #$(string-append prefix "-" (number->string num) ".efi")
+ #$(menu-entry-label entry)))
+
+ (define (boot-alternative->plan alt)
+ (menu-entry->plan (boot-alternative->menu-entry alt)
+ (boot-alternative-generation alt)
+ "generation"))
+
+ (install-efi bootloader-config
+ (let ((entries (bootloader-configuration-menu-entries bootloader-config)))
+ #~(list #$(boot-alternative->plan current-boot-alternative)
+ #$@(map menu-entry->plan entries (iota (length entries)))
+ #$@(map boot-alternative->plan old-boot-alternatives)))))
+
+
+
+(define uki-efi-bootloader
+ (bootloader
+ (name 'uki-efi)
+ (default-targets (list (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+ (installer install-uki)))
diff --git a/gnu/local.mk b/gnu/local.mk
index 8375e13709..32ed753ee2 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -93,6 +93,7 @@ GNU_SYSTEM_MODULES = \
%D%/bootloader/extlinux.scm \
%D%/bootloader/u-boot.scm \
%D%/bootloader/depthcharge.scm \
+ %D%/bootloader/uki.scm \
%D%/ci.scm \
%D%/compression.scm \
%D%/home.scm \
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 12/15] gnu: system: Update examples.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (10 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:31 ` [bug#72457] [PATCH v3 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
` (3 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Florian Pelz, Ludovic Court??s,
Matthew Trzcinski, Maxim Cournoyer
* gnu/system/examples/asus-c201.tmpl (bootloader): Use new depthcharge
bootloader name scheme and update to new target system.
* gnu/system/examples/bare-bones.tmpl (bootloader),
gnu/system/examples/bare-hurd.tmpl (bootloader),
gnu/system/examples/beaglebone-black.tmpl (bootloader),
gnu/system/examples/desktop.tmpl (bootloader),
gnu/system/examples/lightweight-desktop.tmpl (bootloader),
gnu/system/examples/plasma.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64-nfs-root.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64.tmpl (bootloader): Use new target system.
* gnu/system/examples/docker-image.tmpl (bootloader): Delete.
* gnu/system/examples/vm-image.tmpl (bootloader): Use auto image target.
Change-Id: I3675f17ae9cd94cff99328762600fb4e491bc9f2
---
gnu/system/examples/asus-c201.tmpl | 6 +++--
gnu/system/examples/bare-bones.tmpl | 7 ++++--
gnu/system/examples/bare-hurd.tmpl | 4 +++-
gnu/system/examples/beaglebone-black.tmpl | 6 +++--
gnu/system/examples/desktop.tmpl | 4 +++-
gnu/system/examples/docker-image.tmpl | 6 ++---
gnu/system/examples/lightweight-desktop.tmpl | 4 +++-
gnu/system/examples/plasma.tmpl | 4 +++-
.../examples/raspberry-pi-64-nfs-root.tmpl | 23 ++++++++++++-------
gnu/system/examples/raspberry-pi-64.tmpl | 18 ++++++++-------
gnu/system/examples/vm-image.tmpl | 5 ++--
11 files changed, 54 insertions(+), 33 deletions(-)
diff --git a/gnu/system/examples/asus-c201.tmpl b/gnu/system/examples/asus-c201.tmpl
index 019111c167..eec185eebf 100644
--- a/gnu/system/examples/asus-c201.tmpl
+++ b/gnu/system/examples/asus-c201.tmpl
@@ -14,8 +14,10 @@
;; Assuming /dev/mmcblk0p1 is the kernel partition, and
;; "my-root" is the label of the target root file system.
(bootloader (bootloader-configuration
- (bootloader depthcharge-bootloader)
- (targets '("/dev/mmcblk0p1"))))
+ (bootloader depthcharge-veyron-speedy-bootloader)
+ (targets (list (bootloader-target
+ (type 'part)
+ (device "/dev/mmcblk0p1"))))))
;; The ASUS C201PA requires a very particular kernel to boot,
;; as well as the following arguments.
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index 7b6a4b09b0..9eed05f2e0 100644
--- a/gnu/system/examples/bare-bones.tmpl
+++ b/gnu/system/examples/bare-bones.tmpl
@@ -13,10 +13,13 @@
;; Boot in "legacy" BIOS mode, assuming /dev/sdX is the
;; target hard disk, and "my-root" is the label of the target
- ;; root file system.
+ ;; root file system. If you're just building an image, the
+ ;; 'targets' field may be omitted.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
;; It's fitting to support the equally bare bones ‘-nographic’
;; QEMU option, which also nicely sidesteps forcing QWERTY.
(kernel-arguments (list "console=ttyS0,115200"))
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 463c7ee798..8dd700cd9d 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -32,7 +32,9 @@
(inherit %hurd-default-operating-system)
(bootloader (bootloader-configuration
(bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl
index 18bbb2723c..99963ef2fe 100644
--- a/gnu/system/examples/beaglebone-black.tmpl
+++ b/gnu/system/examples/beaglebone-black.tmpl
@@ -11,11 +11,13 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
- ;; Assuming /dev/mmcblk1 is the eMMC, and "my-root" is
+ ;; Assuming /dev/mmcblk1 is the eMMC. and "my-root" is
;; the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader u-boot-beaglebone-black-bootloader)
- (targets '("/dev/mmcblk1"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/mmcblk1"))))))
;; This module is required to mount the SD card.
(initrd-modules (cons "omap_hsmmc" %base-initrd-modules))
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index 2d65f22294..30dbdeea31 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -20,7 +20,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout)))
;; Specify a mapped device for the encrypted root partition.
diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl
index 7123917af4..6d3114a0bc 100644
--- a/gnu/system/examples/docker-image.tmpl
+++ b/gnu/system/examples/docker-image.tmpl
@@ -9,6 +9,8 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
+ ;; Bootloader can be left blank!
+
;; This is where user accounts are specified. The "root" account is
;; implicit, and is initially created with the empty password.
(users (cons (user-account
@@ -34,10 +36,6 @@
;; similar services for us.
;; This will be ignored.
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("does-not-matter"))))
- ;; This will be ignored, too.
(file-systems (list (file-system
(device "does-not-matter")
(mount-point "/")
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index c061284ba8..0964238cb0 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -17,7 +17,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))
;; Assume the target root file system is labelled "my-root",
;; and the EFI System Partition has UUID 1234-ABCD.
diff --git a/gnu/system/examples/plasma.tmpl b/gnu/system/examples/plasma.tmpl
index c3850ffe37..a81916ffe9 100644
--- a/gnu/system/examples/plasma.tmpl
+++ b/gnu/system/examples/plasma.tmpl
@@ -15,7 +15,9 @@
;; is the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device "my-root")
diff --git a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
index 1baca02491..85476854f3 100644
--- a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
+++ b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
@@ -25,14 +25,21 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi")))))
+ (bootloader-configuration
+ (bootloader grub-efi-bootloader)
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel-arguments '("ip=dhcp"))
(kernel (customize-linux #:linux linux-libre-arm64-generic
#:extra-version "arm64-generic-netboot"
diff --git a/gnu/system/examples/raspberry-pi-64.tmpl b/gnu/system/examples/raspberry-pi-64.tmpl
index 414d8ac7a5..d5b90b9705 100644
--- a/gnu/system/examples/raspberry-pi-64.tmpl
+++ b/gnu/system/examples/raspberry-pi-64.tmpl
@@ -24,14 +24,16 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel (customize-linux #:linux linux-libre-arm64-generic
;; It is possible to use a specific defconfig
;; file, for example the "bcmrpi3_defconfig" with
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index 589de493b1..050c0bb971 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -38,11 +38,10 @@ accounts.\x1b[0m
(firmware '())
- ;; Below we assume /dev/vda is the VM's hard disk.
- ;; Adjust as needed.
+ ;; Images automatically get the 'root, 'esp, and 'disk targets configured as
+ ;; needed.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 13/15] doc: Update bootloader documentation.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (11 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
@ 2024-08-04 20:31 ` Lilah Tascheter via Guix-patches
2024-08-04 20:32 ` [bug#72457] [PATCH v3 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
` (2 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:31 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Florian Pelz, Ludovic Court??s,
Matthew Trzcinski, Maxim Cournoyer
* doc/guix.texi
(Manual Installation)[Proceeding with the Installation]: Offload
target reference.
(System Installation)[Building the Installation Image]: Use beaglebone
as the example, and don't reference deleted variables.
(System Configuration)[Using the Configuration System]: Update
example.
[operating-system Reference]<bootloader>: Can use multiple
bootloaders.
[Keyboard Layout]: Update example.
[Bootloader Configuration]<bootloader>: Update documentation for all
bootloaders, and add new ones. Document new fields efi-removable?,
32bit?, and keypair. Update terminal-outputs and terminal-outputs to
not be GRUB-specific.
<bootloader-target>: New record.
<menu-entry>: Remove now-unsupported GRUB specifics in linux. Move
device documentation and add some for device-mount-point and
device-subvol. Fix typo in multiboot-arguments. Document chain-loader
for arbitrary bootloaders.
[Invoking guix system]<switch-generation>: Bootloaders are now
reinstalled.
<image> Other bootloaders may be used.
[Invoking guix deploy]: Update template.
(Creating System Images)[image Reference]<partition Reference>: Add
target field.
[Instantiate an Image]: Update examples and update formatting.
<efi32-disk-image, efi32-raw-image-type>: Delete.
[image-type Reference]<pinebook-pro-image-type, rock64-image-type>:
Reword slightly.
Change-Id: I45ac9d5ad3cb491c693e9a4b2f0b44b527478ee7
---
doc/guix.texi | 458 +++++++++++++++++++++++++++++---------------------
1 file changed, 262 insertions(+), 196 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 41814042f5..b5f35a9066 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2516,12 +2516,9 @@ Proceeding with the Installation
Make sure the @code{bootloader-configuration} form refers to the targets
you want to install GRUB on. It should mention @code{grub-bootloader}
if you are installing GRUB in the legacy way, or
-@code{grub-efi-bootloader} for newer UEFI systems. For legacy systems,
-the @code{targets} field contain the names of the devices, like
-@code{(list "/dev/sda")}; for UEFI systems it names the paths to mounted
-EFI partitions, like @code{(list "/boot/efi")}; do make sure the paths
-are currently mounted and a @code{file-system} entry is specified in
-your configuration.
+@code{grub-efi-bootloader} for newer UEFI systems.
+@xref{Bootloader Configuration} for information on how to format the
+@code{targets} field.
@item
Be sure that your file system labels match the value of their respective
@@ -2653,11 +2650,13 @@ Building the Installation Image
includes the bootloader, specifically:
@example
-guix system image --system=armhf-linux -e '((@@ (gnu system install) os-with-u-boot) (@@ (gnu system install) installation-os) "A20-OLinuXino-Lime2")'
+guix system image --system=armhf-linux -e '(@ (gnu system install) beaglebone-black-installation-os)'
@end example
-@code{A20-OLinuXino-Lime2} is the name of the board. If you specify an invalid
-board, a list of possible boards will be printed.
+@code{beaglebone-black} is the name of the board. Similar
+@code{installation-os} variables exist for most other supported boards.
+Otherwise, you can use @code{embedded-installation-os}, passing it a u-boot
+bootloader and the desired console tty.
@c *********************************************************************
@@ -17229,7 +17228,9 @@ Using the Configuration System
@lisp
(bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi")))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi")))))
@end lisp
@xref{Bootloader Configuration}, for more information on the available
@@ -17535,8 +17536,10 @@ operating-system Reference
List of strings or gexps representing additional arguments to pass on
the command-line of the kernel---e.g., @code{("console=ttyS0")}.
-@item @code{bootloader}
-The system bootloader configuration object. @xref{Bootloader Configuration}.
+@item @code{bootloader} (default: '())
+The system bootloader configuration object. Can either be a single
+@code{bootloader-configuration} or a list of them, to install multiple or no
+bootloaders. @xref{Bootloader Configuration}.
@item @code{label}
This is the label (a string) as it appears in the bootloader's menu entry.
@@ -18731,7 +18734,9 @@ Keyboard Layout
(keyboard-layout (keyboard-layout "tr")) ;for the console
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout))) ;for GRUB
(services (cons (set-xorg-configuration
(xorg-configuration ;for Xorg
@@ -42119,132 +42124,124 @@ Bootloader Configuration
@cindex EFI, bootloader
@cindex UEFI, bootloader
@cindex BIOS, bootloader
-The bootloader to use, as a @code{bootloader} object. For now
-@code{grub-bootloader}, @code{grub-efi-bootloader},
-@code{grub-efi-removable-bootloader}, @code{grub-efi-netboot-bootloader},
-@code{grub-efi-netboot-removable-bootloader}, @code{extlinux-bootloader}
-and @code{u-boot-bootloader} are supported.
+The bootloader to use, as a @code{bootloader} object. Available bootloaders, in
+addition to what target types they require, are as follows:
-@cindex ARM, bootloaders
-@cindex AArch64, bootloaders
-Available bootloaders are described in @code{(gnu bootloader @dots{})}
-modules. In particular, @code{(gnu bootloader u-boot)} contains definitions
-of bootloaders for a wide range of ARM and AArch64 systems, using the
-@uref{https://www.denx.de/wiki/U-Boot/, U-Boot bootloader}.
+@itemize
+@vindex depthcharge-veyron-speedy-bootloader
+@item @code{depthcharge-veyron-speedy-bootloader}
+For the Asus C201. Requires a @code{'part} target, denoting the partition to
+install the kernel blob as a @code{device}, @code{label}, or @code{uuid}.
@vindex grub-bootloader
-@code{grub-bootloader} allows you to boot in particular Intel-based machines
-in ``legacy'' BIOS mode.
+@item @code{grub-bootloader}
+GRUB2 for BIOS systems. Requires a @code{'disk} target providing either a
+@code{device}, @code{label}, or @code{uuid}. If root is mounted over NFS, it
+will load its files and the Guix System over
+@acronym{PXE, Preboot eXecution Environment}.
+
+@vindex grub-minimal-bootloader
+@item @code{grub-minimal-bootloader}
+As above, but using a minimal build of GRUB.
@vindex grub-efi-bootloader
-@code{grub-efi-bootloader} allows to boot on modern systems using the
-@dfn{Unified Extensible Firmware Interface} (UEFI). This is what you should
-use if the installation image contains a @file{/sys/firmware/efi} directory
-when you boot it on your system.
-
-@vindex grub-efi-removable-bootloader
-@code{grub-efi-removable-bootloader} allows you to boot your system from
-removable media by writing the GRUB file to the UEFI-specification location of
-@file{/EFI/BOOT/BOOTX64.efi} of the boot directory, usually @file{/boot/efi}.
-This is also useful for some UEFI firmwares that ``forget'' their configuration
-from their non-volatile storage. Like @code{grub-efi-bootloader}, this can only
-be used if the @file{/sys/firmware/efi} directory is available.
+@item @code{grub-efi-bootloader}
+GRUB2 for "modern" systems using the @dfn{Unified Extensible Firmware Interface}
+(UEFI). Requires an @code{'esp} target providing a @code{path} to the mount
+point of the EFI System Partition. If root is mounted over NFS, it will load
+its files and the Guix System over a
+@acronym{TFTP, Trivial File Transfer Protocol} server as configured over
+@acronym{DHCP, Dynamic Host Configuration Protocol} as per PXE.
+
+@vindex extlinux-bootloader
+@item @code{extlinux-bootloader}
+Extlinux for "legacy" BIOS systems. Requires a @code{'disk} target providing
+either a @code{device}, @code{label}, or @code{uuid}.
+
+@vindex extlinux-gpt-bootloader
+@item @code{extlinux-gpt-bootloader}
+As above, but for systems using the GPT instead of MBR partition table.
+
+@cindex Secure Boot, UEFI
+@vindex uki-efi-bootloader
+@item @code{uki-efi-bootloader}
+Makes and installs UKI images for UEFI systems. Requires an @code{'esp} target
+providing a @code{path} to the mount point of the EFI System Partition. Not all
+system generations may be available with this option, as UKI images contain the
+entire kernel and initramfs, and ESPs tend to be small.
+
+Full disk encryption with @code{uki-efi-bootloader} only requires a single
+password entry with fast decryption, in contrast to GRUB2 requiring a second
+password entry with slow, LUKS1-only decryption.
+
+This is the only bootloader to currently support UEFI secure boot, when
+configured as below.
-@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
-@end quotation
+@cindex ARM, bootloaders
+@cindex AArch64, bootloaders
+@vindex u-boot-a20-olinuxino-lime-bootloader
+@vindex u-boot-a20-olinuxino-lime2-bootloader
+@vindex u-boot-a20-olinuxino-micro-bootloader
+@vindex u-boot-bananapi-m2-ultra-bootloader
+@vindex u-boot-beaglebone-black-bootloader
+@vindex u-boot-cubietruck-bootloader
+@vindex u-boot-firefly-rk3399-bootloader
+@vindex u-boot-mx6cuboxi-bootloader
+@vindex u-boot-nintendo-nes-classic-edition-bootloader
+@vindex u-boot-novena-bootloader
+@vindex u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+@vindex u-boot-pine64-plus-bootloader
+@vindex u-boot-pine64-lts-bootloader
+@vindex u-boot-pinebook-bootloader
+@vindex u-boot-pinebook-pro-rk3399-bootloader
+@vindex u-boot-puma-rk3399-bootloader
+@vindex u-boot-rock64-rk3328-bootloader
+@vindex u-boot-rockpro64-rk3399-bootloader
+@vindex u-boot-sifive-unmatched-bootloader
+@vindex u-boot-qemu-riscv64-bootloader
+@vindex u-boot-starfive-visionfive2-bootloader
+@vindex u-boot-ts7970-q-2g-1000mhz-c-bootloader
+@vindex u-boot-wandboard-bootloader
+@vindex u-boot-rpi-2-bootloader
+@vindex u-boot-rpi-3-bootloader
+@vindex u-boot-rpi-4-bootloader
+@vindex u-boot-rpi-bootloader
+@item U-Boot
+U-Boot has individual bootloaders @code{u-boot-board-bootloader} for each
+of the following @code{board}s: @code{a20-olinuxino-lime},
+@code{a20-olinuxino-lime2}, @code{a20-olinuxino-micro},
+@code{bananapi-m2-ultra}, @code{beaglebone-black}, @code{cubietruck},
+@code{firefly-rk3399}, @code{mx6cuboxi}, @code{nintendo-nes-classic-edition},
+@code{novena}, @code{orangepi-r1-plus-lts-rk3328}, @code{pine64-plus},
+@code{pine64-lts}, @code{pinebook}, @code{pinebook-pro-rk3399},
+@code{puma-rk3399}, @code{rock64-rk3328}, @code{rockpro64-rk3399},
+@code{rpi-2}, @code{rpi-3}, @code{rpi-4}, @code{rpi}, @code{sifive-unmatched},
+@code{ts7970-q-2g-1000mhz-c}, @code{qemu-riscv64}, and @code{wandboard}.
+
+Each of these requires a @code{'disk} target providing either a @code{device},
+@code{label}, or @code{uuid}, except for @code{ts7970-q-2g-1000mhz-c} and
+@code{qemu-riscv64}, in which the bootloader just copies U-Boot to
+@file{/boot/u-boot.imx} or @file{/boot/u-boot.bin}, respectively. You should
+then manually flash it to the SPI flash at the U-Boot prompt.
+
+By default Guix configures U-Boot to boot using a generated extlinux config, but
+U-Boot does support loading UEFI bootloaders, if you want to combine it with
+another.
+@end itemize
-@vindex grub-efi-netboot-bootloader
-@code{grub-efi-netboot-bootloader} allows you to boot your system over network
-through TFTP@. In combination with an NFS root file system this allows you to
-build a diskless Guix system.
-
-The installation of the @code{grub-efi-netboot-bootloader} generates the
-content of the TFTP root directory at @code{targets} (@pxref{Bootloader
-Configuration, @code{targets}}) below the sub-directory @file{efi/Guix}, to be
-served by a TFTP server. You may want to mount your TFTP server directories
-onto the @code{targets} to move the required files to the TFTP server
-automatically during installation.
-
-If you plan to use an NFS root file system as well (actually if you mount the
-store from an NFS share), then the TFTP server needs to serve the file
-@file{/boot/grub/grub.cfg} and other files from the store (like GRUBs background
-image, the kernel (@pxref{operating-system Reference, @code{kernel}}) and the
-initrd (@pxref{operating-system Reference, @code{initrd}})), too. All these
-files from the store will be accessed by GRUB through TFTP with their normal
-store path, for example as
-@file{tftp://tftp-server/gnu/store/…-initrd/initrd.cpio.gz}.
-
-Two symlinks are created to make this possible. For each target in the
-@code{targets} field, the first symlink is
-@samp{target}@file{/efi/Guix/boot/grub/grub.cfg} pointing to
-@file{../../../boot/grub/grub.cfg}, where @samp{target} may be
-@file{/boot}. In this case the link is not leaving the served TFTP root
-directory, but otherwise it does. The second link is
-@samp{target}@file{/gnu/store} and points to @file{../gnu/store}. This
-link is leaving the served TFTP root directory.
-
-The assumption behind all this is that you have an NFS server exporting
-the root file system for your Guix system, and additionally a TFTP
-server exporting your @code{targets} directories—usually a single
-@file{/boot}—from that same root file system for your Guix system. In
-this constellation the symlinks will work.
-
-For other constellations you will have to program your own bootloader
-installer, which then takes care to make necessary files from the store
-accessible through TFTP, for example by copying them into the TFTP root
-directory for your @code{targets}.
-
-It is important to note that symlinks pointing outside the TFTP root directory
-may need to be allowed in the configuration of your TFTP server. Further the
-store link exposes the whole store through TFTP@. Both points need to be
-considered carefully for security aspects. It is advised to disable any TFTP
-write access!
-
-Please note, that this bootloader will not modify the ‘UEFI Boot Manager’ of
-the system.
-
-Beside the @code{grub-efi-netboot-bootloader}, the already mentioned TFTP and
-NFS servers, you also need a properly configured DHCP server to make the booting
-over netboot possible. For all this we can currently only recommend you to look
-for instructions about @acronym{PXE, Preboot eXecution Environment}.
-
-If a local EFI System Partition (ESP) or a similar partition with a FAT
-file system is mounted in @code{targets}, then symlinks cannot be
-created. In this case everything will be prepared for booting from
-local storage, matching the behavior of @code{grub-efi-bootloader}, with
-the difference that all GRUB binaries are copied to @code{targets},
-necessary for booting over the network.
-
-@vindex grub-efi-netboot-removable-bootloader
-@code{grub-efi-netboot-removable-bootloader} is identical to
-@code{grub-efi-netboot-bootloader} with the exception that the
-sub-directory @file{efi/boot} will be used instead of @file{efi/Guix} to
-comply with the UEFI specification for removable media.
+@item @code{targets}
+This is a list of @code{bootloader-target} (see below) structures denoting
+where the bootloader should install itself. Interpretation of specific target
+types and target requirements depend on the specific @code{bootloader} used.
@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
+Bootloaders have a set of default targets, that can interact with user-specified
+targets. For UEFI bootloaders using the @code{'esp} target, this typically
+includes a @code{'vendir} target. If you configure multiple UEFI bootloaders,
+you should set different @code{'vendir} target @code{path}s for each, each
+@code{offset} from @code{'esp}.
@end quotation
-@item @code{targets}
-This is a list of strings denoting the targets onto which to install the
-bootloader.
-
-The interpretation of targets depends on the bootloader in question.
-For @code{grub-bootloader}, for example, they should be device names
-understood by the bootloader @command{installer} command, such as
-@code{/dev/sda} or @code{(hd0)} (@pxref{Invoking grub-install,,, grub,
-GNU GRUB Manual}). For @code{grub-efi-bootloader} and
-@code{grub-efi-removable-bootloader} they should be mount
-points of the EFI file system, usually @file{/boot/efi}. For
-@code{grub-efi-netboot-bootloader}, @code{targets} should be the mount
-points corresponding to TFTP root directories served by your TFTP
-server.
-
@item @code{menu-entries} (default: @code{'()})
A possibly empty list of @code{menu-entry} objects (see below), denoting
entries to appear in the bootloader menu, in addition to the current
@@ -42254,6 +42251,29 @@ Bootloader Configuration
The index of the default boot menu entry. Index 0 is for the entry of the
current system.
+@item @code{efi-removable?} (default: @var{#f})
+Used by all UEFI bootloaders to determine whether they should be installed to
+the UEFI standard fallback bootloader path (on x86_64,
+@file{/EFI/BOOT/BOOTX64.EFI}). This allows it to be booted from removable media
+or otherwise in cases where the system has not been booted from UEFI already.
+
+@quotation Warning
+This will override any other bootloaders installed to the same path!
+@end quotation
+
+@item @code{32bit?} (default: @var{#f})
+Some 64-bit systems require their bootloaders to be 32-bit, including some early
+UEFI systems and some Raspberry Pis. If that is the case, and the bootloader
+supports it, setting this option will force the bootloader to install as if it
+were on a 32-bit system.
+
+@item @code{keypair} (default: @var{#f})
+Designates a keypair to be used by bootloaders that support some kind of
+cryptographic signature, such as UEFI Secure Boot. This must be a pair
+@code{'(cert . priv)} of paths to the public key (@code{cert}) and private key
+(@code{priv}). The keys these paths point to should be owned by root with 600
+permissions for security purposes.
+
@item @code{timeout} (default: @code{5})
The number of seconds to wait for keyboard input before booting. Set to
0 to boot immediately, and to -1 to wait indefinitely.
@@ -42276,19 +42296,20 @@ Bootloader Configuration
is provided, some bootloaders might use a default theme, that's true
for GRUB.
-@item @code{terminal-outputs} (default: @code{'(gfxterm)})
+@item @code{terminal-outputs} (default: @var{#f})
The output terminals used for the bootloader boot menu, as a list of
-symbols. GRUB accepts the values: @code{console}, @code{serial},
-@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text},
-@code{mda_text}, @code{morse}, and @code{pkmodem}. This field
-corresponds to the GRUB variable @code{GRUB_TERMINAL_OUTPUT} (@pxref{Simple
-configuration,,, grub,GNU GRUB manual}).
-
-@item @code{terminal-inputs} (default: @code{'()})
+symbols. When @var{#f}, the default is used. For GRUB this is @code{gfxterm}.
+GRUB accepts the values: @code{console}, @code{serial}, @code{serial_@{0-3@}},
+@code{gfxterm}, @code{vga_text}, @code{mda_text}, @code{morse}, and
+@code{pkmodem}. This field corresponds to the GRUB variable
+@code{GRUB_TERMINAL_OUTPUT}
+(@pxref{Simple configuration,,, grub,GNU GRUB manual}).
+
+@item @code{terminal-inputs} (default: @var{#f})
The input terminals used for the bootloader boot menu, as a list of
-symbols. For GRUB, the default is the native platform terminal as
-determined at run-time. GRUB accepts the values: @code{console},
-@code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
+symbols. When @var{#f}, the default is used. For GRUB, this is the native
+platform terminal as determined at run-time. GRUB accepts the values:
+@code{console}, @code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
@code{usb_keyboard}. This field corresponds to the GRUB variable
@code{GRUB_TERMINAL_INPUT} (@pxref{Simple configuration,,, grub,GNU GRUB
manual}).
@@ -42364,6 +42385,53 @@ Bootloader Configuration
@end deftp
+@vindex bootloader-target
+Configuring bootloader targets uses a specialized record designed for clarity
+and to abstract the varying user-supplied paths bootloaders may need. Only the
+@code{type} field is required; Guix will attempt to extrapolate as needed from
+what information you provide, though at least one of @code{path}, @code{device},
+@code{label}, or @code{uuid} is required to do so.
+
+@deftp {Data Type} bootloader-target
+The type of a target as used in @code{bootloader-configuration}.
+
+@table @asis
+
+@item @code{type}
+What target this record is describing. Must be a symbol, for example @code{'esp}
+or @code{'disk}.
+
+@item @code{path} (default: @var{#f})
+@code{path} denotes a string path, usually interpreted by the bootloader to
+signify a mount point (such as in the case of @code{'esp}). This value is
+automatically offset from the target denoted by @code{offset}, even if the path
+given is absolute. This allows for bootloaders to know what device or partition
+a @code{path} is actually stored on, and how to locate it.
+
+@item @code{offset} (default: @code{'root} when @code{path}, otherwise @var{#f})
+All @code{path} values, even if absolute, are automatically offset from another.
+@code{offset} is a symbol denoting which target type the path should be offset
+from. This allows for bootloaders to know what device or partition a
+@code{path} is actually stored on, and how to locate it.
+
+For most setups, you don't need to deal with this.
+
+@item @code{device} (default: @var{#f})
+@itemx @code{label} (default: @var{#f})
+@itemx @code{uuid} (default: @var{#f})
+These all work as a way of defining some kind of physical device or partition.
+@code{uuid} (taking a @code{uuid} record) and @code{label} (taking a string) are
+vastly preferred over device (a string denoting a filesystem path to a block
+device), as block device names are inconsistant and unrecognized at boot-time.
+
+@item @code{file-system} (default: @var{#f})
+A string denoting a file system type, as used in @ref{File Systems}. Unless
+your filesystem isn't being detected properly, or is unmounted at bootloader
+install-time, you shouldn't need to specify this.
+
+@end table
+@end deftp
+
@cindex dual boot
@cindex boot menu
Should you want to list additional boot menu entries @i{via} the
@@ -42375,6 +42443,8 @@ Bootloader Configuration
@lisp
(menu-entry
(label "The Other Distro")
+ (device (file-system-label "boot"))
+ (device-mount-point "/boot")
(linux "/boot/old/vmlinux-2.6.32")
(linux-arguments '("root=/dev/sda2"))
(initrd "/boot/old/initrd"))
@@ -42390,6 +42460,28 @@ Bootloader Configuration
@item @code{label}
The label to show in the menu---e.g., @code{"GNU"}.
+@item @code{device} (default: @var{#f})
+The device where any files specified below are to be found--eg, for GRUB,
+@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
+
+This may be a file system label (a string), a file system UUID (a
+bytevector, @pxref{File Systems}), or @code{#f}, in which case
+the bootloader will search the device containing the file specified by
+the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
+must @emph{not} be an OS device name such as @file{/dev/sda1}.
+
+@item @code{device-mount-point} (default: @var{#f})
+This is where @code{device} is mounted onto your file system. If provided, it
+allows for you to specify full paths for provided files, which will be
+automatically realized into paths local to their device.
+
+This is not necessary if specified files are already referring to files local to
+@code{device}, including if they're on your root filesystem.
+
+@item @code{device-subvol} (default: @var{#f})
+This is a btrfs subvolume name, useful in case you wish to access files from a
+btrfs subvolume on a device. @xref{Btrfs file system}.
+
@item @code{linux} (default: @code{#f})
The Linux kernel image to boot, for example:
@@ -42397,17 +42489,6 @@ Bootloader Configuration
(file-append linux-libre "/bzImage")
@end lisp
-For GRUB, it is also possible to specify a device explicitly in the
-file path using GRUB's device naming convention (@pxref{Naming
-convention,,, grub, GNU GRUB manual}), for example:
-
-@example
-"(hd0,msdos1)/boot/vmlinuz"
-@end example
-
-If the device is specified explicitly as above, then the @code{device}
-field is ignored entirely.
-
@item @code{linux-arguments} (default: @code{'()})
The list of extra Linux kernel command-line arguments---e.g.,
@code{'("console=ttyS0")}.
@@ -42416,16 +42497,6 @@ Bootloader Configuration
A G-Expression or string denoting the file name of the initial RAM disk
to use (@pxref{G-Expressions}).
-@item @code{device} (default: @code{#f})
-The device where the kernel and initrd are to be found---i.e., for GRUB,
-@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
-
-This may be a file system label (a string), a file system UUID (a
-bytevector, @pxref{File Systems}), or @code{#f}, in which case
-the bootloader will search the device containing the file specified by
-the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
-must @emph{not} be an OS device name such as @file{/dev/sda1}.
-
@item @code{multiboot-kernel} (default: @code{#f})
The kernel to boot in Multiboot-mode (@pxref{multiboot,,, grub, GNU GRUB
manual}). When this field is set, a Multiboot menu-entry is generated.
@@ -42448,7 +42519,7 @@ Bootloader Configuration
To use the new and still experimental
@uref{https://darnassus.sceen.net/~hurd-web/rump_kernel/, rumpdisk
user-level disk driver} instead of GNU@tie{}Mach's in-kernel IDE driver,
-set @code{kernel-arguments} to:
+set @code{multiboot-arguments} to:
@lisp
'("noide")
@@ -42471,10 +42542,11 @@ Bootloader Configuration
@end lisp
@item @code{chain-loader} (default: @code{#f})
-A string that can be accepted by @code{grub}'s @code{chainloader}
-directive. This has no effect if either @code{linux} or
-@code{multiboot-kernel} fields are specified. The following is an
-example of chainloading a different GNU/Linux system.
+Varies slightly depending on bootloader. For @code{grub}, this is anything that
+the @code{chainloader} directive can accept
+(@pxref{Chain-loading,,, grub, GNU GRUB manual}). For @code{uki-efi}, this is
+any efi binary to be installed alongside the system. The following is an example
+of chainloading a different GNU/Linux system.
@lisp
(bootloader
@@ -42682,10 +42754,6 @@ Invoking guix system
supported by the bootloader being used. The next time the system
boots, it will use the specified system generation.
-The bootloader itself is not being reinstalled when using this
-command. Thus, the installed bootloader is used with an updated
-configuration file.
-
The target generation can be specified explicitly by its generation
number. For example, the following invocation would switch to system
generation 7:
@@ -42706,11 +42774,10 @@ Invoking guix system
@end example
Currently, the effect of invoking this action is @emph{only} to switch
-the system profile to an existing generation and rearrange the
-bootloader menu entries. To actually start using the target system
-generation, you must reboot after running this action. In the future,
-it will be updated to do the same things as @command{reconfigure},
-like activating and deactivating services.
+the system profile to an existing generation and reinstall the bootloader. To
+actually start using the target system generation, you must reboot after
+running this action. In the future, it will be updated to do the same things
+as @command{reconfigure}, like activating and deactivating services.
This action will fail if the specified generation does not exist.
@@ -42886,11 +42953,9 @@ Invoking guix system
When using the @code{qcow2} image type, the returned image is in qcow2
format, which the QEMU emulator can efficiently use. @xref{Running Guix
in a VM}, for more information on how to run the image in a virtual
-machine. The @code{grub-bootloader} bootloader is always used
-independently of what is declared in the @code{operating-system} file
-passed as argument. This is to make it easier to work with QEMU, which
-uses the SeaBIOS BIOS by default, expecting a bootloader to be installed
-in the Master Boot Record (MBR).
+machine. Currently, QEMU as packaged in Guix does not have UEFI support,
+so you should select a bootloader for BIOS systems in your
+@code{operating-system} configuration.
@cindex docker-image, creating docker images
When using the @code{docker} image type, a Docker image is produced.
@@ -43208,7 +43273,6 @@ Invoking guix deploy
;; forwarded to the host's loopback interface.
(use-service-modules networking ssh)
-(use-package-modules bootloaders)
(define %system
(operating-system
@@ -43216,7 +43280,9 @@ Invoking guix deploy
(timezone "Etc/UTC")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sda"))))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
@@ -47800,6 +47866,12 @@ partition Reference
this flag set, usually the root one. The @code{'esp} flag identifies a
UEFI System Partition.
+@item @code{target} (default: @var{#f})
+If provided, this partition provides itself as a bootloader target
+(@pxref{Bootloader Configuration}). Most commonly, this is used to provide the
+@code{'root} and @code{'esp} targets, with the root partition and EFI System
+Partition, respectively, though this can provide any target necessary.
+
@item @code{initializer} (default: @code{#false})
The partition initializer procedure as a gexp. This procedure is called
to populate a partition. If no initializer is passed, the
@@ -47848,6 +47920,7 @@ Instantiate an Image
(label "GNU-ESP")
(file-system "vfat")
(flags '(esp))
+ (target 'esp)
(initializer (gexp initialize-efi-partition)))
(partition
(size (* 50 MiB))
@@ -47864,14 +47937,15 @@ Instantiate an Image
(label root-label)
(file-system "ext4")
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))))
@end lisp
-Note that the first and third partitions use generic initializers
-procedures, initialize-efi-partition and initialize-root-partition
-respectively. The initialize-efi-partition installs a GRUB EFI loader
-that is loading the GRUB bootloader located in the root partition. The
-initialize-root-partition instantiates a complete system as defined by
+Note that the first and third partitions use generic initializer
+procedures, @code{initialize-efi-partition} and @code{initialize-root-partition}
+respectively. @code{initialize-efi-partition} simply creates the directory
+structure for an EFI bootloader to install itself to.
+@code{initialize-root-partition} instantiates a complete system as defined by
the @code{%simple-os} operating-system.
You can now run:
@@ -47929,10 +48003,6 @@ Instantiate an Image
@code{i686} machines, supporting BIOS or UEFI booting.
@end defvar
-@defvar efi32-disk-image
-Same as @code{efi-disk-image} but with a 32 bits EFI partition.
-@end defvar
-
@defvar iso9660-image
An ISO-9660 image composed of a single bootable partition. This image
can also be used on most @code{x86_64} and @code{i686} machines.
@@ -48023,10 +48093,6 @@ image-type Reference
Build an image based on the @code{efi-disk-image} image.
@end defvar
-@defvar efi32-raw-image-type
-Build an image based on the @code{efi32-disk-image} image.
-@end defvar
-
@defvar qcow2-image-type
Build an image based on the @code{mbr-disk-image} image but with the
@code{compressed-qcow2} image format.
@@ -48054,14 +48120,14 @@ image-type Reference
@defvar pinebook-pro-image-type
Build an image that is targeting the Pinebook Pro machine. The MBR
image contains a single partition starting at a @code{9MiB} offset. The
-@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader will be
+@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader can be
installed in this gap.
@end defvar
@defvar rock64-image-type
Build an image that is targeting the Rock64 machine. The MBR image
contains a single partition starting at a @code{16MiB} offset. The
-@code{u-boot-rock64-rk3328-bootloader} bootloader will be installed in
+@code{u-boot-rock64-rk3328-bootloader} bootloader can be installed in
this gap.
@end defvar
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 14/15] gnu: tests: Update tests to new targets system.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (12 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
@ 2024-08-04 20:32 ` Lilah Tascheter via Guix-patches
2024-08-04 20:32 ` [bug#72457] [PATCH v3 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
2024-08-05 7:00 ` [bug#72457] [PATCH v3 00/15] Rewrite bootloader subsystem Sergey Trofimov
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:32 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov, Maxim Cournoyer
* gnu/services/virtualization.scm
(%virtual-build-machine-operating-system): Remove bootloader.
(%hurd-vm-operating-system): Remove targets.
* gnu/system/hurd.scm (%hurd-default-operating-system): Remove targets.
* gnu/tests.scm (%simple-os), gnu/tests/ganeti.scm (%ganeti-os),
gnu/tests/image.scm (%simple-efi-os),
gnu/tests/install.scm (%minimal-os, %minimal-extlinux-os,
%minimal-os-on-vda, %separate-home-os, %separate-store-os, %raid-root-os,
%encrypted-root-os, %lvm-separate-home-os, %encrypted-home-os,
%encrypted-home-os-key-file, %encrypted-root-not-boot-os,
%btrfs-root-os-source, %btrfs-raid-root-os-source,
%btrfs-root-on-subvolume-os, %btrfs-raid10-root-os, %jfs-root-os,
%f2fs-root-os, %xfs-root-os), gnu/tests/nfs.scm (%base-os),
gnu/tests/telephony.scm (make-jami-os), gnu/tests/vnc.scm (%xvnc-os):
Update bootloader targets.
Change-Id: I3d66a839a9b2a73b8b65946950728b1e0155ca1e
---
gnu/services/virtualization.scm | 11 ++---
gnu/system/hurd.scm | 4 +-
gnu/tests.scm | 4 +-
gnu/tests/ganeti.scm | 4 +-
gnu/tests/image.scm | 4 +-
gnu/tests/install.scm | 72 ++++++++++++++++++++++++---------
gnu/tests/nfs.scm | 4 +-
gnu/tests/telephony.scm | 4 +-
gnu/tests/vnc.scm | 4 +-
tests/boot-parameters.scm | 2 +-
10 files changed, 77 insertions(+), 36 deletions(-)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index d87e494348..f698532a94 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1191,17 +1191,13 @@ (define %minimal-vm-syslog-config
(define %virtual-build-machine-operating-system
(operating-system
(host-name "build-machine")
-
(locale "en_US.utf8")
(locale-definitions
;; Save space by providing only one locale.
(list (locale-definition (name "en_US.utf8")
(source "en_US")
(charset "UTF-8"))))
-
- (bootloader (bootloader-configuration ;unused
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/null"))))
+ ;; no bootloader
(file-systems (cons (file-system ;unused
(mount-point "/")
(device "none")
@@ -1624,9 +1620,8 @@ (define %hurd-vm-operating-system
(host-name "childhurd")
(timezone "Europe/Amsterdam")
(bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))
- (timeout 0)))
+ (bootloader grub-minimal-bootloader)
+ (timeout 0)))
(packages (cons* gdb-minimal
(operating-system-packages
%hurd-default-operating-system)))
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index cbe0081382..af04e82485 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -119,9 +119,7 @@ (define %hurd-default-operating-system
(kernel %hurd-default-operating-system-kernel)
(kernel-arguments '())
(hurd hurd)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(initrd #f)
(initrd-modules '())
(firmware '())
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 5ff9db82fc..f46ccf5174 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -237,7 +237,9 @@ (define %simple-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device"/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
index 29eb354044..789879b26f 100644
--- a/gnu/tests/ganeti.scm
+++ b/gnu/tests/ganeti.scm
@@ -40,7 +40,9 @@ (define %ganeti-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/image.scm b/gnu/tests/image.scm
index be6852cae0..8d960cf7b8 100644
--- a/gnu/tests/image.scm
+++ b/gnu/tests/image.scm
@@ -55,7 +55,9 @@ (define %simple-efi-os
(inherit %simple-os)
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))))
;; An MBR disk image with a single ext4 partition.
(define i1
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 18a2fc119b..d67a71f12e 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -103,7 +103,9 @@ (define-os-with-source (%minimal-os %minimal-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -141,7 +143,9 @@ (define-os-with-source (%minimal-extlinux-os
(bootloader (bootloader-configuration
(bootloader extlinux-gpt-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -434,7 +438,9 @@ (define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -510,7 +516,9 @@ (define-os-with-source (%separate-home-os %separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "my-root"))
@@ -565,7 +573,9 @@ (define-os-with-source (%separate-store-os %separate-store-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "root-fs"))
@@ -642,7 +652,9 @@ (define-os-with-source (%raid-root-os %raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
;; Add a kernel module for RAID-1 (aka. "mirror").
@@ -725,7 +737,9 @@ (define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -858,7 +872,9 @@ (define-os-with-source (%lvm-separate-home-os %lvm-separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(mapped-devices (list (mapped-device
@@ -943,7 +959,9 @@ (define-os-with-source (%encrypted-home-os %encrypted-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -1070,7 +1088,9 @@ (define-os-with-source (%encrypted-home-os-key-file
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))
(extra-initrd "/key-file.cpio")))
(kernel-arguments '("console=ttyS0"))
@@ -1130,7 +1150,9 @@ (define-os-with-source (%encrypted-root-not-boot-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(mapped-devices (list (mapped-device
(source
@@ -1232,7 +1254,9 @@ (define-os-with-source (%btrfs-root-os %btrfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1306,7 +1330,9 @@ (define-os-with-source (%btrfs-raid-root-os %btrfs-raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1374,7 +1400,9 @@ (define-os-with-source (%btrfs-root-on-subvolume-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "btrfs-pool"))
@@ -1467,7 +1495,9 @@ (define-os-with-source (%btrfs-raid10-root-os
(bootloader (map (lambda (targ)
(bootloader-configuration
(bootloader grub-bootloader)
- (targets (list targ))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device targ))))))
'("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
@@ -1577,7 +1607,9 @@ (define-os-with-source (%jfs-root-os %jfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1650,7 +1682,9 @@ (define-os-with-source (%f2fs-root-os %f2fs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1723,7 +1757,9 @@ (define-os-with-source (%xfs-root-os %xfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 0d9972e0e9..2f97126df7 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -51,7 +51,9 @@ (define %base-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems %base-file-systems)
(users %base-user-accounts)
(packages (cons*
diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index f03ea963f7..ee858d9c91 100644
--- a/gnu/tests/telephony.scm
+++ b/gnu/tests/telephony.scm
@@ -90,7 +90,9 @@ (define* (make-jami-os #:key provisioning? partial?)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/vnc.scm b/gnu/tests/vnc.scm
index ab1c2749f3..cba9c565e0 100644
--- a/gnu/tests/vnc.scm
+++ b/gnu/tests/vnc.scm
@@ -51,7 +51,9 @@ (define %xvnc-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index f214de360d..f343dbdfdb 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -63,7 +63,7 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
- (bootloader-name 'grub)
+ (bootloader-name '(grub))
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 15/15] teams: Add bootloading team.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (13 preceding siblings ...)
2024-08-04 20:32 ` [bug#72457] [PATCH v3 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
@ 2024-08-04 20:32 ` Lilah Tascheter via Guix-patches
2024-08-05 7:00 ` [bug#72457] [PATCH v3 00/15] Rewrite bootloader subsystem Sergey Trofimov
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-04 20:32 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
Might as well, to help ease the transition.
* etc/teams.scm (bootloaders): New team.
(Lilah Tascheter): Create add to above.
Change-Id: I63620f4e3151bb8e3d0bdf619fc70501af6397a0
---
etc/teams.scm | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/etc/teams.scm b/etc/teams.scm
index 408ebbf3d9..d9af4ad7bb 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -328,6 +328,12 @@ (define-team embedded
#:scope (list "gnu/packages/bootloaders.scm"
"gnu/packages/firmware.scm")))
+(define-team bootloaders
+ (team 'bootloaders
+ #:name "Bootloaders"
+ #:scope (list "gnu/bootloader.scm"
+ (make-regexp* "^gnu/bootloader/"))))
+
(define-team rust
(team 'rust
#:name "Rust"
@@ -746,6 +752,10 @@ (define-member (person "Nicolas Goaziou"
"guix@nicolasgoaziou.fr")
tex)
+(define-member (person "Lilah Tascheter"
+ "lilah@lunabee.space")
+ bootloaders)
+
\f
(define (find-team name)
(or (hash-ref %teams (string->symbol name))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v3 00/15] Rewrite bootloader subsystem.
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
` (14 preceding siblings ...)
2024-08-04 20:32 ` [bug#72457] [PATCH v3 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
@ 2024-08-05 7:00 ` Sergey Trofimov
15 siblings, 0 replies; 95+ messages in thread
From: Sergey Trofimov @ 2024-08-05 7:00 UTC (permalink / raw)
To: Lilah Tascheter; +Cc: 72457
Hi Lilah,
On Sun, 4 Aug 2024 at 22:33, Lilah Tascheter <lilah@lunabee.space> wrote:
>
> Goddamnit, alright, how's this?
Unfortunately it still doesn't work. Here is my debug session:
Error:
--8<---------------cut here---------------start------------->8---
In srfi/srfi-1.scm:
586:17 8 (map1 (#f #<<uuid> type: fat bv: #vu8(77 160 163 107)>
#<<uuid> type: dce bv: #vu8(246 188 138 216 255 26 23 84 83 48 172 24
246 188 138 216)> #<<uuid> type: fat bv: #vu8(77 160 163 107)>))
In ice-9/eval.scm:
293:34 7 (_ #(#(#(#(#(#(#<directory (gnu bootloader)
7f49dbce61e0>) #f (#f #<<uuid> type: fat bv: #vu8(77 160 163 107)>
#<<uuid> type: dce bv: #vu8(246 188 138 216 255 26 23 84 83 48 172 24
246 188 138 216)> #<<uuid> type: fat bv: #vu8(77 160 163 107)>))
#<procedure up (a)>) (#f)) (#f #f)) #<procedure offset (a)>))
191:35 6 (_ #(#(#(#(#(#(#<directory (gnu bootloader)
7f49dbce61e0>) #f (#f #<<uuid> type: fat bv: #vu8(77 160 163 107)>
#<<uuid> type: dce bv: #vu8(246 188 138 216 255 26 23 84 83 48 172 24
246 188 138 216)> #<<uuid> type: fat bv: #vu8(77 160 163 107)>))
#<procedure up (a)>) (#f)) (#f #f)) #<procedure offset (a)>))
163:9 5 (_ #(#(#(#(#(#(#<directory (gnu bootloader)
7f49dbce61e0>) #f (#f #<<uuid> type: fat bv: #vu8(77 160 163 107)>
#<<uuid> type: dce bv: #vu8(246 188 138 216 255 26 23 84 83 48 172 24
246 188 138 216)> #<<uuid> type: fat bv: #vu8(77 160 163 107)>))
#<procedure up (a)>) (#f)) (#f #f)) #<procedure offset (a)>))
In srfi/srfi-1.scm:
586:17 4 (map1 (#f))
In ice-9/eval.scm:
263:9 3 (_ #(#(#<directory (gnu bootloader) 7f49dbce61e0>) #f))
155:9 2 (_ _)
In ice-9/boot-9.scm:
1685:16 1 (raise-exception _ #:continuable? _)
1685:16 0 (raise-exception _ #:continuable? _)
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
In procedure struct-vtable: Wrong type argument in position 1
(expecting struct): #f
--8<---------------cut here---------------end--------------->8---
Trying to debug it in REPL:
--8<---------------cut here---------------start------------->8---
,m (gnu bootloader)
,use (gnu bootloader grub)
(bootloader-configuration->gexp
(bootloader-configuration
(bootloader grub-efi-bootloader)
(targets (list (bootloader-target (type 'esp) (path "/boot"))))) '())
--8<---------------cut here---------------end--------------->8---
List of targets passed to normalize:
--8<---------------cut here---------------start------------->8---
#<<bootloader-target> type: vendir expected?: #f path: "EFI/Guix"
offset: #<procedure offset (a)> device: #f file-system: #f label: #f
uuid: #f>
#<<bootloader-target> type: install expected?: #f path: "boot" offset:
#<procedure offset (a)> device: #f file-system: #f label: #f uuid: #f>
#<<bootloader-target> type: root expected?: #f path: "/" offset:
#<procedure offset (x)> device: #f file-system: #f label: #f uuid: #f>
#<<bootloader-target> type: esp expected?: #f path: "/boot" offset:
#<procedure feb5818 at <unknown port>:132:19 (x)> device: #f
file-system: #f label: #f uuid: #f>)
--8<---------------cut here---------------end--------------->8---
(mounts):
--8<---------------cut here---------------start------------->8---
#<<mount> devno: 21 source: "none" point: "/proc" type: "proc"
options: "rw,relatime">
#<<mount> devno: 6 source: "none" point: "/dev" type: "devtmpfs"
options: "rw,relatime">
#<<mount> devno: 22 source: "none" point: "/sys" type: "sysfs"
options: "rw,relatime">
#<<mount> devno: 2050 source: "/dev/sda2" point: "/" type: "ext4"
options: "rw,relatime">
#<<mount> devno: 2049 source: "/dev/sda1" point: "/boot" type: "vfat"
options: "rw,relatime">
#<<mount> devno: 24 source: "none" point: "/dev/pts" type: "devpts"
options: "rw,relatime">
#<<mount> devno: 8 source: "none" point: "/sys/kernel/debug" type:
"debugfs" options: "rw,relatime">
#<<mount> devno: 25 source: "tmpfs" point: "/dev/shm" type: "tmpfs"
options: "rw,nosuid,nodev,relatime">
#<<mount> devno: 26 source: "efivarfs" point:
"/sys/firmware/efi/efivars" type: "efivarfs" options: "rw,relatime">
#<<mount> devno: 2050 source: "/dev/sda2" point: "/gnu/store" type:
"ext4" options: "ro,noatime">
#<<mount> devno: 27 source: "none" point: "/run/systemd" type: "tmpfs"
options: "rw,nosuid,nodev,noexec,relatime">
#<<mount> devno: 28 source: "none" point: "/run/user" type: "tmpfs"
options: "rw,nosuid,nodev,noexec,relatime">
#<<mount> devno: 29 source: "none" point: "/sys/fs/cgroup" type:
"cgroup2" options: "rw,relatime">
#<<mount> devno: 30 source: "cgroup" point: "/sys/fs/cgroup/elogind"
type: "cgroup" options: "rw,relatime">
#<<mount> devno: 31 source: "tmpfs" point: "/run/user/1000" type:
"tmpfs" options: "rw,nosuid,nodev,relatime">
#<<mount> devno: 33 source: "portal" point: "/run/user/1000/doc" type:
"fuse.portal" options: "rw,nosuid,nodev,relatime">
--8<---------------cut here---------------end--------------->8---
(disk-partitions): ("sda" "sda1" "sda2")
labels: sda1: GNU-ESP sda2: Guix_image
uuids:
--8<---------------cut here---------------start------------->8---
(read-partition-uuid "/dev/sda2")
#vu8(246 188 138 216 255 26 23 84 83 48 172 24 246 188 138 216)
(read-partition-uuid "/dev/sda1")
#vu8(77 160 163 107)
--8<---------------cut here---------------end--------------->8---
It seems that device couldn't be guessed for the vendir target, as
(unfold-pathcat) returns a path (/boot/EFI/Guix) that is not in
(mounts).
^ permalink raw reply [flat|nested] 95+ messages in thread
* [bug#72457] [PATCH v4 00/15] Rewrite bootloader subsystem.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (17 preceding siblings ...)
2024-08-04 20:31 ` [bug#72457] [PATCH v3 " Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
` (15 more replies)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (2 subsequent siblings)
21 siblings, 16 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
Fourth time's the charm. Thanks so much for your help!
Lilah Tascheter (15):
guix: scripts: Rewrite reinstall-bootloader to use provenance data.
gnu: Add bootloader target infastructure.
guix: scripts: Remove unused code.
gnu: Core bootloader changes.
gnu: system: Remove useless boot parameters.
gnu: bootloader: Add raspberry pi bootloader.
gnu: system: Fix bootloader crypto device recognition.
gnu: packages: Add pesign.
gnu: packages: Add ukify.
gnu: packages: Add systemd-stub.
gnu: bootloaders: Add uki-efi-bootloader.
gnu: system: Update examples.
doc: Update bootloader documentation.
gnu: tests: Update tests to new targets system.
teams: Add bootloading team.
doc/guix.texi | 458 +++---
etc/teams.scm | 10 +
gnu/bootloader.scm | 665 ++++++---
gnu/bootloader/depthcharge.scm | 153 +-
gnu/bootloader/extlinux.scm | 149 +-
gnu/bootloader/grub.scm | 1279 +++++++----------
gnu/bootloader/u-boot.scm | 505 +++----
gnu/bootloader/uki.scm | 96 ++
gnu/build/bootloader.scm | 157 +-
gnu/build/image.scm | 40 +-
gnu/build/install.scm | 16 +-
gnu/image.scm | 3 +
gnu/installer/parted.scm | 12 +-
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 71 +-
gnu/packages/bootloaders.scm | 277 ++--
gnu/packages/efi.scm | 47 +
gnu/packages/raspberry-pi.scm | 18 -
gnu/services/virtualization.scm | 11 +-
gnu/system.scm | 62 +-
gnu/system/boot.scm | 16 +-
gnu/system/examples/asus-c201.tmpl | 6 +-
gnu/system/examples/bare-bones.tmpl | 7 +-
gnu/system/examples/bare-hurd.tmpl | 4 +-
gnu/system/examples/beaglebone-black.tmpl | 6 +-
gnu/system/examples/desktop.tmpl | 4 +-
gnu/system/examples/docker-image.tmpl | 6 +-
gnu/system/examples/lightweight-desktop.tmpl | 4 +-
gnu/system/examples/plasma.tmpl | 4 +-
.../examples/raspberry-pi-64-nfs-root.tmpl | 23 +-
gnu/system/examples/raspberry-pi-64.tmpl | 18 +-
gnu/system/examples/vm-image.tmpl | 5 +-
gnu/system/hurd.scm | 4 +-
gnu/system/image.scm | 162 ++-
gnu/system/images/hurd.scm | 4 +-
gnu/system/images/novena.scm | 3 +-
.../images/orangepi-r1-plus-lts-rk3328.scm | 3 +-
gnu/system/images/pine64.scm | 3 +-
gnu/system/images/pinebook-pro.scm | 3 +-
gnu/system/images/rock64.scm | 3 +-
gnu/system/images/unmatched.scm | 3 +-
gnu/system/images/visionfive2.scm | 3 +-
gnu/system/images/wsl2.scm | 14 +-
gnu/system/install.scm | 43 +-
gnu/system/vm.scm | 11 -
gnu/tests.scm | 4 +-
gnu/tests/ganeti.scm | 4 +-
gnu/tests/image.scm | 4 +-
gnu/tests/install.scm | 80 +-
gnu/tests/nfs.scm | 4 +-
gnu/tests/reconfigure.scm | 86 +-
gnu/tests/telephony.scm | 4 +-
gnu/tests/vnc.scm | 4 +-
guix/scripts/system.scm | 162 +--
guix/scripts/system/reconfigure.scm | 159 +-
guix/ui.scm | 8 +
tests/boot-parameters.scm | 16 +-
57 files changed, 2392 insertions(+), 2535 deletions(-)
create mode 100644 gnu/bootloader/uki.scm
base-commit: 7d781027c78bdea5fdb3f1c9c9ec432b9606d2b5
--
2.45.2
^ permalink raw reply [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
` (14 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Ludovic Court??s, Mathieu Othacehe,
Simon Tournier, Tobias Geerinckx-Rice
The current implementation is broken anyway. Multiple bootloaders share
a name (including both versions of extlinux) and
bootloader-configuration data is significant to bootloader installation.
It shouldn't be just faked.
Rely on the provenance service instead, which while not always present,
should be for the vast majority of systems.
* guix/scripts/system.scm (reinstall-bootloader): Rename to...
(install-bootloader-from-provenance): ...this, and rewrite to extract
bootloader-configuration data from system provenance.
(switch-to-system-generation, process-command): Use
install-bootloader-from-provenance.
Change-Id: I5713a43ad4f9f32a129d980db06d70de16b03f27
---
guix/scripts/system.scm | 75 ++++++++++++++---------------------------
1 file changed, 25 insertions(+), 50 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0f7d864e06..bb7b5d37bf 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -88,6 +88,7 @@ (define-module (guix scripts system)
#:use-module (srfi srfi-37)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
#:use-module (rnrs bytevectors)
#:export (guix-system
read-operating-system
@@ -377,60 +378,33 @@ (define (switch-to-system-generation store spec)
(activate (string-append generation "/activate")))
(if number
(begin
- (reinstall-bootloader store number)
+ (install-bootloader-from-provenance store number)
(switch-to-generation* %system-profile number)
(unless-file-not-found (primitive-load activate)))
(leave (G_ "cannot switch to system generation '~a'~%") spec))))
-(define* (system-bootloader-name #:optional (system %system-profile))
- "Return the bootloader name stored in SYSTEM's \"parameters\" file."
- (let ((params (unless-file-not-found
- (read-boot-parameters-file system))))
- (boot-parameters-bootloader-name params)))
-
-(define (reinstall-bootloader store number)
- "Re-install bootloader for existing system profile generation NUMBER.
-STORE is an open connection to the store."
+(define (install-bootloader-from-provenance store number)
+ "Re-install an old bootloader using provenance data for system profile
+generation NUMBER with store STORE."
(let* ((generation (generation-file-name %system-profile number))
- ;; Detect the bootloader used in %system-profile.
- (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
-
- ;; Use the detected bootloader with default configuration.
- ;; It will be enough to allow the system to boot.
- (bootloader-config (bootloader-configuration
- (bootloader bootloader)))
-
- ;; Make the specified system generation the default entry.
- (chosen-alternative (generation->boot-alternative
- %system-profile number))
- (params (boot-alternative-parameters chosen-alternative))
- (locale (boot-parameters-locale params))
- (store-crypto-devices (boot-parameters-store-crypto-devices params))
- (store-directory-prefix
- (boot-parameters-store-directory-prefix params))
- (old-generations
- (delv number (reverse (generation-numbers %system-profile))))
- (previous-boot-alternatives (profile->boot-alternatives
- %system-profile old-generations))
- (entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- previous-boot-alternatives))))
- (run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object
- ((bootloader-configuration-file-generator bootloader)
- bootloader-config entries
- #:locale locale
- #:store-crypto-devices store-crypto-devices
- #:store-directory-prefix store-directory-prefix
- #:old-entries old-entries)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))))
+ (os (receive (_ os) (system-provenance generation)
+ (and=> os read-operating-system)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (numbers (delv number (reverse (generation-numbers %system-profile))))
+ (old (profile->boot-alternatives %system-profile numbers)))
+ (if os
+ (run-with-store store
+ (mlet* %store-monad
+ ((bootcfg (lower-object (operating-system-bootcfg os old)))
+ (drvs -> (list bootcfg)))
+ (mbegin %store-monad
+ (built-derivations drvs)
+ ;; Only install bootloader configuration file.
+ (install-bootloader local-eval bootloader-config bootcfg
+ #:run-installer? #f))))
+ (leave (G_ "cannot rollback to provenanceless generation '~a'~%")
+ number))))
\f
;;;
@@ -1416,7 +1390,8 @@ (define (process-command command args opts)
(x (leave (G_ "wrong number of arguments~%"))))))
(with-store* store
(delete-matching-generations store %system-profile pattern)
- (reinstall-bootloader store (generation-number %system-profile)))))
+ (install-bootloader-from-provenance store
+ (generation-number %system-profile)))))
((switch-generation)
(let ((pattern (match args
((pattern) pattern)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 02/15] gnu: Add bootloader target infastructure.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
` (13 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Lilah Tascheter, Ludovic Court??s,
Mathieu Othacehe, Simon Tournier, Tobias Geerinckx-Rice
* gnu/bootloader.scm (bootloader-target): New record.
(&target-error): New condition.
(pathcat, get-target-of-type, parent-of, unfold-pathcat, target-base?,
type-major?, ensure, ensure-target-types, ensure-majors, gbegin):
New procedures.
(define-literal, with-targets, :path, :devpath, :device,
:fs, :label, :uuid): New macros.
(bootloader-modules): Prevent mutual imports.
* guix/ui.scm (call-with-error-handling)[target-error?]:
Handle target-errors.
Change-Id: I3f07c9096dd8b91c04449b6360b3b7d21640da14
---
gnu/bootloader.scm | 212 ++++++++++++++++++++++++++++++++++++++++++++-
guix/ui.scm | 8 ++
2 files changed, 217 insertions(+), 3 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index f32e90e79d..3ddc112cc6 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -31,10 +31,11 @@ (define-module (gnu bootloader)
#:use-module (guix profiles)
#:use-module (guix records)
#:use-module (guix deprecation)
- #:use-module ((guix ui) #:select (warn-about-load-error))
#:use-module (guix diagnostics)
#:use-module (guix i18n)
+ #:use-module (guix modules)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
@@ -63,6 +64,26 @@ (define-module (gnu bootloader)
bootloader-configuration-file
bootloader-configuration-file-generator
+ <bootloader-target>
+ bootloader-target
+ bootloader-target?
+ bootloader-target-type
+ bootloader-target-expected?
+ bootloader-target-path
+ bootloader-target-offset
+ bootloader-target-device
+ bootloader-target-file-system
+ bootloader-target-label
+ bootloader-target-uuid
+
+ target-error?
+ target-error-type
+ target-error-targets
+
+ gbegin
+ :path :devpath :device :fs :label :uuid
+ with-targets
+
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
@@ -236,6 +257,191 @@ (define-record-type* <bootloader>
(configuration-file bootloader-configuration-file)
(configuration-file-generator bootloader-configuration-file-generator))
+\f
+;;;
+;;; Bootloader target record.
+;;;
+
+;; <bootloader-target> represents different kinds of targets in a normalized form.
+
+(define-record-type* <bootloader-target>
+ bootloader-target make-bootloader-target bootloader-target?
+ (type bootloader-target-type) ; symbol
+ (expected? bootloader-target-expected? (default #f)) ; bool
+
+ (path bootloader-target-path (default #f)) ; string|#f
+ (offset bootloader-target-offset (thunked) ; symbol|#f
+ (default (and (bootloader-target-path this-record)
+ (not (eq? (bootloader-target-type this-record) 'root))
+ 'root)))
+ (device bootloader-target-device (default #f)) ; string|#f
+ (file-system bootloader-target-file-system (default #f)) ; string|#f
+ (label bootloader-target-label (default #f)) ; string|#f
+ (uuid bootloader-target-uuid (default #f))) ; uuid|#f
+
+(define-condition-type &target-error &error target-error?
+ (type target-error-type)
+ (targets target-error-targets))
+
+(define (pathcat p1 p2)
+ (string-append (string-trim-right p1 #\/) "/" (string-trim p2 #\/)))
+
+(define* (get-target-of-type type targets #:optional (require? #f))
+ "Finds a target in TARGETS of type TYPE, optionally providing an error when
+not found if REQUIRE? is provided."
+ (let* ((pred (lambda (target) (eq? type (bootloader-target-type target))))
+ (candidates (filter pred targets))
+ (ret (if (pair? candidates) (car candidates) #f)))
+ (if (and require? (not ret))
+ (raise (condition
+ (&message (message (G_ "required, but not provided")))
+ (&target-error (type type) (targets targets))))
+ ret)))
+
+(define (parent-of target targets)
+ (and=> (bootloader-target-offset target)
+ (cut get-target-of-type <> targets #t)))
+
+(define (unfold-pathcat target targets)
+ (let ((quit (lambda (t) (not (and=> t bootloader-target-path)))))
+ (reduce pathcat #f
+ (unfold quit bootloader-target-path (cut parent-of <> targets) target))))
+
+(define (target-base? t)
+ (or (not t) (match-record t <bootloader-target>
+ (expected? offset device label uuid)
+ (or device label uuid (not offset) expected?))))
+
+(define (type-major? target) (memq target '(root esp disk)))
+
+(define (ensure types targets end)
+ (let* ((used-in (cute unfold end identity (cut parent-of <> targets) <>))
+ (cons-in (lambda (t) (cons t (used-in t))))
+ (ensure (map (cut get-target-of-type <> targets #t) types)))
+ (filter ->bool (apply append (map cons-in ensure)))))
+
+(define* (ensure-target-types types targets #:optional (base? #f))
+ "Ensures all TYPES are provided in TARGETS. Returns #t iff every ensured
+target and its requirements are fully provided. Errors out when a required TYPE
+isn't provided. When BASE?, only ensure path requirements up to a device."
+ (not (any bootloader-target-expected?
+ (ensure types targets (if base? target-base? not)))))
+
+(define (ensure-majors types targets)
+ "Errors out when a required TYPE isn't provided, or when use of multiple major
+targets is detected."
+ (let* ((all (map bootloader-target-type (ensure types targets target-base?)))
+ (majors (delete-duplicates (filter type-major? all) eq?)))
+ (if (< (length majors) 2) #t
+ (raise (condition (&message (message (G_ "multiple major targets used")))
+ (&target-error (type majors) (targets targets)))))))
+
+
+
+(define (gbegin . gex)
+ "Sequence provided g-expressions."
+ (case (length gex) ((0) #f) ((1) (car gex)) (else #~(begin #$@gex))))
+
+;; syntax matching on free literals breaks easily, so bind them
+(define-syntax-rule (define-literal id) (define-syntax id (syntax-rules ())))
+(define-literal :path)
+(define-literal :devpath)
+(define-literal :device)
+(define-literal :fs)
+(define-literal :label)
+(define-literal :uuid)
+
+(define-syntax with-targets
+ (cut syntax-case <> ()
+ ((_ targets-expr block ...)
+ (let* ((genvars (compose generate-temporaries iota))
+ (targets (car (genvars 1)))
+
+ (path? (cut syntax-case <> (:path) ((_ :path) #t) (_ #f)))
+ (qualified? (cut syntax-case <> (=>)
+ ((_ => spec ...) (any path? #'(spec ...)))
+ (_ #f)))
+
+ (resolve
+ (lambda (in target base)
+ (with-syntax ((target target) (base base) (targets targets))
+ (syntax-case in
+ (:path :devpath :device :fs :label :uuid)
+ ((name _) (not (identifier? #'name))
+ #`(_ (syntax-error "binds must be to identifiers" #,in)))
+ ((name :device) #'(name (bootloader-target-device base)))
+ ((name :label) #'(name (bootloader-target-label base)))
+ ((name :uuid) #'(name (bootloader-target-uuid base)))
+ ((name :fs) #'(name (bootloader-target-file-system base)))
+ ((name :path) #'(name (unfold-pathcat target targets)))
+ ((name :devpath)
+ #'(name (pathcat "/" (bootloader-target-path target))))
+ (_ #`(_ (syntax-error "invalid binding spec" #,in)))))))
+ (binds
+ (lambda (spec)
+ (syntax-case spec (=>)
+ ((type => binds ...)
+ (with-syntax (((target base) (genvars 2)) (targets targets))
+ (append
+ #`((get (lambda (t) (get-target-of-type t targets #t)))
+ (target (get type))
+ (base (if (target-base? target) target
+ (get (bootloader-target-offset target)))))
+ (map (cut resolve <> #'target #'base) #'(binds ...)))))
+ (_ #f))))
+
+ (blocks
+ (cut syntax-case <> ()
+ ((spec ... expr)
+ (let* ((specs #'(spec ...))
+ (lets (apply append (filter-map binds specs)))
+ (type (cut syntax-case <> (=>)
+ ((t => _ ...) #'t) (t #'t))))
+ (receive (full part) (partition qualified? specs)
+ #`(and (ensure-majors (list #,@(map type specs)) #,targets)
+ (ensure-target-types (list #,@(map type part))
+ #,targets #t)
+ (ensure-target-types (list #,@(map type full))
+ #,targets #f)
+ (let* #,lets expr)))))
+ (bad #'(syntax-error "malformed block" bad)))))
+ "Using the list TARGETS, evaluate and sequence each BLOCK to produce a
+gexp. BLOCK is a set of SPECs followed by an EXPR (evaluating to a gexp). Each
+SPEC denotes a type of target to guard EXPR on their existance and
+full-qualification. This procedure is linear in regards to BLOCKs.
+
+SPEC may be of the following forms:
+@itemize
+@item 'TYPE Requires TYPE to be fully present or promised. Errors otherwise.
+@item ('TYPE => (VAR COMPONENT) ...): As type, but also binds variables. TYPE's
+ COMPONENT is bound to the variable VAR as described below.
+@end itemize
+
+Available COMPONENTs are:
+@itemize
+@item :path (fully-qualified)
+@item :devpath (relative from device)
+@item :device (auto-detected from uuid and label if not user-provided)
+@item :fs
+@item :label
+@item :uuid
+@end itemize
+
+Note that installers may be called multiple times with different targets being
+fully-qualified. To ensure that targets aren't installed multiple times, make sure
+that each BLOCK ensures at least one major target, either directly or indirectly.
+Corrolarily, at most one major target should be ensured per BLOCK, under the same
+conditions. Major targets originate from disk image handling, and are currently:
+@itemize
+@item disk
+@item root
+@item esp
+@end itemize"
+ #`(let ((#,targets targets-expr))
+ (apply gbegin (filter ->bool
+ (list #,@(map blocks #'(block ...))))))))
+ (bad #'(syntax-error "must provide targets" bad))))
+
\f
;;;
;;; Bootloader configuration record.
@@ -305,10 +511,10 @@ (define (bootloader-configuration-targets config)
(define (bootloader-modules)
"Return the list of bootloader modules."
+ ;; don't provide #:warn to prevent mutual imports
(all-modules (map (lambda (entry)
`(,entry . "gnu/bootloader"))
- %load-path)
- #:warn warn-about-load-error))
+ %load-path)))
(define %bootloaders
;; The list of publically-known bootloaders.
diff --git a/guix/ui.scm b/guix/ui.scm
index 9db6f6e9d7..1c9300c9eb 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -36,6 +36,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix ui)
+ #:use-module ((gnu bootloader)
+ #:select (target-error? target-error-type target-error-targets))
#:use-module (guix i18n)
#:use-module (guix colors)
#:use-module (guix diagnostics)
@@ -857,6 +859,12 @@ (define (call-with-error-handling thunk)
(invoke-error-stop-signal c)
(cons (invoke-error-program c)
(invoke-error-arguments c))))
+ ((target-error? c)
+ (leave (G_ "bootloader-target '~a'~@[: ~a~] ~
+ among the following targets:~%~{~y~}")
+ (target-error-type c)
+ (and (message-condition? c) (condition-message c))
+ (target-error-targets c)))
((formatted-message? c)
(apply report-error
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 03/15] guix: scripts: Remove unused code.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
` (12 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Ludovic Court??s, Mathieu Othacehe,
Simon Tournier, Tobias Geerinckx-Rice
* guix/scripts/system.scm (bootloader-installer-script): Delete.
Change-Id: Ic1e0a523c814e4f1bf44b2721f5658f00066b0ab
---
guix/scripts/system.scm | 22 ----------------------
1 file changed, 22 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bb7b5d37bf..344bb74151 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -731,28 +731,6 @@ (define (maybe-suggest-running-guix-pull)
(warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%"))
(warning (G_ "Failing to do that may downgrade your system!~%"))))
-(define (bootloader-installer-script installer
- bootloader device target)
- "Return a file calling INSTALLER gexp with given BOOTLOADER, DEVICE
-and TARGET arguments."
- (scheme-file "bootloader-installer"
- (with-imported-modules '((gnu build bootloader)
- (guix build utils))
- #~(begin
- (use-modules (gnu build bootloader)
- (guix build utils)
- (ice-9 binary-ports)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (guard (c ((message-condition? c) ;XXX: i18n
- (format (current-error-port) "error: ~a~%"
- (condition-message c))
- (exit 1)))
- (#$installer #$bootloader #$device #$target)
- (info (G_ "bootloader successfully installed on '~a'~%")
- #$device))))))
-
(define (local-eval exp)
"Evaluate EXP, a G-Expression, in-place."
(mlet* %store-monad ((lowered (lower-gexp exp))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 04/15] gnu: Core bootloader changes.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (2 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
` (11 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Efraim Flashner, Josselin Poiret, Lilah Tascheter,
Ludovic Court??s, Mathieu Othacehe, Simon Tournier,
Tobias Geerinckx-Rice, Vagrant Cascadian
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/bootloader.scm (menu-entry): Add device-subvol field.
(menu-entry->sexp, sexp->menu-entry): Support device-subvol.
(normalize-file, warn-update-targets, target-overrides, normalize,
bootloader-configuration->gexp, bootloader-configurations->gexps,
efi-arch, install-efi):
New procedures.
(bootloader): Rewrite record.
(bootloader-configuration)[target]: Remove deprecated field.
[targets]: Include sanitizer and allow multiple bootloaders.
[terminal-outputs, terminal-inputs]: Don't assume grub.
[efi-removable?, 32bit?]: New fields.
(warn-target-field-deprecation): Delete deprecation warning.
(%bootloaders): Delete variable.
(bootloader-configuration-target, bootloader-configuration-targets,
lookup-bootloader-by-name, bootloader-modules, efi-bootloader-profile,
efi-bootloader-chain): Delete procedures.
* gnu/bootloader/depthcharge.scm, gnu/bootloader/extlinux.scm,
gnu/bootloader/grub.scm, gnu/bootloader/u-boot.scm: Rewrite entirely.
* gnu/build/bootloader.scm (parse-bootnums): New variable.
(atomic-copy, in-temporary-directory, efi-bootnums): New procedures.
(install-efi-loader): Delete procedure.
(install-efi): Rewrite to support installation of any efi bootloader.
* gnu/build/image.scm (initialize-efi32-partition: Deprecate.
(initialize-efi-partitition): Only create EFI directory.
(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/image.scm (partition)[target]: New field in order to support
dynamic provision of image partitions as bootloader targets.
* gnu/installer/parted.scm (bootloader-configuration),
gnu/machine/ssh.scm (deploy-managed-host) (roll-back-managed-host):
Use new bootloader system.
* gnu/packages/bootloaders.scm (make-grub-efi-netboot): Delete
procedure.
* gnu/packages/raspberry-pi.scm (grub-efi-bootloader-chain-raspi-64):
Delete procedure. Can be recreated with a raspberry pi bootloader
combined with grub-efi.
* gnu/system.scm (convert-bootloader-field): New procedure.
(operating-system)[bootloader]: Use above sanitizer and support
multiple bootloaders.
(operating-system-bootcfg): Rename to...
(operating-system-bootmeta): ...this. Rewrite to return relavent
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.
(boot-parameters->menu-entry): Support device-subvol.
(boot-alternative->menu-entry): New procedure.
* gnu/system/image.scm (root-partition, esp-partition): Use target field.
(esp32-partition, efi32-disk-partition, efi32-raw-image-type): Deprecate.
(root-partition-index): Delete procedure.
(system-disk-image, system-iso9960-image): Support new bootloader system.
(system-disk-image)[targets]: New subprocedure.
* gnu/system/images/hurd.scm (hurd-barebones-os)[bootloader],
gnu/system/images/novena.scm (novena-barebones-os)[bootloader],
gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
(orangepi-r1-plus-lts-rk3328-barebones-os)[bootloader],
gnu/system/images/pine64.scm (pine64-barebones-os)[bootloader],
gnu/system/images/pinebook-pro.scm
(pinebook-pro-barebones-os)[bootloader],
gnu/system/images/rock64.scm (rock64-barebones-os)[bootloader],
gnu/system/images/unmatched.scm (unmatched-barebones-os)[bootloader],
gnu/system/images/visionfive2.scm
(visionfive2-barebones-os)[bootloader]: Use new target format.
* gnu/system/images/wsl2.scm (dummy-bootloader): Delete variable.
(wsl-os)[bootloader]: Don't provide field.
* gnu/system/install.scm (installation-os)[bootloader]: Use new format.
(os-with-u-boot): Delete procedure.
(embedded-installation-os)[bootloader]: Use new format.
(beaglebone-black-installation-os, a20-olinuxino-lime-installation-os,
a20-olinuxino-lime2-emmc-installation-os,
a20-olinuxino-micro-installation-os, bananapi-m2-ultra-installation-os,
firefly-rk3399-installation-os, mx6cuboxi-installation-os,
novena-installation-os, nintendo-nes-classic-edition-installation-os,
orangepi-r1-plus-lts-rk3328-installation-os, pine64-plus-installation-os,
pinebook-installation-os, rock64-installation-os,
rockpro64-installation-os, rk3399-puma-installation-os,
wandboard-installation-os): Don't guess block device.
* gnu/system/vm.scm (virtualized-operating-system): Don't provide
bootloader.
* gnu/tests/install.scm (%minimal-extlinux-os)[bootloader]: Use proper
extlinux variable.
(%btrfs-raid10-root-os): Use multiple bootloaders.
* gnu/tests/reconfigure.scm (%test-install-bootloader): Delete variable.
(run-install-bootloader-test): Delete procedure.
* 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
---
gnu/bootloader.scm | 445 +++---
gnu/bootloader/depthcharge.scm | 153 +-
gnu/bootloader/extlinux.scm | 149 +-
gnu/bootloader/grub.scm | 1279 +++++++----------
gnu/bootloader/u-boot.scm | 439 ++----
gnu/build/bootloader.scm | 157 +-
gnu/build/image.scm | 40 +-
gnu/build/install.scm | 16 +-
gnu/image.scm | 3 +
gnu/installer/parted.scm | 12 +-
gnu/machine/ssh.scm | 71 +-
gnu/packages/bootloaders.scm | 86 --
gnu/packages/raspberry-pi.scm | 18 -
gnu/system.scm | 45 +-
gnu/system/boot.scm | 8 +-
gnu/system/image.scm | 162 ++-
gnu/system/images/hurd.scm | 4 +-
gnu/system/images/novena.scm | 3 +-
.../images/orangepi-r1-plus-lts-rk3328.scm | 3 +-
gnu/system/images/pine64.scm | 3 +-
gnu/system/images/pinebook-pro.scm | 3 +-
gnu/system/images/rock64.scm | 3 +-
gnu/system/images/unmatched.scm | 3 +-
gnu/system/images/visionfive2.scm | 3 +-
gnu/system/images/wsl2.scm | 14 +-
gnu/system/install.scm | 43 +-
gnu/system/vm.scm | 11 -
gnu/tests/install.scm | 10 +-
gnu/tests/reconfigure.scm | 86 +-
guix/scripts/system.scm | 89 +-
guix/scripts/system/reconfigure.scm | 159 +-
31 files changed, 1430 insertions(+), 2090 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 3ddc112cc6..2eae0cd49c 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,45 +25,53 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader)
+ #:autoload (gnu build file-systems)
+ (read-partition-label read-partition-uuid
+ find-partition-by-label find-partition-by-uuid)
+ #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
- #:use-module (guix discovery)
- #:use-module (guix gexp)
- #:use-module (guix profiles)
- #:use-module (guix records)
+ #:autoload (guix build syscalls)
+ (mounts mount-source mount-point mount-type)
#:use-module (guix deprecation)
#:use-module (guix diagnostics)
+ #:use-module (guix gexp)
#:use-module (guix i18n)
#:use-module (guix modules)
+ #:use-module (guix profiles)
+ #:use-module (guix records)
+ #:use-module (guix utils)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
+ #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (ice-9 match)
- #:export (menu-entry
+ #:export (<menu-entry>
+ menu-entry
menu-entry?
menu-entry-label
menu-entry-device
+ menu-entry-device-mount-point
+ menu-entry-device-subvol
menu-entry-linux
menu-entry-linux-arguments
menu-entry-initrd
- menu-entry-device-mount-point
menu-entry-multiboot-kernel
menu-entry-multiboot-arguments
menu-entry-multiboot-modules
menu-entry-chain-loader
+ normalize-file
menu-entry->sexp
sexp->menu-entry
bootloader
bootloader?
bootloader-name
- bootloader-package
+ bootloader-default-targets
bootloader-installer
- bootloader-disk-image-installer
- bootloader-configuration-file
- bootloader-configuration-file-generator
<bootloader-target>
bootloader-target
@@ -84,13 +93,15 @@ (define-module (gnu bootloader)
:path :devpath :device :fs :label :uuid
with-targets
+ <bootloader-configuration>
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
- bootloader-configuration-target ;deprecated
bootloader-configuration-targets
bootloader-configuration-menu-entries
bootloader-configuration-default-entry
+ bootloader-configuration-efi-removable?
+ bootloader-configuration-32bit?
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -101,10 +112,11 @@ (define-module (gnu bootloader)
bootloader-configuration-device-tree-support?
bootloader-configuration-extra-initrd
- %bootloaders
- lookup-bootloader-by-name
+ bootloader-configuration->gexp
+ bootloader-configurations->gexp
- efi-bootloader-chain))
+ efi-arch
+ install-efi))
\f
;;;
@@ -119,6 +131,8 @@ (define-record-type* <menu-entry>
(default #f))
(device-mount-point menu-entry-device-mount-point
(default #f))
+ (device-subvol menu-entry-device-subvol
+ (default #f))
(linux menu-entry-linux
(default #f))
(linux-arguments menu-entry-linux-arguments
@@ -135,6 +149,18 @@ (define-record-type* <menu-entry>
(chain-loader menu-entry-chain-loader
(default #f))) ; string, path of efi file
+(define (normalize-file entry val)
+ "Normalize a file VAL stored in a menu entry into one suitable for a
+bootloader. Realizes device-mount-point and device-subvol."
+ (match-record entry <menu-entry> (device-mount-point device-subvol)
+ #~(let* ((rel (lambda (s) (substring s (if (string-prefix? "/" s) 1 0))))
+ (file (rel #$val))
+ (subvol (and=> #$device-subvol rel))
+ (mount (and=> #$device-mount-point rel)))
+ (string-append (if subvol (string-append "/" subvol "/") "/")
+ (if (and mount (string-prefix? mount file))
+ (substring file (string-length mount)) file)))))
+
(define (report-menu-entry-error menu-entry)
(raise
(condition
@@ -162,7 +188,7 @@ (define (menu-entry->sexp entry)
`(label ,(file-system-label->string label)))
(_ device)))
(match entry
- (($ <menu-entry> label device mount-point
+ (($ <menu-entry> label device mount-point subvol
(? identity linux) linux-arguments (? identity initrd)
#f () () #f)
`(menu-entry (version 0)
@@ -171,8 +197,9 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(linux ,linux)
(linux-arguments ,linux-arguments)
- (initrd ,initrd)))
- (($ <menu-entry> label device mount-point #f () #f
+ (initrd ,initrd)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f
(? identity multiboot-kernel) multiboot-arguments
multiboot-modules #f)
`(menu-entry (version 0)
@@ -181,19 +208,23 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(multiboot-kernel ,multiboot-kernel)
(multiboot-arguments ,multiboot-arguments)
- (multiboot-modules ,multiboot-modules)))
- (($ <menu-entry> label device mount-point #f () #f #f () ()
+ (multiboot-modules ,multiboot-modules)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f #f () ()
(? identity chain-loader))
`(menu-entry (version 0)
(label ,label)
(device ,(device->sexp device))
(device-mount-point ,mount-point)
- (chain-loader ,chain-loader)))
+ (chain-loader ,chain-loader)
+ (device-subvol ,subvol)))
(_ (report-menu-entry-error entry))))
(define (sexp->menu-entry sexp)
"Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
record."
+ ;; XXX: rely on shadowing to support the match ors below
+ (define subvol #f)
(define (sexp->device device-sexp)
(match device-sexp
(('uuid type uuid-string)
@@ -206,35 +237,41 @@ (define (sexp->menu-entry sexp)
('label label) ('device device)
('device-mount-point mount-point)
('linux linux) ('linux-arguments linux-arguments)
- ('initrd initrd) _ ...)
+ ('initrd initrd)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(linux linux)
(linux-arguments linux-arguments)
(initrd initrd)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
+ ('device-mount-point mount-point) ('device-subvol subvol)
('multiboot-kernel multiboot-kernel)
('multiboot-arguments multiboot-arguments)
- ('multiboot-modules multiboot-modules) _ ...)
+ ('multiboot-modules multiboot-modules)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(multiboot-kernel multiboot-kernel)
(multiboot-arguments multiboot-arguments)
(multiboot-modules multiboot-modules)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
- ('chain-loader chain-loader) _ ...)
+ ('device-mount-point mount-point) ('device-subvol subvol)
+ ('chain-loader chain-loader)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(chain-loader chain-loader)))))
\f
@@ -247,15 +284,10 @@ (define (sexp->menu-entry sexp)
;; has to be described by this record.
(define-record-type* <bootloader>
- bootloader make-bootloader
- bootloader?
- (name bootloader-name)
- (package bootloader-package)
- (installer bootloader-installer)
- (disk-image-installer bootloader-disk-image-installer
- (default #f))
- (configuration-file bootloader-configuration-file)
- (configuration-file-generator bootloader-configuration-file-generator))
+ bootloader make-bootloader bootloader?
+ (name bootloader-name)
+ (default-targets bootloader-default-targets (default '()))
+ (installer bootloader-installer))
\f
;;;
@@ -299,10 +331,12 @@ (define* (get-target-of-type type targets #:optional (require? #f))
ret)))
(define (parent-of target targets)
+ "Resolves the parent of a target in targets, or #f if parentless."
(and=> (bootloader-target-offset target)
(cut get-target-of-type <> targets #t)))
(define (unfold-pathcat target targets)
+ "Finds the full VFS path of a target."
(let ((quit (lambda (t) (not (and=> t bootloader-target-path)))))
(reduce pathcat #f
(unfold quit bootloader-target-path (cut parent-of <> targets) target))))
@@ -450,28 +484,48 @@ (define-syntax with-targets
;; The <bootloader-configuration> record contains bootloader independant
;; configuration used to fill bootloader configuration file.
-(define-with-syntax-properties (warn-target-field-deprecation
- (value properties))
- (when value
- (warning (source-properties->location properties)
- (G_ "the 'target' field is deprecated, please use 'targets' \
-instead~%")))
- value)
+(define-with-syntax-properties (warn-update-targets (value properties))
+ (let ((loc (source-properties->location properties)))
+ (define update
+ (match-lambda
+ ((? bootloader-target? target) (cons #f target))
+ ((? string? s) (cons #t (if (string-prefix? "/dev" s)
+ (bootloader-target
+ (type 'disk)
+ (device s))
+ (bootloader-target
+ (type 'esp)
+ (offset 'root)
+ (path s)))))
+ (x (error loc (G_ "invalid target '~a'~%") x))))
+
+ (let* ((updated (map update (if (list? value) value (list value))))
+ (targets (map cdr updated))
+ (types (map bootloader-target-type targets)))
+ ;; XXX: should this be an error?
+ (when (any car updated)
+ (warning loc (G_ "the 'targets' field should now contain \
+<bootloader-target> records. inferring a best guess (this might break!)...~%")))
+ (when (not (eqv? (length types) (length (delete-duplicates types))))
+ (error loc (G_ "the 'targets' field may not contain duplicates~%")))
+ targets)))
(define-record-type* <bootloader-configuration>
bootloader-configuration make-bootloader-configuration
bootloader-configuration?
(bootloader
- bootloader-configuration-bootloader) ;<bootloader>
- (targets %bootloader-configuration-targets
- (default #f)) ;list of strings
- (target %bootloader-configuration-target ;deprecated
- (default #f)
- (sanitize warn-target-field-deprecation))
+ bootloader-configuration-bootloader) ;<bootloader>
+ (targets bootloader-configuration-targets
+ (default '()) ;list of strings
+ (sanitize warn-update-targets))
(menu-entries bootloader-configuration-menu-entries
(default '())) ;list of <menu-entry>
(default-entry bootloader-configuration-default-entry
(default 0)) ;integer
+ (efi-removable? bootloader-configuration-efi-removable?
+ (default #f)) ;bool
+ (32bit? bootloader-configuration-32bit?
+ (default #f)) ;bool
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
@@ -479,9 +533,9 @@ (define-record-type* <bootloader-configuration>
(theme bootloader-configuration-theme
(default #f)) ;bootloader-specific theme
(terminal-outputs bootloader-configuration-terminal-outputs
- (default '(gfxterm))) ;list of symbols
+ (default #f)) ;list of symbols | #f (default outs)
(terminal-inputs bootloader-configuration-terminal-inputs
- (default '())) ;list of symbols
+ (default #f)) ;list of symbols | #f (default ins)
(serial-unit bootloader-configuration-serial-unit
(default #f)) ;integer | #f
(serial-speed bootloader-configuration-serial-speed
@@ -491,164 +545,143 @@ (define-record-type* <bootloader-configuration>
(extra-initrd bootloader-configuration-extra-initrd
(default #f))) ;string | #f
-(define-deprecated (bootloader-configuration-target config)
- bootloader-configuration-targets
- (%bootloader-configuration-target config))
+\f
+;;;
+;;; Bootloader installation paths.
+;;;
-(define (bootloader-configuration-targets config)
- (or (%bootloader-configuration-targets config)
- ;; TODO: Remove after the deprecated 'target' field is removed.
- (list (%bootloader-configuration-target config))
- ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this
- ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f,
- ;; hence the default value of '(#f) rather than '().
- (list #f)))
+;; highest -> lowest priority
+(define (target-overrides . layers)
+ (let* ((types (fold append '()
+ (map (cute map bootloader-target-type <>) layers)))
+ (pred (lambda (type layer found)
+ (or found (get-target-of-type type layer))))
+ (find (lambda (type) (fold (cute pred type <> <>) #f layers))))
+ (filter ->bool (map find (delete-duplicates types)))))
+
+(define (normalize targets)
+ "Augments user-supplied targets with filesystem information at runtime,
+allowing users to specify a lot less information. Relatively minimal to prevent
+errors. Puts targets into a normal form, where all paths are fully specified up
+to a device offset."
+ (let* ((mass (lambda (m) `((,(mount-source m) . ,m) (,(mount-point m) . ,m))))
+ (amounts (delay (apply append (map mass (mounts)))))
+ (accessible=> (lambda (d f) (and d (access? d R_OK) (f d))))
+ (assoc-mnt (lambda (f) (lambda (v)
+ (and=> (assoc-ref (force amounts) v) f)))))
+
+ (define (scrape target)
+ (match-record target <bootloader-target>
+ (expected? path offset device label uuid file-system)
+ (if expected? target
+ (bootloader-target
+ (inherit target)
+ (device (or device (false-if-exception
+ (or (and=> uuid find-partition-by-uuid)
+ (and=> label find-partition-by-label)))
+ (and path ((assoc-mnt mount-source)
+ (unfold-pathcat target targets)))))
+ (label (or label (accessible=> device read-partition-label)))
+ (uuid (or uuid (accessible=> device read-partition-uuid)))
+ (file-system (or file-system (and=> device (assoc-mnt mount-type))))
+ (offset (and path offset))
+ (path (or path (and=> device (assoc-mnt mount-point))))))))
+
+ (define (fixuuid target)
+ (match-record target <bootloader-target> (uuid file-system)
+ (let ((type (cond ((not file-system) 'dce)
+ ((member file-system '("vfat" "fat32")) 'fat)
+ ((string=? file-system "ntfs") 'ntfs)
+ ((string=? file-system "iso9660") 'iso9660)
+ (else 'dce))))
+ (bootloader-target (inherit target)
+ (uuid (cond ((uuid? uuid) uuid)
+ ((bytevector? uuid) (bytevector->uuid uuid type))
+ ((string? uuid) (string->uuid uuid type))
+ (else #f)))))))
+
+ (define (arborify target targets)
+ (let* ((up (lambda (t) (and t (parent-of t targets))))
+ (proto (unfold target-base? identity up (up target) list))
+ (chain (reverse (cons target proto))))
+ (bootloader-target
+ (inherit target)
+ (offset (and=> (car chain) bootloader-target-type))
+ (path (reduce pathcat #f (map bootloader-target-path (cdr chain)))))))
+
+ (let ((mid (map (compose fixuuid scrape) targets)))
+ (map (cut arborify <> mid) mid))))
+
+(define* (bootloader-configuration->gexp bootloader-config args #:key
+ (root-offset "/") (overrides '()))
+ "Returns a gexp to install BOOTLOADER-CONFIG to its targets, passing ARGS
+to each installer alongside the additional #:bootloader-config keyword
+arguments. Target OVERRIDES are applied and all path targets have ROOT-OFFSET
+applied. The following keyword arguments are expected in ARGS:
+@enumerate
+@item current-boot-alternative
+@item old-boot-alternatives
+@item locale (from bootmeta)
+@item store-directory-prefix (from bootmeta)
+@item store-crypto-devices (from bootmeta)
+@end enumerate"
+ (let* ((bootloader (bootloader-configuration-bootloader bootloader-config))
+ (installer (bootloader-installer bootloader))
+ (auto-targets (list (bootloader-target
+ (type 'root)
+ (path root-offset)
+ (offset #f))))
+ (targets (target-overrides
+ overrides
+ (bootloader-configuration-targets bootloader-config)
+ auto-targets
+ (bootloader-default-targets bootloader)))
+ (conf (bootloader-configuration
+ (inherit bootloader-config)
+ (targets (normalize targets)))))
+ (apply installer #:bootloader-config conf args)))
+
+(define (bootloader-configurations->gexp bootloader-configs . rest)
+ (apply gbegin (filter-map (cut apply bootloader-configuration->gexp <> rest)
+ bootloader-configs)))
\f
-;;;
-;;; Bootloaders.
+=
+;;; EFI shit
;;;
-(define (bootloader-modules)
- "Return the list of bootloader modules."
- ;; don't provide #:warn to prevent mutual imports
- (all-modules (map (lambda (entry)
- `(,entry . "gnu/bootloader"))
- %load-path)))
-
-(define %bootloaders
- ;; The list of publically-known bootloaders.
- (delay (fold-module-public-variables (lambda (obj result)
- (if (bootloader? obj)
- (cons obj result)
- result))
- '()
- (bootloader-modules))))
-
-(define (lookup-bootloader-by-name name)
- "Return the bootloader called NAME."
- (or (find (lambda (bootloader)
- (eq? name (bootloader-name bootloader)))
- (force %bootloaders))
- (leave (G_ "~a: no such bootloader~%") name)))
-
-(define (efi-bootloader-profile packages files hooks)
- "Creates a profile from the lists of PACKAGES and FILES from the store.
-This profile is meant to be used by the bootloader-installer.
-
-FILES is a list of file or directory names from the store, which will be
-symlinked into the profile. If a directory name ends with '/', then the
-directory content instead of the directory itself will be symlinked into the
-profile.
-
-FILES may contain file like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-HOOKS lists additional hook functions to modify the profile."
- (define* (efi-bootloader-profile-hook manifest #:optional system)
- (define build
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules ((guix build utils)
- #:select (mkdir-p strip-store-file-name))
- ((ice-9 ftw)
- #:select (scandir))
- ((srfi srfi-1)
- #:select (append-map every remove))
- ((srfi srfi-26)
- #:select (cut)))
- (define (symlink-to file directory transform)
- "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
- (symlink file (string-append directory "/" (transform file))))
- (define (directory-content directory)
- "Creates a list of absolute path names inside DIRECTORY."
- (map (lambda (name)
- (string-append directory name))
- (or (scandir directory (lambda (name)
- (not (member name '("." "..")))))
- '())))
- (define name-ends-with-/? (cut string-suffix? "/" <>))
- (define (name-is-store-entry? name)
- "Return #t if NAME is a direct store entry and nothing inside."
- (not (string-index (strip-store-file-name name) #\/)))
- (let* ((files '#$files)
- (directories (filter name-ends-with-/? files))
- (names-from-directories
- (append-map (lambda (directory)
- (directory-content directory))
- directories))
- (names (append names-from-directories
- (remove name-ends-with-/? files))))
- (mkdir-p #$output)
- (if (every file-exists? names)
- (begin
- (for-each (lambda (name)
- (symlink-to name #$output
- (if (name-is-store-entry? name)
- strip-store-file-name
- basename)))
- names)
- #t)
- #f)))))
-
- (gexp->derivation "efi-bootloader-profile"
- build
- #:system system
- #:local-build? #t
- #:substitutable? #f
- #:properties
- `((type . profile-hook)
- (hook . efi-bootloader-profile-hook))))
-
- (profile (content (packages->manifest packages))
- (name "efi-bootloader-profile")
- (hooks (cons efi-bootloader-profile-hook hooks))
- (locales? #f)
- (allow-collisions? #f)
- (relative-symlinks? #f)))
-
-(define* (efi-bootloader-chain final-bootloader
- #:key
- (packages '())
- (files '())
- (hooks '())
- installer
- disk-image-installer)
- "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES,
-and optional directories and files from the store given in the list of FILES.
-
-The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
-in an efi-bootloader-profile, which will be passed to the INSTALLER.
-
-FILES may contain file-like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-If a directory name in FILES ends with '/', then the directory content instead
-of the directory itself will be symlinked into the efi-bootloader-profile.
-
-The procedures in the HOOKS list can be used to further modify the bootloader
-profile. It is possible to pass a single function instead of a list.
-
-If the INSTALLER argument is used, then this gexp procedure will be called to
-install the efi-bootloader-profile. Otherwise the installer of the
-FINAL-BOOTLOADER will be called.
-
-If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
-to install the efi-bootloader-profile into a disk image. Otherwise the
-disk-image-installer of the FINAL-BOOTLOADER will be called."
- (bootloader
- (inherit final-bootloader)
- (name "efi-bootloader-chain")
- (package
- (efi-bootloader-profile (cons (bootloader-package final-bootloader)
- packages)
- files
- (if (list? hooks)
- hooks
- (list hooks))))
- (installer
- (or installer
- (bootloader-installer final-bootloader)))
- (disk-image-installer
- (or disk-image-installer
- (bootloader-disk-image-installer final-bootloader)))))
+(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
+ (32? #f))
+ "Returns the UEFI architecture name for the current target, in lowercase."
+ (cond ((target-x86-32? target) "ia32")
+ ((target-x86-64? target) (if 32? "ia32" "x64"))
+ ((target-arm32? target) "arm")
+ ((target-aarch64? target) (if 32? "arm" "aa64"))
+ ((target-riscv64? target) (if 32? "riscv32" "riscv64"))
+ (else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
+ target)))))
+
+(define (install-efi bootloader-config plan)
+ "Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
+PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
+should be in boot order. If the user selects a removable bootloader, only the
+first entry in PLAN is used."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets efi-removable? 32bit?)
+ (if efi-removable?
+ ;; Hard code the output location to a well-known path recognized by
+ ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
+ ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
+ (with-targets targets
+ (('esp => (path :path))
+ #~(let ((boot #$(string-append path "/EFI/BOOT"))
+ (arch #$(string-upcase (efi-arch #:32? 32bit?)))
+ (builder (car (car #$plan))))
+ (mkdir-p boot)
+ ;; only realize first planspec
+ (builder (string-append boot "/BOOT" arch ".EFI")))))
+ ;; normal install when not doing a removable config
+ (with-targets targets
+ (('vendir => (vendir :path) (loader :devpath) (disk :device))
+ #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm
index 0a50374bd9..ad29f5d5e4 100644
--- a/gnu/bootloader/depthcharge.scm
+++ b/gnu/bootloader/depthcharge.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,92 +18,86 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader depthcharge)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:use-module (ice-9 match)
- #:export (depthcharge-bootloader))
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
+ #:export (depthcharge-veyron-speedy-bootloader
+ depthcharge-bootloader))
-(define (signed-kernel kernel kernel-arguments initrd)
- (define builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 binary-ports)
- (rnrs bytevectors))
- (set-path-environment-variable "PATH" '("bin") (list #$dtc))
+(define* (install-depthcharge arch dtb
+ #:key bootloader-config current-boot-alternative
+ #:allow-other-keys)
+ (when (not (null? (bootloader-configuration-menu-entries bootloader-config)))
+ (raise (formatted-message
+ (G_ "extra menu-entries are not supported for depthcharge!"))))
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ;; use 'part instead of 'disk, cause we write an image directly into a
+ ;; partition instead of the extra-partition disk space
+ (('part => (disk :device))
+ (match-record (boot-alternative->menu-entry current-boot-alternative)
+ <menu-entry> (linux linux-arguments initrd)
+ #~(begin
+ (use-modules (ice-9 binary-ports) (rnrs bytevectors))
+ (set-path-environment-variable "PATH" '("bin") (list #$dtc))
- ;; TODO: These files have to be writable, so we copy them.
- ;; This can probably be fixed by using a ".its" file, just
- ;; be careful not to break initrd loading.
- (copy-file #$kernel "zImage")
- (chmod "zImage" #o755)
- (copy-file (string-append (dirname #$kernel) "/lib/dtbs/"
- "rk3288-veyron-speedy.dtb")
- "rk3288-veyron-speedy.dtb")
- (chmod "rk3288-veyron-speedy.dtb" #o644)
- (copy-file #$initrd "initrd")
- (chmod "initrd" #o644)
+ ;; TODO: These files have to be writable, so we copy them.
+ ;; This can probably be fixed by using a ".its" file, just
+ ;; be careful not to break initrd loading.
+ (copy-file #$linux "zImage")
+ (chmod "zImage" #o755)
+ (copy-file (string-append (dirname #$linux) "/lib/dtbs/" #$dtb)
+ "dtb")
+ (chmod "dtb" #o644)
+ (copy-file #$initrd "initrd")
+ (chmod "initrd" #o644)
- (invoke (string-append #$u-boot-tools "/bin/mkimage")
- "-D" "-I dts -O dtb -p 2048"
- "-f" "auto"
- "-A" "arm"
- "-O" "linux"
- "-T" "kernel"
- "-C" "None"
- "-d" "zImage"
- "-a" "0"
- "-b" "rk3288-veyron-speedy.dtb"
- "-i" "initrd"
- "image.itb")
- (call-with-output-file "bootloader.bin"
- (lambda (port)
- (put-bytevector port (make-bytevector 512 0))))
- (with-output-to-file "kernel-arguments"
- (lambda ()
- (display (string-join (list #$@kernel-arguments)))))
- (invoke (string-append #$vboot-utils "/bin/vbutil_kernel")
- "--pack" #$output
- "--version" "1"
- "--vmlinuz" "image.itb"
- "--arch" "arm"
- "--keyblock" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel.keyblock")
- "--signprivate" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel_data_key.vbprivk")
- "--config" "kernel-arguments"
- "--bootloader" "bootloader.bin"))))
- (computed-file "vmlinux.kpart" builder))
+ (invoke #+(file-append u-boot-tools "/bin/mkimage")
+ "-D" "-I dts -O dtb -p 2048"
+ "-f" "auto" ; format
+ "-A" #$arch ; architecture
+ "-O" "linux" ; os
+ "-T" "kernel" ; image type
+ "-C" "None" ; compression
+ "-d" "zImage" ; image data
+ "-a" "0" ; load address (hex)
+ "-b" "dtb" ; dtb for device
+ "-i" "initrd" ; initrd
+ "image.itb")
+ (call-with-output-file "bootloader.bin"
+ (lambda (port)
+ (put-bytevector port (make-bytevector 512 0))))
+ (call-with-output-file "kernel-arguments"
+ (lambda (port)
+ (display (string-join (list #$@linux-arguments)) port)))
+ (invoke #+(file-append vboot-utils "/bin/vbutil_kernel")
+ "--version" "1"
+ "--vmlinuz" "image.itb"
+ "--arch" #$arch
+ "--keyblock"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel.keyblock")
+ "--signprivate"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel_data_key.vbprivk")
+ "--config" "kernel-arguments"
+ "--pack" "vmlinux.kpart")
+ (write-file-on-device "vmlinux.kpart"
+ (stat:size (stat "vmlinux.kpart"))
+ #$disk 0))))))
-(define* (depthcharge-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- (match entries
- ((entry)
- (let ((kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- ;; XXX: Make this a symlink.
- (signed-kernel kernel kernel-arguments initrd)))
- (_ (error "Too many bootloader menu entries!"))))
-
-(define install-depthcharge
- #~(lambda (bootloader device mount-point)
- (let ((kpart (string-append mount-point
- "/boot/depthcharge/vmlinux.kpart")))
- (write-file-on-device kpart (stat:size (stat kpart)) device 0))))
-
-(define depthcharge-bootloader
+(define depthcharge-veyron-speedy-bootloader
(bootloader
(name 'depthcharge)
- (package #f)
- (installer install-depthcharge)
- (configuration-file "/boot/depthcharge/vmlinux.kpart")
- (configuration-file-generator depthcharge-configuration-file)))
+ (installer (cute install-depthcharge "arm" "rk3288-veyron-speedy.dtb"
+ <...>))))
+
+(define-deprecated/alias depthcharge-bootloader
+ depthcharge-veyron-speedy-bootloader)
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index d9b6d8bf8a..c3ab6f3275 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,112 +22,102 @@
(define-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:export (extlinux-bootloader
+ #:export (install-extlinux-config ; for u-boot
+ extlinux-bootloader
+ extlinux-gpt-bootloader
extlinux-bootloader-gpt))
-(define* (extlinux-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- "Return the U-Boot configuration file corresponding to CONFIG, a
-<u-boot-configuration> object, and where the store is available at STORE-FS, a
-<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
-corresponding to old generations of the system."
-
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
-
- (define with-fdtdir?
- (bootloader-configuration-device-tree-support? config))
+\f
+;;;
+;;; Config procedures.
+;;;
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- #~(format port "LABEL ~a
+(define* (install-extlinux-config #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ "Installer for the extlinux configuration file, meant to be shared by all
+bootloaders that use the format to specify boot options."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets menu-entries device-tree-support? timeout)
+ (define (menu-entry->gexp entry)
+ (match-record entry <menu-entry> (label linux linux-arguments initrd)
+ (let* ((normkern (normalize-file entry linux))
+ (fdt #~(string-append "FDTDIR" (dirname #$normkern) "/lib/dtbs")))
+ #~(format port "LABEL ~a
MENU LABEL ~a
KERNEL ~a
~a
INITRD ~a
APPEND ~a
-~%"
- #$label #$label
- #$kernel
- (if #$with-fdtdir?
- (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
- "")
- #$initrd
- (string-join (list #$@kernel-arguments)))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (let ((timeout #$(bootloader-configuration-timeout config)))
- (format port "# This file was generated from your Guix configuration. Any changes
+~%" #$label #$label #$normkern
+ #$(if device-tree-support? fdt "")
+ #$(normalize-file entry initrd)
+ (string-join (list #$@linux-arguments))))))
+
+ (let ((ents (cons (boot-alternative->menu-entry current-boot-alternative)
+ (append menu-entries
+ (map boot-alternative->menu-entry old-boot-alternatives)))))
+ (with-targets targets
+ (('extlinux => (path :path))
+ #~(begin (mkdir-p #$path)
+ (call-with-output-file #$path
+ (lambda (port)
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
# will be lost upon reconfiguration.
UI menu.c32
MENU TITLE GNU Guix Boot Options
PROMPT ~a
-TIMEOUT ~a~%"
- (if (> timeout 0) 1 0)
- ;; timeout is expressed in 1/10s of seconds.
- (* 10 timeout))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "~%"))
- #~())))))
-
- (computed-file "extlinux.conf" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-
+TIMEOUT ~a~%" ;; timeout is expressed in tenths of a second
+ #$(if (> timeout 0) 1 0) #$(* 10 timeout))
+ #$@(map menu-entry->gexp ents)))))))))
\f
-
;;;
-;;; Install procedures.
+;;; Install procedure.
;;;
(define (install-extlinux mbr)
- #~(lambda (bootloader device mount-point)
- (let ((extlinux (string-append bootloader "/sbin/extlinux"))
- (install-dir (string-append mount-point "/boot/extlinux"))
- (syslinux-dir (string-append bootloader "/share/syslinux")))
- (for-each (lambda (file)
- (install-file file install-dir))
- (find-files syslinux-dir "\\.c32$"))
- (invoke/quiet extlinux "--install" install-dir)
- (write-file-on-device (string-append syslinux-dir "/" #$mbr)
- 440 device 0))))
-
-(define install-extlinux-mbr
- (install-extlinux "mbr.bin"))
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('extlinux => (path :path))
+ #~(begin
+ #$(apply install-extlinux-config args)
+ (copy-recursively #$(file-append syslinux "/share/syslinux") #$path)
+ (invoke/quiet #+(file-append syslinux "/sbin/extlinux")
+ "--install" #$path)))
+ (('disk => (disk :device))
+ #~(write-file-on-device #$(file-append syslinux "/share/syslinux/" mbr)
+ 440 #$disk 0)))))
-(define install-extlinux-gpt
- (install-extlinux "gptmbr.bin"))
\f
-
;;;
;;; Bootloader definitions.
;;;
(define extlinux-bootloader
(bootloader
- (name 'extlinux)
- (package syslinux)
- (installer install-extlinux-mbr)
- (configuration-file "/boot/extlinux/extlinux.conf")
- (configuration-file-generator extlinux-configuration-file)))
-
-(define extlinux-bootloader-gpt
+ (name 'extlinux)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (install-extlinux "mbr.bin"))))
+
+(define extlinux-gpt-bootloader
(bootloader
- (inherit extlinux-bootloader)
- (installer install-extlinux-gpt)))
+ (inherit extlinux-bootloader)
+ (installer (install-extlinux "gptmbr.bin"))))
+
+(define-deprecated/alias extlinux-bootloader-gpt extlinux-gpt-bootloader)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..71fcc90ec7 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,24 +28,26 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader grub)
- #:use-module (guix build union)
- #:use-module (guix records)
- #:use-module (guix store)
- #:use-module (guix utils)
- #:use-module (guix gexp)
#:use-module (gnu artwork)
#:use-module (gnu bootloader)
- #:use-module (gnu system uuid)
- #:use-module (gnu system file-systems)
- #:use-module (gnu system keyboard)
- #:use-module (gnu system locale)
#:use-module (gnu packages bootloaders)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
#:autoload (gnu packages xorg) (xkeyboard-config)
+ #:use-module (gnu system boot)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system keyboard)
+ #:use-module (gnu system locale)
+ #:use-module (gnu system uuid)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (guix utils)
#:use-module (ice-9 match)
- #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
#:export (grub-theme
grub-theme?
grub-theme-image
@@ -53,54 +56,109 @@ (define-module (gnu bootloader grub)
grub-theme-color-highlight
grub-theme-gfxmode
- install-grub-efi-removable
- make-grub-efi-netboot-installer
-
+ grub.dir ; for (gnu build image) iso9660 images
grub-bootloader
+ grub-minimal-bootloader
grub-efi-bootloader
+ ;; deprecated
grub-efi-removable-bootloader
grub-efi32-bootloader
grub-efi-netboot-bootloader
- grub-efi-netboot-removable-bootloader
- grub-mkrescue-bootloader
- grub-minimal-bootloader
+ grub-efi-netboot-removable-bootloader))
- grub-configuration))
-
-;;; Commentary:
+\f
;;;
-;;; Configuration of GNU GRUB.
+;;; General utils.
;;;
-;;; Code:
-(define* (normalize-file file mount-point store-directory-prefix)
- "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
-G-expression or other lowerable object denoting a file name."
+;; in-gexp procedure to sanitize a value to be inserted into a GRUB script
+(define (sanitize str)
+ "Sanitize a value for use in a GRUB script."
+ #~(let* ((glycerin (lambda (l r) (if (pair? l) (append l r) (cons l r))))
+ (isopropyl (lambda (c) (case c ((#\\ #\$ #\") '(#\\ ,c)) (else c)))))
+ (use-modules (srfi srfi-1))
+ (list->string (fold-right glycerin '()
+ (map isopropyl (string->list #$str))))))
- (define (strip-mount-point mount-point file)
- (if mount-point
- (if (string=? mount-point "/")
- file
- #~(let ((file #$file))
- (if (string-prefix? #$mount-point file)
- (substring #$file #$(string-length mount-point))
- file)))
- file))
- (define (prepend-store-directory-prefix store-directory-prefix file)
- (if store-directory-prefix
- #~(string-append #$store-directory-prefix #$file)
- file))
- (prepend-store-directory-prefix store-directory-prefix
- (strip-mount-point mount-point file)))
+(define (grub-format type 32?)
+ (string-append
+ (cond ((string-prefix? "pc" type) "i386")
+ ((target-x86-32?) "i386")
+ ((target-x86-64?) (if 32? "i386" "x86_64"))
+ ((target-arm32?) "arm")
+ ((target-aarch64?) (if 32? "arm" "arm64"))
+ ((target-powerpc?) "powerpc")
+ ((target-riscv64?) "riscv64")
+ (else (raise (formatted-message (G_ "unrecognized target arch '~a'!")
+ (or (%current-target-system) (%current-system))))))
+ "-" type))
+(define* (search/target type targets var #:optional (port #f))
+ "Returns a gexp of a GRUB search command for target TYPE, storing the result
+in VAR. Optionally outputs to the gexp PORT instead of returning a string."
+ (define (form name val)
+ #~(format #$port "search.~a \"~a\" ~a~%" #$name #$val #$var))
+ (with-targets targets
+ ((type => (path :devpath) (device :device) (fs :fs)
+ (label :label) (uuid :uuid))
+ (cond ((member fs '("tftp" "nfs")) #~(format #$port "set ~a=tftp~%" #$var))
+ (uuid (form "fs_uuid" (uuid->string uuid)))
+ (label (form "fs_label" label))
+ (else (form "file" (sanitize path)))))))
+
+
+
+(define* (search/menu-entry device file var #:optional (port #f))
+ "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
+a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
+code to set the variable VAR. This procedure is able to handle DEVICEs
+unmounted at evaltime."
+ (match device
+ ;; Preferably refer to DEVICE by its UUID or label. This is more
+ ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
+ ((? uuid? idfk) ; calling idfk uuid here errors for some reason
+ #~(format #$port "search.fs_uuid ~a ~a~%" #$(uuid->string device) #$var))
+ ((? file-system-label? label)
+ #~(format #$port "search.fs_label \"~a\" ~a~%"
+ #$(sanitize (file-system-label->string label)) #$var))
+ ((? (lambda (device)
+ (and (string? device) (string-contains device ":/"))) nfs-uri)
+ ;; If the device is an NFS share, then we assume that the expected
+ ;; file on that device (e.g. the GRUB background image or the kernel)
+ ;; has to be loaded over the network. Otherwise we would need an
+ ;; additional device information for some local disk to look for that
+ ;; file, which we do not have.
+ ;;
+ ;; TFTP is preferred to HTTP because it is used more widely and
+ ;; specified in standards more widely--especially BOOTP/DHCPv4
+ ;; defines a TFTP server for DHCP option 66, but not HTTP.
+ ;;
+ ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
+ ;; which can contain a HTTP or TFTP URL.
+ ;;
+ ;; Note: It is assumed that the file paths are of a similar
+ ;; setup on both the TFTP server and the NFS server (it is
+ ;; not possible to search for files on TFTP).
+ ;;
+ ;; TODO: Allow HTTP.
+ #~(format #$port "set ~a=tftp~%" #$var))
+ ((or #f (? string?))
+ #~(format #$port "search.file \"~a\" ~a~%" #$(sanitize file) #$var))))
+
+
+
+\f
+;;;
+;;; Theming.
+;;;
+
(define-record-type* <grub-theme>
;; Default theme contributed by Felipe López.
- grub-theme make-grub-theme
- grub-theme?
+ grub-theme make-grub-theme grub-theme?
(image grub-theme-image
(default (file-append %artwork-repository
"/grub/GuixSD-fully-black-4-3.svg")))
@@ -113,128 +171,274 @@ (define-record-type* <grub-theme>
(gfxmode grub-theme-gfxmode
(default '("auto")))) ;list of string
+(define (grub-theme-png theme)
+ "Return the GRUB background image defined in THEME. If the suffix of the
+image file is \".svg\", then it is converted into a PNG file with the
+resolution provided in CONFIG. Returns #f if no file is provided."
+ (match-record theme <grub-theme> (image resolution)
+ (match resolution
+ (((? number? width) . (? number? height))
+ (computed-file "grub-image.png"
+ (with-imported-modules '((gnu build svg) (guix build utils))
+ (with-extensions (list guile-rsvg guile-cairo)
+ #~(begin (use-modules (gnu build svg) (guix build utils))
+ (if (png-file? #$image) (copy-file #$image #$output)
+ (svg->png #$image #$output
+ #:width #$width
+ #:height #$height)))))))
+ (_ image))))
+
+
+
\f
;;;
-;;; Background image & themes.
+;;; Core config.
+;;; GRUB architecture works by having a bootstage load up a core.img, which then
+;;; sets the root and prefix variables, allowing grub to load its main config
+;;; and modules, and then enter normal mode. On i386-pc systems a boot.img is
+;;; flashed which loads the core.img from the MBR gap, but on efi systems the
+;;; core.img is just a PE executable, able to be booted directly. We set up a
+;;; minimal core.img capable of finding the user-configured 'install target to
+;;; load its config from there.
;;;
-(define (bootloader-theme config)
- "Return user defined theme in CONFIG if defined or a default theme
-otherwise."
- (or (bootloader-configuration-theme config) (grub-theme)))
-
-(define* (image->png image #:key width height)
- "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\".
-Otherwise the picture in IMAGE is just copied."
- (computed-file "grub-image.png"
- (with-imported-modules '((gnu build svg))
- (with-extensions (list guile-rsvg guile-cairo)
- #~(if (string-suffix? ".svg" #+image)
- (begin
- (use-modules (gnu build svg))
- (svg->png #+image #$output
- #:width #$width
- #:height #$height))
- (copy-file #+image #$output))))))
-
-(define* (grub-background-image config)
- "Return the GRUB background image defined in CONFIG or #f if none was found.
-If the suffix of the image file is \".svg\", then it is converted into a PNG
-file with the resolution provided in CONFIG."
- (let* ((theme (bootloader-theme config))
- (image (grub-theme-image theme)))
- (and image
- (match (grub-theme-resolution theme)
- (((? number? width) . (? number? height))
- (image->png image #:width width #:height height))
- (_ #f)))))
-
-(define (grub-locale-directory grub)
- "Generate a directory with the locales from GRUB."
- (define builder
- #~(begin
- (use-modules (ice-9 ftw))
- (let ((locale (string-append #$grub "/share/locale"))
- (out #$output))
- (mkdir out)
- (chdir out)
- (for-each (lambda (lang)
- (let ((file (string-append locale "/" lang
- "/LC_MESSAGES/grub.mo"))
- (dest (string-append lang ".mo")))
- (when (file-exists? file)
- (copy-file file dest))))
- (scandir locale)))))
- (computed-file "grub-locales" builder))
-
-(define* (eye-candy config store-device store-mount-point
- #:key store-directory-prefix port)
- "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
-concerned with graphics mode, background images, colors, and all that.
-STORE-DEVICE designates the device holding the store, and STORE-MOUNT-POINT is
-its mount point; these are used to determine where the background image and
-fonts must be searched for. STORE-DIRECTORY-PREFIX is a directory prefix to
-prepend to any store file name."
- (define (setup-gfxterm config)
- (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
- #~(format #f "
+(define (core.cfg targets store-crypto-devices)
+ "Returns a filelike object for a core configuration file good enough to
+decrypt STORE-CRYPTO-DEVICES and boot to normal."
+ (define (crypto-device->cryptomount dev)
+ (and (uuid? dev) ; ignore non-uuids - warning given by os
+ #~(format port "cryptomount -u ~a~%"
+ ;; cryptomount only accepts UUID without the hyphen.
+ #$(string-delete #\- (uuid->string dev)))))
+
+ (and=>
+ (with-targets targets
+ (('install => (path :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ #$@(filter ->bool
+ (map crypto-device->cryptomount store-crypto-devices))
+ #$(search/target 'install targets "root" #~port)
+ (format port "set \"prefix=($root)~a\"~%" #$(sanitize path))))))
+ (cut computed-file "core.cfg" <>)))
+
+
+
+;; TODO: do we need LVM support here?
+(define* (core.img grub format #:key bootloader-config store-crypto-devices
+ #:allow-other-keys)
+ "The core image for GRUB, built for FORMAT."
+ (let* ((targets (bootloader-configuration-targets bootloader-config))
+ (bios? (string-prefix? format "pc"))
+ (efi? (string=? format "efi"))
+ (32? (bootloader-configuration-32bit? bootloader-config))
+ (cfg (core.cfg targets store-crypto-devices)))
+ (and cfg
+ (and=>
+ (with-targets targets
+ (('install => (fs :fs))
+ (let ((tftp? (or (string=? fs "tftp") (string=? fs "nfs"))))
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils) (ice-9 textual-ports)
+ (srfi srfi-1))
+ (apply invoke #$(file-append grub "/bin/grub-mkimage")
+ "--output" #$output
+ "--config" #$cfg
+ "--prefix" "none" ; we override this in cfg
+ ;; bios pxe uses pxeboot instead of diskboot - diff format
+ "--format" #$(string-append (grub-format format 32?)
+ (if (and bios? tftp?) "-pxe" ""))
+ "--compression" "auto"
+ ;; modules
+ "minicmd"
+ (append
+ ;; disk drivers
+ '#$(if bios? '("biosdisk") '())
+ ;; partmaps (TODO: detect which to use?)
+ '#$(if tftp? '() '("part_msdos" "part_gpt"))
+ ;; file systems
+ '#$(cond ((member fs '("ext2" "ext3" "ext4")) '("ext2"))
+ ((member fs "vfat" "fat32") "fat")
+ ((and tftp? efi?) "efinet")
+ ((and tftp? bios?) "pxe")
+ (else (list fs)))
+ ;; store crypto devs
+ '#$(if (any uuid? store-crypto-devices)
+ '("luks" "luks2" "cryptomount") '())
+ ;; search module that cfg uses
+ (call-with-input-file #$cfg
+ (lambda (port)
+ (let* ((str (get-string-all port))
+ (use (lambda (s) (string-contains str s))))
+ (cond ((use "search.fs_uuid") '("search_fs_uuid"))
+ ((use "search.fs_label") '("search_label"))
+ ((use "search.file") '("search_fs_file"))
+ (else '()))))))))))))
+ (cut computed-file "core.img" <>
+ #:options '(#:local-build? #t #:substitutable? #f))))))
+
+
+
+\f
+;;;
+;;; Main config.
+;;; This is what does the heavy lifting after core.img finds it.
+;;;
+
+(define (menu-entry->gexp store extra-initrd port)
+ (lambda (entry)
+ (match-record entry <menu-entry>
+ (label device linux linux-arguments initrd
+ multiboot-kernel multiboot-arguments multiboot-modules chain-loader)
+ (let ((norm (compose sanitize (cut normalize-file entry <>))))
+ #~(begin
+ (format #$port "menuentry ~s {~% " #$label)
+ #$(search/menu-entry
+ device (or linux multiboot-kernel chain-loader) "boot" port)
+ #$@(cond
+ (linux
+ (list #~(format #$port " linux \"($boot)~a\" ~a~%"
+ #$(norm linux)
+ ;; grub passes rest of the line _verbatim_
+ (string-join (list #$@linux-arguments)))
+ #~(format #$port " initrd ~a \"($boot)~a\"~%"
+ (if #$extra-initrd (string-append "($boot)\""
+ (norm #$extra-initrd) "\"")
+ "")
+ #$(norm initrd))))
+ ;; previously, this provided a (wrong) root= argument. just
+ ;; don't bother anymore. better less info than wrong info
+ (multiboot-kernel
+ (cons #~(format #$port " multiboot \"($boot)~a\" ~a~%"
+ #$(norm multiboot-kernel)
+ (string-join (list #$@multiboot-arguments)))
+ (map (lambda (mod) #~(format port " module \"($boot)~a\"~%"
+ #$(norm mod)))
+ multiboot-modules)))
+ (chain-loader
+ (list #~(format #$port " chainloader \"~a\"~%"
+ #$(norm chain-loader)))))
+ (format #$port "}~%"))))))
+
+
+
+(define* (grub.cfg #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ locale
+ store-directory-prefix
+ #:allow-other-keys)
+ "Returns a valid grub config given installer inputs. Expects locales, keymap,
+and theme image at LOCALES-TARG, KEYMAP-TARG, and IMAGE-TARG, respectively."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match keyboard-layout here cause it's bound to its struct
+ (targets menu-entries default-entry timeout extra-initrd
+ theme terminal-outputs terminal-inputs serial-unit serial-speed)
+ (let* ((entry->gexp (menu-entry->gexp store-directory-prefix
+ extra-initrd #~port))
+ (terms->str (compose string-join (cut map symbol->string <>)))
+ (colors->str (lambda (c) (format #f "~a/~a" (assoc-ref c 'fg)
+ (assoc-ref c 'bg))))
+ (outputs (or terminal-outputs '(gfxterm))) ; set default outs
+ (inputs (or terminal-inputs '())) ; set default ins
+ (theme (or theme (grub-theme))))
+ (and=>
+ (with-targets targets
+ (('install => (install :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ ;; preamble
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
+# will be lost upon reconfiguration~%")
+ #$@(filter ->bool
+ (list
+ ;; menu settings
+ (and default-entry
+ #~(format port "set default=~a~%" #$default-entry))
+ (and timeout
+ #~(format port "set timeout=~a~%" #$timeout))
+ ;; gfxterm setup
+ (and (memq 'gfxterm outputs)
+ #~(format port "\
if loadfont unicode; then
set gfxmode=~a
insmod all_video
insmod gfxterm
-fi~%"
- #$(string-join
- (grub-theme-gfxmode (bootloader-theme config))
- ";"))
- ""))
-
- (define (theme-colors type)
- (let* ((theme (bootloader-theme config))
- (colors (type theme)))
- (string-append (symbol->string (assoc-ref colors 'fg)) "/"
- (symbol->string (assoc-ref colors 'bg)))))
-
- (define image
- (normalize-file (grub-background-image config)
- store-mount-point
- store-directory-prefix))
-
- (and image
- #~(format #$port "
-# Set 'root' to the partition that contains /gnu/store.
-~a
-
-~a
-~a
-
+fi~%" #$(string-join (grub-theme-gfxmode theme) ";")))
+ ;; io
+ (and (or serial-unit serial-speed)
+ #~(format port "serial --unit=~a --speed=~a~%"
+ ;; documented defaults are unit 0 at 9600 baud.
+ #$(number->string (or serial-unit 0))
+ #$(number->string (or serial-speed 9600))))
+ (and (pair? outputs)
+ #~(format port "terminal_output ~a~%"
+ #$(terms->str outputs)))
+ (and (pair? inputs)
+ #~(format port "terminal_input ~a~%"
+ #$(terms->str inputs)))
+ ;; locale
+ (and locale
+ #~(format port "\
+set \"locale_dir=($root)~a/locales\"
+set lang=~a~%" #$(sanitize install)
+ #$(locale-definition-source
+ (locale-name->definition locale))))
+ ;; keyboard layout
+ (and (bootloader-configuration-keyboard-layout
+ bootloader-config)
+ #~(format port "\
+insmod keylayouts
+keymap \"($root)~a/keymap~%\"" #$(sanitize install)))
+ ;; theme
+ (match-record theme <grub-theme>
+ (image color-normal color-highlight)
+ (and image
+ #~(format port "\
insmod png
-if background_image ~a; then
+if background_image \"($root)~a/image.png\"; then
set color_normal=~a
set color_highlight=~a
else
set menu_color_normal=cyan/blue
- set menu_color_highlight=white/blue
-fi~%"
- #$(grub-root-search store-device image)
- #$(setup-gfxterm config)
- #$(grub-setup-io config)
+ set menu_color_highlight=whiute/blue
+fi~%" #$(sanitize install)
+ #$(colors->str color-normal)
+ #$(colors->str color-highlight))))))
+ ;; menu entries
+ #$(entry->gexp
+ (boot-alternative->menu-entry current-boot-alternative))
+ #$@(map entry->gexp menu-entries)
+ #$@(if (pair? old-boot-alternatives)
+ (append (list #~(format port "submenu ~s {~%"
+ "GNU system, old configurations..."))
+ (map (compose entry->gexp
+ boot-alternative->menu-entry)
+ old-boot-alternatives)
+ (list #~(format port "}~%"))) '())
+ (format port "
+if [ \"${grub_platform}\" == efi ]; then
+ menuentry \"Firmware setup\" {
+ fwsetup
+ }
+fi~%")))))
+ (cut computed-file "grub.cfg" <>
+ ;; Since this file is rather unique, there's no point in trying to
+ ;; substitute it.
+ #:options '(#:local-build? #t #:substitutable? #f))))))
- #$image
- #$(theme-colors grub-theme-color-normal)
- #$(theme-colors grub-theme-color-highlight))))
-\f
-;;;
-;;; Configuration file.
-;;;
-(define* (keyboard-layout-file layout
- #:key
- (grub grub))
+(define (keyboard-layout-file layout grub)
"Process the X keyboard layout description LAYOUT, a <keyboard-layout> record,
and return a file in the format for GRUB keymaps. LAYOUT must be present in
the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
- (define builder
+ (computed-file
+ (string-append "grub-keymap."
+ (string-map (match-lambda (#\, #\-) (chr chr))
+ (keyboard-layout-name layout)))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
@@ -243,670 +447,175 @@ (define* (keyboard-layout-file layout
;; (from the 'console-setup' package).
(invoke #+(file-append grub "/bin/grub-mklayout")
"-i" #+(keyboard-layout->console-keymap layout)
- "-o" #$output))))
-
- (computed-file (string-append "grub-keymap."
- (string-map (match-lambda
- (#\, #\-)
- (chr chr))
- (keyboard-layout-name layout)))
- builder))
-
-(define (grub-setup-io config)
- "Return GRUB commands to configure the input / output interfaces. The result
-is a string that can be inserted in grub.cfg."
- (let* ((symbols->string (lambda (list)
- (string-join (map symbol->string list) " ")))
- (outputs (bootloader-configuration-terminal-outputs config))
- (inputs (bootloader-configuration-terminal-inputs config))
- (unit (bootloader-configuration-serial-unit config))
- (speed (bootloader-configuration-serial-speed config))
-
- ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
- ;; as documented in GRUB manual section "Simple Configuration
- ;; Handling".
- (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
- gfxterm vga_text mda_text morse spkmodem))
- (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
- at_keyboard usb_keyboard))
-
- (io (string-append
- ;; UNIT and SPEED are arguments to the same GRUB command
- ;; ("serial"), so we process them together.
- (if (or unit speed)
- (string-append
- "serial"
- (if unit
- ;; COM ports 1 through 4
- (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
- (string-append " --unit=" (number->string unit))
- #f)
- "")
- (if speed
- (if (exact-integer? speed)
- (string-append " --speed=" (number->string speed))
- #f)
- "")
- "\n")
- "")
- (if (null? inputs)
- ""
- (string-append
- "terminal_input "
- (symbols->string
- (map
- (lambda (input)
- (if (memq input valid-inputs) input #f)) inputs))
- "\n"))
- "terminal_output "
- (symbols->string
- (map
- (lambda (output)
- (if (memq output valid-outputs) output #f)) outputs)))))
- (format #f "~a" io)))
-
-(define (grub-root-search device file)
- "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
-a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
-code."
- ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
- ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
- ;; custom menu entries. In the latter case, don't emit a 'search' command.
- (if (and (string? file) (not (string-prefix? "/" file)))
- ""
- (match device
- ;; Preferably refer to DEVICE by its UUID or label. This is more
- ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
- ((? uuid? uuid)
- (format #f "search --fs-uuid --set ~a"
- (uuid->string device)))
- ((? file-system-label? label)
- (format #f "search --label --set ~a"
- (file-system-label->string label)))
- ((? (lambda (device)
- (and (string? device) (string-contains device ":/"))) nfs-uri)
- ;; If the device is an NFS share, then we assume that the expected
- ;; file on that device (e.g. the GRUB background image or the kernel)
- ;; has to be loaded over the network. Otherwise we would need an
- ;; additional device information for some local disk to look for that
- ;; file, which we do not have.
- ;;
- ;; We explicitly set "root=(tftp)" here even though if grub.cfg
- ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
- ;; automatically anyway. The reason is if you have a system that
- ;; used to be on NFS but now is local, root would be set to local
- ;; disk. If you then selected an older system generation that is
- ;; supposed to boot from network in the Grub boot menu, Grub still
- ;; wouldn't load those files from network otherwise.
- ;;
- ;; TFTP is preferred to HTTP because it is used more widely and
- ;; specified in standards more widely--especially BOOTP/DHCPv4
- ;; defines a TFTP server for DHCP option 66, but not HTTP.
- ;;
- ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
- ;; which can contain a HTTP or TFTP URL.
- ;;
- ;; Note: It is assumed that the file paths are of a similar
- ;; setup on both the TFTP server and the NFS server (it is
- ;; not possible to search for files on TFTP).
- ;;
- ;; TODO: Allow HTTP.
- "set root=(tftp)")
- ((or #f (? string?))
- #~(format #f "search --file --set ~a" #$file)))))
-
-(define* (make-grub-configuration grub config entries
- #:key
- (locale #f)
- (system (%current-system))
- (old-entries '())
- (store-crypto-devices '())
- store-directory-prefix)
- "Return the GRUB configuration file corresponding to CONFIG, a
-<bootloader-configuration> object, and where the store is available at
-STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
-entries corresponding to old generations of the system.
-STORE-CRYPTO-DEVICES contain the UUIDs of the encrypted units that must
-be unlocked to access the store contents.
-STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
-when booting a root file system on a Btrfs subvolume."
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (linux (menu-entry-linux entry))
- (device (menu-entry-device entry))
- (device-mount-point (menu-entry-device-mount-point entry))
- (multiboot-kernel (menu-entry-multiboot-kernel entry))
- (chain-loader (menu-entry-chain-loader entry)))
- (cond
- (linux
- (let ((arguments (menu-entry-linux-arguments entry))
- (linux (normalize-file linux
- device-mount-point
- store-directory-prefix))
- (initrd (normalize-file (menu-entry-initrd entry)
- device-mount-point
- store-directory-prefix))
- (extra-initrd (bootloader-configuration-extra-initrd config)))
- ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
- ;; Use the right file names for LINUX and INITRD in case
- ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
- ;; separate partition.
-
- ;; When STORE-DIRECTORY-PREFIX is defined, prepend it the linux and
- ;; initrd paths, to allow booting from a Btrfs subvolume.
- #~(format port "menuentry ~s {
- ~a
- linux ~a ~a
- initrd ~a ~a
-}~%"
- #$label
- #$(grub-root-search device linux)
- #$linux (string-join (list #$@arguments))
- (or #$extra-initrd "")
- #$initrd)))
- (multiboot-kernel
- (let* ((kernel (menu-entry-multiboot-kernel entry))
- (arguments (menu-entry-multiboot-arguments entry))
- ;; Choose between device names as understood by Mach's built-in
- ;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
- ;; in the "noide" case).
- (disk (if (member "noide" arguments) "w" "h"))
- (modules (menu-entry-multiboot-modules entry))
- (root-index 1)) ; XXX EFI will need root-index 2
- #~(format port "
-menuentry ~s {
- multiboot ~a root=part:~a:device:~ad0~a~a
-}~%"
- #$label
- #$kernel
- #$root-index
- #$disk
- (string-join (list #$@arguments) " " 'prefix)
- (string-join (map string-join '#$modules)
- "\n module " 'prefix))))
- (chain-loader
- #~(format port "
-menuentry ~s {
- ~a
- chainloader ~a
-}~%"
- #$label
- #$(grub-root-search device chain-loader)
- #$chain-loader)))))
-
- (define (crypto-devices)
- (define (crypto-device->cryptomount dev)
- (if (uuid? dev)
- #~(format port "cryptomount -u ~a~%"
- ;; cryptomount only accepts UUID without the hypen.
- #$(string-delete #\- (uuid->string dev)))
- ;; Other type of devices aren't implemented.
- #~()))
- (let ((devices (map crypto-device->cryptomount store-crypto-devices))
- (modules #~(format port "insmod luks~%insmod luks2~%")))
- (if (null? devices)
- devices
- (cons modules devices))))
-
- (define (sugar)
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- (eye-candy config
- device
- mount-point
- #:store-directory-prefix store-directory-prefix
- #:port #~port)))
-
- (define locale-config
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- #~(let ((locale #$(and locale
- (locale-definition-source
- (locale-name->definition locale))))
- (locales #$(and locale
- (normalize-file (grub-locale-directory grub)
- mount-point
- store-directory-prefix))))
- (when locale
- (format port "\
-# Localization configuration.
-~asearch --file --set ~a/en@quot.mo
-set locale_dir=~a
-set lang=~a~%"
- ;; Skip the search if there is an image, as it has already
- ;; been performed by eye-candy and traversing the store is
- ;; an expensive operation.
- #$(if (grub-theme-image (bootloader-theme config))
- "# "
- "")
- locales
- locales
- locale)))))
-
- (define keyboard-layout-config
- (let* ((layout (bootloader-configuration-keyboard-layout config))
- (keymap* (and layout
- (keyboard-layout-file layout #:grub grub)))
- (entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry))
- (keymap (and keymap*
- (normalize-file keymap* mount-point
- store-directory-prefix))))
- #~(when #$keymap
- (format port "\
-insmod keylayouts
-keymap ~a~%" #$keymap))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (format port
- "# This file was generated from your Guix configuration. Any changes
-# will be lost upon reconfiguration.
-")
- #$@(crypto-devices)
- #$(sugar)
- #$locale-config
- #$keyboard-layout-config
- (format port "
-set default=~a
-set timeout=~a~%"
- #$(bootloader-configuration-default-entry config)
- #$(bootloader-configuration-timeout config))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "
-submenu \"GNU system, old configurations...\" {~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "}~%"))
- #~())
- (format port "
-if [ \"${grub_platform}\" == efi ]; then
- menuentry \"Firmware setup\" {
- fwsetup
- }
-fi~%"))))
+ "-o" #$output)))))
+
+
+
+(define* (grub.dir grub #:key bootloader-config locale
+ #:allow-other-keys . args)
+ "Everything what should go in GRUB's prefix, including fonts, modules,
+locales, keymap, theme image, and grub.cfg."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match for keyboard-layout: identifier bound in this scope
+ (targets theme)
+ (let* ((theme (or theme (grub-theme)))
+ (keyboard-layout (bootloader-configuration-keyboard-layout
+ bootloader-config))
+ (lang (and=> locale (compose locale-definition-source
+ locale-name->definition)))
+ (lc-mesg (and=> lang (cut file-append grub "/share/locale" <>
+ "/LC_MESSAGES/grub.mo"))))
+ (computed-file "grub.dir"
+ (with-imported-modules '((guix build utils))
+ #~(begin (use-modules (guix build utils))
+ (mkdir-p #$output)
+ (chdir #$output)
+ ;; grub files
+ (copy-recursively #$(file-append grub "/lib/grub/") #$output
+ #:copy-file symlink)
+ (mkdir "fonts")
+ (symlink #$(file-append grub "/share/grub/unicode.pf2")
+ "fonts/unicode.pf2")
+ ;; config file
+ (symlink #$(apply grub.cfg args) "grub.cfg")
+ ;; locales
+ (when (and=> #$lc-mesg file-exists?)
+ (mkdir "locales")
+ (symlink #$lc-mesg (string-append "locales/" #$lang ".mo")))
+ ;; keymap
+ #$@(filter ->bool
+ (list
+ (and keyboard-layout
+ #~(symlink #$(keyboard-layout-file keyboard-layout grub)
+ "keymap"))
+ ;; image
+ (and (grub-theme-image theme)
+ #~(copy-file #$(grub-theme-png theme) "image.png"))))))
+ #:options '(#:local-build? #t #:substitutable? #f)))))
- ;; Since this file is rather unique, there's no point in trying to
- ;; substitute it.
- (computed-file "grub.cfg" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-(define (grub-configuration-file config . args)
- (let* ((bootloader (bootloader-configuration-bootloader config))
- (grub (bootloader-package bootloader)))
- (apply make-grub-configuration grub config args)))
-
-(define (grub-efi-configuration-file . args)
- (apply make-grub-configuration grub-efi args))
-
-(define grub-cfg "/boot/grub/grub.cfg")
\f
-
;;;
-;;; Install procedures.
+;;; Installers.
;;;
-(define install-grub
- #~(lambda (bootloader device mount-point)
- (let ((grub (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot")))
- ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE
- ;; is #f, then we populate the disk-image rooted at MOUNT-POINT.
- (if device
- (begin
- ;; Tell 'grub-install' that there might be a LUKS-encrypted
- ;; /boot or root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-
- ;; Hide potentially confusing messages from the user, such as
- ;; "Installing for i386-pc platform."
- (invoke/quiet grub "--no-floppy" "--target=i386-pc"
- "--boot-directory" install-dir
- device))
- ;; When creating a disk-image, only install a font and GRUB modules.
- (let* ((fonts (string-append install-dir "/grub/fonts")))
- (mkdir-p fonts)
- (copy-file (string-append bootloader "/share/grub/unicode.pf2")
- (string-append fonts "/unicode.pf2"))
- (copy-recursively (string-append bootloader "/lib/")
- install-dir))))))
-
-(define install-grub-disk-image
- #~(lambda (bootloader root-index image)
- ;; Install GRUB on the given IMAGE. The root partition index is
- ;; ROOT-INDEX.
- (let ((grub-mkimage
- (string-append bootloader "/bin/grub-mkimage"))
- (modules '("biosdisk" "part_msdos" "fat" "ext2"))
- (grub-bios-setup
- (string-append bootloader "/sbin/grub-bios-setup"))
- (root-device (format #f "hd0,msdos~a" root-index))
- (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img"))
- (device-map "device.map"))
-
- ;; Create a minimal, standalone GRUB image that will be written
- ;; directly in the MBR-GAP (space between the end of the MBR and the
- ;; first partition).
- (apply invoke grub-mkimage
- "-O" "i386-pc"
- "-o" "core.img"
- "-p" (format #f "(~a)/boot/grub" root-device)
- modules)
-
- ;; Create a device mapping file.
- (call-with-output-file device-map
- (lambda (port)
- (format port "(hd0) ~a~%" image)))
-
- ;; Copy the default boot.img, that will be written on the MBR sector
- ;; by GRUB-BIOS-SETUP.
- (copy-file boot-img "boot.img")
-
- ;; Install both the "boot.img" and the "core.img" files on the given
- ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB
- ;; written in the MBR-GAP. GRUB configuration and missing modules will
- ;; be read from ROOT-DEVICE.
- (invoke grub-bios-setup
- "-m" device-map
- "-r" root-device
- "-d" "."
- image))))
-
-(define install-grub-efi
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi-removable
- #~(lambda (bootloader efi-dir mount-point)
- ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
- ;; NOTE: efi-dir comes from target list of booloader configuration
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--removable"
- ;; "--no-nvram"
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi32
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- (cond ((target-x86?) "--target=i386-efi")
- ((target-arm?) "--target=arm-efi"))
- "--efi-directory" target-esp)))))
-
-(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
- "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
-its files in SUBDIR and its configuration file in GRUB-CFG.
-
-As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
-installer basically copies all files from the bootloader-package (or profile)
-into the bootloader-target directory.
-
-Additionally for network booting over TFTP, two relative symlinks to the store
-and to the GRUB-CFG file are necessary. Due to this a TFTP root directory must
-not be located on a FAT file-system.
-
-If the bootloader-target does not support symlinks, then it is assumed to be a
-kind of EFI System Partition (ESP). In this case an intermediate configuration
-file is created with the help of GRUB-EFI to load the GRUB-CFG.
-
-The installer is usable for any efi-bootloader-chain, which prepares the
-bootloader-profile in a way ready for copying.
-
-The installer does not manipulate the system's 'UEFI Boot Manager'.
-
-The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
-arguments. Its job is to copy the BOOTLOADER, which must be a pre-installed
-grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
-directory TARGET for the system whose root is mounted at MOUNT-POINT.
-
-MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
-or '/' for other 'guix system' commands.
-
-Where TARGET comes from the targets argument given to the
-bootloader-configuration in:
-
-(operating-system
- (bootloader (bootloader-configuration
- (targets '(\"/boot/efi\"))
- …))
- …)
-
-TARGET is required to be an absolute directory name, usually mounted via NFS,
-and finally needs to be provided by a TFTP server as
-the TFTP root directory.
-
-Usually the installer will be used to prepare network booting over TFTP. Then
-GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
-load more files from the store like tftp://server/gnu/store/…-linux…/Image.
-
-To make this possible two symlinks are created. The first symlink points
-relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
-MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
-MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.
-
-It is important to note that these symlinks need to be relative, as the absolute
-paths on the TFTP server side are unknown.
-
-It is also important to note that both symlinks will point outside the TFTP root
-directory and that the TARGET/%store-prefix symlink makes the whole store
-accessible via TFTP. Possibly the TFTP server must be configured to allow
-accesses outside its TFTP root directory. This all may need to be considered
-for security aspects. It is advised to disable any TFTP write access!
-
-The installer can also be used to prepare booting from local storage, if the
-underlying file-system, like FAT on an EFI System Partition (ESP), does not
-support symlinks. In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
-created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file. A
-symlink to the store is not needed in this case."
- (with-imported-modules '((guix build union))
- #~(lambda (bootloader target mount-point)
- ;; In context of a disk image creation TARGET will be #f and an
- ;; installer is expected to do necessary installations on MOUNT-POINT,
- ;; which will become the root file system. If TARGET is #f, this
- ;; installer has nothing to do, as it only cares about the EFI System
- ;; Partition (ESP).
- (when target
- (use-modules ((guix build union) #:select (symlink-relative))
- (ice-9 popen)
- (ice-9 rdelim))
- (let* ((mount-point/target (string-append mount-point target "/"))
- ;; When installing Guix, it is common to mount TARGET below
- ;; MOUNT-POINT rather than the root directory.
- (bootloader-target (if (file-exists? mount-point/target)
- mount-point/target
- target))
- (store (string-append mount-point (%store-prefix)))
- (store-link (string-append bootloader-target (%store-prefix)))
- (grub-cfg (string-append mount-point #$grub-cfg))
- (grub-cfg-link (string-append bootloader-target
- #$subdir "/"
- (basename grub-cfg))))
- ;; Copy the bootloader into the bootloader-target directory.
- ;; Should we beforehand recursively delete any existing file?
- (copy-recursively bootloader bootloader-target
- #:follow-symlinks? #t
- #:log (%make-void-port "w"))
- ;; For TFTP we need to install additional relative symlinks.
- ;; If we install on an EFI System Partition (ESP) or some other FAT
- ;; file-system, then symlinks cannot be created and are not needed.
- ;; Therefore we ignore exceptions when trying.
- ;; Prepare the symlink to the grub.cfg.
- (mkdir-p (dirname grub-cfg-link))
- (false-if-exception (delete-file grub-cfg-link))
- (if (unspecified?
- (false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
- ;; Symlinks are supported.
- (begin
- ;; Prepare the symlink to the store.
- (mkdir-p (dirname store-link))
- (false-if-exception (delete-file store-link))
- (symlink-relative store store-link))
- ;; Creating symlinks does not seem to be supported. Probably
- ;; an ESP is used. Add a script to search and load the actual
- ;; grub.cfg.
- (let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
- (port (open-pipe* OPEN_READ probe "--target=fs_uuid"
- grub-cfg))
- (search-root
- (match (read-line port)
- ((? eof-object?)
- ;; There is no UUID available. As a fallback search
- ;; everywhere for the grub.cfg.
- (string-append "search --file --set " #$grub-cfg))
- (fs-uuid
- ;; The UUID to load the grub.cfg from is known.
- (string-append "search --fs-uuid --set " fs-uuid))))
- (load-grub-cfg (string-append "configfile " #$grub-cfg)))
- (close-pipe port)
- (with-output-to-file grub-cfg-link
- (lambda ()
- (display (string-join (list search-root
- load-grub-cfg)
- "\n")))))))))))
+(define* (install-grub.dir grub #:key bootloader-config
+ #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('install => (path :path))
+ #~(copy-recursively #$(apply grub.dir grub args) #$path
+ #:log (%make-void-port "w")
+ #:follow-symlinks? #t
+ #:copy-file atomic-copy))))
+
+(define (install-grub-bios grub)
+ "Returns an installer for the bios-bootable grub package GRUB."
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (gbegin (apply install-grub.dir grub args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('disk => (device :device))
+ #~(invoke #$(file-append grub "/sbin/grub-bios-setup") "-v" "-v"
+ "--directory" "/" ; can't be blank
+ "--device-map" "" ; no dev map - need to specify
+ "--boot-image"
+ #$(file-append grub "/lib/grub/i386-pc/boot.img")
+ "--core-image" #$(apply core.img grub "pc" args)
+ "--root-device" #$(string-append "hostdisk/" device)
+ #$device))))))
+
+(define* (install-grub-efi #:key bootloader-config #:allow-other-keys . args)
+ "Installs grub into the system's uefi bootloader, taking into account
+user-specified requirements for a 32-bit or fallback bootloader."
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (grub (if 32? grub-efi32 grub-efi))
+ (core (apply core.img grub "efi" args))
+ (copy #~(lambda (dest) (copy-file #$core dest))))
+ (gbegin (apply install-grub.dir grub args)
+ (install-efi bootloader-config #~`((,#$copy "grub.efi" . "GNU GRUB"))))))
+
-\f
+\f
;;;
-;;; Bootloader definitions.
+;;; Bootloaders.
;;;
-;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
-;;; is fixed. Inheriting and overwriting the field 'configuration-file' will
-;;; break 'guix system delete-generations', 'guix system switch-generation',
-;;; and 'guix system roll-back'.
+
+(define %grub-default-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))))
(define grub-bootloader
(bootloader
- (name 'grub)
- (package grub)
- (installer install-grub)
- (disk-image-installer install-grub-disk-image)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub))))
(define grub-minimal-bootloader
(bootloader
- (inherit grub-bootloader)
- (package grub-minimal)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub-minimal))))
(define grub-efi-bootloader
(bootloader
- (name 'grub-efi)
- (package grub-efi)
- (installer install-grub-efi)
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
-
-(define grub-efi-removable-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (name 'grub-efi-removable-bootloader)
- (installer install-grub-efi-removable)))
+ (name 'grub-efi)
+ (default-targets (cons (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))
+ %grub-default-targets))
+ (installer install-grub-efi)))
-(define grub-efi32-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (installer install-grub-efi32)
- (name 'grub-efi32)
- (package grub-efi32)))
-(define (make-grub-efi-netboot-bootloader name subdir)
- (bootloader
- (name name)
- (package (make-grub-efi-netboot (symbol->string name) subdir))
- (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-efi-configuration-file)))
-
-(define grub-efi-netboot-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
- "efi/Guix"))
-
-(define grub-efi-netboot-removable-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
- "efi/boot"))
-
-(define grub-mkrescue-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (package grub-hybrid)))
\f
;;;
-;;; Compatibility macros.
+;;; deprecated shit!
+;;; use the bootloader-config flags instead! or, in the case of netboot, set
+;;; your 'install (or parent thereof) target fs to be "tftp" or "nfs"
;;;
-(define-syntax grub-configuration
- (syntax-rules (grub)
- ((_ (grub package) fields ...)
- (if (eq? package grub)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...)
- (bootloader-configuration
- (bootloader grub-efi-bootloader)
- fields ...)))
- ((_ fields ...)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...))))
-
-;;; grub.scm ends here
+(define (deprecated-installer installer removable? 32?)
+ (lambda args (apply installer
+ (substitute-keyword-arguments args
+ ((#:bootloader-config conf) (bootloader-configuration
+ (inherit conf)
+ (efi-removable? removable?)
+ (32bit? 32?)))))))
+
+(define-deprecated grub-efi-removable-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #t #f))))
+
+(define-deprecated grub-efi32-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #f #t))))
+
+(define %netboot-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot")
+ (file-system "tftp"))
+ (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+
+(define-deprecated grub-efi-netboot-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)))
+
+(define-deprecated grub-efi-netboot-removable-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)
+ (installer (deprecated-installer install-grub-efi #t #f))))
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index c5437a7b63..7d3e202f8c 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Herman Rimm <herman_rimm@protonmail.com>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,12 +25,11 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader u-boot)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
+ #:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
- #:export (u-boot-bootloader
- u-boot-a20-olinuxino-lime-bootloader
+ #:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
u-boot-bananapi-m2-ultra-bootloader
@@ -53,301 +53,172 @@ (define-module (gnu bootloader u-boot)
u-boot-ts7970-q-2g-1000mhz-c-bootloader
u-boot-wandboard-bootloader))
-(define install-u-boot
- #~(lambda (bootloader root-index image)
- (if bootloader
- (error "Failed to install U-Boot"))))
+(define (make-install-u-boot firmware installers)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('extlinux (apply install-extlinux-config args))
+ (('install => (path :path)) #~(let ((path #$path) #$firmware)))
+ (('disk => (disk :device)) #~(let ((disk #$disk)) #f #$@installers)))))
+
+(define-syntax-rule (define-u-bootloader def-name package firmware
+ (file size doffset) ...)
+ "Defines a u-boot installer DEF-NAME, using u-boot PACKAGE. Installs each
+given FILE of SIZE (or #f to autodetect) to the targetted disk at OFFSET.
+FIRMWARE is ran on the u-boot firmware directory for installation of supporting
+files, with the variable path set to the dir path."
+ (define def-name
+ (bootloader
+ (name 'u-boot)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (make-install-u-boot firmware
+ (list #~(let ((fw #$(file-append package "/libexec/" file)))
+ (write-file-on-device fw
+ #$(or size #~(stat:size (stat fw)))
+ disk #$doffset)) ...))))))
+
+\f
+;;;
+;;; Bootloader definitions.
+;;;
-(define install-beaglebone-black-u-boot
+(define-u-bootloader u-boot-beaglebone-black-bootloader
+ u-boot-am335x-boneblack #f
;; http://wiki.beyondlogic.org/index.php?title=BeagleBoneBlack_Upgrading_uBoot
;; This first stage bootloader called MLO (U-Boot SPL) is expected at
;; 0x20000 by BBB ROM code. The second stage bootloader will be loaded by
;; the MLO and is expected at 0x60000. Write both first stage ("MLO") and
- ;; second stage ("u-boot.img") images, read in BOOTLOADER directory, to the
- ;; specified DEVICE.
- #~(lambda (bootloader root-index image)
- (let ((mlo (string-append bootloader "/libexec/MLO"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device mlo (* 256 512)
- image (* 256 512))
- (write-file-on-device u-boot (* 1024 512)
- image (* 768 512)))))
-
-(define install-allwinner-u-boot
- #~(lambda (bootloader root-index image)
- (let ((u-boot (string-append bootloader
- "/libexec/u-boot-sunxi-with-spl.bin")))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 8 1024)))))
-
-(define install-allwinner64-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 8 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 40 1024)))))
-
-(define install-imx-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/SPL"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 1 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 69 1024)))))
-
-(define install-orangepi-r1-plus-lts-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-puma-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 512 512)))))
-
-(define install-firefly-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rock64-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rockpro64-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-pinebook-pro-rk3399-u-boot install-rockpro64-rk3399-u-boot)
-
-(define install-u-boot-ts7970-q-2g-1000mhz-c-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.imx (string-append bootloader "/libexec/u-boot.imx"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.imx install-dir))))
-
-(define install-sifive-unmatched-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/spl/u-boot-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append
- bootloader "/libexec/spl/u-boot-spl.bin.normal.out"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-uEnv.txt
- #~(lambda (bootloader device mount-point)
- (mkdir-p (string-append mount-point "/boot"))
- (call-with-output-file (string-append mount-point "/boot/uEnv.txt")
+ ;; second stage ("u-boot.img") images to the target.
+ ("MLO" (* 256 512) (* 256 512))
+ ("u-boot.img" (* 1024 512) (* 768 512)))
+
+(define-u-bootloader u-boot-sifive-unmatched-bootloader
+ u-boot-sifive-unmatched #f
+ ("spl/u-boot-spl.bin" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+(define-u-bootloader u-boot-starfive-visionfive2-bootloader
+ u-boot-starfive-visionfive2
+ #~(begin (mkdir-p path)
+ (call-with-output-file (string-append path "/uEnv.txt")
(lambda (port)
(format port
- ;; if board SPI use vender's u-boot, will find
- ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
- ;; that users will update this u-boot, so set it.
- "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%")))))
+ ;; if board SPI use vender's u-boot, will find
+ ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
+ ;; that users will update this u-boot, so set it.
+ "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%"))))
+ ("spl/u-boot-spl.bin.normal.out" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+\f
+;;;
+;;; Allwinner bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))))
+
-(define install-qemu-riscv64-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.bin (string-append bootloader "/libexec/u-boot.bin"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.bin install-dir))))
+(define-u-bootloader-allwinner u-boot-nintendo-nes-classic-edition-bootloader
+ u-boot-nintendo-nes-classic-edition)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime-bootloader
+ u-boot-a20-olinuxino-lime)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime2-bootloader
+ u-boot-a20-olinuxino-lime2)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-micro-bootloader
+ u-boot-a20-olinuxino-micro)
+
+(define-u-bootloader-allwinner u-boot-bananapi-m2-ultra-bootloader
+ u-boot-bananapi-m2-ultra)
+
+(define-u-bootloader-allwinner u-boot-cubietruck-bootloader u-boot-cubietruck)
+
+(define-u-bootloader-allwinner u-boot-pine64-lts-bootloader u-boot-pine64-lts)
\f
+;;;
+;;; Allwinner64 bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner64 def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))
+ ("u-boot-sunxi-with-spl.fit.itb" #f (* 40 1024))))
+
+
+(define-u-bootloader-allwinner64 u-boot-pine64-plus-bootloader
+ u-boot-pine64-plus)
+
+(define-u-bootloader-allwinner64 u-boot-pinebook-bootloader u-boot-pinebook)
+\f
;;;
-;;; Bootloader definitions.
+;;; IMX bootloader definitions.
;;;
+(define-syntax-rule (define-u-bootloader-imx def-name package)
+ (define-u-bootloader def-name package #f
+ ("SPL" #f (* 8 1024))
+ ("u-boot.img" #f (* 40 1024))))
-(define u-boot-bootloader
- (bootloader
- (inherit extlinux-bootloader)
- (name 'u-boot)
- (package #f)
- (installer #f)
- (disk-image-installer install-u-boot)))
-
-(define u-boot-beaglebone-black-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-am335x-boneblack)
- (disk-image-installer install-beaglebone-black-u-boot)))
-
-(define u-boot-allwinner-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner-u-boot)))
-
-(define u-boot-allwinner64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner64-u-boot)))
-
-(define u-boot-imx-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-imx-u-boot)))
-
-(define u-boot-nintendo-nes-classic-edition-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-nintendo-nes-classic-edition)))
-
-(define u-boot-a20-olinuxino-lime-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime)))
-
-(define u-boot-a20-olinuxino-lime2-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime2)))
-
-(define u-boot-a20-olinuxino-micro-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-micro)))
-
-(define u-boot-bananapi-m2-ultra-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-bananapi-m2-ultra)))
-
-(define u-boot-cubietruck-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-cubietruck)))
-
-(define u-boot-firefly-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-firefly-rk3399)
- (disk-image-installer install-firefly-rk3399-u-boot)))
-
-(define u-boot-mx6cuboxi-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-mx6cuboxi)))
-
-(define u-boot-wandboard-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-wandboard)))
-
-(define u-boot-novena-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-novena)))
-
-(define u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-orangepi-r1-plus-lts-rk3328)
- (disk-image-installer install-orangepi-r1-plus-lts-rk3328-u-boot)))
-
-(define u-boot-pine64-plus-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pine64-plus)))
-
-(define u-boot-pine64-lts-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-pine64-lts)))
-
-(define u-boot-pinebook-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pinebook)))
-
-(define u-boot-puma-rk3399-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-puma-rk3399)
- (disk-image-installer install-puma-rk3399-u-boot)))
-
-(define u-boot-rock64-rk3328-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rock64-rk3328)
- (disk-image-installer install-rock64-rk3328-u-boot)))
-(define u-boot-rockpro64-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rockpro64-rk3399)
- (disk-image-installer install-rockpro64-rk3399-u-boot)))
+(define-u-bootloader-imx u-boot-mx6cuboxi-bootloader u-boot-mx6cuboxi)
+
+(define-u-bootloader-imx u-boot-wandboard-bootloader u-boot-wandboard)
-(define u-boot-pinebook-pro-rk3399-bootloader
+(define-u-bootloader-imx u-boot-novena-bootloader u-boot-novena)
+
+\f
+;;;
+;;; Rockchip bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-rockchip def-name package)
;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-pinebook-pro-rk3399)
- (disk-image-installer install-pinebook-pro-rk3399-u-boot)))
-
-(define u-boot-ts7970-q-2g-1000mhz-c-bootloader
- ;; This bootloader doesn't really need to be installed, as it is read from
- ;; an SPI memory chip, not the SD card. It is copied to /boot/u-boot.imx
- ;; for convenience and should be manually flashed at the U-Boot prompt.
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-ts7970-q-2g-1000mhz-c)
- (installer install-u-boot-ts7970-q-2g-1000mhz-c-u-boot)
- (disk-image-installer #f)))
-
-(define u-boot-sifive-unmatched-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-sifive-unmatched)
- (disk-image-installer install-sifive-unmatched-u-boot)))
-
-(define u-boot-starfive-visionfive2-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-starfive-visionfive2)
- (installer install-starfive-visionfive2-uEnv.txt)
- (disk-image-installer install-starfive-visionfive2-u-boot)))
-
-(define u-boot-qemu-riscv64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-qemu-riscv64)
- (installer install-qemu-riscv64-u-boot)
- (disk-image-installer #f)))
+ (define-u-bootloader def-name package #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 16384 512))))
+
+(define-u-bootloader-rockchip u-boot-firefly-rk3399-bootloader
+ u-boot-firefly-rk3399)
+
+(define-u-bootloader-rockchip u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+ u-boot-orangepi-r1-plus-lts-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rock64-rk3328-bootloader
+ u-boot-rock64-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rockpro64-rk3399-bootloader
+ u-boot-rockpro64-rk3399)
+
+(define-u-bootloader-rockchip u-boot-pinebook-pro-rk3399-bootloader
+ u-boot-pinebook-pro-rk3399)
+
+(define-u-bootloader u-boot-puma-rk3399-bootloader u-boot-puma-rk3399 #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 512 512)))
+
+\f
+;;;
+;;; Copy-only bootloader definitions.
+;;;
+
+;; These bootloaders don't really need to be installed, as they are read from
+;; an SPI memory chip or directly from the FS, not the disk.
+(define-syntax-rule (define-u-bootloader-copy def-name package file)
+ (define-u-bootloader def-name package
+ #~(install-file #$(file-append package "/libexec/" file) path)))
+
+;; user should manually install this to SPI flash
+;; TODO: write directly to SPI flash? unless wear issues are a problem.
+(define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
+ u-boot-ts7970-q-2g-1000mhz-c "u-boot.imx")
+
+(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
+ u-boot-qemu-riscv64 "u-boot.bin")
diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm
index af6063a884..b59287d759 100644
--- a/gnu/build/bootloader.scm
+++ b/gnu/build/bootloader.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,20 +21,45 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build bootloader)
+ #:autoload (guix build syscalls) (free-disk-space)
#:use-module (guix build utils)
- #:use-module (guix utils)
- #:use-module (ice-9 binary-ports)
+ #: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)
- #:export (write-file-on-device
- install-efi-loader))
+ #: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))
\f
;;;
;;; 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 block ...)
+ "Run blocks... while chdir'd into a temporary directory."
+ ;; mkdtemp under POSIX.1-2008 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 () block ...)
+ (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
@@ -56,57 +82,78 @@ (define (write-file-on-device file size device offset)
;;; EFI bootloader.
;;;
-(define* (install-efi grub grub-config esp #:key targets)
- "Write a self-contained GRUB EFI loader to the mounted ESP using
-GRUB-CONFIG.
-
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let* ((system %host-type)
- ;; Hard code the output location to a well-known path recognized by
- ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
- ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
- (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
- (efi-directory (string-append esp "/EFI/BOOT"))
- ;; Map grub target names to boot file names.
- (efi-targets (or targets
- (cond ((string-prefix? "x86_64" system)
- '("x86_64-efi" . "BOOTX64.EFI"))
- ((string-prefix? "i686" system)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((string-prefix? "armhf" system)
- '("arm-efi" . "BOOTARM.EFI"))
- ((string-prefix? "aarch64" system)
- '("arm64-efi" . "BOOTAA64.EFI"))))))
- ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
- (setenv "TMPDIR" esp)
-
- (mkdir-p efi-directory)
- (invoke grub-mkstandalone "-O" (car efi-targets)
- "-o" (string-append efi-directory "/"
- (cdr efi-targets))
- ;; Graft the configuration file onto the image.
- (string-append "boot/grub/grub.cfg=" grub-config))))
+(define parse-bootnums
+ (make-regexp "^Boot([0-9a-fA-F]+).*[^A-Za-z]File\\(([^)]+)\\)$" regexp/newline))
-(define* (install-efi-loader grub-efi esp #:key targets)
- "Install in ESP directory the given GRUB-EFI bootloader. Configure it to
-load the Grub bootloader located in the 'Guix_image' root partition.
+;; 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))))
+ (unless (zero? status)
+ (raise-exception
+ (formatted-message (G_ "efibootmgr exited with error code ~a") status)))
+ (fold-matches parse-bootnums text '()
+ (lambda (match acc)
+ (let* ((path (match:substring match 2))
+ (bootnum (match:substring match 1)))
+ (cons (cons path bootnum) acc))))))
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let ((grub-config "grub.cfg"))
- (call-with-output-file grub-config
- (lambda (port)
- ;; Create a tiny configuration file telling the embedded grub where to
- ;; load the real thing. XXX This is quite fragile, and can prevent
- ;; the image from booting when there's more than one volume with this
- ;; label present. Reproducible almost-UUIDs could reduce the risk
- ;; (not eliminate it).
- (format port
- "insmod part_msdos~@
- insmod part_gpt~@
- search --set=root --label Guix_image~@
- configfile /boot/grub/grub.cfg~%")))
- (install-efi grub-efi grub-config esp #:targets targets)
- (delete-file grub-config)))
+(define (install-efi efibootmgr vendir loader* disk plan)
+ "See 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)))))
+ (builder name) ; build to a tmp file so we can check size
+ ;; 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))
+ ;; esp 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 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!~%")))
+ ;; boot order. recall efi-bootnums to get fresh list with new installs
+ ;; 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"
+ (let ((num (cute assoc-ref (efi-bootnums efibootmgr) <>))) ; cute is eager
+ (string-join (filter-map (compose num loaderof) plan-files) ",")))))
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 49dc01c0d1..b1abc99bba 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -28,6 +28,7 @@ (define-module (gnu build image)
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
+ #:use-module (guix deprecation)
#:use-module (guix store database)
#:use-module (guix utils)
#:use-module (gnu build bootloader)
@@ -181,30 +182,13 @@ (define* (register-closure prefix closure
#:prefix prefix
#:registration-time %epoch)))))
-(define* (initialize-efi-partition root
- #:key
- grub-efi
- #:allow-other-keys)
- "Install in ROOT directory, an EFI loader using GRUB-EFI."
- (install-efi-loader grub-efi root))
-
-(define* (initialize-efi32-partition root
- #:key
- grub-efi32
- #:allow-other-keys)
- "Install in ROOT directory, an EFI 32bit loader using GRUB-EFI32."
- (install-efi-loader grub-efi32 root
- #:targets (cond ((target-x86?)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((target-arm?)
- '("arm-efi" . "BOOTARM.EFI")))))
+(define (initialize-efi-partition root . rest)
+ (mkdir-p (string-append root "/EFI")))
+
+(define-deprecated/alias initialize-efi32-partition initialize-efi-partition)
(define* (initialize-root-partition root
#:key
- bootcfg
- bootcfg-location
- bootloader-package
- bootloader-installer
(copy-closures? #t)
(deduplicate? #t)
references-graphs
@@ -251,18 +235,10 @@ (define* (initialize-root-partition root
(unless copy-closures?
(delete-file root-store)
- (rename-file tmp-store root-store)))
-
- ;; There's no point installing a bootloader if we do not populate the store.
- (when copy-closures?
- (when bootloader-installer
- (display "installing bootloader...\n")
- (bootloader-installer bootloader-package #f root))
- (when bootcfg
- (install-boot-config bootcfg bootcfg-location root))))
+ (rename-file tmp-store root-store))))
(define* (make-iso9660-image xorriso grub-mkrescue-environment
- grub bootcfg system-directory root target
+ grub grub.dir system-directory root target
#:key (volume-id "Guix_image") (volume-uuid #f)
register-closures? (references-graphs '())
(compression? #t))
@@ -321,7 +297,7 @@ (define* (make-iso9660-image xorriso grub-mkrescue-environment
(apply invoke grub-mkrescue
(string-append "--xorriso=" grub-mkrescue-sed.sh)
"-o" target
- (string-append "boot/grub/grub.cfg=" bootcfg)
+ (string-append "boot/grub=" grub.dir)
root
"--"
;; Set all timestamps to 1.
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 0aa227b4d8..6b5435f13c 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -25,8 +25,7 @@ (define-module (gnu build install)
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (install-boot-config
- evaluate-populate-directive
+ #:export (evaluate-populate-directive
populate-root-file-system
install-database-and-gc-roots
populate-single-profile-directory
@@ -42,19 +41,6 @@ (define-module (gnu build install)
;;;
;;; Code:
-(define (install-boot-config bootcfg bootcfg-location mount-point)
- "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note
-that the caller must make sure that BOOTCFG is registered as a GC root so
-that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
- (let* ((target (string-append mount-point bootcfg-location))
- (pivot (string-append target ".new")))
- (mkdir-p (dirname target))
-
- ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
- ;; work when /boot is on a separate partition. Do that atomically.
- (copy-file bootcfg pivot)
- (rename-file pivot target)))
-
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
diff --git a/gnu/image.scm b/gnu/image.scm
index 7fb06dec10..6a3251014f 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -35,6 +35,7 @@ (define-module (gnu image)
partition-label
partition-uuid
partition-flags
+ partition-target
partition-initializer
image
@@ -131,6 +132,8 @@ (define-record-type* <partition> partition make-partition
(flags partition-flags
(default '()) ;list of symbols
(sanitize validate-partition-flags))
+ (target partition-target ; bootloader target type: symbol | #f
+ (default #f))
(initializer partition-initializer
(default #false))) ;gexp | #false
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 51fa7cf9d9..83682ea539 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1454,15 +1454,19 @@ (define (root-user-partition? partition)
(define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
- (let* ((root-partition (find root-user-partition?
- user-partitions))
+ (let* ((root-partition (find root-user-partition? user-partitions))
(root-partition-disk (user-partition-disk-file-name root-partition)))
`((bootloader-configuration
,@(if (efi-installation?)
`((bootloader grub-efi-bootloader)
- (targets (list ,(default-esp-mount-point))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path ,(default-esp-mount-point))))))
`((bootloader grub-bootloader)
- (targets (list ,root-partition-disk))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ ;; TODO: we should provide a uuid or label here
+ (device ,root-partition-disk))))))
;; XXX: Assume we defined the 'keyboard-layout' field of
;; <operating-system> right above.
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 8dd8c342a0..4a9d3faee1 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -505,18 +505,15 @@ (define (deploy-managed-host machine)
(machine-ssh-session machine)
(machine-become-command machine)))
- (mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-alternatives (machine->boot-alternatives machine)))
+ (mlet %store-monad ((_ (check-deployment-sanity machine)))
;; Make sure code that check %CURRENT-SYSTEM, such as
;; %BASE-INITRD-MODULES, gets to see the right value.
(parameterize ((%current-system system)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters boot-alternatives)))
- (bootloader-configuration (operating-system-bootloader os))
- (bootcfg (operating-system-bootcfg os menu-entries)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootmeta (operating-system-bootmeta os)))
(define-syntax-rule (eval/error-handling condition handler ...)
;; Return a wrapper around EVAL such that HANDLER is evaluated if an
;; exception is raised.
@@ -548,13 +545,15 @@ (define (deploy-managed-host machine)
(inferior-exception-arguments
c)))
os)
- (install-bootloader (eval/error-handling c
- (raise (formatted-message
- (G_ "\
+ (mlet %store-monad
+ ((boot-alternatives (machine->boot-alternatives machine)))
+ (apply install-bootloader
+ (eval/error-handling c
+ (raise (formatted-message
+ (G_ "\
failed to install bootloader on '~a':~%~{~s ~}~%")
- host
- (inferior-exception-arguments c))))
- bootloader-configuration bootcfg)))))))))
+ host (inferior-exception-arguments c))))
+ bootloader-config boot-alternatives bootmeta))))))))))
\f
;;;
@@ -585,32 +584,28 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
- (_ -> (if (< (length boot-alternatives) 2)
- (raise roll-back-failure)))
- (chosen-alternative (second boot-alternatives))
- (parameters (boot-alternative-parameters chosen-alternative))
- (entries -> (list (boot-parameters->menu-entry parameters)))
- (locale -> (boot-parameters-locale parameters))
- (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
- (store-dir -> (boot-parameters-store-directory-prefix parameters))
- (old-entries -> (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (drop boot-alternatives 2))))
- (bootloader -> (operating-system-bootloader
- (machine-operating-system machine)))
- (bootcfg (lower-object
- ((bootloader-configuration-file-generator
- (bootloader-configuration-bootloader
- bootloader))
- bootloader entries
- #:locale locale
- #:store-crypto-devices crypto-dev
- #:store-directory-prefix store-dir
- #:old-entries old-entries)))
- (remote-result (machine-remote-eval machine remote-exp)))
- (when (eqv? 'error remote-result)
- (raise roll-back-failure))))
+ (mlet %store-monad ((boot-alternatives (machine->boot-alternatives machine)))
+ (when (< (length boot-alternatives) 2) (raise roll-back-failure))
+ (mlet* %store-monad ((remote-result (machine-remote-eval machine remote-exp)))
+ (mwhen (eqv? 'error remote-result)
+ (raise roll-back-failure)))
+
+ (mlet* %store-monad ((os -> (machine-operating-system machine))
+ (chosen -> (cadr boot-alternatives))
+ (alts -> (cons* chosen (car boot-alternatives)
+ (cddr boot-alternatives)))
+ (params -> (boot-alternative-parameters chosen))
+ (locale -> (boot-parameters-locale chosen))
+ (crypto-dev -> (boot-parameters-store-crypto-devices
+ chosen))
+ (store-pre -> (boot-parameters-store-directory-prefix
+ chosen)))
+ (install-bootloader (cute machine-remote-eval machine <>)
+ (operating-system-bootloader os)
+ alts
+ #:locale locale
+ #:store-crypto-devices crypto-dev
+ #:store-directory-prefix store-pre))))
\f
;;;
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 4072df50d7..12f918a123 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -498,92 +498,6 @@ (define-public grub-hybrid
basename))))
(scandir input-dir)))))))))))
-(define-public (make-grub-efi-netboot name subdir)
- "Make a grub-efi-netboot package named NAME, which will be able to boot over
-network via TFTP by accessing its files in the SUBDIR of a TFTP root directory.
-This package is also able to boot from local storage devices.
-
-A bootloader-installer basically needs to copy the package content into the
-bootloader-target directory, which will usually be the TFTP root, as
-'grub-mknetdir' will be invoked already during the package creation.
-
-Alternatively the bootloader-target directory can be a mounted EFI System
-Partition (ESP), or a similar partition with a FAT file system, for booting
-from local storage devices.
-
-The name of the GRUB EFI binary will conform to the UEFI specification for
-removable media. Depending on the system it will be e.g. bootx64.efi or
-bootaa64.efi below SUBDIR.
-
-The SUBDIR argument needs to be set to \"efi/boot\" to create a package which
-conforms to the UEFI specification for removable media.
-
-The SUBDIR argument defaults to \"efi/Guix\", as it is also the case for
-'grub-efi-bootloader'."
- (package
- (name name)
- (version (package-version grub-efi))
- ;; Source is not needed, but it cannot be omitted.
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (let* ((system (string-split (nix-system->gnu-triplet
- (or (%current-target-system)
- (%current-system)))
- #\-))
- (arch (first system))
- (boot-efi
- (match system
- ;; These are the supportend systems and the names defined by
- ;; the UEFI standard for removable media.
- (("i686" _ ...) "/bootia32.efi")
- (("x86_64" _ ...) "/bootx64.efi")
- (("arm" _ ...) "/bootarm.efi")
- (("aarch64" _ ...) "/bootaa64.efi")
- (("riscv" _ ...) "/bootriscv32.efi")
- (("riscv64" _ ...) "/bootriscv64.efi")
- ;; Other systems are not supported, although defined.
- ;; (("riscv128" _ ...) "/bootriscv128.efi")
- ;; (("ia64" _ ...) "/bootia64.efi")
- ((_ ...) #f)))
- (core-efi (string-append
- ;; This is the arch dependent file name of GRUB, e.g.
- ;; i368-efi/core.efi or arm64-efi/core.efi.
- (match arch
- ("i686" "i386")
- ("aarch64" "arm64")
- ("riscv" "riscv32")
- (_ arch))
- "-efi/core.efi")))
- (list
- #:modules '((guix build utils))
- #:builder
- #~(begin
- (use-modules (guix build utils))
- (let* ((bootloader #$(this-package-input "grub-efi"))
- (net-dir #$output)
- (sub-dir (string-append net-dir "/" #$subdir "/"))
- (boot-efi (string-append sub-dir #$boot-efi))
- (core-efi (string-append sub-dir #$core-efi)))
- ;; Install GRUB, which refers to the grub.cfg, with support for
- ;; encrypted partitions,
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
- (string-append "--net-directory=" net-dir)
- (string-append "--subdir=" #$subdir)
- ;; These modules must be pre-loaded to allow booting
- ;; from an ESP or a similar partition with a FAT
- ;; file system.
- (string-append "--modules=part_msdos part_gpt fat"))
- ;; Move GRUB's core.efi to the removable media name.
- (false-if-exception (delete-file boot-efi))
- (rename-file core-efi boot-efi))))))
- (inputs (list grub-efi))
- (synopsis (package-synopsis grub-efi))
- (description (package-description grub-efi))
- (home-page (package-home-page grub-efi))
- (license (package-license grub-efi))))
-
(define-public syslinux
(let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
(package
diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index c4f03c3ed9..66f980dd79 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -19,8 +19,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages raspberry-pi)
- #:use-module (gnu bootloader)
- #:use-module (gnu bootloader grub)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages algebra)
@@ -328,22 +326,6 @@ (define (make-raspi-bcm28-dtbs linux)
(format #f "The device-tree files for Raspberry Pi models from ~a."
(package-name linux)))))
-(define-public grub-efi-bootloader-chain-raspi-64
- ;; A bootloader capable to boot a Raspberry Pi over network via TFTP or from
- ;; a local storage like a micro SD card. It neither installs firmware nor
- ;; device-tree files for the Raspberry Pi. It just assumes them to be
- ;; existing in boot/efi in the same way that some UEFI firmware with ACPI
- ;; data is usually assumed to be existing on PCs. It creates firmware
- ;; configuration files and a bootloader-chain with U-Boot to provide an EFI
- ;; API for the final GRUB bootloader. It also serves as a blue-print to
- ;; create an a custom bootloader-chain with firmware and device-tree
- ;; packages or files.
- (efi-bootloader-chain grub-efi-netboot-removable-bootloader
- #:packages (list u-boot-rpi-arm64-efi-bin)
- #:files (list %raspi-config-txt
- %raspi-bcm27-dtb-txt
- %raspi-u-boot-bootloader-txt)))
-
(define (make-raspi-defconfig arch defconfig sha256-as-base32)
"Make for the architecture ARCH a file-like object from the DEFCONFIG file
with the hash SHA256-AS-BASE32. This object can be used as the #:defconfig
diff --git a/gnu/system.scm b/gnu/system.scm
index 4a084b2ecf..a345b52d55 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -140,10 +140,11 @@ (define-module (gnu system)
operating-system-derivation
operating-system-profile
- operating-system-bootcfg
+ operating-system-bootmeta
operating-system-etc-directory
operating-system-locale-directory
operating-system-boot-script
+ operating-system-boot-parameters
operating-system-uuid
operating-system-with-gc-roots
@@ -171,6 +172,9 @@ (define-module (gnu system)
;;;
;;; Code:
+(define (convert-bootloader-field bootloader)
+ (if (list? bootloader) bootloader (list bootloader)))
+
(define-with-syntax-properties (warn-hosts-file-field-deprecation
(value properties))
(when value
@@ -193,7 +197,9 @@ (define-record-type* <operating-system> operating-system
(default %default-kernel-arguments)) ; list of gexps/strings
(hurd operating-system-hurd
(default #f)) ; package
- (bootloader operating-system-bootloader) ; <bootloader-configuration>
+ (bootloader operating-system-bootloader ; <bootloader-configuration>
+ (default '())
+ (sanitize convert-bootloader-field))
(label operating-system-label ; string
(thunked)
(default (operating-system-default-label this-operating-system)))
@@ -1208,30 +1214,17 @@ (define (operating-system-store-file-system os)
"Return the file system that contains the store of OS."
(store-file-system (operating-system-file-systems os)))
-(define* (operating-system-bootcfg os #:optional (old-entries '()))
- "Return the bootloader configuration file for OS. Use OLD-ENTRIES,
-a list of <menu-entry>, to populate the \"old entries\" menu."
+(define (operating-system-bootmeta os)
+ "Return operating system information to be passed to the bootloader
+installers."
(let* ((file-systems (operating-system-file-systems os))
+ (store-root (btrfs-store-subvolume-file-name file-systems))
(root-fs (operating-system-root-file-system os))
- (root-device (file-system-device root-fs))
(locale (operating-system-locale os))
- (crypto-devices (operating-system-bootloader-crypto-devices os))
- (params (operating-system-boot-parameters
- os root-device
- #:system-kernel-arguments? #t))
- (entry (boot-parameters->menu-entry params))
- (bootloader-conf (operating-system-bootloader os)))
-
- (define generate-config-file
- (bootloader-configuration-file-generator
- (bootloader-configuration-bootloader bootloader-conf)))
-
- (generate-config-file bootloader-conf (list entry)
- #:old-entries old-entries
- #:locale locale
- #:store-crypto-devices crypto-devices
- #:store-directory-prefix
- (btrfs-store-subvolume-file-name file-systems))))
+ (crypto-devices (operating-system-bootloader-crypto-devices os)))
+ (list #:store-crypto-devices crypto-devices
+ #:store-directory-prefix store-root
+ #:locale locale)))
(define (operating-system-multiboot-modules os)
(if (operating-system-hurd os) (hurd-multiboot-modules os) '()))
@@ -1295,9 +1288,9 @@ (define* (operating-system-boot-parameters os root-device
(file-systems (operating-system-file-systems os))
(crypto-devices (operating-system-bootloader-crypto-devices os))
(locale (operating-system-locale os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os)))
- (bootloader-name (bootloader-name bootloader))
+ (bootloader (map bootloader-configuration-bootloader
+ (operating-system-bootloader os)))
+ (bootloader-name (map bootloader-name bootloader))
(label (operating-system-label os))
(multiboot-modules (operating-system-multiboot-modules os)))
(boot-parameters
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 833caef496..2b5302ce5f 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -81,6 +81,7 @@ (define-module (gnu system boot)
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
+ boot-alternative->menu-entry
ensure-not-/dev
system-linux-image-file-name))
@@ -171,7 +172,8 @@ (define (read-boot-parameters port)
(bootloader-name
(match (assq 'bootloader-name rest)
- ((_ args) args)
+ ((_ (args ...)) args)
+ ((_ args) (list args))
(#f 'grub))) ; for compatibility reasons.
(bootloader-menu-entries
@@ -340,6 +342,7 @@ (define (boot-parameters->menu-entry conf)
(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)
@@ -353,6 +356,9 @@ (define (boot-parameters->menu-entry conf)
(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
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index b0c96c60f0..050f5b578b 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system image)
+ #:use-module (guix deprecation)
#:use-module (guix diagnostics)
#:use-module (guix discovery)
#:use-module (guix gexp)
@@ -42,6 +44,7 @@ (define-module (gnu system image)
#:use-module (gnu services base)
#:use-module (gnu system)
#:use-module (gnu system accounts)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system linux-container)
#:use-module (gnu system uuid)
@@ -133,12 +136,10 @@ (define esp-partition
;; FAT-ness is based on file system size (16 in this case).
(file-system "vfat")
(flags '(esp))
- (initializer (gexp initialize-efi-partition))))
+ (target 'esp)
+ (initializer #~initialize-efi-partition)))
-(define esp32-partition
- (partition
- (inherit esp-partition)
- (initializer (gexp initialize-efi32-partition))))
+(define-deprecated/alias esp32-partition esp-partition)
(define root-partition
(partition
@@ -149,6 +150,7 @@ (define root-partition
;; with U-Boot.
(file-system-options (list "-O" "^metadata_csum,^64bit"))
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))
(define mbr-disk-image
@@ -173,11 +175,7 @@ (define efi-disk-image
(partition-table-type 'gpt)
(partitions (list esp-partition root-partition))))
-(define efi32-disk-image
- (image-without-os
- (format 'disk-image)
- (partition-table-type 'gpt)
- (partitions (list esp32-partition root-partition))))
+(define-deprecated/alias efi32-disk-image efi-disk-image)
(define iso9660-image
(image-without-os
@@ -238,10 +236,7 @@ (define efi-raw-image-type
(name 'efi-raw)
(constructor (cut image-with-os efi-disk-image <>))))
-(define efi32-raw-image-type
- (image-type
- (name 'efi32-raw)
- (constructor (cut image-with-os efi32-disk-image <>))))
+(define-deprecated/alias efi32-raw-image-type efi-raw-image-type)
(define qcow2-image-type
(image-type
@@ -350,10 +345,6 @@ (define (find-root-partition image)
(raise (formatted-message
(G_ "image lacks a partition with the 'boot' flag")))))
-(define (root-partition-index image)
- "Return the index of the root partition of the given IMAGE."
- (1+ (srfi-1:list-index root-partition? (image-partitions image))))
-
\f
;;
;; Disk image.
@@ -362,8 +353,8 @@ (define (root-partition-index image)
(define* (system-disk-image image
#:key
(name "disk-image")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '()))
"Return as a file-like object, the disk-image described by IMAGE. Said
@@ -380,6 +371,28 @@ (define* (system-disk-image image
(define genimage-name "image")
+ (define (targets current)
+ ;; provides list of target overrides for a given CURRENT partition, which
+ ;; may be #f for the full-disk targets.
+
+ ;; XXX: how we pass paths is v much a hack
+ (cons (bootloader-target
+ (type 'disk)
+ (device (and (not current) (string-append "images/" genimage-name)))
+ (expected? (->bool current)))
+ (map (lambda (partition)
+ (let ((current? (and current (eq? (partition-target partition)
+ (partition-target current)))))
+ (bootloader-target
+ (type (partition-target partition))
+ (expected? (not current?))
+ (path (and current? "tmp-root"))
+ (offset #f)
+ (file-system (partition-file-system partition))
+ (label (partition-label partition))
+ (uuid (partition-uuid partition)))))
+ (filter partition-target (image-partitions image)))))
+
(define (image->genimage-cfg image)
;; Return as a file-like object, the genimage configuration file
;; describing the given IMAGE.
@@ -460,7 +473,8 @@ (define* (system-disk-image image
(list dosfstools fakeroot mtools))
(else
'())))
- (image-root "tmp-root"))
+ (image-root (string-append (getcwd) "/tmp-root"))
+ (copy-closures? (not #$(image-shared-store? image))))
(sql-schema #$schema)
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
@@ -476,18 +490,13 @@ (define* (system-disk-image image
(initializer image-root
#:references-graphs '#$graph
#:deduplicate? #f
- #:copy-closures? (not
- #$(image-shared-store? image))
- #:system-directory #$os
- #:grub-efi #+grub-efi
- #:grub-efi32 #+grub-efi32
- #:bootloader-package
- #+(bootloader-package bootloader)
- #:bootloader-installer
- #+(bootloader-installer bootloader)
- #:bootcfg #$bootcfg
- #:bootcfg-location
- #$(bootloader-configuration-file bootloader))
+ #:copy-closures? copy-closures?
+ #:system-directory #$os)
+ ;; no point installing a bootloader if we don't populate store
+ (when copy-closures?
+ ;; root-offset isn't necessary - we override 'root
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets partition)))
(make-partition-image #$(partition->gexp partition)
#$output
image-root)))))
@@ -534,14 +543,6 @@ (define* (system-disk-image image
(image-partition-table-type image)))
(else "")))
- (when (and (memq (bootloader-name bootloader)
- '(grub-efi grub-efi32 grub-efi-removable-bootloader))
- (not
- (gpt-image? image)))
- (raise
- (formatted-message
- (G_ "EFI bootloader required with GPT partitioning"))))
-
(let* ((format (image-format image))
(image-type (format->image-type format))
(image-type-options (genimage-type-options image-type image))
@@ -552,13 +553,15 @@ (define* (system-disk-image image
(let ((format (@ (ice-9 format) format)))
(call-with-output-file #$output
(lambda (port)
- (format port
- "\
+ (format port "\
image ~a {
~/~a {~a}
~{~a~^~%~}
-}~%" #$genimage-name #$image-type #$image-type-options
- (list #$@partitions-config))))))))
+}~%"
+ #$genimage-name
+ #$image-type
+ #$image-type-options
+ (list #$@partitions-config))))))))
(computed-file "genimage.cfg" builder)))
(let* ((image-name (image-name image))
@@ -570,17 +573,13 @@ (define* (system-disk-image image
(builder
(with-imported-modules*
(let ((inputs '#+(list genimage coreutils findutils qemu-minimal))
- (bootloader-installer
- #+(bootloader-disk-image-installer bootloader))
(out-image (string-append "images/" #$genimage-name)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(genimage #$(image->genimage-cfg image))
- ;; Install the bootloader directly on the disk-image.
- (when bootloader-installer
- (bootloader-installer
- #+(bootloader-package bootloader)
- #$(root-partition-index image)
- out-image))
+ ;; don't install bootloader unless installing store
+ (unless #$(image-shared-store? image)
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets #f)))
(convert-disk-image out-image '#$format #$output)))))
(computed-file name builder
#:local-build? #f ;too I/O-intensive
@@ -600,8 +599,8 @@ (define (has-guix-service-type? os)
(define* (system-iso9660-image image
#:key
(name "image.iso")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '())
(grub-mkrescue-environment '()))
@@ -621,7 +620,6 @@ (define* (system-iso9660-image image
(uuid-bytevector (partition-uuid partition)))))
(let* ((os (image-operating-system image))
- (bootloader (bootloader-package bootloader))
(compression? (image-compression? image))
(substitutable? (image-substitutable? image))
(schema (local-file (search-path %load-path
@@ -629,6 +627,14 @@ (define* (system-iso9660-image image
(graph (match inputs
(((names . _) ...)
names)))
+ (config (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list (bootloader-target
+ (type 'root)
+ (path "tmp-root"))
+ (bootloader-target
+ (type 'install)
+ (path "boot/grub"))))))
(builder
(with-imported-modules*
(let* ((inputs '#$(list parted e2fsprogs dosfstools xorriso
@@ -649,10 +655,12 @@ (define* (system-iso9660-image image
#:references-graphs '#$graph
#:deduplicate? #f
#:system-directory #$os)
+
(make-iso9660-image #$xorriso
'#$grub-mkrescue-environment
- #$bootloader
- #$bootcfg
+ #$grub-hybrid
+ #$(apply grub.dir grub-hybrid
+ #:bootloader-config config bootmeta)
#$os
image-root
#$output
@@ -954,11 +962,7 @@ (define (operating-system-for-image image)
file-systems
#:volatile-root? volatile-root?
rest)))
- (bootloader (if (eq? format 'iso9660)
- (bootloader-configuration
- (inherit
- (operating-system-bootloader base-os))
- (bootloader grub-mkrescue-bootloader))
+ (bootloader (if (eq? format 'iso9660) '()
(operating-system-bootloader base-os)))
(file-systems (cons (file-system
(mount-point "/")
@@ -1007,17 +1011,28 @@ (define* (system-image image)
(image* (image-with-os* image os))
(image-format (image-format image))
(register-closures? (has-guix-service-type? os))
- (bootcfg (operating-system-bootcfg os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os))))
+ ;; force removable - images don't have efivarfs
+ (bootloader-config (map (lambda (c) (bootloader-configuration
+ (inherit c)
+ (efi-removable? #t)))
+ (operating-system-bootloader os)))
+ (alt (boot-alternative
+ (generation 1)
+ (system-path "/var/guix/profiles/system-1-link")
+ (epoch 0)
+ (parameters (operating-system-boot-parameters os
+ (partition-uuid (find-root-partition image*))
+ #:system-kernel-arguments? #t))))
+ (bootmeta (cons* #:current-boot-alternative alt
+ #:old-boot-alternatives '()
+ (operating-system-bootmeta os))))
(cond
((memq image-format '(disk-image compressed-qcow2))
(system-disk-image image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))))
+ #:inputs `(("system" ,os))))
((memq image-format '(docker))
(system-docker-image image*))
((memq image-format '(tarball))
@@ -1027,11 +1042,10 @@ (define* (system-image image)
((memq image-format '(iso9660))
(system-iso9660-image
image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))
+ #:inputs `(("system" ,os))
;; Make sure to use a mode that does no imply
;; HFS+ tree creation that may fail with:
;;
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 9b618f7dc6..8fb00a6903 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -41,9 +41,7 @@ (define-module (gnu system images hurd)
(define hurd-barebones-os
(operating-system
(inherit %hurd-default-operating-system)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 810e2bed5f..a7a1f499dd 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -39,8 +39,7 @@ (define novena-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-novena-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-novena-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm-generic)
(kernel-arguments '("console=ttymxc1,115200"))
diff --git a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
index 6ec644f113..a3dae24377 100644
--- a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
+++ b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
@@ -39,8 +39,7 @@ (define orangepi-r1-plus-lts-rk3328-barebones-os
(timezone "Europe/Amsterdam")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 457ff4345f..b166838ddd 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -41,8 +41,7 @@ (define pine64-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pine64-lts-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pine64-lts-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 3a0f3abf1f..b26adfb7b9 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -38,8 +38,7 @@ (define pinebook-pro-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pinebook-pro-rk3399-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pinebook-pro-rk3399-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index b3dcfc6193..0b243662d6 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -39,8 +39,7 @@ (define rock64-barebones-os
(timezone "Europe/Oslo")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-rock64-rk3328-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader u-boot-rock64-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/unmatched.scm b/gnu/system/images/unmatched.scm
index d40a32f184..7eb147bbab 100644
--- a/gnu/system/images/unmatched.scm
+++ b/gnu/system/images/unmatched.scm
@@ -39,8 +39,7 @@ (define unmatched-barebones-os
(timezone "Asia/Jerusalem")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-sifive-unmatched-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-sifive-unmatched-bootloader)))
(initrd-modules '())
(kernel linux-libre-riscv64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/visionfive2.scm b/gnu/system/images/visionfive2.scm
index 26f70afbc1..a1c0733692 100644
--- a/gnu/system/images/visionfive2.scm
+++ b/gnu/system/images/visionfive2.scm
@@ -62,8 +62,7 @@ (define visionfive2-barebones-os
(timezone "Etc/UTC")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-starfive-visionfive2-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-starfive-visionfive2-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "Guix_image"))
(mount-point "/")
diff --git a/gnu/system/images/wsl2.scm b/gnu/system/images/wsl2.scm
index d9aaa1a271..1501cb9a90 100644
--- a/gnu/system/images/wsl2.scm
+++ b/gnu/system/images/wsl2.scm
@@ -127,16 +127,6 @@ (define dummy-package
(description #f)
(license (fsdg-compatible "dummy"))))
-(define dummy-bootloader
- (bootloader
- (name 'dummy-bootloader)
- (package dummy-package)
- (configuration-file "/dev/null")
- (configuration-file-generator
- (lambda (. _rest)
- (plain-file "dummy-bootloader" "")))
- (installer #~(const #t))))
-
(define dummy-kernel dummy-package)
(define (dummy-initrd . _rest)
@@ -146,9 +136,7 @@ (define-public wsl-os
(operating-system
(host-name "gnu")
(timezone "Etc/UTC")
- (bootloader
- (bootloader-configuration
- (bootloader dummy-bootloader)))
+ ;; no bootloader
(kernel dummy-kernel)
(initrd dummy-initrd)
(initrd-modules '())
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 0195a0804d..e76d12e95a 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -77,8 +77,7 @@ (define-module (gnu system install)
rock64-installation-os
rockpro64-installation-os
rk3399-puma-installation-os
- wandboard-installation-os
- os-with-u-boot))
+ wandboard-installation-os))
;;; Commentary:
;;;
@@ -503,9 +502,7 @@ (define installation-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(name-service-switch %mdns-host-lookup-nss)
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader (bootloader-configuration (bootloader grub-bootloader)))
(label (string-append "GNU Guix installation "
(or (getenv "GUIX_DISPLAYED_VERSION")
(package-version guix))))
@@ -555,30 +552,14 @@ (define installation-os
%installer-disk-utilities
%base-packages))))
-(define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
- (triplet "arm-linux-gnueabihf"))
- "Given OS, amend it with the u-boot bootloader for BOARD,
-installed to BOOTLOADER-TARGET (a drive), compiled for TRIPLET.
-
-If you want a serial console, make sure to specify one in your
-operating-system's kernel-arguments (\"console=ttyS0\" or similar)."
- (operating-system (inherit os)
- (bootloader (bootloader-configuration
- (bootloader (bootloader (inherit u-boot-bootloader)
- (package (make-u-boot-package board triplet))))
- (targets (list bootloader-target))))))
-
-(define* (embedded-installation-os bootloader bootloader-target tty
- #:key (extra-modules '()))
+(define* (embedded-installation-os bootloader tty #:key (extra-modules '()))
"Return an installation os for embedded systems.
The initrd gets the extra modules EXTRA-MODULES.
A getty is provided on TTY.
The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
(operating-system
(inherit installation-os)
- (bootloader (bootloader-configuration
- (bootloader bootloader)
- (targets (list bootloader-target))))
+ (bootloader (bootloader-configuration (bootloader bootloader)))
(kernel linux-libre)
(kernel-arguments
(cons (string-append "console=" tty)
@@ -587,7 +568,6 @@ (define* (embedded-installation-os bootloader bootloader-target tty
(define beaglebone-black-installation-os
(embedded-installation-os u-boot-beaglebone-black-bootloader
- "/dev/sda"
"ttyO0"
#:extra-modules
;; This module is required to mount the sd card.
@@ -596,77 +576,62 @@ (define beaglebone-black-installation-os
(define a20-olinuxino-lime-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define a20-olinuxino-lime2-emmc-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define a20-olinuxino-micro-installation-os
(embedded-installation-os u-boot-a20-olinuxino-micro-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define bananapi-m2-ultra-installation-os
(embedded-installation-os u-boot-bananapi-m2-ultra-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define firefly-rk3399-installation-os
(embedded-installation-os u-boot-firefly-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define mx6cuboxi-installation-os
(embedded-installation-os u-boot-mx6cuboxi-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
(define novena-installation-os
(embedded-installation-os u-boot-novena-bootloader
- "/dev/mmcblk1" ; SD card storage
"ttymxc1"))
(define nintendo-nes-classic-edition-installation-os
(embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader
- "/dev/mmcblk0" ; SD card (solder it yourself)
"ttyS0"))
(define orangepi-r1-plus-lts-rk3328-installation-os
(embedded-installation-os u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pine64-plus-installation-os
(embedded-installation-os u-boot-pine64-plus-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pinebook-installation-os
(embedded-installation-os u-boot-pinebook-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define rock64-installation-os
(embedded-installation-os u-boot-rock64-rk3328-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rockpro64-installation-os
(embedded-installation-os u-boot-rockpro64-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rk3399-puma-installation-os
(embedded-installation-os u-boot-puma-rk3399-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define wandboard-installation-os
(embedded-installation-os u-boot-wandboard-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
;; Return the default os here so 'guix system' can consume it directly.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a2743453e7..be12ae6b6c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -172,17 +172,6 @@ (define* (virtualized-operating-system os
(operating-system
(inherit os)
- ;; XXX: Until we run QEMU with UEFI support (with the OVMF firmware),
- ;; force the traditional i386/BIOS method.
- ;; See <https://bugs.gnu.org/28768>.
- (bootloader (bootloader-configuration
- (inherit (operating-system-bootloader os))
- (bootloader
- (if (target-riscv64? (or target system))
- u-boot-qemu-riscv64-bootloader
- grub-bootloader))
- (targets '("/dev/vda"))))
-
(initrd (lambda (file-systems . rest)
(apply (operating-system-initrd os)
file-systems
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..18a2fc119b 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -140,7 +140,7 @@ (define-os-with-source (%minimal-extlinux-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
- (bootloader extlinux-bootloader-gpt)
+ (bootloader extlinux-gpt-bootloader)
(targets (list "/dev/vdb"))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1464,9 +1464,11 @@ (define-os-with-source (%btrfs-raid10-root-os
(host-name "hurd")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets (list "/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde"))))
+ (bootloader (map (lambda (targ)
+ (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list targ))))
+ '("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (uuid "16ff18e2-eb41-4324-8df5-80d3b53c411b"))
diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm
index bcc7645fa3..8aa5311171 100644
--- a/gnu/tests/reconfigure.scm
+++ b/gnu/tests/reconfigure.scm
@@ -30,8 +30,7 @@ (define-module (gnu tests reconfigure)
#:use-module (guix scripts system reconfigure)
#:use-module (guix store)
#:export (%test-switch-to-system
- %test-upgrade-services
- %test-install-bootloader))
+ %test-upgrade-services))
;;; Commentary:
;;;
@@ -178,83 +177,6 @@ (define* (run-upgrade-services-test)
(disable (upgrade-services-program '() '() '(dummy) '())))
(test enable disable))))
-(define* (run-install-bootloader-test)
- "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a
-bootloader's configuration file."
- (define os
- (marionette-operating-system
- (simple-operating-system)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
-
- (define vm (virtual-machine
- (operating-system os)
- (volatile? #f)))
-
- (define (test script)
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (ice-9 regex)
- (srfi srfi-1)
- (srfi srfi-64))
-
- (define marionette
- (make-marionette (list #$vm)))
-
- ;; Return the system generation paths that have GRUB menu entries.
- (define (generations-in-grub-cfg marionette)
- (let ((grub-cfg (marionette-eval
- '(begin
- (use-modules (rnrs io ports))
- (call-with-input-file "/boot/grub/grub.cfg"
- get-string-all))
- marionette)))
- (map (lambda (parameter)
- (second (string-split (match:substring parameter) #\=)))
- (list-matches "system=[^ ]*" grub-cfg))))
-
- (test-runner-current (system-test-runner #$output))
- (test-begin "install-bootloader")
-
- (test-assert "no prior menu entry for system generation"
- (not (member #$os (generations-in-grub-cfg marionette))))
-
- (test-assert "script successfully evaluated"
- (marionette-eval
- '(primitive-load #$script)
- marionette))
-
- (test-assert "menu entry created for system generation"
- (member #$os (generations-in-grub-cfg marionette)))
-
- (test-end))))
-
- (let* ((bootloader ((compose bootloader-configuration-bootloader
- operating-system-bootloader)
- os))
- ;; The typical use-case for 'install-bootloader-program' is to read
- ;; the boot parameters for the existing menu entries on the system,
- ;; parse them with 'boot-parameters->menu-entry', and pass the
- ;; results to 'operating-system-bootcfg'. However, to obtain boot
- ;; parameters, we would need to start the marionette, which we should
- ;; ideally avoid doing outside of the 'test' G-Expression. Thus, we
- ;; generate a bootloader configuration for the script as if there
- ;; were no existing menu entries. In the grand scheme of things, this
- ;; matters little -- these tests should not make assertions about the
- ;; behavior of 'operating-system-bootcfg'.
- (bootcfg (operating-system-bootcfg os '()))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (gexp->derivation
- "install-bootloader"
- ;; Due to the read-only nature of the virtual machines used in the system
- ;; test suite, the bootloader installer script is omitted. 'grub-install'
- ;; would attempt to write directly to the virtual disk if the
- ;; installation script were run.
- (test
- (install-bootloader-program #f #f #f bootcfg bootcfg-file '(#f) "/")))))
-
-
(define %test-switch-to-system
(system-test
(name "switch-to-system")
@@ -267,9 +189,3 @@ (define %test-upgrade-services
(description "Upgrade the Shepherd by unloading obsolete services and
loading new services.")
(value (run-upgrade-services-test))))
-
-(define %test-install-bootloader
- (system-test
- (name "install-bootloader")
- (description "Install a bootloader and its configuration file.")
- (value (run-install-bootloader-test))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 344bb74151..aba637f6e3 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -209,7 +209,7 @@ (define* (copy-closure item target
(define* (install os-drv target
#:key (log-port (current-output-port))
- install-bootloader? bootloader bootcfg)
+ install-bootloader? bootloaders bootmeta)
"Copy the closure of BOOTCFG, which includes the output of OS-DRV, to
directory TARGET. TARGET must be an absolute directory name since that's what
'register-path' expects.
@@ -247,24 +247,27 @@ (define* (install os-drv target
(chmod target #o755)
(let ((os-dir (derivation->output-path os-drv))
(format (lift format %store-monad))
- (populate (lift2 populate-root-file-system %store-monad)))
-
- (mlet %store-monad ((bootcfg (lower-object bootcfg)))
- (mbegin %store-monad
- ;; Copy the closure of BOOTCFG, which includes OS-DIR,
- ;; eventual background image and so on.
- (maybe-copy (derivation->output-path bootcfg))
-
- ;; Create a bunch of additional files.
- (format log-port "populating '~a'...~%" target)
- (populate os-dir target)
-
+ (populate (lift2 populate-root-file-system %store-monad))
+ (profile (string-append target "/var/guix/profiles/system")))
+
+ (mbegin %store-monad
+ ;; Create a bunch of system files.
+ (format log-port "populating '~a'...~%" target)
+ (populate os-dir target)
+
+ ;; Copy the bootloader's closure, which includes OS-DIR,
+ ;; eventual background image and so on.
+ (mlet* %store-monad
+ ((alt -> (generation->boot-alternative profile 1))
+ (inst (apply install-bootloader local-eval bootloaders
+ (list alt) #:dry-run (not install-bootloader?)
+ #:root-offset target bootmeta)))
+ (maybe-copy (derivation->output-path inst)))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target target)
(return
(info (G_ "bootloader successfully installed on~{ ~a~}~%")
- (bootloader-configuration-targets bootloader))))))))
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))))
\f
;;;
@@ -389,20 +392,13 @@ (define (install-bootloader-from-provenance store number)
(let* ((generation (generation-file-name %system-profile number))
(os (receive (_ os) (system-provenance generation)
(and=> os read-operating-system)))
- (bootloader-config (operating-system-bootloader os))
- (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (new (generation->boot-alternative %system-profile number))
(numbers (delv number (reverse (generation-numbers %system-profile))))
(old (profile->boot-alternatives %system-profile numbers)))
(if os
(run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object (operating-system-bootcfg os old)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))
+ (apply install-bootloader local-eval (operating-system-bootloader os)
+ (cons new old) (operating-system-bootmeta os)))
(leave (G_ "cannot rollback to provenanceless generation '~a'~%")
number))))
@@ -489,7 +485,8 @@ (define* (display-system-generation number
(format #t (G_ " canonical file name: ~a~%") (readlink* generation))
;; TRANSLATORS: Please preserve the two-space indentation.
(format #t (G_ " label: ~a~%") label)
- (format #t (G_ " bootloader: ~a~%") bootloader-name)
+ (format #t (G_ " bootloader: ~a~%")
+ (string-join (map symbol->string bootloader-name)))
;; TRANSLATORS: The '~[', '~;', and '~]' sequences in this string must
;; be preserved. They denote conditionals, such that the result will
@@ -775,18 +772,11 @@ (define* (perform-action action image
(define os
(image-operating-system image))
- (define bootloader
+ (define bootloaders
(operating-system-bootloader os))
- (define bootcfg
- (and (memq action '(init reconfigure))
- (operating-system-bootcfg
- os
- (if (eq? action 'init)
- '()
- (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (profile->boot-alternatives)))))))
+ (define bootmeta
+ (operating-system-bootmeta os))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
@@ -817,10 +807,7 @@ (define* (perform-action action image
;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root.
;; See <http://bugs.gnu.org/21068>.
- (drvs (mapm/accumulate-builds lower-object
- (if (memq action '(init reconfigure))
- (list sys bootcfg)
- (list sys))))
+ (drvs (mapm/accumulate-builds lower-object (list sys)))
(% (if derivations-only?
(return (for-each (compose println derivation-file-name)
drvs))
@@ -838,12 +825,16 @@ (define* (perform-action action image
(format #t (G_ "activating system...~%"))
(mbegin %store-monad
(switch-to-system local-eval os)
+ (apply install-bootloader local-eval bootloaders
+ (profile->boot-alternatives)
+ #:dry-run? (not install-bootloader?)
+ (if target (cons* #:root-offset target bootmeta) bootmeta))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target (or target "/"))
(return
(info (G_ "bootloader successfully installed on '~a'~%")
- (bootloader-configuration-targets bootloader))))
+ (map bootloader-target-path
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))
(with-shepherd-error-handling
(upgrade-shepherd-services local-eval os)
(return (format #t (G_ "\
@@ -857,8 +848,8 @@ (define* (perform-action action image
target)
(install sys (canonicalize-path target)
#:install-bootloader? install-bootloader?
- #:bootloader bootloader
- #:bootcfg bootcfg))
+ #:bootloaders bootloaders
+ #:bootmeta bootmeta))
(else
;; All we had to do was to build SYS and maybe register an
;; indirect GC root.
@@ -1254,11 +1245,7 @@ (define (process-action action args opts)
(G_ "image lacks an operating-system")))))
(target-file (match args
((first second) second)
- (_ #f)))
- (bootloader-targets
- (and bootloader?
- (bootloader-configuration-targets
- (operating-system-bootloader os)))))
+ (_ #f))))
(define (graph-backend)
(lookup-backend (assoc-ref opts 'graph-backend)))
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 604ba08fee..8add639e6a 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -209,101 +210,83 @@ (define* (upgrade-shepherd-services eval os)
;;; Bootloader configuration.
;;;
-(define (install-bootloader-program installer disk-installer
- bootloader-package bootcfg
- bootcfg-file devices target)
+(define (install-bootloader-program configs offset chosen-alt old-alts locale
+ store-crypto-devices store-directory-prefix)
"Return an executable store item that, upon being evaluated, will install
BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICES, a list of file system
devices, at TARGET, a mount point, and subsequently run INSTALLER from
BOOTLOADER-PACKAGE."
(program-file
- "install-bootloader.scm"
- (with-extensions (list guile-gcrypt)
- (with-imported-modules `(,@(source-module-closure
- '((gnu build bootloader)
- (gnu build install)
- (guix store)
- (guix utils))
- #:select? not-config?)
- ((guix config) => ,(make-config.scm)))
- #~(begin
- (use-modules (gnu build bootloader)
- (gnu build install)
- (guix build utils)
- (guix store)
- (guix utils)
- (ice-9 binary-ports)
- (ice-9 match)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (let* ((gc-root (string-append #$target %gc-roots-directory "/bootcfg"))
- (new-gc-root (string-append gc-root ".new")))
- ;; #$bootcfg has dependencies.
- ;; The bootloader magically loads the configuration from
- ;; (string-append #$target #$bootcfg-file) (for example
- ;; "/boot/grub/grub.cfg").
- ;; If we didn't do something special, the garbage collector
- ;; would remove the dependencies of #$bootcfg.
- ;; Register #$bootcfg as a GC root.
- ;; Preserve the previous activation's garbage collector root
- ;; until the bootloader installer has run, so that a failure in
- ;; the bootloader's installer script doesn't leave the user with
- ;; a broken installation.
- (switch-symlinks new-gc-root #$bootcfg)
- (install-boot-config #$bootcfg #$bootcfg-file #$target)
- (when (or #$installer #$disk-installer)
- (catch #t
- (lambda ()
- ;; The bootloader might not support installation on a
- ;; mounted directory using the BOOTLOADER-INSTALLER
- ;; procedure. In that case, fallback to installing the
- ;; bootloader directly on DEVICES using the
- ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
- (if #$installer
- (for-each (lambda (device)
- (#$installer #$bootloader-package device
- #$target))
- '#$devices)
- (for-each (lambda (device)
- (#$disk-installer #$bootloader-package
- 0 device))
- '#$devices)))
- (lambda args
- (delete-file new-gc-root)
- (match args
- (('%exception exception) ;Guile 3 SRFI-34 or similar
- (raise-exception exception))
- ((key . args)
- (apply throw key args))))))
- ;; We are sure that the installation of the bootloader
- ;; succeeded, so we can replace the old GC root by the new
- ;; GC root now.
- (rename-file new-gc-root gc-root)))))))
+ "install-bootloader.scm"
+ ;; three sources of boot entries: bootloader-configuration-menu-entries,
+ ;; current-boot-alternative, and old-boot-alternatives.
+ (let ((args (list #:current-boot-alternative chosen-alt
+ #:old-boot-alternatives old-alts
+ #:locale locale
+ #:store-directory-prefix store-directory-prefix
+ #:store-crypto-devices store-crypto-devices)))
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules
+ `(,@(source-module-closure '((gnu build bootloader)
+ (gnu build install)
+ (guix store)
+ (guix utils))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (gnu build bootloader)
+ (gnu build install)
+ (guix build utils)
+ (guix store)
+ (guix utils)
+ (ice-9 binary-ports)
+ (ice-9 match)
+ (srfi srfi-34)
+ (srfi srfi-35))
+ ;; bootloader-installer is passed an additional #:target argument
+ ;; denoting the specific target currently being installed to.
+ ;; bootloaders should determine when to fully reinstall themselves.
+ #$(bootloader-configurations->gexp configs args
+ #:root-offset offset)))))))
-(define* (install-bootloader eval configuration bootcfg
- #:key
- (run-installer? #t)
- (target "/"))
+(define* (install-bootloader eval configs alts #:key locale
+ store-crypto-devices store-directory-prefix
+ (root-offset "/") (dry-run? #f))
"Using EVAL, a monadic procedure taking a single G-Expression as an argument,
-configure the bootloader on TARGET such that OS will be booted by default and
-additional configurations specified by MENU-ENTRIES can be selected."
- (let* ((bootloader (bootloader-configuration-bootloader configuration))
- (installer (and run-installer?
- (bootloader-installer bootloader)))
- (disk-installer (and run-installer?
- (bootloader-disk-image-installer bootloader)))
- (package (bootloader-package bootloader))
- (devices (bootloader-configuration-targets configuration))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
- (primitive-load #$(install-bootloader-program installer
- disk-installer
- package
- bootcfg
- bootcfg-file
- devices
- target))))))
+configure the bootloader with bootloader-configuration CONFIG such that
+ALTS may be selected, with the first element being the default. If QUICK? only
+the bootloader config is reinstalled. Returns the config installer drv."
+ (mlet* %store-monad
+ ((program (lower-object
+ (install-bootloader-program configs root-offset
+ (car alts) (cdr alts) locale
+ store-crypto-devices store-directory-prefix))))
+ (mbegin %store-monad
+ (eval
+ (with-imported-modules `(,@(source-module-closure '((guix build utils)
+ (guix store))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (guix build utils) (guix store))
+ (parameterize ((current-warning-port (%make-void-port "w")))
+ (let* ((gc-root (string-append
+ #$root-offset %gc-roots-directory "/bootcfg"))
+ (new-gc-root (string-append gc-root ".new")))
+ ;; since the installers are gexps directly included, we add
+ ;; the installer runner as a gc root. this should make sure
+ ;; no bootloader files get gc'd. only remove the old one on
+ ;; success.
+ ;; XXX: is this still necessary?
+ (switch-symlinks new-gc-root #$program)
+ (dynamic-wind (const #t)
+ (lambda ()
+ (unless #$dry-run? (primitive-load #$program))
+ (rename-file new-gc-root gc-root))
+ (lambda () ; delete new root if failed
+ (when (file-exists? new-gc-root)
+ (delete-file new-gc-root)))))))))
+ (return program))))
\f
;;;
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 05/15] gnu: system: Remove useless boot parameters.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (3 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
` (10 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
* gnu/system.scm (operating-system-boot-parameters,
operating-system-boot-parameters-file): Delete
bootloader-menu-entries.
* gnu/system/boot.scm (boot-parameters)[bootloader-menu-entries]: Delete
fields.
(read-boot-parameters): Don't read bootloader-menu-entries.
* tests/boot-parameters.scm (%grub-boot-parameters,
test-read-boot-parameters, test-read-boot-parameters): Don't include
bootloader-menu-entries.
("read, bootloader-menu-entries, default value"): Delete test.
Change-Id: I46d9cff4604dbfcf654b0820fdb77e72aecffbb4
---
gnu/system.scm | 7 -------
gnu/system/boot.scm | 8 --------
tests/boot-parameters.scm | 14 ++------------
3 files changed, 2 insertions(+), 27 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index a345b52d55..66c1a80733 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1304,8 +1304,6 @@ (define* (operating-system-boot-parameters os root-device
(initrd initrd)
(multiboot-modules multiboot-modules)
(bootloader-name bootloader-name)
- (bootloader-menu-entries
- (bootloader-configuration-menu-entries (operating-system-bootloader os)))
(locale locale)
(store-device (ensure-not-/dev (file-system-device store)))
(store-directory-prefix (btrfs-store-subvolume-file-name file-systems))
@@ -1347,11 +1345,6 @@ (define* (operating-system-boot-parameters-file os)
#$(boot-parameters-multiboot-modules params)))
#~())
(bootloader-name #$(boot-parameters-bootloader-name params))
- (bootloader-menu-entries
- #$(map menu-entry->sexp
- (or (and=> (operating-system-bootloader os)
- bootloader-configuration-menu-entries)
- '())))
(locale #$(boot-parameters-locale params))
(store
(device
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 2b5302ce5f..4d89827ced 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -54,7 +54,6 @@ (define-module (gnu system boot)
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
@@ -113,8 +112,6 @@ (define-record-type* <boot-parameters>
;; 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)
@@ -176,11 +173,6 @@ (define (read-boot-parameters port)
((_ args) (list 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))
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 2e7976aa6c..f214de360d 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -64,7 +64,6 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
@@ -107,7 +106,6 @@ (define* (test-read-boot-parameters
#:key
(version %boot-parameters-version)
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(label %default-label)
(root-device (quote-uuid %default-root-device))
(kernel %default-kernel)
@@ -127,7 +125,7 @@ (define* (test-read-boot-parameters
(cond ((eq? 'false val) (format #false fmt #false))
(val (format #false fmt val))
(else "")))
- (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a~a)"
+ (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a)"
(sexp-or-nothing " (version ~S)" version)
(sexp-or-nothing " (label ~S)" label)
(sexp-or-nothing " (root-device ~S)" root-device)
@@ -145,9 +143,7 @@ (define* (test-read-boot-parameters
store-crypto-devices))
"")
(sexp-or-nothing " (locale ~S)" locale)
- (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)
- (sexp-or-nothing " (bootloader-menu-entries ~S)"
- bootloader-menu-entries)))
+ (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)))
(let ((str (generate-boot-parameters)))
(call-with-input-string str read-boot-parameters)))
@@ -170,7 +166,6 @@ (define* (test-read-boot-parameters
(test-assert "read, construction, optional fields"
(and (test-read-boot-parameters #:bootloader-name #false)
- (test-read-boot-parameters #:bootloader-menu-entries #false)
(test-read-boot-parameters #:kernel-arguments #false)
(test-read-boot-parameters #:with-store #false)
(test-read-boot-parameters #:store-device #false)
@@ -223,11 +218,6 @@ (define* (test-read-boot-parameters
(boot-parameters-bootloader-name
(test-read-boot-parameters #:bootloader-name #false)))
-(test-eq "read, bootloader-menu-entries, default value"
- '()
- (boot-parameters-bootloader-menu-entries
- (test-read-boot-parameters #:bootloader-menu-entries #false)))
-
(test-eq "read, kernel-arguments, default value"
'()
(boot-parameters-kernel-arguments
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 06/15] gnu: bootloader: Add raspberry pi bootloader.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (4 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
` (9 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Efraim Flashner,
Lilah Tascheter, Vagrant Cascadian
Less adding and more making it an actual bootloader rather than some
weirdly specified packages.
* gnu/bootloader/u-boot.scm (rpi-config, install-rpi): New procedures.
(define-u-bootloader-rpi): New macro.
(u-boot-rpi-2-bootloader, u-boot-rpi-3-bootloader,
u-boot-rpi-4-bootloader, u-boot-rpi-bootloader): New variables.
* gnu/packages/bootloaders.scm (make-u-boot-bin-package): Delete
procedure.
(%u-boot-rpi-efi-description, %u-boot-rpi-efi-description-32-bit,
u-boot-rpi-2-efi, u-boot-rpi-3-32b-efi, u-boot-rpi-4-32b-efi,
u-boot-rpi-arm64-efi, u-boot-rpi-2-bin, u-boot-rpi-3_32b-bin,
u-boot-rpi-4_32b-bin, u-boot-rpi-arm64-bin, u-boot-rpi-2-efi-bin,
u-boot-rpi-3-32b-efi-bin, u-boot-rpi-4-32b-efi-bin,
u-boot-rpi-arm64-efi-bin): Delete variables.
Change-Id: I5139a0b00ec89189e8e7c84e06a7a3b7240259cd
---
gnu/bootloader/u-boot.scm | 66 ++++++++++++++++++++++++-
gnu/packages/bootloaders.scm | 94 +++---------------------------------
2 files changed, 71 insertions(+), 89 deletions(-)
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 7d3e202f8c..e8dfe9b3a2 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -28,7 +28,10 @@ (define-module (gnu bootloader u-boot)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages raspberry-pi)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix utils)
#:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
@@ -51,7 +54,11 @@ (define-module (gnu bootloader u-boot)
u-boot-qemu-riscv64-bootloader
u-boot-starfive-visionfive2-bootloader
u-boot-ts7970-q-2g-1000mhz-c-bootloader
- u-boot-wandboard-bootloader))
+ u-boot-wandboard-bootloader
+ u-boot-rpi-2-bootloader
+ u-boot-rpi-3-bootloader
+ u-boot-rpi-4-bootloader
+ u-boot-rpi-bootloader))
(define (make-install-u-boot firmware installers)
(lambda* (#:key bootloader-config #:allow-other-keys . args)
@@ -222,3 +229,60 @@ (define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
u-boot-qemu-riscv64 "u-boot.bin")
+
+\f
+;;;
+;;; RasPi bootloader definitions.
+;;;
+
+(define (rpi-config 32?)
+ ;; allows a user-specified custom.txt
+ (plain-file "config.txt"
+ (format #f
+ "arm_64bit=~a~%enable_uart=1~%kernel=u-boot.bin~%include custom.txt~%"
+ (if (or 32? (not (target-64bit?))) "0" "1"))))
+
+(define (install-rpi u-boot-32 u-boot-64)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('install (apply install-extlinux-config args))
+ (('firmware => (firmware :path))
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (use-32? (or 32? (not (target-64bit?)) (not u-boot-64))))
+ #~(begin
+ (atomic-copy #$(file-append (if use-32? u-boot-32 u-boot-64)
+ "/libexec/u-boot.bin")
+ (string-append #$firmware "/u-boot.bin"))
+ (atomic-copy #$(rpi-config use-32?)
+ (string-append #$firmware "/config.txt"))))))))
+
+(define-syntax-rule (define-u-bootloader-rpi def-name u-boot-32 u-boot-64)
+ (define def-name
+ (bootloader (name 'u-boot)
+ (default-targets
+ (list (bootloader-target (type 'install)
+ (offset 'firmware)
+ (path "extlinux"))
+ (bootloader-target (type 'firmware)
+ (offset 'root)
+ (path "boot"))))
+ (installer (install-rpi u-boot-32 u-boot-64)))))
+
+
+;; These neither install firmware nor device-tree files for the Raspberry Pi.
+;; They just assume them to be existing in 'install in the same way that some
+;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
+;; They can be used with either extlinux or as UEFI firmware (alongside, eg,
+;; GRUB).
+(define-u-bootloader-rpi u-boot-rpi-2-bootloader
+ u-boot-rpi-2 #f)
+
+(define-u-bootloader-rpi u-boot-rpi-3-bootloader
+ u-boot-rpi-3-32b u-boot-rpi-arm64)
+
+(define-u-bootloader-rpi u-boot-rpi-4-bootloader
+ u-boot-rpi-4-32b u-boot-rpi-arm64)
+
+;; Usable for any 64-bit raspberry pi.
+(define-u-bootloader-rpi u-boot-rpi-bootloader
+ #f u-boot-rpi-arm64)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 12f918a123..e78602379d 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -1409,40 +1409,8 @@ (define-public u-boot-pinebook-pro-rk3399
(modify-inputs (package-inputs base)
(append arm-trusted-firmware-rk3399))))))
-(define*-public (make-u-boot-bin-package u-boot-package
- #:key
- (u-boot-bin "u-boot.bin"))
- "Return a package with a single U-BOOT-BIN file from the U-BOOT-PACKAGE.
-The package name will be that of the U-BOOT package suffixed with \"-bin\"."
- (package
- (name (string-append (package-name u-boot-package) "-bin"))
- (version (package-version u-boot-package))
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (list
- #:builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils))
- (mkdir #$output)
- (symlink (search-input-file %build-inputs
- (string-append "libexec/" #$u-boot-bin))
- (string-append #$output "/" #$u-boot-bin))))))
- (inputs (list u-boot-package))
- (home-page (package-home-page u-boot-package))
- (synopsis (package-synopsis u-boot-package))
- (description (string-append
- (package-description u-boot-package)
- "\n\n"
- (format #f
- "This package only contains the file ~a."
- u-boot-bin)))
- (license (package-license u-boot-package))))
-
-(define-public %u-boot-rpi-efi-configs
- '("CONFIG_OF_EMBED"
- "CONFIG_OF_BOARD=y"))
+;; get dtbs from firmware to support dtoverlays
+(define-public %u-boot-rpi-configs '("CONFIG_OF_EMBED" "CONFIG_OF_BOARD=y"))
(define %u-boot-rpi-description-32-bit
"This is a 32-bit build of U-Boot.")
@@ -1451,76 +1419,26 @@ (define %u-boot-rpi-description-64-bit
"This is a common 64-bit build of U-Boot for all 64-bit capable Raspberry Pi
variants.")
-(define %u-boot-rpi-efi-description
- "It allows network booting and uses the device-tree from the firmware,
-allowing the usage of overlays. It can act as an EFI firmware for the
-grub-efi-netboot-removable-bootloader.")
-
-(define %u-boot-rpi-efi-description-32-bit
- (string-append %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-32-bit))
-
(define-public u-boot-rpi-2
(make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-3-32b
(make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-4-32b
(make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-arm64
(make-u-boot-package "rpi_arm64" "aarch64-linux-gnu"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-64-bit))
-(define-public u-boot-rpi-2-efi
- (make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-3-32b-efi
- (make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-4-32b-efi
- (make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-arm64-efi
- (make-u-boot-package "rpi_arm64""aarch64-linux-gnu"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description (string-append
- %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-64-bit)))
-
-(define-public u-boot-rpi-2-bin (make-u-boot-bin-package u-boot-rpi-2))
-
-(define-public u-boot-rpi-3_32b-bin (make-u-boot-bin-package u-boot-rpi-3-32b))
-
-(define-public u-boot-rpi-4_32b-bin (make-u-boot-bin-package u-boot-rpi-4-32b))
-
-(define-public u-boot-rpi-arm64-bin (make-u-boot-bin-package u-boot-rpi-arm64))
-
-(define-public u-boot-rpi-2-efi-bin (make-u-boot-bin-package u-boot-rpi-2-efi))
-
-(define-public u-boot-rpi-3-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-3-32b-efi))
-
-(define-public u-boot-rpi-4-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-4-32b-efi))
-
-(define-public u-boot-rpi-arm64-efi-bin
- (make-u-boot-bin-package u-boot-rpi-arm64-efi))
-
(define u-boot-ts-mx6
;; There is no release; use the latest commit of the
;; 'imx_v2015.04_3.14.52_1.1.0_ga' branch.
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 07/15] gnu: system: Fix bootloader crypto device recognition.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (5 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
` (8 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
* gnu/system.scm (operating-system-bootloader-crypto-devices): Check for
luks-device-mapping-with-options in addition to luks-device-mapping.
Change-Id: Iafc9afe608640b97083c4d559c9240846330472a
---
gnu/system.scm | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 66c1a80733..093c8fa350 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -400,10 +400,12 @@ (define operating-system-bootloader-crypto-devices
(mlambdaq (os) ;to avoid duplicated output
"Return the sources of the LUKS mapped devices specified by UUID."
;; XXX: Device ordering is important, we trust the returned one.
- (let* ((luks-devices (filter (lambda (m)
- (eq? luks-device-mapping
- (mapped-device-type m)))
- (operating-system-boot-mapped-devices os)))
+ ;; Check against the close-luks-device procedure to get both maptypes
+ (let* ((close (mapped-device-kind-close luks-device-mapping))
+ (luks? (lambda (m) (let ((t (mapped-device-type m)))
+ (eq? (mapped-device-kind-close t) close))))
+ (luks-devices (filter luks?
+ (operating-system-boot-mapped-devices os)))
(uuid-crypto-devices non-uuid-crypto-devices
(partition (compose uuid? mapped-device-source)
luks-devices)))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 08/15] gnu: packages: Add pesign.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (6 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
` (7 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
* gnu/packages/efi.scm (pesign): New variable.
Change-Id: I00fcc679d9514c85d508183b9ec7e121e0a814db
---
gnu/packages/efi.scm | 47 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 47 insertions(+)
diff --git a/gnu/packages/efi.scm b/gnu/packages/efi.scm
index 499745eba1..417b70d91b 100644
--- a/gnu/packages/efi.scm
+++ b/gnu/packages/efi.scm
@@ -24,8 +24,10 @@ (define-module (gnu packages efi)
#:use-module (gnu packages bash)
#:use-module (gnu packages linux)
#:use-module (gnu packages man)
+ #:use-module (gnu packages nss)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages popt)
#:use-module (gnu packages tls)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
@@ -153,6 +155,51 @@ (define-public sbsigntools
(home-page "https://git.kernel.org/pub/scm/linux/kernel/git/jejb/sbsigntools.git/")
(license license:gpl3+)))
+(define-public pesign
+ (package
+ (name "pesign")
+ (version "116")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/rhboot/pesign")
+ (commit version)))
+ (snippet #~(substitute* "Make.defaults"
+ (("pkg-config-ccldflags") "pkg-config-ldflags")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "0fnqfiivj46bha4hsnwiqy8vq8b4i3w2dig0h9h2k4j7yq7r5qvj"))))
+ (build-system gnu-build-system)
+ (arguments
+ (list #:tests? #f
+ #:modules '((guix build gnu-build-system)
+ (guix build utils)
+ (ice-9 match))
+ #:phases #~(modify-phases %standard-phases (delete 'configure))
+ #:make-flags
+ (let ((system (%current-system)) (target (%current-target-system)))
+ (define (arch s) (match (string-split s #\-)
+ (("i386" _ ...) "ia32")
+ (("i486" _ ...) "ia32")
+ (("i586" _ ...) "ia32")
+ (("i686" _ ...) "ia32")
+ ((x _ ...) x)))
+ #~(list "prefix=/" "libdir=/lib/"
+ (string-append "DESTDIR=" #$output)
+ (string-append "HOSTARCH=" #$(arch system))
+ (string-append "ARCH=" #$(arch (or target system)))
+ (string-append "CROSS_COMPILE="
+ #$@(if target (list target "-gcc") '()))))))
+ (inputs (list efivar nspr nss popt `(,util-linux "lib")))
+ (native-inputs (list mandoc pkg-config))
+ (synopsis "PE-COFF binary signing tools")
+ (description "Supports EFI keygen and subsequent signing of PE-COFF
+binaries. Contains the tools authvar, efikeygen, pesigcheck, pesign,
+pesign-client, and pesum.")
+ (home-page "https://github.com/rhboot/pesign")
+ (license license:gpl2+)))
+
(define-public efitools
(package
(name "efitools")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 09/15] gnu: packages: Add ukify.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (7 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
` (6 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov, Efraim Flashner,
Vagrant Cascadian
* gnu/packages/bootloaders.scm
(systemd-version,systemd-source,ukify): New variables.
Change-Id: Icde59b7266529c8002331ff0375e0a35af3a2add
---
gnu/packages/bootloaders.scm | 54 ++++++++++++++++++++++++++++++++++++
1 file changed, 54 insertions(+)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index e78602379d..04bb1b06f0 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -20,6 +20,7 @@
;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Herman Rimm <herman@rimm.ee>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,6 +48,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages disk)
+ #:use-module (gnu packages efi)
#:use-module (gnu packages firmware)
#:use-module (gnu packages flex)
#:use-module (gnu packages fontutils)
@@ -73,11 +75,13 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages valgrind)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages xorg)
+ #:use-module (gnu packages python-crypto)
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz)
#:use-module (guix build-system gnu)
#:use-module (guix build-system meson)
#:use-module (guix build-system pyproject)
+ #:use-module (guix build-system python)
#:use-module (guix build-system trivial)
#:use-module (guix download)
#:use-module (guix gexp)
@@ -573,6 +577,56 @@ (define-public syslinux
;; Also contains:
license:expat license:isc license:zlib)))))
+(define systemd-version "255")
+(define systemd-source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/systemd/systemd")
+ (commit (string-append "v" systemd-version))))
+ (file-name (git-file-name "systemd" systemd-version))
+ (snippet #~(substitute* "src/ukify/ukify.py" ; remove after python 3.11
+ (("datetime\\.UTC") "datetime.timezone.utc")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+
+(define-public ukify
+ (package
+ (name "ukify")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system python-build-system)
+ (arguments
+ (list #:phases
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key inputs #:allow-other-keys)
+ (define (get-tool tool)
+ (search-input-file inputs (string-append "bin/" tool)))
+
+ (substitute* "src/ukify/ukify.py" ; hardcode tool paths
+ (("(find_tool\\(')(readelf|sbsign|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',"))
+ (("('name': ')(sbverify|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',")))))
+ (delete 'check)
+ (replace 'install
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let* ((bin (string-append #$output "/bin"))
+ (file (string-append bin "/ukify")))
+ (mkdir-p bin)
+ (copy-file "src/ukify/ukify.py" file)))))))
+ (inputs
+ (list binutils pesign python-cryptography python-pefile sbsigntools))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI tool")
+ (description "@command{ukify} joins together a UKI stub, linux kernel, initrd,
+kernel arguments, and optional secure boot signatures into a single, UEFI-bootable
+image.")
+ (license license:lgpl2.1+)))
+
(define-public dtc
(package
(name "dtc")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 10/15] gnu: packages: Add systemd-stub.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (8 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
` (5 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Efraim Flashner,
Lilah Tascheter, Vagrant Cascadian
* gnu/bootloader.scm (%efi-supported-systems, lazy-efibootmgr): New variable.
(install-efi): Use lazy-efibootmgr.
* gnu/packages/bootloaders.scm (systemd-stub): New variable.
Change-Id: I974bad9ff7a52f736286d05de53f7c5ccb60b9d6
---
gnu/bootloader.scm | 13 +++++++++--
gnu/packages/bootloaders.scm | 43 ++++++++++++++++++++++++++++++++++++
2 files changed, 54 insertions(+), 2 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 2eae0cd49c..9fb2accfd2 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -28,7 +28,6 @@ (define-module (gnu bootloader)
#:autoload (gnu build file-systems)
(read-partition-label read-partition-uuid
find-partition-by-label find-partition-by-uuid)
- #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:autoload (guix build syscalls)
@@ -115,6 +114,7 @@ (define-module (gnu bootloader)
bootloader-configuration->gexp
bootloader-configurations->gexp
+ %efi-supported-systems
efi-arch
install-efi))
@@ -650,6 +650,11 @@ (define (bootloader-configurations->gexp bootloader-configs . rest)
;;; EFI shit
;;;
+;; systems currently supported by efi-arch. should be used for packages relying
+;; on it.
+(define %efi-supported-systems
+ '("i686-linux" "x86_64-linux" "armhf-linux" "aarch64-linux" "riscv64-linux"))
+
(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
(32? #f))
"Returns the UEFI architecture name for the current target, in lowercase."
@@ -661,6 +666,10 @@ (define* (efi-arch #:key (target (or (%current-target-system) (%current-system))
(else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
target)))))
+(define (lazy-efibootmgr)
+ "Lazy-loaded efibootmgr package, in order to prevent circular refs."
+ (module-ref (resolve-interface '(gnu packages linux)) 'efibootmgr))
+
(define (install-efi bootloader-config plan)
"Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
@@ -683,5 +692,5 @@ (define (install-efi bootloader-config plan)
;; normal install when not doing a removable config
(with-targets targets
(('vendir => (vendir :path) (loader :devpath) (disk :device))
- #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #~(install-efi #+(file-append (lazy-efibootmgr) "/sbin/efibootmgr")
#$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 04bb1b06f0..2bc04059d2 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -38,6 +38,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages bootloaders)
+ #:use-module (gnu bootloader)
#:use-module (gnu packages)
#:use-module (gnu packages assembly)
#:use-module (gnu packages base)
@@ -54,6 +55,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gcc)
#:use-module (gnu packages gettext)
+ #:use-module (gnu packages gperf)
#:use-module (gnu packages linux)
#:use-module (gnu packages llvm)
#:use-module (gnu packages man)
@@ -592,6 +594,47 @@ (define systemd-source
(base32
"1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+(define-public systemd-stub
+ (package
+ (name "systemd-stub")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system meson-build-system)
+ (arguments
+ (list #:configure-flags
+ #~(list "-Dmode=release" "-Defi=true" "-Dsbat-distro=guix"
+ "-Dsbat-distro-generation=1" ; package revision!
+ "-Dsbat-distro-summary=Guix System"
+ "-Dsbat-distro-url=https://guix.gnu.org"
+ #$(string-append "-Dsbat-distro-pkgname="
+ (package-name this-package))
+ #$(string-append "-Dsbat-distro-version="
+ (package-version this-package)))
+ #:phases
+ ;; TODO: 32bit support
+ (let* ((stub (string-append
+ "src/boot/efi/linux" (efi-arch) ".efi.stub")))
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key parallel-build? #:allow-other-keys)
+ (invoke "ninja" #$stub
+ "-j" (if parallel-build?
+ (number->string (parallel-job-count)) "1"))))
+ (replace 'install
+ (lambda _
+ (let ((libexec (string-append #$output "/libexec")))
+ (install-file #$stub libexec))))
+ (delete 'check)))))
+ (supported-systems %efi-supported-systems)
+ (inputs (list libcap python-pyelftools `(,util-linux "lib")))
+ (native-inputs (list gperf pkg-config python-3 python-jinja2))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI stub")
+ (description "Simple UEFI boot stub that loads a conjoined kernel image and
+supporting data to their proper locations, before chainloading to the kernel.
+Supports measured and/or verified boot environments.")
+ (license license:lgpl2.1+)))
+
(define-public ukify
(package
(name "ukify")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 11/15] gnu: bootloaders: Add uki-efi-bootloader.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (9 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
` (4 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov, Lilah Tascheter
* gnu/bootloader.scm (<bootloader-configuration>): New keypair field.
* gnu/bootloader/uki.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add bootloader/uki.scm.
Change-Id: I2097da9f3dd35137b3419f6d0545de26d53cb6da
---
gnu/bootloader.scm | 3 ++
gnu/bootloader/uki.scm | 96 ++++++++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 100 insertions(+)
create mode 100644 gnu/bootloader/uki.scm
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 9fb2accfd2..e261b38e71 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -101,6 +101,7 @@ (define-module (gnu bootloader)
bootloader-configuration-default-entry
bootloader-configuration-efi-removable?
bootloader-configuration-32bit?
+ bootloader-configuration-keypair
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -526,6 +527,8 @@ (define-record-type* <bootloader-configuration>
(default #f)) ;bool
(32bit? bootloader-configuration-32bit?
(default #f)) ;bool
+ (keypair bootloader-configuration-keypair
+ (default #f)) ;(cert . priv) pair
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
diff --git a/gnu/bootloader/uki.scm b/gnu/bootloader/uki.scm
new file mode 100644
index 0000000000..4871dbe037
--- /dev/null
+++ b/gnu/bootloader/uki.scm
@@ -0,0 +1,96 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; 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 bootloader uki)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages efi)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu system boot)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:export (uki-efi-bootloader))
+
+;; TODO: support 32bit/mixed-mode UEFI.
+;; https://github.com/systemd/systemd/issues/17056 may be relevant
+(define bootcfg->menu-entry->builder
+ (match-record-lambda <bootloader-configuration> (32bit? theme keypair)
+ (match-record-lambda <menu-entry>
+ (label linux linux-arguments initrd chain-loader)
+ ;; support chainloader in order to allow arbitrary signed EFI binaries
+ (cond
+ ((and chain-loader keypair)
+ #~(lambda (dest)
+ (invoke/quiet #+(sbsigntools "/bin/sbsign")
+ "--cert" #$(car keypair) "--key" #$(cdr keypair)
+ "--output" dest #$chain-loader)
+ (invoke/quiet #+(sbsigntools "/bin/sbverify")
+ "--cert" #$(car keypair) dest)))
+ (chain-loader #~(lambda (dest) (copy-file #$chain-loader dest)))
+ (linux
+ (let* ((arch (efi-arch #:32? 32bit?))
+ (stub (file-append systemd-stub
+ "/libexec/linux" arch ".efi.stub")))
+ #~(lambda (dest)
+ (invoke/quiet #+(file-append ukify "/bin/ukify")
+ "build" "--output" dest
+ "--linux" #$linux "--initrd" #$initrd
+ "--cmdline" (string-join (list #$@linux-arguments))
+ "--os-release" #$label "--stub" #$stub "--efi-arch" #$arch
+ #$@(if theme #~("--splash" #$theme) '())
+ #$@(if keypair #~("--secureboot-certificate" #$(car keypair)
+ "--secureboot-private-key" #$(cdr keypair))
+ '())))))
+ (else (leave (G_ "uki-efi-bootloader doesn't support multiboot")))))))
+
+;; we cannot use guix's build system to make UKI images for two reasons:
+;; 1. signing is necessarily non-reproducable, especially since keys should not
+;; be in the store, or else risk being publically accessible.
+;; 2. menu-entries may reference files which do not exist in the store.
+(define* (install-uki #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ (define* (menu-entry->plan entry num #:optional (prefix "menu-entry"))
+ #~(cons* #$((bootcfg->menu-entry->builder bootloader-config) entry)
+ #$(string-append prefix "-" (number->string num) ".efi")
+ #$(menu-entry-label entry)))
+
+ (define (boot-alternative->plan alt)
+ (menu-entry->plan (boot-alternative->menu-entry alt)
+ (boot-alternative-generation alt)
+ "generation"))
+
+ (install-efi bootloader-config
+ (let ((entries (bootloader-configuration-menu-entries bootloader-config)))
+ #~(list #$(boot-alternative->plan current-boot-alternative)
+ #$@(map menu-entry->plan entries (iota (length entries)))
+ #$@(map boot-alternative->plan old-boot-alternatives)))))
+
+
+
+(define uki-efi-bootloader
+ (bootloader
+ (name 'uki-efi)
+ (default-targets (list (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+ (installer install-uki)))
diff --git a/gnu/local.mk b/gnu/local.mk
index 8375e13709..32ed753ee2 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -93,6 +93,7 @@ GNU_SYSTEM_MODULES = \
%D%/bootloader/extlinux.scm \
%D%/bootloader/u-boot.scm \
%D%/bootloader/depthcharge.scm \
+ %D%/bootloader/uki.scm \
%D%/ci.scm \
%D%/compression.scm \
%D%/home.scm \
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 12/15] gnu: system: Update examples.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (10 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
` (3 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Florian Pelz, Ludovic Court??s,
Matthew Trzcinski, Maxim Cournoyer
* gnu/system/examples/asus-c201.tmpl (bootloader): Use new depthcharge
bootloader name scheme and update to new target system.
* gnu/system/examples/bare-bones.tmpl (bootloader),
gnu/system/examples/bare-hurd.tmpl (bootloader),
gnu/system/examples/beaglebone-black.tmpl (bootloader),
gnu/system/examples/desktop.tmpl (bootloader),
gnu/system/examples/lightweight-desktop.tmpl (bootloader),
gnu/system/examples/plasma.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64-nfs-root.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64.tmpl (bootloader): Use new target system.
* gnu/system/examples/docker-image.tmpl (bootloader): Delete.
* gnu/system/examples/vm-image.tmpl (bootloader): Use auto image target.
Change-Id: I3675f17ae9cd94cff99328762600fb4e491bc9f2
---
gnu/system/examples/asus-c201.tmpl | 6 +++--
gnu/system/examples/bare-bones.tmpl | 7 ++++--
gnu/system/examples/bare-hurd.tmpl | 4 +++-
gnu/system/examples/beaglebone-black.tmpl | 6 +++--
gnu/system/examples/desktop.tmpl | 4 +++-
gnu/system/examples/docker-image.tmpl | 6 ++---
gnu/system/examples/lightweight-desktop.tmpl | 4 +++-
gnu/system/examples/plasma.tmpl | 4 +++-
.../examples/raspberry-pi-64-nfs-root.tmpl | 23 ++++++++++++-------
gnu/system/examples/raspberry-pi-64.tmpl | 18 ++++++++-------
gnu/system/examples/vm-image.tmpl | 5 ++--
11 files changed, 54 insertions(+), 33 deletions(-)
diff --git a/gnu/system/examples/asus-c201.tmpl b/gnu/system/examples/asus-c201.tmpl
index 019111c167..eec185eebf 100644
--- a/gnu/system/examples/asus-c201.tmpl
+++ b/gnu/system/examples/asus-c201.tmpl
@@ -14,8 +14,10 @@
;; Assuming /dev/mmcblk0p1 is the kernel partition, and
;; "my-root" is the label of the target root file system.
(bootloader (bootloader-configuration
- (bootloader depthcharge-bootloader)
- (targets '("/dev/mmcblk0p1"))))
+ (bootloader depthcharge-veyron-speedy-bootloader)
+ (targets (list (bootloader-target
+ (type 'part)
+ (device "/dev/mmcblk0p1"))))))
;; The ASUS C201PA requires a very particular kernel to boot,
;; as well as the following arguments.
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index 7b6a4b09b0..9eed05f2e0 100644
--- a/gnu/system/examples/bare-bones.tmpl
+++ b/gnu/system/examples/bare-bones.tmpl
@@ -13,10 +13,13 @@
;; Boot in "legacy" BIOS mode, assuming /dev/sdX is the
;; target hard disk, and "my-root" is the label of the target
- ;; root file system.
+ ;; root file system. If you're just building an image, the
+ ;; 'targets' field may be omitted.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
;; It's fitting to support the equally bare bones ‘-nographic’
;; QEMU option, which also nicely sidesteps forcing QWERTY.
(kernel-arguments (list "console=ttyS0,115200"))
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 463c7ee798..8dd700cd9d 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -32,7 +32,9 @@
(inherit %hurd-default-operating-system)
(bootloader (bootloader-configuration
(bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl
index 18bbb2723c..99963ef2fe 100644
--- a/gnu/system/examples/beaglebone-black.tmpl
+++ b/gnu/system/examples/beaglebone-black.tmpl
@@ -11,11 +11,13 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
- ;; Assuming /dev/mmcblk1 is the eMMC, and "my-root" is
+ ;; Assuming /dev/mmcblk1 is the eMMC. and "my-root" is
;; the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader u-boot-beaglebone-black-bootloader)
- (targets '("/dev/mmcblk1"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/mmcblk1"))))))
;; This module is required to mount the SD card.
(initrd-modules (cons "omap_hsmmc" %base-initrd-modules))
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index 2d65f22294..30dbdeea31 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -20,7 +20,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout)))
;; Specify a mapped device for the encrypted root partition.
diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl
index 7123917af4..6d3114a0bc 100644
--- a/gnu/system/examples/docker-image.tmpl
+++ b/gnu/system/examples/docker-image.tmpl
@@ -9,6 +9,8 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
+ ;; Bootloader can be left blank!
+
;; This is where user accounts are specified. The "root" account is
;; implicit, and is initially created with the empty password.
(users (cons (user-account
@@ -34,10 +36,6 @@
;; similar services for us.
;; This will be ignored.
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("does-not-matter"))))
- ;; This will be ignored, too.
(file-systems (list (file-system
(device "does-not-matter")
(mount-point "/")
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index c061284ba8..0964238cb0 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -17,7 +17,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))
;; Assume the target root file system is labelled "my-root",
;; and the EFI System Partition has UUID 1234-ABCD.
diff --git a/gnu/system/examples/plasma.tmpl b/gnu/system/examples/plasma.tmpl
index c3850ffe37..a81916ffe9 100644
--- a/gnu/system/examples/plasma.tmpl
+++ b/gnu/system/examples/plasma.tmpl
@@ -15,7 +15,9 @@
;; is the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device "my-root")
diff --git a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
index 1baca02491..85476854f3 100644
--- a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
+++ b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
@@ -25,14 +25,21 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi")))))
+ (bootloader-configuration
+ (bootloader grub-efi-bootloader)
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel-arguments '("ip=dhcp"))
(kernel (customize-linux #:linux linux-libre-arm64-generic
#:extra-version "arm64-generic-netboot"
diff --git a/gnu/system/examples/raspberry-pi-64.tmpl b/gnu/system/examples/raspberry-pi-64.tmpl
index 414d8ac7a5..d5b90b9705 100644
--- a/gnu/system/examples/raspberry-pi-64.tmpl
+++ b/gnu/system/examples/raspberry-pi-64.tmpl
@@ -24,14 +24,16 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel (customize-linux #:linux linux-libre-arm64-generic
;; It is possible to use a specific defconfig
;; file, for example the "bcmrpi3_defconfig" with
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index 589de493b1..050c0bb971 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -38,11 +38,10 @@ accounts.\x1b[0m
(firmware '())
- ;; Below we assume /dev/vda is the VM's hard disk.
- ;; Adjust as needed.
+ ;; Images automatically get the 'root, 'esp, and 'disk targets configured as
+ ;; needed.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 13/15] doc: Update bootloader documentation.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (11 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
` (2 subsequent siblings)
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Florian Pelz, Ludovic Court??s,
Matthew Trzcinski, Maxim Cournoyer
* doc/guix.texi
(Manual Installation)[Proceeding with the Installation]: Offload
target reference.
(System Installation)[Building the Installation Image]: Use beaglebone
as the example, and don't reference deleted variables.
(System Configuration)[Using the Configuration System]: Update
example.
[operating-system Reference]<bootloader>: Can use multiple
bootloaders.
[Keyboard Layout]: Update example.
[Bootloader Configuration]<bootloader>: Update documentation for all
bootloaders, and add new ones. Document new fields efi-removable?,
32bit?, and keypair. Update terminal-outputs and terminal-outputs to
not be GRUB-specific.
<bootloader-target>: New record.
<menu-entry>: Remove now-unsupported GRUB specifics in linux. Move
device documentation and add some for device-mount-point and
device-subvol. Fix typo in multiboot-arguments. Document chain-loader
for arbitrary bootloaders.
[Invoking guix system]<switch-generation>: Bootloaders are now
reinstalled.
<image> Other bootloaders may be used.
[Invoking guix deploy]: Update template.
(Creating System Images)[image Reference]<partition Reference>: Add
target field.
[Instantiate an Image]: Update examples and update formatting.
<efi32-disk-image, efi32-raw-image-type>: Delete.
[image-type Reference]<pinebook-pro-image-type, rock64-image-type>:
Reword slightly.
Change-Id: I45ac9d5ad3cb491c693e9a4b2f0b44b527478ee7
---
doc/guix.texi | 458 +++++++++++++++++++++++++++++---------------------
1 file changed, 262 insertions(+), 196 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 41814042f5..b5f35a9066 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2516,12 +2516,9 @@ Proceeding with the Installation
Make sure the @code{bootloader-configuration} form refers to the targets
you want to install GRUB on. It should mention @code{grub-bootloader}
if you are installing GRUB in the legacy way, or
-@code{grub-efi-bootloader} for newer UEFI systems. For legacy systems,
-the @code{targets} field contain the names of the devices, like
-@code{(list "/dev/sda")}; for UEFI systems it names the paths to mounted
-EFI partitions, like @code{(list "/boot/efi")}; do make sure the paths
-are currently mounted and a @code{file-system} entry is specified in
-your configuration.
+@code{grub-efi-bootloader} for newer UEFI systems.
+@xref{Bootloader Configuration} for information on how to format the
+@code{targets} field.
@item
Be sure that your file system labels match the value of their respective
@@ -2653,11 +2650,13 @@ Building the Installation Image
includes the bootloader, specifically:
@example
-guix system image --system=armhf-linux -e '((@@ (gnu system install) os-with-u-boot) (@@ (gnu system install) installation-os) "A20-OLinuXino-Lime2")'
+guix system image --system=armhf-linux -e '(@ (gnu system install) beaglebone-black-installation-os)'
@end example
-@code{A20-OLinuXino-Lime2} is the name of the board. If you specify an invalid
-board, a list of possible boards will be printed.
+@code{beaglebone-black} is the name of the board. Similar
+@code{installation-os} variables exist for most other supported boards.
+Otherwise, you can use @code{embedded-installation-os}, passing it a u-boot
+bootloader and the desired console tty.
@c *********************************************************************
@@ -17229,7 +17228,9 @@ Using the Configuration System
@lisp
(bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi")))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi")))))
@end lisp
@xref{Bootloader Configuration}, for more information on the available
@@ -17535,8 +17536,10 @@ operating-system Reference
List of strings or gexps representing additional arguments to pass on
the command-line of the kernel---e.g., @code{("console=ttyS0")}.
-@item @code{bootloader}
-The system bootloader configuration object. @xref{Bootloader Configuration}.
+@item @code{bootloader} (default: '())
+The system bootloader configuration object. Can either be a single
+@code{bootloader-configuration} or a list of them, to install multiple or no
+bootloaders. @xref{Bootloader Configuration}.
@item @code{label}
This is the label (a string) as it appears in the bootloader's menu entry.
@@ -18731,7 +18734,9 @@ Keyboard Layout
(keyboard-layout (keyboard-layout "tr")) ;for the console
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout))) ;for GRUB
(services (cons (set-xorg-configuration
(xorg-configuration ;for Xorg
@@ -42119,132 +42124,124 @@ Bootloader Configuration
@cindex EFI, bootloader
@cindex UEFI, bootloader
@cindex BIOS, bootloader
-The bootloader to use, as a @code{bootloader} object. For now
-@code{grub-bootloader}, @code{grub-efi-bootloader},
-@code{grub-efi-removable-bootloader}, @code{grub-efi-netboot-bootloader},
-@code{grub-efi-netboot-removable-bootloader}, @code{extlinux-bootloader}
-and @code{u-boot-bootloader} are supported.
+The bootloader to use, as a @code{bootloader} object. Available bootloaders, in
+addition to what target types they require, are as follows:
-@cindex ARM, bootloaders
-@cindex AArch64, bootloaders
-Available bootloaders are described in @code{(gnu bootloader @dots{})}
-modules. In particular, @code{(gnu bootloader u-boot)} contains definitions
-of bootloaders for a wide range of ARM and AArch64 systems, using the
-@uref{https://www.denx.de/wiki/U-Boot/, U-Boot bootloader}.
+@itemize
+@vindex depthcharge-veyron-speedy-bootloader
+@item @code{depthcharge-veyron-speedy-bootloader}
+For the Asus C201. Requires a @code{'part} target, denoting the partition to
+install the kernel blob as a @code{device}, @code{label}, or @code{uuid}.
@vindex grub-bootloader
-@code{grub-bootloader} allows you to boot in particular Intel-based machines
-in ``legacy'' BIOS mode.
+@item @code{grub-bootloader}
+GRUB2 for BIOS systems. Requires a @code{'disk} target providing either a
+@code{device}, @code{label}, or @code{uuid}. If root is mounted over NFS, it
+will load its files and the Guix System over
+@acronym{PXE, Preboot eXecution Environment}.
+
+@vindex grub-minimal-bootloader
+@item @code{grub-minimal-bootloader}
+As above, but using a minimal build of GRUB.
@vindex grub-efi-bootloader
-@code{grub-efi-bootloader} allows to boot on modern systems using the
-@dfn{Unified Extensible Firmware Interface} (UEFI). This is what you should
-use if the installation image contains a @file{/sys/firmware/efi} directory
-when you boot it on your system.
-
-@vindex grub-efi-removable-bootloader
-@code{grub-efi-removable-bootloader} allows you to boot your system from
-removable media by writing the GRUB file to the UEFI-specification location of
-@file{/EFI/BOOT/BOOTX64.efi} of the boot directory, usually @file{/boot/efi}.
-This is also useful for some UEFI firmwares that ``forget'' their configuration
-from their non-volatile storage. Like @code{grub-efi-bootloader}, this can only
-be used if the @file{/sys/firmware/efi} directory is available.
+@item @code{grub-efi-bootloader}
+GRUB2 for "modern" systems using the @dfn{Unified Extensible Firmware Interface}
+(UEFI). Requires an @code{'esp} target providing a @code{path} to the mount
+point of the EFI System Partition. If root is mounted over NFS, it will load
+its files and the Guix System over a
+@acronym{TFTP, Trivial File Transfer Protocol} server as configured over
+@acronym{DHCP, Dynamic Host Configuration Protocol} as per PXE.
+
+@vindex extlinux-bootloader
+@item @code{extlinux-bootloader}
+Extlinux for "legacy" BIOS systems. Requires a @code{'disk} target providing
+either a @code{device}, @code{label}, or @code{uuid}.
+
+@vindex extlinux-gpt-bootloader
+@item @code{extlinux-gpt-bootloader}
+As above, but for systems using the GPT instead of MBR partition table.
+
+@cindex Secure Boot, UEFI
+@vindex uki-efi-bootloader
+@item @code{uki-efi-bootloader}
+Makes and installs UKI images for UEFI systems. Requires an @code{'esp} target
+providing a @code{path} to the mount point of the EFI System Partition. Not all
+system generations may be available with this option, as UKI images contain the
+entire kernel and initramfs, and ESPs tend to be small.
+
+Full disk encryption with @code{uki-efi-bootloader} only requires a single
+password entry with fast decryption, in contrast to GRUB2 requiring a second
+password entry with slow, LUKS1-only decryption.
+
+This is the only bootloader to currently support UEFI secure boot, when
+configured as below.
-@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
-@end quotation
+@cindex ARM, bootloaders
+@cindex AArch64, bootloaders
+@vindex u-boot-a20-olinuxino-lime-bootloader
+@vindex u-boot-a20-olinuxino-lime2-bootloader
+@vindex u-boot-a20-olinuxino-micro-bootloader
+@vindex u-boot-bananapi-m2-ultra-bootloader
+@vindex u-boot-beaglebone-black-bootloader
+@vindex u-boot-cubietruck-bootloader
+@vindex u-boot-firefly-rk3399-bootloader
+@vindex u-boot-mx6cuboxi-bootloader
+@vindex u-boot-nintendo-nes-classic-edition-bootloader
+@vindex u-boot-novena-bootloader
+@vindex u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+@vindex u-boot-pine64-plus-bootloader
+@vindex u-boot-pine64-lts-bootloader
+@vindex u-boot-pinebook-bootloader
+@vindex u-boot-pinebook-pro-rk3399-bootloader
+@vindex u-boot-puma-rk3399-bootloader
+@vindex u-boot-rock64-rk3328-bootloader
+@vindex u-boot-rockpro64-rk3399-bootloader
+@vindex u-boot-sifive-unmatched-bootloader
+@vindex u-boot-qemu-riscv64-bootloader
+@vindex u-boot-starfive-visionfive2-bootloader
+@vindex u-boot-ts7970-q-2g-1000mhz-c-bootloader
+@vindex u-boot-wandboard-bootloader
+@vindex u-boot-rpi-2-bootloader
+@vindex u-boot-rpi-3-bootloader
+@vindex u-boot-rpi-4-bootloader
+@vindex u-boot-rpi-bootloader
+@item U-Boot
+U-Boot has individual bootloaders @code{u-boot-board-bootloader} for each
+of the following @code{board}s: @code{a20-olinuxino-lime},
+@code{a20-olinuxino-lime2}, @code{a20-olinuxino-micro},
+@code{bananapi-m2-ultra}, @code{beaglebone-black}, @code{cubietruck},
+@code{firefly-rk3399}, @code{mx6cuboxi}, @code{nintendo-nes-classic-edition},
+@code{novena}, @code{orangepi-r1-plus-lts-rk3328}, @code{pine64-plus},
+@code{pine64-lts}, @code{pinebook}, @code{pinebook-pro-rk3399},
+@code{puma-rk3399}, @code{rock64-rk3328}, @code{rockpro64-rk3399},
+@code{rpi-2}, @code{rpi-3}, @code{rpi-4}, @code{rpi}, @code{sifive-unmatched},
+@code{ts7970-q-2g-1000mhz-c}, @code{qemu-riscv64}, and @code{wandboard}.
+
+Each of these requires a @code{'disk} target providing either a @code{device},
+@code{label}, or @code{uuid}, except for @code{ts7970-q-2g-1000mhz-c} and
+@code{qemu-riscv64}, in which the bootloader just copies U-Boot to
+@file{/boot/u-boot.imx} or @file{/boot/u-boot.bin}, respectively. You should
+then manually flash it to the SPI flash at the U-Boot prompt.
+
+By default Guix configures U-Boot to boot using a generated extlinux config, but
+U-Boot does support loading UEFI bootloaders, if you want to combine it with
+another.
+@end itemize
-@vindex grub-efi-netboot-bootloader
-@code{grub-efi-netboot-bootloader} allows you to boot your system over network
-through TFTP@. In combination with an NFS root file system this allows you to
-build a diskless Guix system.
-
-The installation of the @code{grub-efi-netboot-bootloader} generates the
-content of the TFTP root directory at @code{targets} (@pxref{Bootloader
-Configuration, @code{targets}}) below the sub-directory @file{efi/Guix}, to be
-served by a TFTP server. You may want to mount your TFTP server directories
-onto the @code{targets} to move the required files to the TFTP server
-automatically during installation.
-
-If you plan to use an NFS root file system as well (actually if you mount the
-store from an NFS share), then the TFTP server needs to serve the file
-@file{/boot/grub/grub.cfg} and other files from the store (like GRUBs background
-image, the kernel (@pxref{operating-system Reference, @code{kernel}}) and the
-initrd (@pxref{operating-system Reference, @code{initrd}})), too. All these
-files from the store will be accessed by GRUB through TFTP with their normal
-store path, for example as
-@file{tftp://tftp-server/gnu/store/…-initrd/initrd.cpio.gz}.
-
-Two symlinks are created to make this possible. For each target in the
-@code{targets} field, the first symlink is
-@samp{target}@file{/efi/Guix/boot/grub/grub.cfg} pointing to
-@file{../../../boot/grub/grub.cfg}, where @samp{target} may be
-@file{/boot}. In this case the link is not leaving the served TFTP root
-directory, but otherwise it does. The second link is
-@samp{target}@file{/gnu/store} and points to @file{../gnu/store}. This
-link is leaving the served TFTP root directory.
-
-The assumption behind all this is that you have an NFS server exporting
-the root file system for your Guix system, and additionally a TFTP
-server exporting your @code{targets} directories—usually a single
-@file{/boot}—from that same root file system for your Guix system. In
-this constellation the symlinks will work.
-
-For other constellations you will have to program your own bootloader
-installer, which then takes care to make necessary files from the store
-accessible through TFTP, for example by copying them into the TFTP root
-directory for your @code{targets}.
-
-It is important to note that symlinks pointing outside the TFTP root directory
-may need to be allowed in the configuration of your TFTP server. Further the
-store link exposes the whole store through TFTP@. Both points need to be
-considered carefully for security aspects. It is advised to disable any TFTP
-write access!
-
-Please note, that this bootloader will not modify the ‘UEFI Boot Manager’ of
-the system.
-
-Beside the @code{grub-efi-netboot-bootloader}, the already mentioned TFTP and
-NFS servers, you also need a properly configured DHCP server to make the booting
-over netboot possible. For all this we can currently only recommend you to look
-for instructions about @acronym{PXE, Preboot eXecution Environment}.
-
-If a local EFI System Partition (ESP) or a similar partition with a FAT
-file system is mounted in @code{targets}, then symlinks cannot be
-created. In this case everything will be prepared for booting from
-local storage, matching the behavior of @code{grub-efi-bootloader}, with
-the difference that all GRUB binaries are copied to @code{targets},
-necessary for booting over the network.
-
-@vindex grub-efi-netboot-removable-bootloader
-@code{grub-efi-netboot-removable-bootloader} is identical to
-@code{grub-efi-netboot-bootloader} with the exception that the
-sub-directory @file{efi/boot} will be used instead of @file{efi/Guix} to
-comply with the UEFI specification for removable media.
+@item @code{targets}
+This is a list of @code{bootloader-target} (see below) structures denoting
+where the bootloader should install itself. Interpretation of specific target
+types and target requirements depend on the specific @code{bootloader} used.
@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
+Bootloaders have a set of default targets, that can interact with user-specified
+targets. For UEFI bootloaders using the @code{'esp} target, this typically
+includes a @code{'vendir} target. If you configure multiple UEFI bootloaders,
+you should set different @code{'vendir} target @code{path}s for each, each
+@code{offset} from @code{'esp}.
@end quotation
-@item @code{targets}
-This is a list of strings denoting the targets onto which to install the
-bootloader.
-
-The interpretation of targets depends on the bootloader in question.
-For @code{grub-bootloader}, for example, they should be device names
-understood by the bootloader @command{installer} command, such as
-@code{/dev/sda} or @code{(hd0)} (@pxref{Invoking grub-install,,, grub,
-GNU GRUB Manual}). For @code{grub-efi-bootloader} and
-@code{grub-efi-removable-bootloader} they should be mount
-points of the EFI file system, usually @file{/boot/efi}. For
-@code{grub-efi-netboot-bootloader}, @code{targets} should be the mount
-points corresponding to TFTP root directories served by your TFTP
-server.
-
@item @code{menu-entries} (default: @code{'()})
A possibly empty list of @code{menu-entry} objects (see below), denoting
entries to appear in the bootloader menu, in addition to the current
@@ -42254,6 +42251,29 @@ Bootloader Configuration
The index of the default boot menu entry. Index 0 is for the entry of the
current system.
+@item @code{efi-removable?} (default: @var{#f})
+Used by all UEFI bootloaders to determine whether they should be installed to
+the UEFI standard fallback bootloader path (on x86_64,
+@file{/EFI/BOOT/BOOTX64.EFI}). This allows it to be booted from removable media
+or otherwise in cases where the system has not been booted from UEFI already.
+
+@quotation Warning
+This will override any other bootloaders installed to the same path!
+@end quotation
+
+@item @code{32bit?} (default: @var{#f})
+Some 64-bit systems require their bootloaders to be 32-bit, including some early
+UEFI systems and some Raspberry Pis. If that is the case, and the bootloader
+supports it, setting this option will force the bootloader to install as if it
+were on a 32-bit system.
+
+@item @code{keypair} (default: @var{#f})
+Designates a keypair to be used by bootloaders that support some kind of
+cryptographic signature, such as UEFI Secure Boot. This must be a pair
+@code{'(cert . priv)} of paths to the public key (@code{cert}) and private key
+(@code{priv}). The keys these paths point to should be owned by root with 600
+permissions for security purposes.
+
@item @code{timeout} (default: @code{5})
The number of seconds to wait for keyboard input before booting. Set to
0 to boot immediately, and to -1 to wait indefinitely.
@@ -42276,19 +42296,20 @@ Bootloader Configuration
is provided, some bootloaders might use a default theme, that's true
for GRUB.
-@item @code{terminal-outputs} (default: @code{'(gfxterm)})
+@item @code{terminal-outputs} (default: @var{#f})
The output terminals used for the bootloader boot menu, as a list of
-symbols. GRUB accepts the values: @code{console}, @code{serial},
-@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text},
-@code{mda_text}, @code{morse}, and @code{pkmodem}. This field
-corresponds to the GRUB variable @code{GRUB_TERMINAL_OUTPUT} (@pxref{Simple
-configuration,,, grub,GNU GRUB manual}).
-
-@item @code{terminal-inputs} (default: @code{'()})
+symbols. When @var{#f}, the default is used. For GRUB this is @code{gfxterm}.
+GRUB accepts the values: @code{console}, @code{serial}, @code{serial_@{0-3@}},
+@code{gfxterm}, @code{vga_text}, @code{mda_text}, @code{morse}, and
+@code{pkmodem}. This field corresponds to the GRUB variable
+@code{GRUB_TERMINAL_OUTPUT}
+(@pxref{Simple configuration,,, grub,GNU GRUB manual}).
+
+@item @code{terminal-inputs} (default: @var{#f})
The input terminals used for the bootloader boot menu, as a list of
-symbols. For GRUB, the default is the native platform terminal as
-determined at run-time. GRUB accepts the values: @code{console},
-@code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
+symbols. When @var{#f}, the default is used. For GRUB, this is the native
+platform terminal as determined at run-time. GRUB accepts the values:
+@code{console}, @code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
@code{usb_keyboard}. This field corresponds to the GRUB variable
@code{GRUB_TERMINAL_INPUT} (@pxref{Simple configuration,,, grub,GNU GRUB
manual}).
@@ -42364,6 +42385,53 @@ Bootloader Configuration
@end deftp
+@vindex bootloader-target
+Configuring bootloader targets uses a specialized record designed for clarity
+and to abstract the varying user-supplied paths bootloaders may need. Only the
+@code{type} field is required; Guix will attempt to extrapolate as needed from
+what information you provide, though at least one of @code{path}, @code{device},
+@code{label}, or @code{uuid} is required to do so.
+
+@deftp {Data Type} bootloader-target
+The type of a target as used in @code{bootloader-configuration}.
+
+@table @asis
+
+@item @code{type}
+What target this record is describing. Must be a symbol, for example @code{'esp}
+or @code{'disk}.
+
+@item @code{path} (default: @var{#f})
+@code{path} denotes a string path, usually interpreted by the bootloader to
+signify a mount point (such as in the case of @code{'esp}). This value is
+automatically offset from the target denoted by @code{offset}, even if the path
+given is absolute. This allows for bootloaders to know what device or partition
+a @code{path} is actually stored on, and how to locate it.
+
+@item @code{offset} (default: @code{'root} when @code{path}, otherwise @var{#f})
+All @code{path} values, even if absolute, are automatically offset from another.
+@code{offset} is a symbol denoting which target type the path should be offset
+from. This allows for bootloaders to know what device or partition a
+@code{path} is actually stored on, and how to locate it.
+
+For most setups, you don't need to deal with this.
+
+@item @code{device} (default: @var{#f})
+@itemx @code{label} (default: @var{#f})
+@itemx @code{uuid} (default: @var{#f})
+These all work as a way of defining some kind of physical device or partition.
+@code{uuid} (taking a @code{uuid} record) and @code{label} (taking a string) are
+vastly preferred over device (a string denoting a filesystem path to a block
+device), as block device names are inconsistant and unrecognized at boot-time.
+
+@item @code{file-system} (default: @var{#f})
+A string denoting a file system type, as used in @ref{File Systems}. Unless
+your filesystem isn't being detected properly, or is unmounted at bootloader
+install-time, you shouldn't need to specify this.
+
+@end table
+@end deftp
+
@cindex dual boot
@cindex boot menu
Should you want to list additional boot menu entries @i{via} the
@@ -42375,6 +42443,8 @@ Bootloader Configuration
@lisp
(menu-entry
(label "The Other Distro")
+ (device (file-system-label "boot"))
+ (device-mount-point "/boot")
(linux "/boot/old/vmlinux-2.6.32")
(linux-arguments '("root=/dev/sda2"))
(initrd "/boot/old/initrd"))
@@ -42390,6 +42460,28 @@ Bootloader Configuration
@item @code{label}
The label to show in the menu---e.g., @code{"GNU"}.
+@item @code{device} (default: @var{#f})
+The device where any files specified below are to be found--eg, for GRUB,
+@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
+
+This may be a file system label (a string), a file system UUID (a
+bytevector, @pxref{File Systems}), or @code{#f}, in which case
+the bootloader will search the device containing the file specified by
+the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
+must @emph{not} be an OS device name such as @file{/dev/sda1}.
+
+@item @code{device-mount-point} (default: @var{#f})
+This is where @code{device} is mounted onto your file system. If provided, it
+allows for you to specify full paths for provided files, which will be
+automatically realized into paths local to their device.
+
+This is not necessary if specified files are already referring to files local to
+@code{device}, including if they're on your root filesystem.
+
+@item @code{device-subvol} (default: @var{#f})
+This is a btrfs subvolume name, useful in case you wish to access files from a
+btrfs subvolume on a device. @xref{Btrfs file system}.
+
@item @code{linux} (default: @code{#f})
The Linux kernel image to boot, for example:
@@ -42397,17 +42489,6 @@ Bootloader Configuration
(file-append linux-libre "/bzImage")
@end lisp
-For GRUB, it is also possible to specify a device explicitly in the
-file path using GRUB's device naming convention (@pxref{Naming
-convention,,, grub, GNU GRUB manual}), for example:
-
-@example
-"(hd0,msdos1)/boot/vmlinuz"
-@end example
-
-If the device is specified explicitly as above, then the @code{device}
-field is ignored entirely.
-
@item @code{linux-arguments} (default: @code{'()})
The list of extra Linux kernel command-line arguments---e.g.,
@code{'("console=ttyS0")}.
@@ -42416,16 +42497,6 @@ Bootloader Configuration
A G-Expression or string denoting the file name of the initial RAM disk
to use (@pxref{G-Expressions}).
-@item @code{device} (default: @code{#f})
-The device where the kernel and initrd are to be found---i.e., for GRUB,
-@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
-
-This may be a file system label (a string), a file system UUID (a
-bytevector, @pxref{File Systems}), or @code{#f}, in which case
-the bootloader will search the device containing the file specified by
-the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
-must @emph{not} be an OS device name such as @file{/dev/sda1}.
-
@item @code{multiboot-kernel} (default: @code{#f})
The kernel to boot in Multiboot-mode (@pxref{multiboot,,, grub, GNU GRUB
manual}). When this field is set, a Multiboot menu-entry is generated.
@@ -42448,7 +42519,7 @@ Bootloader Configuration
To use the new and still experimental
@uref{https://darnassus.sceen.net/~hurd-web/rump_kernel/, rumpdisk
user-level disk driver} instead of GNU@tie{}Mach's in-kernel IDE driver,
-set @code{kernel-arguments} to:
+set @code{multiboot-arguments} to:
@lisp
'("noide")
@@ -42471,10 +42542,11 @@ Bootloader Configuration
@end lisp
@item @code{chain-loader} (default: @code{#f})
-A string that can be accepted by @code{grub}'s @code{chainloader}
-directive. This has no effect if either @code{linux} or
-@code{multiboot-kernel} fields are specified. The following is an
-example of chainloading a different GNU/Linux system.
+Varies slightly depending on bootloader. For @code{grub}, this is anything that
+the @code{chainloader} directive can accept
+(@pxref{Chain-loading,,, grub, GNU GRUB manual}). For @code{uki-efi}, this is
+any efi binary to be installed alongside the system. The following is an example
+of chainloading a different GNU/Linux system.
@lisp
(bootloader
@@ -42682,10 +42754,6 @@ Invoking guix system
supported by the bootloader being used. The next time the system
boots, it will use the specified system generation.
-The bootloader itself is not being reinstalled when using this
-command. Thus, the installed bootloader is used with an updated
-configuration file.
-
The target generation can be specified explicitly by its generation
number. For example, the following invocation would switch to system
generation 7:
@@ -42706,11 +42774,10 @@ Invoking guix system
@end example
Currently, the effect of invoking this action is @emph{only} to switch
-the system profile to an existing generation and rearrange the
-bootloader menu entries. To actually start using the target system
-generation, you must reboot after running this action. In the future,
-it will be updated to do the same things as @command{reconfigure},
-like activating and deactivating services.
+the system profile to an existing generation and reinstall the bootloader. To
+actually start using the target system generation, you must reboot after
+running this action. In the future, it will be updated to do the same things
+as @command{reconfigure}, like activating and deactivating services.
This action will fail if the specified generation does not exist.
@@ -42886,11 +42953,9 @@ Invoking guix system
When using the @code{qcow2} image type, the returned image is in qcow2
format, which the QEMU emulator can efficiently use. @xref{Running Guix
in a VM}, for more information on how to run the image in a virtual
-machine. The @code{grub-bootloader} bootloader is always used
-independently of what is declared in the @code{operating-system} file
-passed as argument. This is to make it easier to work with QEMU, which
-uses the SeaBIOS BIOS by default, expecting a bootloader to be installed
-in the Master Boot Record (MBR).
+machine. Currently, QEMU as packaged in Guix does not have UEFI support,
+so you should select a bootloader for BIOS systems in your
+@code{operating-system} configuration.
@cindex docker-image, creating docker images
When using the @code{docker} image type, a Docker image is produced.
@@ -43208,7 +43273,6 @@ Invoking guix deploy
;; forwarded to the host's loopback interface.
(use-service-modules networking ssh)
-(use-package-modules bootloaders)
(define %system
(operating-system
@@ -43216,7 +43280,9 @@ Invoking guix deploy
(timezone "Etc/UTC")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sda"))))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
@@ -47800,6 +47866,12 @@ partition Reference
this flag set, usually the root one. The @code{'esp} flag identifies a
UEFI System Partition.
+@item @code{target} (default: @var{#f})
+If provided, this partition provides itself as a bootloader target
+(@pxref{Bootloader Configuration}). Most commonly, this is used to provide the
+@code{'root} and @code{'esp} targets, with the root partition and EFI System
+Partition, respectively, though this can provide any target necessary.
+
@item @code{initializer} (default: @code{#false})
The partition initializer procedure as a gexp. This procedure is called
to populate a partition. If no initializer is passed, the
@@ -47848,6 +47920,7 @@ Instantiate an Image
(label "GNU-ESP")
(file-system "vfat")
(flags '(esp))
+ (target 'esp)
(initializer (gexp initialize-efi-partition)))
(partition
(size (* 50 MiB))
@@ -47864,14 +47937,15 @@ Instantiate an Image
(label root-label)
(file-system "ext4")
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))))
@end lisp
-Note that the first and third partitions use generic initializers
-procedures, initialize-efi-partition and initialize-root-partition
-respectively. The initialize-efi-partition installs a GRUB EFI loader
-that is loading the GRUB bootloader located in the root partition. The
-initialize-root-partition instantiates a complete system as defined by
+Note that the first and third partitions use generic initializer
+procedures, @code{initialize-efi-partition} and @code{initialize-root-partition}
+respectively. @code{initialize-efi-partition} simply creates the directory
+structure for an EFI bootloader to install itself to.
+@code{initialize-root-partition} instantiates a complete system as defined by
the @code{%simple-os} operating-system.
You can now run:
@@ -47929,10 +48003,6 @@ Instantiate an Image
@code{i686} machines, supporting BIOS or UEFI booting.
@end defvar
-@defvar efi32-disk-image
-Same as @code{efi-disk-image} but with a 32 bits EFI partition.
-@end defvar
-
@defvar iso9660-image
An ISO-9660 image composed of a single bootable partition. This image
can also be used on most @code{x86_64} and @code{i686} machines.
@@ -48023,10 +48093,6 @@ image-type Reference
Build an image based on the @code{efi-disk-image} image.
@end defvar
-@defvar efi32-raw-image-type
-Build an image based on the @code{efi32-disk-image} image.
-@end defvar
-
@defvar qcow2-image-type
Build an image based on the @code{mbr-disk-image} image but with the
@code{compressed-qcow2} image format.
@@ -48054,14 +48120,14 @@ image-type Reference
@defvar pinebook-pro-image-type
Build an image that is targeting the Pinebook Pro machine. The MBR
image contains a single partition starting at a @code{9MiB} offset. The
-@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader will be
+@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader can be
installed in this gap.
@end defvar
@defvar rock64-image-type
Build an image that is targeting the Rock64 machine. The MBR image
contains a single partition starting at a @code{16MiB} offset. The
-@code{u-boot-rock64-rk3328-bootloader} bootloader will be installed in
+@code{u-boot-rock64-rk3328-bootloader} bootloader can be installed in
this gap.
@end defvar
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 14/15] gnu: tests: Update tests to new targets system.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (12 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 2:44 ` [bug#72457] [PATCH v4 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
2024-08-06 6:13 ` [bug#72457] [PATCH v4 00/15] Rewrite bootloader subsystem Sergey Trofimov
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov, Maxim Cournoyer
* gnu/services/virtualization.scm
(%virtual-build-machine-operating-system): Remove bootloader.
(%hurd-vm-operating-system): Remove targets.
* gnu/system/hurd.scm (%hurd-default-operating-system): Remove targets.
* gnu/tests.scm (%simple-os), gnu/tests/ganeti.scm (%ganeti-os),
gnu/tests/image.scm (%simple-efi-os),
gnu/tests/install.scm (%minimal-os, %minimal-extlinux-os,
%minimal-os-on-vda, %separate-home-os, %separate-store-os, %raid-root-os,
%encrypted-root-os, %lvm-separate-home-os, %encrypted-home-os,
%encrypted-home-os-key-file, %encrypted-root-not-boot-os,
%btrfs-root-os-source, %btrfs-raid-root-os-source,
%btrfs-root-on-subvolume-os, %btrfs-raid10-root-os, %jfs-root-os,
%f2fs-root-os, %xfs-root-os), gnu/tests/nfs.scm (%base-os),
gnu/tests/telephony.scm (make-jami-os), gnu/tests/vnc.scm (%xvnc-os):
Update bootloader targets.
Change-Id: I3d66a839a9b2a73b8b65946950728b1e0155ca1e
---
gnu/services/virtualization.scm | 11 ++---
gnu/system/hurd.scm | 4 +-
gnu/tests.scm | 4 +-
gnu/tests/ganeti.scm | 4 +-
gnu/tests/image.scm | 4 +-
gnu/tests/install.scm | 72 ++++++++++++++++++++++++---------
gnu/tests/nfs.scm | 4 +-
gnu/tests/telephony.scm | 4 +-
gnu/tests/vnc.scm | 4 +-
tests/boot-parameters.scm | 2 +-
10 files changed, 77 insertions(+), 36 deletions(-)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index d87e494348..f698532a94 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1191,17 +1191,13 @@ (define %minimal-vm-syslog-config
(define %virtual-build-machine-operating-system
(operating-system
(host-name "build-machine")
-
(locale "en_US.utf8")
(locale-definitions
;; Save space by providing only one locale.
(list (locale-definition (name "en_US.utf8")
(source "en_US")
(charset "UTF-8"))))
-
- (bootloader (bootloader-configuration ;unused
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/null"))))
+ ;; no bootloader
(file-systems (cons (file-system ;unused
(mount-point "/")
(device "none")
@@ -1624,9 +1620,8 @@ (define %hurd-vm-operating-system
(host-name "childhurd")
(timezone "Europe/Amsterdam")
(bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))
- (timeout 0)))
+ (bootloader grub-minimal-bootloader)
+ (timeout 0)))
(packages (cons* gdb-minimal
(operating-system-packages
%hurd-default-operating-system)))
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index cbe0081382..af04e82485 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -119,9 +119,7 @@ (define %hurd-default-operating-system
(kernel %hurd-default-operating-system-kernel)
(kernel-arguments '())
(hurd hurd)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(initrd #f)
(initrd-modules '())
(firmware '())
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 5ff9db82fc..f46ccf5174 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -237,7 +237,9 @@ (define %simple-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device"/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
index 29eb354044..789879b26f 100644
--- a/gnu/tests/ganeti.scm
+++ b/gnu/tests/ganeti.scm
@@ -40,7 +40,9 @@ (define %ganeti-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/image.scm b/gnu/tests/image.scm
index be6852cae0..8d960cf7b8 100644
--- a/gnu/tests/image.scm
+++ b/gnu/tests/image.scm
@@ -55,7 +55,9 @@ (define %simple-efi-os
(inherit %simple-os)
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))))
;; An MBR disk image with a single ext4 partition.
(define i1
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 18a2fc119b..d67a71f12e 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -103,7 +103,9 @@ (define-os-with-source (%minimal-os %minimal-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -141,7 +143,9 @@ (define-os-with-source (%minimal-extlinux-os
(bootloader (bootloader-configuration
(bootloader extlinux-gpt-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -434,7 +438,9 @@ (define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -510,7 +516,9 @@ (define-os-with-source (%separate-home-os %separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "my-root"))
@@ -565,7 +573,9 @@ (define-os-with-source (%separate-store-os %separate-store-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "root-fs"))
@@ -642,7 +652,9 @@ (define-os-with-source (%raid-root-os %raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
;; Add a kernel module for RAID-1 (aka. "mirror").
@@ -725,7 +737,9 @@ (define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -858,7 +872,9 @@ (define-os-with-source (%lvm-separate-home-os %lvm-separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(mapped-devices (list (mapped-device
@@ -943,7 +959,9 @@ (define-os-with-source (%encrypted-home-os %encrypted-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -1070,7 +1088,9 @@ (define-os-with-source (%encrypted-home-os-key-file
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))
(extra-initrd "/key-file.cpio")))
(kernel-arguments '("console=ttyS0"))
@@ -1130,7 +1150,9 @@ (define-os-with-source (%encrypted-root-not-boot-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(mapped-devices (list (mapped-device
(source
@@ -1232,7 +1254,9 @@ (define-os-with-source (%btrfs-root-os %btrfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1306,7 +1330,9 @@ (define-os-with-source (%btrfs-raid-root-os %btrfs-raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1374,7 +1400,9 @@ (define-os-with-source (%btrfs-root-on-subvolume-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "btrfs-pool"))
@@ -1467,7 +1495,9 @@ (define-os-with-source (%btrfs-raid10-root-os
(bootloader (map (lambda (targ)
(bootloader-configuration
(bootloader grub-bootloader)
- (targets (list targ))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device targ))))))
'("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
@@ -1577,7 +1607,9 @@ (define-os-with-source (%jfs-root-os %jfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1650,7 +1682,9 @@ (define-os-with-source (%f2fs-root-os %f2fs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1723,7 +1757,9 @@ (define-os-with-source (%xfs-root-os %xfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 0d9972e0e9..2f97126df7 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -51,7 +51,9 @@ (define %base-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems %base-file-systems)
(users %base-user-accounts)
(packages (cons*
diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index f03ea963f7..ee858d9c91 100644
--- a/gnu/tests/telephony.scm
+++ b/gnu/tests/telephony.scm
@@ -90,7 +90,9 @@ (define* (make-jami-os #:key provisioning? partial?)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/vnc.scm b/gnu/tests/vnc.scm
index ab1c2749f3..cba9c565e0 100644
--- a/gnu/tests/vnc.scm
+++ b/gnu/tests/vnc.scm
@@ -51,7 +51,9 @@ (define %xvnc-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index f214de360d..f343dbdfdb 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -63,7 +63,7 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
- (bootloader-name 'grub)
+ (bootloader-name '(grub))
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 15/15] teams: Add bootloading team.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (13 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
@ 2024-08-06 2:44 ` Lilah Tascheter via Guix-patches
2024-08-06 6:13 ` [bug#72457] [PATCH v4 00/15] Rewrite bootloader subsystem Sergey Trofimov
15 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-06 2:44 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
Might as well, to help ease the transition.
* etc/teams.scm (bootloaders): New team.
(Lilah Tascheter): Create add to above.
Change-Id: I63620f4e3151bb8e3d0bdf619fc70501af6397a0
---
etc/teams.scm | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/etc/teams.scm b/etc/teams.scm
index 408ebbf3d9..d9af4ad7bb 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -328,6 +328,12 @@ (define-team embedded
#:scope (list "gnu/packages/bootloaders.scm"
"gnu/packages/firmware.scm")))
+(define-team bootloaders
+ (team 'bootloaders
+ #:name "Bootloaders"
+ #:scope (list "gnu/bootloader.scm"
+ (make-regexp* "^gnu/bootloader/"))))
+
(define-team rust
(team 'rust
#:name "Rust"
@@ -746,6 +752,10 @@ (define-member (person "Nicolas Goaziou"
"guix@nicolasgoaziou.fr")
tex)
+(define-member (person "Lilah Tascheter"
+ "lilah@lunabee.space")
+ bootloaders)
+
\f
(define (find-team name)
(or (hash-ref %teams (string->symbol name))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v4 00/15] Rewrite bootloader subsystem.
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
` (14 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
@ 2024-08-06 6:13 ` Sergey Trofimov
15 siblings, 0 replies; 95+ messages in thread
From: Sergey Trofimov @ 2024-08-06 6:13 UTC (permalink / raw)
To: Lilah Tascheter; +Cc: 72457
Hi Lilah,
Lilah Tascheter <lilah@lunabee.space> writes:
> Fourth time's the charm. Thanks so much for your help!
>
We're doing progress here. After a small fix the new system generation
got successfully activated. Rebooting has shown that grub can't find own
files and enters rescue mode. The culprit is that core.cfg contains
extra `/boot` in the prefix var.
Generated cfg:
--8<---------------cut here---------------start------------->8---
search.fs_uuid "6BA3-A04D" root
set "prefix=($root)/boot"
--8<---------------cut here---------------end--------------->8---
How it probably should be:
--8<---------------cut here---------------start------------->8---
search.fs_uuid "6BA3-A04D" boot
set "prefix=($boot)"
--8<---------------cut here---------------end--------------->8---
Small fixes:
--8<---------------cut here---------------start------------->8---
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 71fcc90ec7..bba5cad80d 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -259,9 +259,9 @@ (define* (core.img grub format #:key bootloader-config store-crypto-devices
'#$(if tftp? '() '("part_msdos" "part_gpt"))
;; file systems
'#$(cond ((member fs '("ext2" "ext3" "ext4")) '("ext2"))
- ((member fs "vfat" "fat32") "fat")
- ((and tftp? efi?) "efinet")
- ((and tftp? bios?) "pxe")
+ ((member fs '("vfat" "fat32")) '("fat"))
+ ((and tftp? efi?) '("efinet"))
+ ((and tftp? bios?) '("pxe"))
(else (list fs)))
;; store crypto devs
'#$(if (any uuid? store-crypto-devices)
@@ -403,7 +403,7 @@ (define* (grub.cfg #:key bootloader-config
set color_highlight=~a
else
set menu_color_normal=cyan/blue
- set menu_color_highlight=whiute/blue
+ set menu_color_highlight=white/blue
fi~%" #$(sanitize install)
#$(colors->str color-normal)
#$(colors->str color-highlight))))))
--8<---------------cut here---------------end--------------->8---
^ permalink raw reply related [flat|nested] 95+ messages in thread
* [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (18 preceding siblings ...)
2024-08-06 2:44 ` [bug#72457] [PATCH v4 " Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
` (16 more replies)
2024-09-12 18:08 ` [bug#72457] [PATCH v5 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Herman Rimm via Guix-patches via
2024-09-15 9:11 ` [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem Herman Rimm via Guix-patches via
21 siblings, 17 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
Alright, hopefully this works then!
Lilah Tascheter (15):
guix: scripts: Rewrite reinstall-bootloader to use provenance data.
gnu: Add bootloader target infastructure.
guix: scripts: Remove unused code.
gnu: Core bootloader changes.
gnu: system: Remove useless boot parameters.
gnu: bootloader: Add raspberry pi bootloader.
gnu: system: Fix bootloader crypto device recognition.
gnu: packages: Add pesign.
gnu: packages: Add ukify.
gnu: packages: Add systemd-stub.
gnu: bootloaders: Add uki-efi-bootloader.
gnu: system: Update examples.
doc: Update bootloader documentation.
gnu: tests: Update tests to new targets system.
teams: Add bootloading team.
doc/guix.texi | 458 +++---
etc/teams.scm | 10 +
gnu/bootloader.scm | 666 ++++++---
gnu/bootloader/depthcharge.scm | 153 +-
gnu/bootloader/extlinux.scm | 149 +-
gnu/bootloader/grub.scm | 1280 +++++++----------
gnu/bootloader/u-boot.scm | 505 +++----
gnu/bootloader/uki.scm | 96 ++
gnu/build/bootloader.scm | 157 +-
gnu/build/image.scm | 40 +-
gnu/build/install.scm | 16 +-
gnu/image.scm | 3 +
gnu/installer/parted.scm | 12 +-
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 71 +-
gnu/packages/bootloaders.scm | 277 ++--
gnu/packages/efi.scm | 47 +
gnu/packages/raspberry-pi.scm | 18 -
gnu/services/virtualization.scm | 11 +-
gnu/system.scm | 62 +-
gnu/system/boot.scm | 16 +-
gnu/system/examples/asus-c201.tmpl | 6 +-
gnu/system/examples/bare-bones.tmpl | 7 +-
gnu/system/examples/bare-hurd.tmpl | 4 +-
gnu/system/examples/beaglebone-black.tmpl | 6 +-
gnu/system/examples/desktop.tmpl | 4 +-
gnu/system/examples/docker-image.tmpl | 6 +-
gnu/system/examples/lightweight-desktop.tmpl | 4 +-
gnu/system/examples/plasma.tmpl | 4 +-
.../examples/raspberry-pi-64-nfs-root.tmpl | 23 +-
gnu/system/examples/raspberry-pi-64.tmpl | 18 +-
gnu/system/examples/vm-image.tmpl | 5 +-
gnu/system/hurd.scm | 4 +-
gnu/system/image.scm | 162 ++-
gnu/system/images/hurd.scm | 4 +-
gnu/system/images/novena.scm | 3 +-
.../images/orangepi-r1-plus-lts-rk3328.scm | 3 +-
gnu/system/images/pine64.scm | 3 +-
gnu/system/images/pinebook-pro.scm | 3 +-
gnu/system/images/rock64.scm | 3 +-
gnu/system/images/unmatched.scm | 3 +-
gnu/system/images/visionfive2.scm | 3 +-
gnu/system/images/wsl2.scm | 14 +-
gnu/system/install.scm | 43 +-
gnu/system/vm.scm | 11 -
gnu/tests.scm | 4 +-
gnu/tests/ganeti.scm | 4 +-
gnu/tests/image.scm | 4 +-
gnu/tests/install.scm | 80 +-
gnu/tests/nfs.scm | 4 +-
gnu/tests/reconfigure.scm | 86 +-
gnu/tests/telephony.scm | 4 +-
gnu/tests/vnc.scm | 4 +-
guix/scripts/system.scm | 162 +--
guix/scripts/system/reconfigure.scm | 159 +-
guix/ui.scm | 8 +
tests/boot-parameters.scm | 16 +-
57 files changed, 2395 insertions(+), 2534 deletions(-)
create mode 100644 gnu/bootloader/uki.scm
base-commit: 7d781027c78bdea5fdb3f1c9c9ec432b9606d2b5
--
2.45.2
^ permalink raw reply [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
` (15 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Ludovic Court??s, Mathieu Othacehe,
Simon Tournier, Tobias Geerinckx-Rice
The current implementation is broken anyway. Multiple bootloaders share
a name (including both versions of extlinux) and
bootloader-configuration data is significant to bootloader installation.
It shouldn't be just faked.
Rely on the provenance service instead, which while not always present,
should be for the vast majority of systems.
* guix/scripts/system.scm (reinstall-bootloader): Rename to...
(install-bootloader-from-provenance): ...this, and rewrite to extract
bootloader-configuration data from system provenance.
(switch-to-system-generation, process-command): Use
install-bootloader-from-provenance.
Change-Id: I5713a43ad4f9f32a129d980db06d70de16b03f27
---
guix/scripts/system.scm | 75 ++++++++++++++---------------------------
1 file changed, 25 insertions(+), 50 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0f7d864e06..bb7b5d37bf 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -88,6 +88,7 @@ (define-module (guix scripts system)
#:use-module (srfi srfi-37)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
#:use-module (rnrs bytevectors)
#:export (guix-system
read-operating-system
@@ -377,60 +378,33 @@ (define (switch-to-system-generation store spec)
(activate (string-append generation "/activate")))
(if number
(begin
- (reinstall-bootloader store number)
+ (install-bootloader-from-provenance store number)
(switch-to-generation* %system-profile number)
(unless-file-not-found (primitive-load activate)))
(leave (G_ "cannot switch to system generation '~a'~%") spec))))
-(define* (system-bootloader-name #:optional (system %system-profile))
- "Return the bootloader name stored in SYSTEM's \"parameters\" file."
- (let ((params (unless-file-not-found
- (read-boot-parameters-file system))))
- (boot-parameters-bootloader-name params)))
-
-(define (reinstall-bootloader store number)
- "Re-install bootloader for existing system profile generation NUMBER.
-STORE is an open connection to the store."
+(define (install-bootloader-from-provenance store number)
+ "Re-install an old bootloader using provenance data for system profile
+generation NUMBER with store STORE."
(let* ((generation (generation-file-name %system-profile number))
- ;; Detect the bootloader used in %system-profile.
- (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
-
- ;; Use the detected bootloader with default configuration.
- ;; It will be enough to allow the system to boot.
- (bootloader-config (bootloader-configuration
- (bootloader bootloader)))
-
- ;; Make the specified system generation the default entry.
- (chosen-alternative (generation->boot-alternative
- %system-profile number))
- (params (boot-alternative-parameters chosen-alternative))
- (locale (boot-parameters-locale params))
- (store-crypto-devices (boot-parameters-store-crypto-devices params))
- (store-directory-prefix
- (boot-parameters-store-directory-prefix params))
- (old-generations
- (delv number (reverse (generation-numbers %system-profile))))
- (previous-boot-alternatives (profile->boot-alternatives
- %system-profile old-generations))
- (entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- previous-boot-alternatives))))
- (run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object
- ((bootloader-configuration-file-generator bootloader)
- bootloader-config entries
- #:locale locale
- #:store-crypto-devices store-crypto-devices
- #:store-directory-prefix store-directory-prefix
- #:old-entries old-entries)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))))
+ (os (receive (_ os) (system-provenance generation)
+ (and=> os read-operating-system)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (numbers (delv number (reverse (generation-numbers %system-profile))))
+ (old (profile->boot-alternatives %system-profile numbers)))
+ (if os
+ (run-with-store store
+ (mlet* %store-monad
+ ((bootcfg (lower-object (operating-system-bootcfg os old)))
+ (drvs -> (list bootcfg)))
+ (mbegin %store-monad
+ (built-derivations drvs)
+ ;; Only install bootloader configuration file.
+ (install-bootloader local-eval bootloader-config bootcfg
+ #:run-installer? #f))))
+ (leave (G_ "cannot rollback to provenanceless generation '~a'~%")
+ number))))
\f
;;;
@@ -1416,7 +1390,8 @@ (define (process-command command args opts)
(x (leave (G_ "wrong number of arguments~%"))))))
(with-store* store
(delete-matching-generations store %system-profile pattern)
- (reinstall-bootloader store (generation-number %system-profile)))))
+ (install-bootloader-from-provenance store
+ (generation-number %system-profile)))))
((switch-generation)
(let ((pattern (match args
((pattern) pattern)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 02/15] gnu: Add bootloader target infastructure.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
` (14 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Lilah Tascheter, Ludovic Court??s,
Mathieu Othacehe, Simon Tournier, Tobias Geerinckx-Rice
* gnu/bootloader.scm (bootloader-target): New record.
(&target-error): New condition.
(pathcat, get-target-of-type, parent-of, unfold-pathcat, target-base?,
type-major?, ensure, ensure-target-types, ensure-majors, gbegin):
New procedures.
(define-literal, with-targets, :path, :devpath, :device,
:fs, :label, :uuid): New macros.
(bootloader-modules): Prevent mutual imports.
* guix/ui.scm (call-with-error-handling)[target-error?]:
Handle target-errors.
Change-Id: I3f07c9096dd8b91c04449b6360b3b7d21640da14
---
gnu/bootloader.scm | 212 ++++++++++++++++++++++++++++++++++++++++++++-
guix/ui.scm | 8 ++
2 files changed, 217 insertions(+), 3 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index f32e90e79d..3ddc112cc6 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -31,10 +31,11 @@ (define-module (gnu bootloader)
#:use-module (guix profiles)
#:use-module (guix records)
#:use-module (guix deprecation)
- #:use-module ((guix ui) #:select (warn-about-load-error))
#:use-module (guix diagnostics)
#:use-module (guix i18n)
+ #:use-module (guix modules)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (ice-9 match)
@@ -63,6 +64,26 @@ (define-module (gnu bootloader)
bootloader-configuration-file
bootloader-configuration-file-generator
+ <bootloader-target>
+ bootloader-target
+ bootloader-target?
+ bootloader-target-type
+ bootloader-target-expected?
+ bootloader-target-path
+ bootloader-target-offset
+ bootloader-target-device
+ bootloader-target-file-system
+ bootloader-target-label
+ bootloader-target-uuid
+
+ target-error?
+ target-error-type
+ target-error-targets
+
+ gbegin
+ :path :devpath :device :fs :label :uuid
+ with-targets
+
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
@@ -236,6 +257,191 @@ (define-record-type* <bootloader>
(configuration-file bootloader-configuration-file)
(configuration-file-generator bootloader-configuration-file-generator))
+\f
+;;;
+;;; Bootloader target record.
+;;;
+
+;; <bootloader-target> represents different kinds of targets in a normalized form.
+
+(define-record-type* <bootloader-target>
+ bootloader-target make-bootloader-target bootloader-target?
+ (type bootloader-target-type) ; symbol
+ (expected? bootloader-target-expected? (default #f)) ; bool
+
+ (path bootloader-target-path (default #f)) ; string|#f
+ (offset bootloader-target-offset (thunked) ; symbol|#f
+ (default (and (bootloader-target-path this-record)
+ (not (eq? (bootloader-target-type this-record) 'root))
+ 'root)))
+ (device bootloader-target-device (default #f)) ; string|#f
+ (file-system bootloader-target-file-system (default #f)) ; string|#f
+ (label bootloader-target-label (default #f)) ; string|#f
+ (uuid bootloader-target-uuid (default #f))) ; uuid|#f
+
+(define-condition-type &target-error &error target-error?
+ (type target-error-type)
+ (targets target-error-targets))
+
+(define (pathcat p1 p2)
+ (string-append (string-trim-right p1 #\/) "/" (string-trim p2 #\/)))
+
+(define* (get-target-of-type type targets #:optional (require? #f))
+ "Finds a target in TARGETS of type TYPE, optionally providing an error when
+not found if REQUIRE? is provided."
+ (let* ((pred (lambda (target) (eq? type (bootloader-target-type target))))
+ (candidates (filter pred targets))
+ (ret (if (pair? candidates) (car candidates) #f)))
+ (if (and require? (not ret))
+ (raise (condition
+ (&message (message (G_ "required, but not provided")))
+ (&target-error (type type) (targets targets))))
+ ret)))
+
+(define (parent-of target targets)
+ (and=> (bootloader-target-offset target)
+ (cut get-target-of-type <> targets #t)))
+
+(define (unfold-pathcat target targets)
+ (let ((quit (lambda (t) (not (and=> t bootloader-target-path)))))
+ (reduce pathcat #f
+ (unfold quit bootloader-target-path (cut parent-of <> targets) target))))
+
+(define (target-base? t)
+ (or (not t) (match-record t <bootloader-target>
+ (expected? offset device label uuid)
+ (or device label uuid (not offset) expected?))))
+
+(define (type-major? target) (memq target '(root esp disk)))
+
+(define (ensure types targets end)
+ (let* ((used-in (cute unfold end identity (cut parent-of <> targets) <>))
+ (cons-in (lambda (t) (cons t (used-in t))))
+ (ensure (map (cut get-target-of-type <> targets #t) types)))
+ (filter ->bool (apply append (map cons-in ensure)))))
+
+(define* (ensure-target-types types targets #:optional (base? #f))
+ "Ensures all TYPES are provided in TARGETS. Returns #t iff every ensured
+target and its requirements are fully provided. Errors out when a required TYPE
+isn't provided. When BASE?, only ensure path requirements up to a device."
+ (not (any bootloader-target-expected?
+ (ensure types targets (if base? target-base? not)))))
+
+(define (ensure-majors types targets)
+ "Errors out when a required TYPE isn't provided, or when use of multiple major
+targets is detected."
+ (let* ((all (map bootloader-target-type (ensure types targets target-base?)))
+ (majors (delete-duplicates (filter type-major? all) eq?)))
+ (if (< (length majors) 2) #t
+ (raise (condition (&message (message (G_ "multiple major targets used")))
+ (&target-error (type majors) (targets targets)))))))
+
+
+
+(define (gbegin . gex)
+ "Sequence provided g-expressions."
+ (case (length gex) ((0) #f) ((1) (car gex)) (else #~(begin #$@gex))))
+
+;; syntax matching on free literals breaks easily, so bind them
+(define-syntax-rule (define-literal id) (define-syntax id (syntax-rules ())))
+(define-literal :path)
+(define-literal :devpath)
+(define-literal :device)
+(define-literal :fs)
+(define-literal :label)
+(define-literal :uuid)
+
+(define-syntax with-targets
+ (cut syntax-case <> ()
+ ((_ targets-expr block ...)
+ (let* ((genvars (compose generate-temporaries iota))
+ (targets (car (genvars 1)))
+
+ (path? (cut syntax-case <> (:path) ((_ :path) #t) (_ #f)))
+ (qualified? (cut syntax-case <> (=>)
+ ((_ => spec ...) (any path? #'(spec ...)))
+ (_ #f)))
+
+ (resolve
+ (lambda (in target base)
+ (with-syntax ((target target) (base base) (targets targets))
+ (syntax-case in
+ (:path :devpath :device :fs :label :uuid)
+ ((name _) (not (identifier? #'name))
+ #`(_ (syntax-error "binds must be to identifiers" #,in)))
+ ((name :device) #'(name (bootloader-target-device base)))
+ ((name :label) #'(name (bootloader-target-label base)))
+ ((name :uuid) #'(name (bootloader-target-uuid base)))
+ ((name :fs) #'(name (bootloader-target-file-system base)))
+ ((name :path) #'(name (unfold-pathcat target targets)))
+ ((name :devpath)
+ #'(name (pathcat "/" (bootloader-target-path target))))
+ (_ #`(_ (syntax-error "invalid binding spec" #,in)))))))
+ (binds
+ (lambda (spec)
+ (syntax-case spec (=>)
+ ((type => binds ...)
+ (with-syntax (((target base) (genvars 2)) (targets targets))
+ (append
+ #`((get (lambda (t) (get-target-of-type t targets #t)))
+ (target (get type))
+ (base (if (target-base? target) target
+ (get (bootloader-target-offset target)))))
+ (map (cut resolve <> #'target #'base) #'(binds ...)))))
+ (_ #f))))
+
+ (blocks
+ (cut syntax-case <> ()
+ ((spec ... expr)
+ (let* ((specs #'(spec ...))
+ (lets (apply append (filter-map binds specs)))
+ (type (cut syntax-case <> (=>)
+ ((t => _ ...) #'t) (t #'t))))
+ (receive (full part) (partition qualified? specs)
+ #`(and (ensure-majors (list #,@(map type specs)) #,targets)
+ (ensure-target-types (list #,@(map type part))
+ #,targets #t)
+ (ensure-target-types (list #,@(map type full))
+ #,targets #f)
+ (let* #,lets expr)))))
+ (bad #'(syntax-error "malformed block" bad)))))
+ "Using the list TARGETS, evaluate and sequence each BLOCK to produce a
+gexp. BLOCK is a set of SPECs followed by an EXPR (evaluating to a gexp). Each
+SPEC denotes a type of target to guard EXPR on their existance and
+full-qualification. This procedure is linear in regards to BLOCKs.
+
+SPEC may be of the following forms:
+@itemize
+@item 'TYPE Requires TYPE to be fully present or promised. Errors otherwise.
+@item ('TYPE => (VAR COMPONENT) ...): As type, but also binds variables. TYPE's
+ COMPONENT is bound to the variable VAR as described below.
+@end itemize
+
+Available COMPONENTs are:
+@itemize
+@item :path (fully-qualified)
+@item :devpath (relative from device)
+@item :device (auto-detected from uuid and label if not user-provided)
+@item :fs
+@item :label
+@item :uuid
+@end itemize
+
+Note that installers may be called multiple times with different targets being
+fully-qualified. To ensure that targets aren't installed multiple times, make sure
+that each BLOCK ensures at least one major target, either directly or indirectly.
+Corrolarily, at most one major target should be ensured per BLOCK, under the same
+conditions. Major targets originate from disk image handling, and are currently:
+@itemize
+@item disk
+@item root
+@item esp
+@end itemize"
+ #`(let ((#,targets targets-expr))
+ (apply gbegin (filter ->bool
+ (list #,@(map blocks #'(block ...))))))))
+ (bad #'(syntax-error "must provide targets" bad))))
+
\f
;;;
;;; Bootloader configuration record.
@@ -305,10 +511,10 @@ (define (bootloader-configuration-targets config)
(define (bootloader-modules)
"Return the list of bootloader modules."
+ ;; don't provide #:warn to prevent mutual imports
(all-modules (map (lambda (entry)
`(,entry . "gnu/bootloader"))
- %load-path)
- #:warn warn-about-load-error))
+ %load-path)))
(define %bootloaders
;; The list of publically-known bootloaders.
diff --git a/guix/ui.scm b/guix/ui.scm
index 9db6f6e9d7..1c9300c9eb 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -36,6 +36,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix ui)
+ #:use-module ((gnu bootloader)
+ #:select (target-error? target-error-type target-error-targets))
#:use-module (guix i18n)
#:use-module (guix colors)
#:use-module (guix diagnostics)
@@ -857,6 +859,12 @@ (define (call-with-error-handling thunk)
(invoke-error-stop-signal c)
(cons (invoke-error-program c)
(invoke-error-arguments c))))
+ ((target-error? c)
+ (leave (G_ "bootloader-target '~a'~@[: ~a~] ~
+ among the following targets:~%~{~y~}")
+ (target-error-type c)
+ (and (message-condition? c) (condition-message c))
+ (target-error-targets c)))
((formatted-message? c)
(apply report-error
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 03/15] guix: scripts: Remove unused code.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 02/15] gnu: Add bootloader target infastructure Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
` (13 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Josselin Poiret, Ludovic Court??s, Mathieu Othacehe,
Simon Tournier, Tobias Geerinckx-Rice
* guix/scripts/system.scm (bootloader-installer-script): Delete.
Change-Id: Ic1e0a523c814e4f1bf44b2721f5658f00066b0ab
---
guix/scripts/system.scm | 22 ----------------------
1 file changed, 22 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bb7b5d37bf..344bb74151 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -731,28 +731,6 @@ (define (maybe-suggest-running-guix-pull)
(warning (G_ "Consider running 'guix pull' before 'reconfigure'.~%"))
(warning (G_ "Failing to do that may downgrade your system!~%"))))
-(define (bootloader-installer-script installer
- bootloader device target)
- "Return a file calling INSTALLER gexp with given BOOTLOADER, DEVICE
-and TARGET arguments."
- (scheme-file "bootloader-installer"
- (with-imported-modules '((gnu build bootloader)
- (guix build utils))
- #~(begin
- (use-modules (gnu build bootloader)
- (guix build utils)
- (ice-9 binary-ports)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (guard (c ((message-condition? c) ;XXX: i18n
- (format (current-error-port) "error: ~a~%"
- (condition-message c))
- (exit 1)))
- (#$installer #$bootloader #$device #$target)
- (info (G_ "bootloader successfully installed on '~a'~%")
- #$device))))))
-
(define (local-eval exp)
"Evaluate EXP, a G-Expression, in-place."
(mlet* %store-monad ((lowered (lower-gexp exp))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 04/15] gnu: Core bootloader changes.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (2 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 03/15] guix: scripts: Remove unused code Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
` (12 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Christopher Baines,
Efraim Flashner, Josselin Poiret, Lilah Tascheter,
Ludovic Court??s, Mathieu Othacehe, Simon Tournier,
Tobias Geerinckx-Rice, Vagrant Cascadian
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/bootloader.scm (menu-entry): Add device-subvol field.
(menu-entry->sexp, sexp->menu-entry): Support device-subvol.
(normalize-file, warn-update-targets, target-overrides, normalize,
bootloader-configuration->gexp, bootloader-configurations->gexps,
efi-arch, install-efi):
New procedures.
(bootloader): Rewrite record.
(bootloader-configuration)[target]: Remove deprecated field.
[targets]: Include sanitizer and allow multiple bootloaders.
[terminal-outputs, terminal-inputs]: Don't assume grub.
[efi-removable?, 32bit?]: New fields.
(warn-target-field-deprecation): Delete deprecation warning.
(%bootloaders): Delete variable.
(bootloader-configuration-target, bootloader-configuration-targets,
lookup-bootloader-by-name, bootloader-modules, efi-bootloader-profile,
efi-bootloader-chain): Delete procedures.
* gnu/bootloader/depthcharge.scm, gnu/bootloader/extlinux.scm,
gnu/bootloader/grub.scm, gnu/bootloader/u-boot.scm: Rewrite entirely.
* gnu/build/bootloader.scm (parse-bootnums): New variable.
(atomic-copy, in-temporary-directory, efi-bootnums): New procedures.
(install-efi-loader): Delete procedure.
(install-efi): Rewrite to support installation of any efi bootloader.
* gnu/build/image.scm (initialize-efi32-partition: Deprecate.
(initialize-efi-partitition): Only create EFI directory.
(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/image.scm (partition)[target]: New field in order to support
dynamic provision of image partitions as bootloader targets.
* gnu/installer/parted.scm (bootloader-configuration),
gnu/machine/ssh.scm (deploy-managed-host) (roll-back-managed-host):
Use new bootloader system.
* gnu/packages/bootloaders.scm (make-grub-efi-netboot): Delete
procedure.
* gnu/packages/raspberry-pi.scm (grub-efi-bootloader-chain-raspi-64):
Delete procedure. Can be recreated with a raspberry pi bootloader
combined with grub-efi.
* gnu/system.scm (convert-bootloader-field): New procedure.
(operating-system)[bootloader]: Use above sanitizer and support
multiple bootloaders.
(operating-system-bootcfg): Rename to...
(operating-system-bootmeta): ...this. Rewrite to return relavent
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.
(boot-parameters->menu-entry): Support device-subvol.
(boot-alternative->menu-entry): New procedure.
* gnu/system/image.scm (root-partition, esp-partition): Use target field.
(esp32-partition, efi32-disk-partition, efi32-raw-image-type): Deprecate.
(root-partition-index): Delete procedure.
(system-disk-image, system-iso9960-image): Support new bootloader system.
(system-disk-image)[targets]: New subprocedure.
* gnu/system/images/hurd.scm (hurd-barebones-os)[bootloader],
gnu/system/images/novena.scm (novena-barebones-os)[bootloader],
gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
(orangepi-r1-plus-lts-rk3328-barebones-os)[bootloader],
gnu/system/images/pine64.scm (pine64-barebones-os)[bootloader],
gnu/system/images/pinebook-pro.scm
(pinebook-pro-barebones-os)[bootloader],
gnu/system/images/rock64.scm (rock64-barebones-os)[bootloader],
gnu/system/images/unmatched.scm (unmatched-barebones-os)[bootloader],
gnu/system/images/visionfive2.scm
(visionfive2-barebones-os)[bootloader]: Use new target format.
* gnu/system/images/wsl2.scm (dummy-bootloader): Delete variable.
(wsl-os)[bootloader]: Don't provide field.
* gnu/system/install.scm (installation-os)[bootloader]: Use new format.
(os-with-u-boot): Delete procedure.
(embedded-installation-os)[bootloader]: Use new format.
(beaglebone-black-installation-os, a20-olinuxino-lime-installation-os,
a20-olinuxino-lime2-emmc-installation-os,
a20-olinuxino-micro-installation-os, bananapi-m2-ultra-installation-os,
firefly-rk3399-installation-os, mx6cuboxi-installation-os,
novena-installation-os, nintendo-nes-classic-edition-installation-os,
orangepi-r1-plus-lts-rk3328-installation-os, pine64-plus-installation-os,
pinebook-installation-os, rock64-installation-os,
rockpro64-installation-os, rk3399-puma-installation-os,
wandboard-installation-os): Don't guess block device.
* gnu/system/vm.scm (virtualized-operating-system): Don't provide
bootloader.
* gnu/tests/install.scm (%minimal-extlinux-os)[bootloader]: Use proper
extlinux variable.
(%btrfs-raid10-root-os): Use multiple bootloaders.
* gnu/tests/reconfigure.scm (%test-install-bootloader): Delete variable.
(run-install-bootloader-test): Delete procedure.
* 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
---
gnu/bootloader.scm | 448 +++---
gnu/bootloader/depthcharge.scm | 153 +-
gnu/bootloader/extlinux.scm | 149 +-
gnu/bootloader/grub.scm | 1280 +++++++----------
gnu/bootloader/u-boot.scm | 439 ++----
gnu/build/bootloader.scm | 157 +-
gnu/build/image.scm | 40 +-
gnu/build/install.scm | 16 +-
gnu/image.scm | 3 +
gnu/installer/parted.scm | 12 +-
gnu/machine/ssh.scm | 71 +-
gnu/packages/bootloaders.scm | 86 --
gnu/packages/raspberry-pi.scm | 18 -
gnu/system.scm | 45 +-
gnu/system/boot.scm | 8 +-
gnu/system/image.scm | 162 ++-
gnu/system/images/hurd.scm | 4 +-
gnu/system/images/novena.scm | 3 +-
.../images/orangepi-r1-plus-lts-rk3328.scm | 3 +-
gnu/system/images/pine64.scm | 3 +-
gnu/system/images/pinebook-pro.scm | 3 +-
gnu/system/images/rock64.scm | 3 +-
gnu/system/images/unmatched.scm | 3 +-
gnu/system/images/visionfive2.scm | 3 +-
gnu/system/images/wsl2.scm | 14 +-
gnu/system/install.scm | 43 +-
gnu/system/vm.scm | 11 -
gnu/tests/install.scm | 10 +-
gnu/tests/reconfigure.scm | 86 +-
guix/scripts/system.scm | 89 +-
guix/scripts/system/reconfigure.scm | 159 +-
31 files changed, 1434 insertions(+), 2090 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 3ddc112cc6..97305265b7 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,45 +25,53 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader)
+ #:autoload (gnu build file-systems)
+ (read-partition-label read-partition-uuid
+ find-partition-by-label find-partition-by-uuid)
+ #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
- #:use-module (guix discovery)
- #:use-module (guix gexp)
- #:use-module (guix profiles)
- #:use-module (guix records)
+ #:autoload (guix build syscalls)
+ (mounts mount-source mount-point mount-type)
#:use-module (guix deprecation)
#:use-module (guix diagnostics)
+ #:use-module (guix gexp)
#:use-module (guix i18n)
#:use-module (guix modules)
+ #:use-module (guix profiles)
+ #:use-module (guix records)
+ #:use-module (guix utils)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 receive)
+ #:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
- #:use-module (ice-9 match)
- #:export (menu-entry
+ #:export (<menu-entry>
+ menu-entry
menu-entry?
menu-entry-label
menu-entry-device
+ menu-entry-device-mount-point
+ menu-entry-device-subvol
menu-entry-linux
menu-entry-linux-arguments
menu-entry-initrd
- menu-entry-device-mount-point
menu-entry-multiboot-kernel
menu-entry-multiboot-arguments
menu-entry-multiboot-modules
menu-entry-chain-loader
+ normalize-file
menu-entry->sexp
sexp->menu-entry
bootloader
bootloader?
bootloader-name
- bootloader-package
+ bootloader-default-targets
bootloader-installer
- bootloader-disk-image-installer
- bootloader-configuration-file
- bootloader-configuration-file-generator
<bootloader-target>
bootloader-target
@@ -84,13 +93,15 @@ (define-module (gnu bootloader)
:path :devpath :device :fs :label :uuid
with-targets
+ <bootloader-configuration>
bootloader-configuration
bootloader-configuration?
bootloader-configuration-bootloader
- bootloader-configuration-target ;deprecated
bootloader-configuration-targets
bootloader-configuration-menu-entries
bootloader-configuration-default-entry
+ bootloader-configuration-efi-removable?
+ bootloader-configuration-32bit?
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -101,10 +112,11 @@ (define-module (gnu bootloader)
bootloader-configuration-device-tree-support?
bootloader-configuration-extra-initrd
- %bootloaders
- lookup-bootloader-by-name
+ bootloader-configuration->gexp
+ bootloader-configurations->gexp
- efi-bootloader-chain))
+ efi-arch
+ install-efi))
\f
;;;
@@ -119,6 +131,8 @@ (define-record-type* <menu-entry>
(default #f))
(device-mount-point menu-entry-device-mount-point
(default #f))
+ (device-subvol menu-entry-device-subvol
+ (default #f))
(linux menu-entry-linux
(default #f))
(linux-arguments menu-entry-linux-arguments
@@ -135,6 +149,18 @@ (define-record-type* <menu-entry>
(chain-loader menu-entry-chain-loader
(default #f))) ; string, path of efi file
+(define (normalize-file entry val)
+ "Normalize a file VAL stored in a menu entry into one suitable for a
+bootloader. Realizes device-mount-point and device-subvol."
+ (match-record entry <menu-entry> (device-mount-point device-subvol)
+ #~(let* ((rel (lambda (s) (substring s (if (string-prefix? "/" s) 1 0))))
+ (file (rel #$val))
+ (subvol (and=> #$device-subvol rel))
+ (mount (and=> #$device-mount-point rel)))
+ (string-append (if subvol (string-append "/" subvol "/") "/")
+ (if (and mount (string-prefix? mount file))
+ (substring file (string-length mount)) file)))))
+
(define (report-menu-entry-error menu-entry)
(raise
(condition
@@ -162,7 +188,7 @@ (define (menu-entry->sexp entry)
`(label ,(file-system-label->string label)))
(_ device)))
(match entry
- (($ <menu-entry> label device mount-point
+ (($ <menu-entry> label device mount-point subvol
(? identity linux) linux-arguments (? identity initrd)
#f () () #f)
`(menu-entry (version 0)
@@ -171,8 +197,9 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(linux ,linux)
(linux-arguments ,linux-arguments)
- (initrd ,initrd)))
- (($ <menu-entry> label device mount-point #f () #f
+ (initrd ,initrd)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f
(? identity multiboot-kernel) multiboot-arguments
multiboot-modules #f)
`(menu-entry (version 0)
@@ -181,19 +208,23 @@ (define (menu-entry->sexp entry)
(device-mount-point ,mount-point)
(multiboot-kernel ,multiboot-kernel)
(multiboot-arguments ,multiboot-arguments)
- (multiboot-modules ,multiboot-modules)))
- (($ <menu-entry> label device mount-point #f () #f #f () ()
+ (multiboot-modules ,multiboot-modules)
+ (device-subvol ,subvol)))
+ (($ <menu-entry> label device mount-point subvol #f () #f #f () ()
(? identity chain-loader))
`(menu-entry (version 0)
(label ,label)
(device ,(device->sexp device))
(device-mount-point ,mount-point)
- (chain-loader ,chain-loader)))
+ (chain-loader ,chain-loader)
+ (device-subvol ,subvol)))
(_ (report-menu-entry-error entry))))
(define (sexp->menu-entry sexp)
"Turn SEXP, an sexp as returned by 'menu-entry->sexp', into a <menu-entry>
record."
+ ;; XXX: rely on shadowing to support the match ors below
+ (define subvol #f)
(define (sexp->device device-sexp)
(match device-sexp
(('uuid type uuid-string)
@@ -206,35 +237,41 @@ (define (sexp->menu-entry sexp)
('label label) ('device device)
('device-mount-point mount-point)
('linux linux) ('linux-arguments linux-arguments)
- ('initrd initrd) _ ...)
+ ('initrd initrd)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(linux linux)
(linux-arguments linux-arguments)
(initrd initrd)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
+ ('device-mount-point mount-point) ('device-subvol subvol)
('multiboot-kernel multiboot-kernel)
('multiboot-arguments multiboot-arguments)
- ('multiboot-modules multiboot-modules) _ ...)
+ ('multiboot-modules multiboot-modules)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(multiboot-kernel multiboot-kernel)
(multiboot-arguments multiboot-arguments)
(multiboot-modules multiboot-modules)))
(('menu-entry ('version 0)
('label label) ('device device)
- ('device-mount-point mount-point)
- ('chain-loader chain-loader) _ ...)
+ ('device-mount-point mount-point) ('device-subvol subvol)
+ ('chain-loader chain-loader)
+ (or ('device-subvol subvol _ ...) (_ ...)))
(menu-entry
(label label)
(device (sexp->device device))
(device-mount-point mount-point)
+ (device-subvol subvol)
(chain-loader chain-loader)))))
\f
@@ -247,15 +284,10 @@ (define (sexp->menu-entry sexp)
;; has to be described by this record.
(define-record-type* <bootloader>
- bootloader make-bootloader
- bootloader?
- (name bootloader-name)
- (package bootloader-package)
- (installer bootloader-installer)
- (disk-image-installer bootloader-disk-image-installer
- (default #f))
- (configuration-file bootloader-configuration-file)
- (configuration-file-generator bootloader-configuration-file-generator))
+ bootloader make-bootloader bootloader?
+ (name bootloader-name)
+ (default-targets bootloader-default-targets (default '()))
+ (installer bootloader-installer))
\f
;;;
@@ -299,10 +331,12 @@ (define* (get-target-of-type type targets #:optional (require? #f))
ret)))
(define (parent-of target targets)
+ "Resolves the parent of a target in targets, or #f if parentless."
(and=> (bootloader-target-offset target)
(cut get-target-of-type <> targets #t)))
(define (unfold-pathcat target targets)
+ "Finds the full VFS path of a target."
(let ((quit (lambda (t) (not (and=> t bootloader-target-path)))))
(reduce pathcat #f
(unfold quit bootloader-target-path (cut parent-of <> targets) target))))
@@ -375,7 +409,8 @@ (define-syntax with-targets
((name :fs) #'(name (bootloader-target-file-system base)))
((name :path) #'(name (unfold-pathcat target targets)))
((name :devpath)
- #'(name (pathcat "/" (bootloader-target-path target))))
+ #'(name (pathcat "/" (if (target-base? target) ""
+ (bootloader-target-path target)))))
(_ #`(_ (syntax-error "invalid binding spec" #,in)))))))
(binds
(lambda (spec)
@@ -450,28 +485,48 @@ (define-syntax with-targets
;; The <bootloader-configuration> record contains bootloader independant
;; configuration used to fill bootloader configuration file.
-(define-with-syntax-properties (warn-target-field-deprecation
- (value properties))
- (when value
- (warning (source-properties->location properties)
- (G_ "the 'target' field is deprecated, please use 'targets' \
-instead~%")))
- value)
+(define-with-syntax-properties (warn-update-targets (value properties))
+ (let ((loc (source-properties->location properties)))
+ (define update
+ (match-lambda
+ ((? bootloader-target? target) (cons #f target))
+ ((? string? s) (cons #t (if (string-prefix? "/dev" s)
+ (bootloader-target
+ (type 'disk)
+ (device s))
+ (bootloader-target
+ (type 'esp)
+ (offset 'root)
+ (path s)))))
+ (x (error loc (G_ "invalid target '~a'~%") x))))
+
+ (let* ((updated (map update (if (list? value) value (list value))))
+ (targets (map cdr updated))
+ (types (map bootloader-target-type targets)))
+ ;; XXX: should this be an error?
+ (when (any car updated)
+ (warning loc (G_ "the 'targets' field should now contain \
+<bootloader-target> records. inferring a best guess (this might break!)...~%")))
+ (when (not (eqv? (length types) (length (delete-duplicates types))))
+ (error loc (G_ "the 'targets' field may not contain duplicates~%")))
+ targets)))
(define-record-type* <bootloader-configuration>
bootloader-configuration make-bootloader-configuration
bootloader-configuration?
(bootloader
- bootloader-configuration-bootloader) ;<bootloader>
- (targets %bootloader-configuration-targets
- (default #f)) ;list of strings
- (target %bootloader-configuration-target ;deprecated
- (default #f)
- (sanitize warn-target-field-deprecation))
+ bootloader-configuration-bootloader) ;<bootloader>
+ (targets bootloader-configuration-targets
+ (default '()) ;list of strings
+ (sanitize warn-update-targets))
(menu-entries bootloader-configuration-menu-entries
(default '())) ;list of <menu-entry>
(default-entry bootloader-configuration-default-entry
(default 0)) ;integer
+ (efi-removable? bootloader-configuration-efi-removable?
+ (default #f)) ;bool
+ (32bit? bootloader-configuration-32bit?
+ (default #f)) ;bool
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
@@ -479,9 +534,9 @@ (define-record-type* <bootloader-configuration>
(theme bootloader-configuration-theme
(default #f)) ;bootloader-specific theme
(terminal-outputs bootloader-configuration-terminal-outputs
- (default '(gfxterm))) ;list of symbols
+ (default #f)) ;list of symbols | #f (default outs)
(terminal-inputs bootloader-configuration-terminal-inputs
- (default '())) ;list of symbols
+ (default #f)) ;list of symbols | #f (default ins)
(serial-unit bootloader-configuration-serial-unit
(default #f)) ;integer | #f
(serial-speed bootloader-configuration-serial-speed
@@ -491,164 +546,143 @@ (define-record-type* <bootloader-configuration>
(extra-initrd bootloader-configuration-extra-initrd
(default #f))) ;string | #f
-(define-deprecated (bootloader-configuration-target config)
- bootloader-configuration-targets
- (%bootloader-configuration-target config))
+\f
+;;;
+;;; Bootloader installation paths.
+;;;
-(define (bootloader-configuration-targets config)
- (or (%bootloader-configuration-targets config)
- ;; TODO: Remove after the deprecated 'target' field is removed.
- (list (%bootloader-configuration-target config))
- ;; XXX: At least the GRUB installer (see (gnu bootloader grub)) has this
- ;; peculiar behavior of installing fonts and GRUB modules when DEVICE is #f,
- ;; hence the default value of '(#f) rather than '().
- (list #f)))
+;; highest -> lowest priority
+(define (target-overrides . layers)
+ (let* ((types (fold append '()
+ (map (cute map bootloader-target-type <>) layers)))
+ (pred (lambda (type layer found)
+ (or found (get-target-of-type type layer))))
+ (find (lambda (type) (fold (cute pred type <> <>) #f layers))))
+ (filter ->bool (map find (delete-duplicates types)))))
+
+(define (normalize targets)
+ "Augments user-supplied targets with filesystem information at runtime,
+allowing users to specify a lot less information. Relatively minimal to prevent
+errors. Puts targets into a normal form, where all paths are fully specified up
+to a device offset."
+ (let* ((mass (lambda (m) `((,(mount-source m) . ,m) (,(mount-point m) . ,m))))
+ (amounts (delay (apply append (map mass (mounts)))))
+ (accessible=> (lambda (d f) (and d (access? d R_OK) (f d))))
+ (assoc-mnt (lambda (f) (lambda (v)
+ (and=> (assoc-ref (force amounts) v) f)))))
+
+ (define (scrape target)
+ (match-record target <bootloader-target>
+ (expected? path offset device label uuid file-system)
+ (if expected? target
+ (bootloader-target
+ (inherit target)
+ (device (or device (false-if-exception
+ (or (and=> uuid find-partition-by-uuid)
+ (and=> label find-partition-by-label)))
+ (and path ((assoc-mnt mount-source)
+ (unfold-pathcat target targets)))))
+ (label (or label (accessible=> device read-partition-label)))
+ (uuid (or uuid (accessible=> device read-partition-uuid)))
+ (file-system (or file-system (and=> device (assoc-mnt mount-type))))
+ (offset (and path offset))
+ (path (or path (and=> device (assoc-mnt mount-point))))))))
+
+ (define (fixuuid target)
+ (match-record target <bootloader-target> (uuid file-system)
+ (let ((type (cond ((not file-system) 'dce)
+ ((member file-system '("vfat" "fat32")) 'fat)
+ ((string=? file-system "ntfs") 'ntfs)
+ ((string=? file-system "iso9660") 'iso9660)
+ (else 'dce))))
+ (bootloader-target (inherit target)
+ (uuid (cond ((uuid? uuid) uuid)
+ ((bytevector? uuid) (bytevector->uuid uuid type))
+ ((string? uuid) (string->uuid uuid type))
+ (else #f)))))))
+
+ (define (arborify target targets)
+ (let* ((up (lambda (t) (and t (parent-of t targets))))
+ (proto (unfold target-base? identity up (up target) list))
+ (chain (reverse (cons target proto))))
+ (bootloader-target
+ (inherit target)
+ (offset (and=> (car chain) bootloader-target-type))
+ (path (reduce pathcat #f (map bootloader-target-path (cdr chain)))))))
+
+ (let ((mid (map (compose fixuuid scrape) targets)))
+ (map (cut arborify <> mid) mid))))
+
+(define* (bootloader-configuration->gexp bootloader-config args #:key
+ (root-offset "/") (overrides '()))
+ "Returns a gexp to install BOOTLOADER-CONFIG to its targets, passing ARGS
+to each installer alongside the additional #:bootloader-config keyword
+arguments. Target OVERRIDES are applied and all path targets have ROOT-OFFSET
+applied. The following keyword arguments are expected in ARGS:
+@enumerate
+@item current-boot-alternative
+@item old-boot-alternatives
+@item locale (from bootmeta)
+@item store-directory-prefix (from bootmeta)
+@item store-crypto-devices (from bootmeta)
+@end enumerate"
+ (let* ((bootloader (bootloader-configuration-bootloader bootloader-config))
+ (installer (bootloader-installer bootloader))
+ (auto-targets (list (bootloader-target
+ (type 'root)
+ (path root-offset)
+ (offset #f))))
+ (targets (target-overrides
+ overrides
+ (bootloader-configuration-targets bootloader-config)
+ auto-targets
+ (bootloader-default-targets bootloader)))
+ (conf (bootloader-configuration
+ (inherit bootloader-config)
+ (targets (normalize targets)))))
+ (apply installer #:bootloader-config conf args)))
+
+(define (bootloader-configurations->gexp bootloader-configs . rest)
+ (apply gbegin (filter-map (cut apply bootloader-configuration->gexp <> rest)
+ bootloader-configs)))
\f
-;;;
-;;; Bootloaders.
+=
+;;; EFI shit
;;;
-(define (bootloader-modules)
- "Return the list of bootloader modules."
- ;; don't provide #:warn to prevent mutual imports
- (all-modules (map (lambda (entry)
- `(,entry . "gnu/bootloader"))
- %load-path)))
-
-(define %bootloaders
- ;; The list of publically-known bootloaders.
- (delay (fold-module-public-variables (lambda (obj result)
- (if (bootloader? obj)
- (cons obj result)
- result))
- '()
- (bootloader-modules))))
-
-(define (lookup-bootloader-by-name name)
- "Return the bootloader called NAME."
- (or (find (lambda (bootloader)
- (eq? name (bootloader-name bootloader)))
- (force %bootloaders))
- (leave (G_ "~a: no such bootloader~%") name)))
-
-(define (efi-bootloader-profile packages files hooks)
- "Creates a profile from the lists of PACKAGES and FILES from the store.
-This profile is meant to be used by the bootloader-installer.
-
-FILES is a list of file or directory names from the store, which will be
-symlinked into the profile. If a directory name ends with '/', then the
-directory content instead of the directory itself will be symlinked into the
-profile.
-
-FILES may contain file like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-HOOKS lists additional hook functions to modify the profile."
- (define* (efi-bootloader-profile-hook manifest #:optional system)
- (define build
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules ((guix build utils)
- #:select (mkdir-p strip-store-file-name))
- ((ice-9 ftw)
- #:select (scandir))
- ((srfi srfi-1)
- #:select (append-map every remove))
- ((srfi srfi-26)
- #:select (cut)))
- (define (symlink-to file directory transform)
- "Creates a symlink to FILE named (TRANSFORM FILE) in DIRECTORY."
- (symlink file (string-append directory "/" (transform file))))
- (define (directory-content directory)
- "Creates a list of absolute path names inside DIRECTORY."
- (map (lambda (name)
- (string-append directory name))
- (or (scandir directory (lambda (name)
- (not (member name '("." "..")))))
- '())))
- (define name-ends-with-/? (cut string-suffix? "/" <>))
- (define (name-is-store-entry? name)
- "Return #t if NAME is a direct store entry and nothing inside."
- (not (string-index (strip-store-file-name name) #\/)))
- (let* ((files '#$files)
- (directories (filter name-ends-with-/? files))
- (names-from-directories
- (append-map (lambda (directory)
- (directory-content directory))
- directories))
- (names (append names-from-directories
- (remove name-ends-with-/? files))))
- (mkdir-p #$output)
- (if (every file-exists? names)
- (begin
- (for-each (lambda (name)
- (symlink-to name #$output
- (if (name-is-store-entry? name)
- strip-store-file-name
- basename)))
- names)
- #t)
- #f)))))
-
- (gexp->derivation "efi-bootloader-profile"
- build
- #:system system
- #:local-build? #t
- #:substitutable? #f
- #:properties
- `((type . profile-hook)
- (hook . efi-bootloader-profile-hook))))
-
- (profile (content (packages->manifest packages))
- (name "efi-bootloader-profile")
- (hooks (cons efi-bootloader-profile-hook hooks))
- (locales? #f)
- (allow-collisions? #f)
- (relative-symlinks? #f)))
-
-(define* (efi-bootloader-chain final-bootloader
- #:key
- (packages '())
- (files '())
- (hooks '())
- installer
- disk-image-installer)
- "Define a chain of bootloaders with the FINAL-BOOTLOADER, optional PACKAGES,
-and optional directories and files from the store given in the list of FILES.
-
-The package of the FINAL-BOOTLOADER and all PACKAGES and FILES will be placed
-in an efi-bootloader-profile, which will be passed to the INSTALLER.
-
-FILES may contain file-like objects produced by procedures like plain-file,
-local-file, etc., or package contents produced with file-append.
-
-If a directory name in FILES ends with '/', then the directory content instead
-of the directory itself will be symlinked into the efi-bootloader-profile.
-
-The procedures in the HOOKS list can be used to further modify the bootloader
-profile. It is possible to pass a single function instead of a list.
-
-If the INSTALLER argument is used, then this gexp procedure will be called to
-install the efi-bootloader-profile. Otherwise the installer of the
-FINAL-BOOTLOADER will be called.
-
-If the DISK-IMAGE-INSTALLER is used, then this gexp procedure will be called
-to install the efi-bootloader-profile into a disk image. Otherwise the
-disk-image-installer of the FINAL-BOOTLOADER will be called."
- (bootloader
- (inherit final-bootloader)
- (name "efi-bootloader-chain")
- (package
- (efi-bootloader-profile (cons (bootloader-package final-bootloader)
- packages)
- files
- (if (list? hooks)
- hooks
- (list hooks))))
- (installer
- (or installer
- (bootloader-installer final-bootloader)))
- (disk-image-installer
- (or disk-image-installer
- (bootloader-disk-image-installer final-bootloader)))))
+(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
+ (32? #f))
+ "Returns the UEFI architecture name for the current target, in lowercase."
+ (cond ((target-x86-32? target) "ia32")
+ ((target-x86-64? target) (if 32? "ia32" "x64"))
+ ((target-arm32? target) "arm")
+ ((target-aarch64? target) (if 32? "arm" "aa64"))
+ ((target-riscv64? target) (if 32? "riscv32" "riscv64"))
+ (else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
+ target)))))
+
+(define (install-efi bootloader-config plan)
+ "Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
+PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
+should be in boot order. If the user selects a removable bootloader, only the
+first entry in PLAN is used."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets efi-removable? 32bit?)
+ (if efi-removable?
+ ;; Hard code the output location to a well-known path recognized by
+ ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
+ ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
+ (with-targets targets
+ (('esp => (path :path))
+ #~(let ((boot #$(string-append path "/EFI/BOOT"))
+ (arch #$(string-upcase (efi-arch #:32? 32bit?)))
+ (builder (car (car #$plan))))
+ (mkdir-p boot)
+ ;; only realize first planspec
+ (builder (string-append boot "/BOOT" arch ".EFI")))))
+ ;; normal install when not doing a removable config
+ (with-targets targets
+ (('vendir => (vendir :path) (loader :devpath) (disk :device))
+ #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/bootloader/depthcharge.scm b/gnu/bootloader/depthcharge.scm
index 0a50374bd9..ad29f5d5e4 100644
--- a/gnu/bootloader/depthcharge.scm
+++ b/gnu/bootloader/depthcharge.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,92 +18,86 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader depthcharge)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:use-module (ice-9 match)
- #:export (depthcharge-bootloader))
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
+ #:export (depthcharge-veyron-speedy-bootloader
+ depthcharge-bootloader))
-(define (signed-kernel kernel kernel-arguments initrd)
- (define builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils)
- (ice-9 binary-ports)
- (rnrs bytevectors))
- (set-path-environment-variable "PATH" '("bin") (list #$dtc))
+(define* (install-depthcharge arch dtb
+ #:key bootloader-config current-boot-alternative
+ #:allow-other-keys)
+ (when (not (null? (bootloader-configuration-menu-entries bootloader-config)))
+ (raise (formatted-message
+ (G_ "extra menu-entries are not supported for depthcharge!"))))
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ;; use 'part instead of 'disk, cause we write an image directly into a
+ ;; partition instead of the extra-partition disk space
+ (('part => (disk :device))
+ (match-record (boot-alternative->menu-entry current-boot-alternative)
+ <menu-entry> (linux linux-arguments initrd)
+ #~(begin
+ (use-modules (ice-9 binary-ports) (rnrs bytevectors))
+ (set-path-environment-variable "PATH" '("bin") (list #$dtc))
- ;; TODO: These files have to be writable, so we copy them.
- ;; This can probably be fixed by using a ".its" file, just
- ;; be careful not to break initrd loading.
- (copy-file #$kernel "zImage")
- (chmod "zImage" #o755)
- (copy-file (string-append (dirname #$kernel) "/lib/dtbs/"
- "rk3288-veyron-speedy.dtb")
- "rk3288-veyron-speedy.dtb")
- (chmod "rk3288-veyron-speedy.dtb" #o644)
- (copy-file #$initrd "initrd")
- (chmod "initrd" #o644)
+ ;; TODO: These files have to be writable, so we copy them.
+ ;; This can probably be fixed by using a ".its" file, just
+ ;; be careful not to break initrd loading.
+ (copy-file #$linux "zImage")
+ (chmod "zImage" #o755)
+ (copy-file (string-append (dirname #$linux) "/lib/dtbs/" #$dtb)
+ "dtb")
+ (chmod "dtb" #o644)
+ (copy-file #$initrd "initrd")
+ (chmod "initrd" #o644)
- (invoke (string-append #$u-boot-tools "/bin/mkimage")
- "-D" "-I dts -O dtb -p 2048"
- "-f" "auto"
- "-A" "arm"
- "-O" "linux"
- "-T" "kernel"
- "-C" "None"
- "-d" "zImage"
- "-a" "0"
- "-b" "rk3288-veyron-speedy.dtb"
- "-i" "initrd"
- "image.itb")
- (call-with-output-file "bootloader.bin"
- (lambda (port)
- (put-bytevector port (make-bytevector 512 0))))
- (with-output-to-file "kernel-arguments"
- (lambda ()
- (display (string-join (list #$@kernel-arguments)))))
- (invoke (string-append #$vboot-utils "/bin/vbutil_kernel")
- "--pack" #$output
- "--version" "1"
- "--vmlinuz" "image.itb"
- "--arch" "arm"
- "--keyblock" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel.keyblock")
- "--signprivate" (string-append #$vboot-utils
- "/share/vboot-utils/devkeys/"
- "kernel_data_key.vbprivk")
- "--config" "kernel-arguments"
- "--bootloader" "bootloader.bin"))))
- (computed-file "vmlinux.kpart" builder))
+ (invoke #+(file-append u-boot-tools "/bin/mkimage")
+ "-D" "-I dts -O dtb -p 2048"
+ "-f" "auto" ; format
+ "-A" #$arch ; architecture
+ "-O" "linux" ; os
+ "-T" "kernel" ; image type
+ "-C" "None" ; compression
+ "-d" "zImage" ; image data
+ "-a" "0" ; load address (hex)
+ "-b" "dtb" ; dtb for device
+ "-i" "initrd" ; initrd
+ "image.itb")
+ (call-with-output-file "bootloader.bin"
+ (lambda (port)
+ (put-bytevector port (make-bytevector 512 0))))
+ (call-with-output-file "kernel-arguments"
+ (lambda (port)
+ (display (string-join (list #$@linux-arguments)) port)))
+ (invoke #+(file-append vboot-utils "/bin/vbutil_kernel")
+ "--version" "1"
+ "--vmlinuz" "image.itb"
+ "--arch" #$arch
+ "--keyblock"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel.keyblock")
+ "--signprivate"
+ #$(file-append vboot-utils
+ "/share/vboot-utils/devkeys/kernel_data_key.vbprivk")
+ "--config" "kernel-arguments"
+ "--pack" "vmlinux.kpart")
+ (write-file-on-device "vmlinux.kpart"
+ (stat:size (stat "vmlinux.kpart"))
+ #$disk 0))))))
-(define* (depthcharge-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- (match entries
- ((entry)
- (let ((kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- ;; XXX: Make this a symlink.
- (signed-kernel kernel kernel-arguments initrd)))
- (_ (error "Too many bootloader menu entries!"))))
-
-(define install-depthcharge
- #~(lambda (bootloader device mount-point)
- (let ((kpart (string-append mount-point
- "/boot/depthcharge/vmlinux.kpart")))
- (write-file-on-device kpart (stat:size (stat kpart)) device 0))))
-
-(define depthcharge-bootloader
+(define depthcharge-veyron-speedy-bootloader
(bootloader
(name 'depthcharge)
- (package #f)
- (installer install-depthcharge)
- (configuration-file "/boot/depthcharge/vmlinux.kpart")
- (configuration-file-generator depthcharge-configuration-file)))
+ (installer (cute install-depthcharge "arm" "rk3288-veyron-speedy.dtb"
+ <...>))))
+
+(define-deprecated/alias depthcharge-bootloader
+ depthcharge-veyron-speedy-bootloader)
diff --git a/gnu/bootloader/extlinux.scm b/gnu/bootloader/extlinux.scm
index d9b6d8bf8a..c3ab6f3275 100644
--- a/gnu/bootloader/extlinux.scm
+++ b/gnu/bootloader/extlinux.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2017 David Craven <david@craven.ch>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,112 +22,102 @@
(define-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix deprecation)
+ #:use-module (guix records)
#:use-module (guix utils)
- #:export (extlinux-bootloader
+ #:export (install-extlinux-config ; for u-boot
+ extlinux-bootloader
+ extlinux-gpt-bootloader
extlinux-bootloader-gpt))
-(define* (extlinux-configuration-file config entries
- #:key
- (system (%current-system))
- (old-entries '())
- #:allow-other-keys)
- "Return the U-Boot configuration file corresponding to CONFIG, a
-<u-boot-configuration> object, and where the store is available at STORE-FS, a
-<file-system> object. OLD-ENTRIES is taken to be a list of menu entries
-corresponding to old generations of the system."
-
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
-
- (define with-fdtdir?
- (bootloader-configuration-device-tree-support? config))
+\f
+;;;
+;;; Config procedures.
+;;;
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (kernel (menu-entry-linux entry))
- (kernel-arguments (menu-entry-linux-arguments entry))
- (initrd (menu-entry-initrd entry)))
- #~(format port "LABEL ~a
+(define* (install-extlinux-config #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ "Installer for the extlinux configuration file, meant to be shared by all
+bootloaders that use the format to specify boot options."
+ (match-record bootloader-config <bootloader-configuration>
+ (targets menu-entries device-tree-support? timeout)
+ (define (menu-entry->gexp entry)
+ (match-record entry <menu-entry> (label linux linux-arguments initrd)
+ (let* ((normkern (normalize-file entry linux))
+ (fdt #~(string-append "FDTDIR" (dirname #$normkern) "/lib/dtbs")))
+ #~(format port "LABEL ~a
MENU LABEL ~a
KERNEL ~a
~a
INITRD ~a
APPEND ~a
-~%"
- #$label #$label
- #$kernel
- (if #$with-fdtdir?
- (string-append "FDTDIR " (dirname #$kernel) "/lib/dtbs")
- "")
- #$initrd
- (string-join (list #$@kernel-arguments)))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (let ((timeout #$(bootloader-configuration-timeout config)))
- (format port "# This file was generated from your Guix configuration. Any changes
+~%" #$label #$label #$normkern
+ #$(if device-tree-support? fdt "")
+ #$(normalize-file entry initrd)
+ (string-join (list #$@linux-arguments))))))
+
+ (let ((ents (cons (boot-alternative->menu-entry current-boot-alternative)
+ (append menu-entries
+ (map boot-alternative->menu-entry old-boot-alternatives)))))
+ (with-targets targets
+ (('extlinux => (path :path))
+ #~(begin (mkdir-p #$path)
+ (call-with-output-file #$path
+ (lambda (port)
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
# will be lost upon reconfiguration.
UI menu.c32
MENU TITLE GNU Guix Boot Options
PROMPT ~a
-TIMEOUT ~a~%"
- (if (> timeout 0) 1 0)
- ;; timeout is expressed in 1/10s of seconds.
- (* 10 timeout))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "~%"))
- #~())))))
-
- (computed-file "extlinux.conf" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-
+TIMEOUT ~a~%" ;; timeout is expressed in tenths of a second
+ #$(if (> timeout 0) 1 0) #$(* 10 timeout))
+ #$@(map menu-entry->gexp ents)))))))))
\f
-
;;;
-;;; Install procedures.
+;;; Install procedure.
;;;
(define (install-extlinux mbr)
- #~(lambda (bootloader device mount-point)
- (let ((extlinux (string-append bootloader "/sbin/extlinux"))
- (install-dir (string-append mount-point "/boot/extlinux"))
- (syslinux-dir (string-append bootloader "/share/syslinux")))
- (for-each (lambda (file)
- (install-file file install-dir))
- (find-files syslinux-dir "\\.c32$"))
- (invoke/quiet extlinux "--install" install-dir)
- (write-file-on-device (string-append syslinux-dir "/" #$mbr)
- 440 device 0))))
-
-(define install-extlinux-mbr
- (install-extlinux "mbr.bin"))
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('extlinux => (path :path))
+ #~(begin
+ #$(apply install-extlinux-config args)
+ (copy-recursively #$(file-append syslinux "/share/syslinux") #$path)
+ (invoke/quiet #+(file-append syslinux "/sbin/extlinux")
+ "--install" #$path)))
+ (('disk => (disk :device))
+ #~(write-file-on-device #$(file-append syslinux "/share/syslinux/" mbr)
+ 440 #$disk 0)))))
-(define install-extlinux-gpt
- (install-extlinux "gptmbr.bin"))
\f
-
;;;
;;; Bootloader definitions.
;;;
(define extlinux-bootloader
(bootloader
- (name 'extlinux)
- (package syslinux)
- (installer install-extlinux-mbr)
- (configuration-file "/boot/extlinux/extlinux.conf")
- (configuration-file-generator extlinux-configuration-file)))
-
-(define extlinux-bootloader-gpt
+ (name 'extlinux)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (install-extlinux "mbr.bin"))))
+
+(define extlinux-gpt-bootloader
(bootloader
- (inherit extlinux-bootloader)
- (installer install-extlinux-gpt)))
+ (inherit extlinux-bootloader)
+ (installer (install-extlinux "gptmbr.bin"))))
+
+(define-deprecated/alias extlinux-bootloader-gpt extlinux-gpt-bootloader)
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 2723eda5f4..7bb7e4eefa 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -10,6 +10,7 @@
;;; Copyright © 2022 Karl Hallsby <karl@hallsby.com>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -27,24 +28,26 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader grub)
- #:use-module (guix build union)
- #:use-module (guix records)
- #:use-module (guix store)
- #:use-module (guix utils)
- #:use-module (guix gexp)
#:use-module (gnu artwork)
#:use-module (gnu bootloader)
- #:use-module (gnu system uuid)
- #:use-module (gnu system file-systems)
- #:use-module (gnu system keyboard)
- #:use-module (gnu system locale)
#:use-module (gnu packages bootloaders)
#:autoload (gnu packages gtk) (guile-cairo guile-rsvg)
#:autoload (gnu packages xorg) (xkeyboard-config)
+ #:use-module (gnu system boot)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system keyboard)
+ #:use-module (gnu system locale)
+ #:use-module (gnu system uuid)
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
+ #:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (guix utils)
#:use-module (ice-9 match)
- #:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
- #:use-module (srfi srfi-2)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-35)
#:export (grub-theme
grub-theme?
grub-theme-image
@@ -53,54 +56,109 @@ (define-module (gnu bootloader grub)
grub-theme-color-highlight
grub-theme-gfxmode
- install-grub-efi-removable
- make-grub-efi-netboot-installer
-
+ grub.dir ; for (gnu build image) iso9660 images
grub-bootloader
+ grub-minimal-bootloader
grub-efi-bootloader
+ ;; deprecated
grub-efi-removable-bootloader
grub-efi32-bootloader
grub-efi-netboot-bootloader
- grub-efi-netboot-removable-bootloader
- grub-mkrescue-bootloader
- grub-minimal-bootloader
+ grub-efi-netboot-removable-bootloader))
- grub-configuration))
-
-;;; Commentary:
+\f
;;;
-;;; Configuration of GNU GRUB.
+;;; General utils.
;;;
-;;; Code:
-(define* (normalize-file file mount-point store-directory-prefix)
- "Strip MOUNT-POINT and prepend STORE-DIRECTORY-PREFIX, if any, to FILE, a
-G-expression or other lowerable object denoting a file name."
+;; in-gexp procedure to sanitize a value to be inserted into a GRUB script
+(define (sanitize str)
+ "Sanitize a value for use in a GRUB script."
+ #~(let* ((glycerin (lambda (l r) (if (pair? l) (append l r) (cons l r))))
+ (isopropyl (lambda (c) (case c ((#\\ #\$ #\") '(#\\ ,c)) (else c)))))
+ (use-modules (srfi srfi-1))
+ (list->string (fold-right glycerin '()
+ (map isopropyl (string->list #$str))))))
- (define (strip-mount-point mount-point file)
- (if mount-point
- (if (string=? mount-point "/")
- file
- #~(let ((file #$file))
- (if (string-prefix? #$mount-point file)
- (substring #$file #$(string-length mount-point))
- file)))
- file))
- (define (prepend-store-directory-prefix store-directory-prefix file)
- (if store-directory-prefix
- #~(string-append #$store-directory-prefix #$file)
- file))
- (prepend-store-directory-prefix store-directory-prefix
- (strip-mount-point mount-point file)))
+(define (grub-format type 32?)
+ (string-append
+ (cond ((string-prefix? "pc" type) "i386")
+ ((target-x86-32?) "i386")
+ ((target-x86-64?) (if 32? "i386" "x86_64"))
+ ((target-arm32?) "arm")
+ ((target-aarch64?) (if 32? "arm" "arm64"))
+ ((target-powerpc?) "powerpc")
+ ((target-riscv64?) "riscv64")
+ (else (raise (formatted-message (G_ "unrecognized target arch '~a'!")
+ (or (%current-target-system) (%current-system))))))
+ "-" type))
+(define* (search/target type targets var #:optional (port #f))
+ "Returns a gexp of a GRUB search command for target TYPE, storing the result
+in VAR. Optionally outputs to the gexp PORT instead of returning a string."
+ (define (form name val)
+ #~(format #$port "search.~a \"~a\" ~a~%" #$name #$val #$var))
+ (with-targets targets
+ ((type => (path :devpath) (device :device) (fs :fs)
+ (label :label) (uuid :uuid))
+ (cond ((member fs '("tftp" "nfs")) #~(format #$port "set ~a=tftp~%" #$var))
+ (uuid (form "fs_uuid" (uuid->string uuid)))
+ (label (form "fs_label" label))
+ (else (form "file" (sanitize path)))))))
+
+
+
+(define* (search/menu-entry device file var #:optional (port #f))
+ "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
+a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
+code to set the variable VAR. This procedure is able to handle DEVICEs
+unmounted at evaltime."
+ (match device
+ ;; Preferably refer to DEVICE by its UUID or label. This is more
+ ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
+ ((? uuid? idfk) ; calling idfk uuid here errors for some reason
+ #~(format #$port "search.fs_uuid ~a ~a~%" #$(uuid->string device) #$var))
+ ((? file-system-label? label)
+ #~(format #$port "search.fs_label \"~a\" ~a~%"
+ #$(sanitize (file-system-label->string label)) #$var))
+ ((? (lambda (device)
+ (and (string? device) (string-contains device ":/"))) nfs-uri)
+ ;; If the device is an NFS share, then we assume that the expected
+ ;; file on that device (e.g. the GRUB background image or the kernel)
+ ;; has to be loaded over the network. Otherwise we would need an
+ ;; additional device information for some local disk to look for that
+ ;; file, which we do not have.
+ ;;
+ ;; TFTP is preferred to HTTP because it is used more widely and
+ ;; specified in standards more widely--especially BOOTP/DHCPv4
+ ;; defines a TFTP server for DHCP option 66, but not HTTP.
+ ;;
+ ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
+ ;; which can contain a HTTP or TFTP URL.
+ ;;
+ ;; Note: It is assumed that the file paths are of a similar
+ ;; setup on both the TFTP server and the NFS server (it is
+ ;; not possible to search for files on TFTP).
+ ;;
+ ;; TODO: Allow HTTP.
+ #~(format #$port "set ~a=tftp~%" #$var))
+ ((or #f (? string?))
+ #~(format #$port "search.file \"~a\" ~a~%" #$(sanitize file) #$var))))
+
+
+
+\f
+;;;
+;;; Theming.
+;;;
+
(define-record-type* <grub-theme>
;; Default theme contributed by Felipe López.
- grub-theme make-grub-theme
- grub-theme?
+ grub-theme make-grub-theme grub-theme?
(image grub-theme-image
(default (file-append %artwork-repository
"/grub/GuixSD-fully-black-4-3.svg")))
@@ -113,128 +171,274 @@ (define-record-type* <grub-theme>
(gfxmode grub-theme-gfxmode
(default '("auto")))) ;list of string
+(define (grub-theme-png theme)
+ "Return the GRUB background image defined in THEME. If the suffix of the
+image file is \".svg\", then it is converted into a PNG file with the
+resolution provided in CONFIG. Returns #f if no file is provided."
+ (match-record theme <grub-theme> (image resolution)
+ (match resolution
+ (((? number? width) . (? number? height))
+ (computed-file "grub-image.png"
+ (with-imported-modules '((gnu build svg) (guix build utils))
+ (with-extensions (list guile-rsvg guile-cairo)
+ #~(begin (use-modules (gnu build svg) (guix build utils))
+ (if (png-file? #$image) (copy-file #$image #$output)
+ (svg->png #$image #$output
+ #:width #$width
+ #:height #$height)))))))
+ (_ image))))
+
+
+
\f
;;;
-;;; Background image & themes.
+;;; Core config.
+;;; GRUB architecture works by having a bootstage load up a core.img, which then
+;;; sets the root and prefix variables, allowing grub to load its main config
+;;; and modules, and then enter normal mode. On i386-pc systems a boot.img is
+;;; flashed which loads the core.img from the MBR gap, but on efi systems the
+;;; core.img is just a PE executable, able to be booted directly. We set up a
+;;; minimal core.img capable of finding the user-configured 'install target to
+;;; load its config from there.
;;;
-(define (bootloader-theme config)
- "Return user defined theme in CONFIG if defined or a default theme
-otherwise."
- (or (bootloader-configuration-theme config) (grub-theme)))
-
-(define* (image->png image #:key width height)
- "Build a PNG of HEIGHT x WIDTH from IMAGE if its file suffix is \".svg\".
-Otherwise the picture in IMAGE is just copied."
- (computed-file "grub-image.png"
- (with-imported-modules '((gnu build svg))
- (with-extensions (list guile-rsvg guile-cairo)
- #~(if (string-suffix? ".svg" #+image)
- (begin
- (use-modules (gnu build svg))
- (svg->png #+image #$output
- #:width #$width
- #:height #$height))
- (copy-file #+image #$output))))))
-
-(define* (grub-background-image config)
- "Return the GRUB background image defined in CONFIG or #f if none was found.
-If the suffix of the image file is \".svg\", then it is converted into a PNG
-file with the resolution provided in CONFIG."
- (let* ((theme (bootloader-theme config))
- (image (grub-theme-image theme)))
- (and image
- (match (grub-theme-resolution theme)
- (((? number? width) . (? number? height))
- (image->png image #:width width #:height height))
- (_ #f)))))
-
-(define (grub-locale-directory grub)
- "Generate a directory with the locales from GRUB."
- (define builder
- #~(begin
- (use-modules (ice-9 ftw))
- (let ((locale (string-append #$grub "/share/locale"))
- (out #$output))
- (mkdir out)
- (chdir out)
- (for-each (lambda (lang)
- (let ((file (string-append locale "/" lang
- "/LC_MESSAGES/grub.mo"))
- (dest (string-append lang ".mo")))
- (when (file-exists? file)
- (copy-file file dest))))
- (scandir locale)))))
- (computed-file "grub-locales" builder))
-
-(define* (eye-candy config store-device store-mount-point
- #:key store-directory-prefix port)
- "Return a gexp that writes to PORT (a port-valued gexp) the 'grub.cfg' part
-concerned with graphics mode, background images, colors, and all that.
-STORE-DEVICE designates the device holding the store, and STORE-MOUNT-POINT is
-its mount point; these are used to determine where the background image and
-fonts must be searched for. STORE-DIRECTORY-PREFIX is a directory prefix to
-prepend to any store file name."
- (define (setup-gfxterm config)
- (if (memq 'gfxterm (bootloader-configuration-terminal-outputs config))
- #~(format #f "
+(define (core.cfg targets store-crypto-devices)
+ "Returns a filelike object for a core configuration file good enough to
+decrypt STORE-CRYPTO-DEVICES and boot to normal."
+ (define (crypto-device->cryptomount dev)
+ (and (uuid? dev) ; ignore non-uuids - warning given by os
+ #~(format port "cryptomount -u ~a~%"
+ ;; cryptomount only accepts UUID without the hyphen.
+ #$(string-delete #\- (uuid->string dev)))))
+
+ (and=>
+ (with-targets targets
+ (('install => (path :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ #$@(filter ->bool
+ (map crypto-device->cryptomount store-crypto-devices))
+ #$(search/target 'install targets "root" #~port)
+ (format port "set \"prefix=($root)~a\"~%" #$(sanitize path))))))
+ (cut computed-file "core.cfg" <>)))
+
+
+
+;; TODO: do we need LVM support here?
+(define* (core.img grub format #:key bootloader-config store-crypto-devices
+ #:allow-other-keys)
+ "The core image for GRUB, built for FORMAT."
+ (let* ((targets (bootloader-configuration-targets bootloader-config))
+ (bios? (string-prefix? format "pc"))
+ (efi? (string=? format "efi"))
+ (32? (bootloader-configuration-32bit? bootloader-config))
+ (cfg (core.cfg targets store-crypto-devices)))
+ (and cfg
+ (and=>
+ (with-targets targets
+ (('install => (fs :fs))
+ (let ((tftp? (or (string=? fs "tftp") (string=? fs "nfs"))))
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils) (ice-9 textual-ports)
+ (srfi srfi-1))
+ (apply invoke #$(file-append grub "/bin/grub-mkimage")
+ "--output" #$output
+ "--config" #$cfg
+ "--prefix" "none" ; we override this in cfg
+ ;; bios pxe uses pxeboot instead of diskboot - diff format
+ "--format" #$(string-append (grub-format format 32?)
+ (if (and bios? tftp?) "-pxe" ""))
+ "--compression" "auto"
+ ;; modules
+ "minicmd"
+ (append
+ ;; disk drivers
+ '#$(if bios? '("biosdisk") '())
+ ;; partmaps (TODO: detect which to use?)
+ '#$(if tftp? '() '("part_msdos" "part_gpt"))
+ ;; file systems
+ '#$(cond ((member fs '("ext2" "ext3" "ext4")) '("ext2"))
+ ((member fs "vfat" "fat32") '("fat"))
+ ((and tftp? efi?) '("efinet"))
+ ((and tftp? bios?) '("pxe"))
+ (else (list fs)))
+ ;; store crypto devs
+ '#$(if (any uuid? store-crypto-devices)
+ '("luks" "luks2" "cryptomount") '())
+ ;; search module that cfg uses
+ (call-with-input-file #$cfg
+ (lambda (port)
+ (let* ((str (get-string-all port))
+ (use (lambda (s) (string-contains str s))))
+ (cond ((use "search.fs_uuid") '("search_fs_uuid"))
+ ((use "search.fs_label") '("search_label"))
+ ((use "search.file") '("search_fs_file"))
+ (else '()))))))))))))
+ (cut computed-file "core.img" <>
+ #:options '(#:local-build? #t #:substitutable? #f))))))
+
+
+
+\f
+;;;
+;;; Main config.
+;;; This is what does the heavy lifting after core.img finds it.
+;;;
+
+(define (menu-entry->gexp store extra-initrd port)
+ (lambda (entry)
+ (match-record entry <menu-entry>
+ (label device linux linux-arguments initrd
+ multiboot-kernel multiboot-arguments multiboot-modules chain-loader)
+ (let ((norm (compose sanitize (cut normalize-file entry <>))))
+ #~(begin
+ (format #$port "menuentry ~s {~% " #$label)
+ #$(search/menu-entry
+ device (or linux multiboot-kernel chain-loader) "boot" port)
+ #$@(cond
+ (linux
+ (list #~(format #$port " linux \"($boot)~a\" ~a~%"
+ #$(norm linux)
+ ;; grub passes rest of the line _verbatim_
+ (string-join (list #$@linux-arguments)))
+ #~(format #$port " initrd ~a \"($boot)~a\"~%"
+ (if #$extra-initrd (string-append "($boot)\""
+ (norm #$extra-initrd) "\"")
+ "")
+ #$(norm initrd))))
+ ;; previously, this provided a (wrong) root= argument. just
+ ;; don't bother anymore. better less info than wrong info
+ (multiboot-kernel
+ (cons #~(format #$port " multiboot \"($boot)~a\" ~a~%"
+ #$(norm multiboot-kernel)
+ (string-join (list #$@multiboot-arguments)))
+ (map (lambda (mod) #~(format port " module \"($boot)~a\"~%"
+ #$(norm mod)))
+ multiboot-modules)))
+ (chain-loader
+ (list #~(format #$port " chainloader \"~a\"~%"
+ #$(norm chain-loader)))))
+ (format #$port "}~%"))))))
+
+
+
+(define* (grub.cfg #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ locale
+ store-directory-prefix
+ #:allow-other-keys)
+ "Returns a valid grub config given installer inputs. Expects locales, keymap,
+and theme image at LOCALES-TARG, KEYMAP-TARG, and IMAGE-TARG, respectively."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match keyboard-layout here cause it's bound to its struct
+ (targets menu-entries default-entry timeout extra-initrd
+ theme terminal-outputs terminal-inputs serial-unit serial-speed)
+ (let* ((entry->gexp (menu-entry->gexp store-directory-prefix
+ extra-initrd #~port))
+ (terms->str (compose string-join (cut map symbol->string <>)))
+ (colors->str (lambda (c) (format #f "~a/~a" (assoc-ref c 'fg)
+ (assoc-ref c 'bg))))
+ (outputs (or terminal-outputs '(gfxterm))) ; set default outs
+ (inputs (or terminal-inputs '())) ; set default ins
+ (theme (or theme (grub-theme))))
+ (and=>
+ (with-targets targets
+ (('install => (install :devpath))
+ #~(call-with-output-file #$output
+ (lambda (port)
+ ;; preamble
+ (format port "\
+# This file was generated from your Guix configuration. Any changes
+# will be lost upon reconfiguration~%")
+ #$@(filter ->bool
+ (list
+ ;; menu settings
+ (and default-entry
+ #~(format port "set default=~a~%" #$default-entry))
+ (and timeout
+ #~(format port "set timeout=~a~%" #$timeout))
+ ;; gfxterm setup
+ (and (memq 'gfxterm outputs)
+ #~(format port "\
if loadfont unicode; then
set gfxmode=~a
insmod all_video
insmod gfxterm
-fi~%"
- #$(string-join
- (grub-theme-gfxmode (bootloader-theme config))
- ";"))
- ""))
-
- (define (theme-colors type)
- (let* ((theme (bootloader-theme config))
- (colors (type theme)))
- (string-append (symbol->string (assoc-ref colors 'fg)) "/"
- (symbol->string (assoc-ref colors 'bg)))))
-
- (define image
- (normalize-file (grub-background-image config)
- store-mount-point
- store-directory-prefix))
-
- (and image
- #~(format #$port "
-# Set 'root' to the partition that contains /gnu/store.
-~a
-
-~a
-~a
-
+fi~%" #$(string-join (grub-theme-gfxmode theme) ";")))
+ ;; io
+ (and (or serial-unit serial-speed)
+ #~(format port "serial --unit=~a --speed=~a~%"
+ ;; documented defaults are unit 0 at 9600 baud.
+ #$(number->string (or serial-unit 0))
+ #$(number->string (or serial-speed 9600))))
+ (and (pair? outputs)
+ #~(format port "terminal_output ~a~%"
+ #$(terms->str outputs)))
+ (and (pair? inputs)
+ #~(format port "terminal_input ~a~%"
+ #$(terms->str inputs)))
+ ;; locale
+ (and locale
+ #~(format port "\
+set \"locale_dir=($root)~a/locales\"
+set lang=~a~%" #$(sanitize install)
+ #$(locale-definition-source
+ (locale-name->definition locale))))
+ ;; keyboard layout
+ (and (bootloader-configuration-keyboard-layout
+ bootloader-config)
+ #~(format port "\
+insmod keylayouts
+keymap \"($root)~a/keymap~%\"" #$(sanitize install)))
+ ;; theme
+ (match-record theme <grub-theme>
+ (image color-normal color-highlight)
+ (and image
+ #~(format port "\
insmod png
-if background_image ~a; then
+if background_image \"($root)~a/image.png\"; then
set color_normal=~a
set color_highlight=~a
else
set menu_color_normal=cyan/blue
set menu_color_highlight=white/blue
-fi~%"
- #$(grub-root-search store-device image)
- #$(setup-gfxterm config)
- #$(grub-setup-io config)
+fi~%" #$(sanitize install)
+ #$(colors->str color-normal)
+ #$(colors->str color-highlight))))))
+ ;; menu entries
+ #$(entry->gexp
+ (boot-alternative->menu-entry current-boot-alternative))
+ #$@(map entry->gexp menu-entries)
+ #$@(if (pair? old-boot-alternatives)
+ (append (list #~(format port "submenu ~s {~%"
+ "GNU system, old configurations..."))
+ (map (compose entry->gexp
+ boot-alternative->menu-entry)
+ old-boot-alternatives)
+ (list #~(format port "}~%"))) '())
+ (format port "
+if [ \"${grub_platform}\" == efi ]; then
+ menuentry \"Firmware setup\" {
+ fwsetup
+ }
+fi~%")))))
+ (cut computed-file "grub.cfg" <>
+ ;; Since this file is rather unique, there's no point in trying to
+ ;; substitute it.
+ #:options '(#:local-build? #t #:substitutable? #f))))))
- #$image
- #$(theme-colors grub-theme-color-normal)
- #$(theme-colors grub-theme-color-highlight))))
-\f
-;;;
-;;; Configuration file.
-;;;
-(define* (keyboard-layout-file layout
- #:key
- (grub grub))
+(define (keyboard-layout-file layout grub)
"Process the X keyboard layout description LAYOUT, a <keyboard-layout> record,
and return a file in the format for GRUB keymaps. LAYOUT must be present in
the 'share/X11/xkb/symbols/' directory of 'xkeyboard-config'."
- (define builder
+ (computed-file
+ (string-append "grub-keymap."
+ (string-map (match-lambda (#\, #\-) (chr chr))
+ (keyboard-layout-name layout)))
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
@@ -243,670 +447,178 @@ (define* (keyboard-layout-file layout
;; (from the 'console-setup' package).
(invoke #+(file-append grub "/bin/grub-mklayout")
"-i" #+(keyboard-layout->console-keymap layout)
- "-o" #$output))))
-
- (computed-file (string-append "grub-keymap."
- (string-map (match-lambda
- (#\, #\-)
- (chr chr))
- (keyboard-layout-name layout)))
- builder))
-
-(define (grub-setup-io config)
- "Return GRUB commands to configure the input / output interfaces. The result
-is a string that can be inserted in grub.cfg."
- (let* ((symbols->string (lambda (list)
- (string-join (map symbol->string list) " ")))
- (outputs (bootloader-configuration-terminal-outputs config))
- (inputs (bootloader-configuration-terminal-inputs config))
- (unit (bootloader-configuration-serial-unit config))
- (speed (bootloader-configuration-serial-speed config))
-
- ;; Respectively, GRUB_TERMINAL_OUTPUT and GRUB_TERMINAL_INPUT,
- ;; as documented in GRUB manual section "Simple Configuration
- ;; Handling".
- (valid-outputs '(console serial serial_0 serial_1 serial_2 serial_3
- gfxterm vga_text mda_text morse spkmodem))
- (valid-inputs '(console serial serial_0 serial_1 serial_2 serial_3
- at_keyboard usb_keyboard))
-
- (io (string-append
- ;; UNIT and SPEED are arguments to the same GRUB command
- ;; ("serial"), so we process them together.
- (if (or unit speed)
- (string-append
- "serial"
- (if unit
- ;; COM ports 1 through 4
- (if (and (exact-integer? unit) (<= unit 3) (>= unit 0))
- (string-append " --unit=" (number->string unit))
- #f)
- "")
- (if speed
- (if (exact-integer? speed)
- (string-append " --speed=" (number->string speed))
- #f)
- "")
- "\n")
- "")
- (if (null? inputs)
- ""
- (string-append
- "terminal_input "
- (symbols->string
- (map
- (lambda (input)
- (if (memq input valid-inputs) input #f)) inputs))
- "\n"))
- "terminal_output "
- (symbols->string
- (map
- (lambda (output)
- (if (memq output valid-outputs) output #f)) outputs)))))
- (format #f "~a" io)))
-
-(define (grub-root-search device file)
- "Return the GRUB 'search' command to look for DEVICE, which contains FILE,
-a gexp. The result is a gexp that can be inserted in the grub.cfg-generation
-code."
- ;; Usually FILE is a file name gexp like "/gnu/store/…-linux/vmlinuz", but
- ;; it can also be something like "(hd0,msdos1)/vmlinuz" in the case of
- ;; custom menu entries. In the latter case, don't emit a 'search' command.
- (if (and (string? file) (not (string-prefix? "/" file)))
- ""
- (match device
- ;; Preferably refer to DEVICE by its UUID or label. This is more
- ;; efficient and less ambiguous, see <http://bugs.gnu.org/22281>.
- ((? uuid? uuid)
- (format #f "search --fs-uuid --set ~a"
- (uuid->string device)))
- ((? file-system-label? label)
- (format #f "search --label --set ~a"
- (file-system-label->string label)))
- ((? (lambda (device)
- (and (string? device) (string-contains device ":/"))) nfs-uri)
- ;; If the device is an NFS share, then we assume that the expected
- ;; file on that device (e.g. the GRUB background image or the kernel)
- ;; has to be loaded over the network. Otherwise we would need an
- ;; additional device information for some local disk to look for that
- ;; file, which we do not have.
- ;;
- ;; We explicitly set "root=(tftp)" here even though if grub.cfg
- ;; had been loaded via TFTP, Grub would have set "root=(tftp)"
- ;; automatically anyway. The reason is if you have a system that
- ;; used to be on NFS but now is local, root would be set to local
- ;; disk. If you then selected an older system generation that is
- ;; supposed to boot from network in the Grub boot menu, Grub still
- ;; wouldn't load those files from network otherwise.
- ;;
- ;; TFTP is preferred to HTTP because it is used more widely and
- ;; specified in standards more widely--especially BOOTP/DHCPv4
- ;; defines a TFTP server for DHCP option 66, but not HTTP.
- ;;
- ;; Note: DHCPv6 specifies option 59 to contain a boot-file-url,
- ;; which can contain a HTTP or TFTP URL.
- ;;
- ;; Note: It is assumed that the file paths are of a similar
- ;; setup on both the TFTP server and the NFS server (it is
- ;; not possible to search for files on TFTP).
- ;;
- ;; TODO: Allow HTTP.
- "set root=(tftp)")
- ((or #f (? string?))
- #~(format #f "search --file --set ~a" #$file)))))
-
-(define* (make-grub-configuration grub config entries
- #:key
- (locale #f)
- (system (%current-system))
- (old-entries '())
- (store-crypto-devices '())
- store-directory-prefix)
- "Return the GRUB configuration file corresponding to CONFIG, a
-<bootloader-configuration> object, and where the store is available at
-STORE-FS, a <file-system> object. OLD-ENTRIES is taken to be a list of menu
-entries corresponding to old generations of the system.
-STORE-CRYPTO-DEVICES contain the UUIDs of the encrypted units that must
-be unlocked to access the store contents.
-STORE-DIRECTORY-PREFIX may be used to specify a store prefix, as is required
-when booting a root file system on a Btrfs subvolume."
- (define all-entries
- (append entries (bootloader-configuration-menu-entries config)))
- (define (menu-entry->gexp entry)
- (let ((label (menu-entry-label entry))
- (linux (menu-entry-linux entry))
- (device (menu-entry-device entry))
- (device-mount-point (menu-entry-device-mount-point entry))
- (multiboot-kernel (menu-entry-multiboot-kernel entry))
- (chain-loader (menu-entry-chain-loader entry)))
- (cond
- (linux
- (let ((arguments (menu-entry-linux-arguments entry))
- (linux (normalize-file linux
- device-mount-point
- store-directory-prefix))
- (initrd (normalize-file (menu-entry-initrd entry)
- device-mount-point
- store-directory-prefix))
- (extra-initrd (bootloader-configuration-extra-initrd config)))
- ;; Here DEVICE is the store and DEVICE-MOUNT-POINT is its mount point.
- ;; Use the right file names for LINUX and INITRD in case
- ;; DEVICE-MOUNT-POINT is not "/", meaning that the store is on a
- ;; separate partition.
-
- ;; When STORE-DIRECTORY-PREFIX is defined, prepend it the linux and
- ;; initrd paths, to allow booting from a Btrfs subvolume.
- #~(format port "menuentry ~s {
- ~a
- linux ~a ~a
- initrd ~a ~a
-}~%"
- #$label
- #$(grub-root-search device linux)
- #$linux (string-join (list #$@arguments))
- (or #$extra-initrd "")
- #$initrd)))
- (multiboot-kernel
- (let* ((kernel (menu-entry-multiboot-kernel entry))
- (arguments (menu-entry-multiboot-arguments entry))
- ;; Choose between device names as understood by Mach's built-in
- ;; IDE driver ("hdX") and those understood by rumpdisk ("wdX"
- ;; in the "noide" case).
- (disk (if (member "noide" arguments) "w" "h"))
- (modules (menu-entry-multiboot-modules entry))
- (root-index 1)) ; XXX EFI will need root-index 2
- #~(format port "
-menuentry ~s {
- multiboot ~a root=part:~a:device:~ad0~a~a
-}~%"
- #$label
- #$kernel
- #$root-index
- #$disk
- (string-join (list #$@arguments) " " 'prefix)
- (string-join (map string-join '#$modules)
- "\n module " 'prefix))))
- (chain-loader
- #~(format port "
-menuentry ~s {
- ~a
- chainloader ~a
-}~%"
- #$label
- #$(grub-root-search device chain-loader)
- #$chain-loader)))))
-
- (define (crypto-devices)
- (define (crypto-device->cryptomount dev)
- (if (uuid? dev)
- #~(format port "cryptomount -u ~a~%"
- ;; cryptomount only accepts UUID without the hypen.
- #$(string-delete #\- (uuid->string dev)))
- ;; Other type of devices aren't implemented.
- #~()))
- (let ((devices (map crypto-device->cryptomount store-crypto-devices))
- (modules #~(format port "insmod luks~%insmod luks2~%")))
- (if (null? devices)
- devices
- (cons modules devices))))
-
- (define (sugar)
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- (eye-candy config
- device
- mount-point
- #:store-directory-prefix store-directory-prefix
- #:port #~port)))
-
- (define locale-config
- (let* ((entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry)))
- #~(let ((locale #$(and locale
- (locale-definition-source
- (locale-name->definition locale))))
- (locales #$(and locale
- (normalize-file (grub-locale-directory grub)
- mount-point
- store-directory-prefix))))
- (when locale
- (format port "\
-# Localization configuration.
-~asearch --file --set ~a/en@quot.mo
-set locale_dir=~a
-set lang=~a~%"
- ;; Skip the search if there is an image, as it has already
- ;; been performed by eye-candy and traversing the store is
- ;; an expensive operation.
- #$(if (grub-theme-image (bootloader-theme config))
- "# "
- "")
- locales
- locales
- locale)))))
-
- (define keyboard-layout-config
- (let* ((layout (bootloader-configuration-keyboard-layout config))
- (keymap* (and layout
- (keyboard-layout-file layout #:grub grub)))
- (entry (first all-entries))
- (device (menu-entry-device entry))
- (mount-point (menu-entry-device-mount-point entry))
- (keymap (and keymap*
- (normalize-file keymap* mount-point
- store-directory-prefix))))
- #~(when #$keymap
- (format port "\
-insmod keylayouts
-keymap ~a~%" #$keymap))))
-
- (define builder
- #~(call-with-output-file #$output
- (lambda (port)
- (format port
- "# This file was generated from your Guix configuration. Any changes
-# will be lost upon reconfiguration.
-")
- #$@(crypto-devices)
- #$(sugar)
- #$locale-config
- #$keyboard-layout-config
- (format port "
-set default=~a
-set timeout=~a~%"
- #$(bootloader-configuration-default-entry config)
- #$(bootloader-configuration-timeout config))
- #$@(map menu-entry->gexp all-entries)
-
- #$@(if (pair? old-entries)
- #~((format port "
-submenu \"GNU system, old configurations...\" {~%")
- #$@(map menu-entry->gexp old-entries)
- (format port "}~%"))
- #~())
- (format port "
-if [ \"${grub_platform}\" == efi ]; then
- menuentry \"Firmware setup\" {
- fwsetup
- }
-fi~%"))))
+ "-o" #$output)))))
+
+
+
+(define* (grub.dir grub #:key bootloader-config locale
+ #:allow-other-keys . args)
+ "Everything what should go in GRUB's prefix, including fonts, modules,
+locales, keymap, theme image, and grub.cfg."
+ (match-record bootloader-config <bootloader-configuration>
+ ;; can't match for keyboard-layout: identifier bound in this scope
+ (targets theme)
+ (let* ((theme (or theme (grub-theme)))
+ (keyboard-layout (bootloader-configuration-keyboard-layout
+ bootloader-config))
+ (lang (and=> locale (compose locale-definition-source
+ locale-name->definition)))
+ (lc-mesg (and=> lang (cut file-append grub "/share/locale" <>
+ "/LC_MESSAGES/grub.mo"))))
+ (computed-file "grub.dir"
+ (with-imported-modules '((guix build utils))
+ #~(begin (use-modules (guix build utils))
+ (mkdir-p #$output)
+ (chdir #$output)
+ ;; grub files
+ (copy-recursively #$(file-append grub "/lib/grub/") #$output
+ #:copy-file symlink)
+ (mkdir "fonts")
+ (symlink #$(file-append grub "/share/grub/unicode.pf2")
+ "fonts/unicode.pf2")
+ ;; config file
+ (symlink #$(apply grub.cfg args) "grub.cfg")
+ ;; locales
+ (when (and=> #$lc-mesg file-exists?)
+ (mkdir "locales")
+ (symlink #$lc-mesg (string-append "locales/" #$lang ".mo")))
+ ;; keymap
+ #$@(filter ->bool
+ (list
+ (and keyboard-layout
+ #~(symlink #$(keyboard-layout-file keyboard-layout grub)
+ "keymap"))
+ ;; image
+ (and (grub-theme-image theme)
+ #~(copy-file #$(grub-theme-png theme) "image.png"))))))
+ #:options '(#:local-build? #t #:substitutable? #f)))))
- ;; Since this file is rather unique, there's no point in trying to
- ;; substitute it.
- (computed-file "grub.cfg" builder
- #:options '(#:local-build? #t
- #:substitutable? #f)))
-(define (grub-configuration-file config . args)
- (let* ((bootloader (bootloader-configuration-bootloader config))
- (grub (bootloader-package bootloader)))
- (apply make-grub-configuration grub config args)))
-
-(define (grub-efi-configuration-file . args)
- (apply make-grub-configuration grub-efi args))
-
-(define grub-cfg "/boot/grub/grub.cfg")
\f
-
;;;
-;;; Install procedures.
+;;; Installers.
;;;
-(define install-grub
- #~(lambda (bootloader device mount-point)
- (let ((grub (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot")))
- ;; Install GRUB on DEVICE which is mounted at MOUNT-POINT. If DEVICE
- ;; is #f, then we populate the disk-image rooted at MOUNT-POINT.
- (if device
- (begin
- ;; Tell 'grub-install' that there might be a LUKS-encrypted
- ;; /boot or root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
-
- ;; Hide potentially confusing messages from the user, such as
- ;; "Installing for i386-pc platform."
- (invoke/quiet grub "--no-floppy" "--target=i386-pc"
- "--boot-directory" install-dir
- device))
- ;; When creating a disk-image, only install a font and GRUB modules.
- (let* ((fonts (string-append install-dir "/grub/fonts")))
- (mkdir-p fonts)
- (copy-file (string-append bootloader "/share/grub/unicode.pf2")
- (string-append fonts "/unicode.pf2"))
- (copy-recursively (string-append bootloader "/lib/")
- install-dir))))))
-
-(define install-grub-disk-image
- #~(lambda (bootloader root-index image)
- ;; Install GRUB on the given IMAGE. The root partition index is
- ;; ROOT-INDEX.
- (let ((grub-mkimage
- (string-append bootloader "/bin/grub-mkimage"))
- (modules '("biosdisk" "part_msdos" "fat" "ext2"))
- (grub-bios-setup
- (string-append bootloader "/sbin/grub-bios-setup"))
- (root-device (format #f "hd0,msdos~a" root-index))
- (boot-img (string-append bootloader "/lib/grub/i386-pc/boot.img"))
- (device-map "device.map"))
-
- ;; Create a minimal, standalone GRUB image that will be written
- ;; directly in the MBR-GAP (space between the end of the MBR and the
- ;; first partition).
- (apply invoke grub-mkimage
- "-O" "i386-pc"
- "-o" "core.img"
- "-p" (format #f "(~a)/boot/grub" root-device)
- modules)
-
- ;; Create a device mapping file.
- (call-with-output-file device-map
- (lambda (port)
- (format port "(hd0) ~a~%" image)))
-
- ;; Copy the default boot.img, that will be written on the MBR sector
- ;; by GRUB-BIOS-SETUP.
- (copy-file boot-img "boot.img")
-
- ;; Install both the "boot.img" and the "core.img" files on the given
- ;; IMAGE. On boot, the MBR sector will execute the minimal GRUB
- ;; written in the MBR-GAP. GRUB configuration and missing modules will
- ;; be read from ROOT-DEVICE.
- (invoke grub-bios-setup
- "-m" device-map
- "-r" root-device
- "-d" "."
- image))))
-
-(define install-grub-efi
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi-removable
- #~(lambda (bootloader efi-dir mount-point)
- ;; NOTE: mount-point is /mnt in guix system init /etc/config.scm /mnt/point
- ;; NOTE: efi-dir comes from target list of booloader configuration
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--removable"
- ;; "--no-nvram"
- "--bootloader-id=Guix"
- "--efi-directory" target-esp)))))
-
-(define install-grub-efi32
- #~(lambda (bootloader efi-dir mount-point)
- ;; There is nothing useful to do when called in the context of a disk
- ;; image generation.
- (when efi-dir
- ;; Install GRUB onto the EFI partition mounted at EFI-DIR, for the
- ;; system whose root is mounted at MOUNT-POINT.
- (let ((grub-install (string-append bootloader "/sbin/grub-install"))
- (install-dir (string-append mount-point "/boot"))
- ;; When installing Guix, it's common to mount EFI-DIR below
- ;; MOUNT-POINT rather than /boot/efi on the live image.
- (target-esp (if (file-exists? (string-append mount-point efi-dir))
- (string-append mount-point efi-dir)
- efi-dir)))
- ;; Tell 'grub-install' that there might be a LUKS-encrypted /boot or
- ;; root partition.
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet grub-install "--boot-directory" install-dir
- "--bootloader-id=Guix"
- (cond ((target-x86?) "--target=i386-efi")
- ((target-arm?) "--target=arm-efi"))
- "--efi-directory" target-esp)))))
-
-(define* (make-grub-efi-netboot-installer grub-efi grub-cfg subdir)
- "Make a bootloader-installer for a grub-efi-netboot bootloader, which expects
-its files in SUBDIR and its configuration file in GRUB-CFG.
-
-As a grub-efi-netboot package is already pre-installed by 'grub-mknetdir', the
-installer basically copies all files from the bootloader-package (or profile)
-into the bootloader-target directory.
-
-Additionally for network booting over TFTP, two relative symlinks to the store
-and to the GRUB-CFG file are necessary. Due to this a TFTP root directory must
-not be located on a FAT file-system.
-
-If the bootloader-target does not support symlinks, then it is assumed to be a
-kind of EFI System Partition (ESP). In this case an intermediate configuration
-file is created with the help of GRUB-EFI to load the GRUB-CFG.
-
-The installer is usable for any efi-bootloader-chain, which prepares the
-bootloader-profile in a way ready for copying.
-
-The installer does not manipulate the system's 'UEFI Boot Manager'.
-
-The returned installer accepts the BOOTLOADER, TARGET and MOUNT-POINT
-arguments. Its job is to copy the BOOTLOADER, which must be a pre-installed
-grub-efi-netboot package with a SUBDIR like efi/boot or efi/Guix, below the
-directory TARGET for the system whose root is mounted at MOUNT-POINT.
-
-MOUNT-POINT is the last argument in 'guix system init /etc/config.scm mnt/point'
-or '/' for other 'guix system' commands.
-
-Where TARGET comes from the targets argument given to the
-bootloader-configuration in:
-
-(operating-system
- (bootloader (bootloader-configuration
- (targets '(\"/boot/efi\"))
- …))
- …)
-
-TARGET is required to be an absolute directory name, usually mounted via NFS,
-and finally needs to be provided by a TFTP server as
-the TFTP root directory.
-
-Usually the installer will be used to prepare network booting over TFTP. Then
-GRUB will load tftp://server/SUBDIR/grub.cfg and this file will instruct it to
-load more files from the store like tftp://server/gnu/store/…-linux…/Image.
-
-To make this possible two symlinks are created. The first symlink points
-relatively form MOUNT-POINT/TARGET/SUBDIR/grub.cfg to
-MOUNT-POINT/boot/grub/grub.cfg, and the second symlink points relatively from
-MOUNT-POINT/TARGET/%store-prefix to MOUNT-POINT/%store-prefix.
-
-It is important to note that these symlinks need to be relative, as the absolute
-paths on the TFTP server side are unknown.
-
-It is also important to note that both symlinks will point outside the TFTP root
-directory and that the TARGET/%store-prefix symlink makes the whole store
-accessible via TFTP. Possibly the TFTP server must be configured to allow
-accesses outside its TFTP root directory. This all may need to be considered
-for security aspects. It is advised to disable any TFTP write access!
-
-The installer can also be used to prepare booting from local storage, if the
-underlying file-system, like FAT on an EFI System Partition (ESP), does not
-support symlinks. In this case the MOUNT-POINT/TARGET/SUBDIR/grub.cfg will be
-created with the help of GRUB-EFI to load the /boot/grub/grub.cfg file. A
-symlink to the store is not needed in this case."
- (with-imported-modules '((guix build union))
- #~(lambda (bootloader target mount-point)
- ;; In context of a disk image creation TARGET will be #f and an
- ;; installer is expected to do necessary installations on MOUNT-POINT,
- ;; which will become the root file system. If TARGET is #f, this
- ;; installer has nothing to do, as it only cares about the EFI System
- ;; Partition (ESP).
- (when target
- (use-modules ((guix build union) #:select (symlink-relative))
- (ice-9 popen)
- (ice-9 rdelim))
- (let* ((mount-point/target (string-append mount-point target "/"))
- ;; When installing Guix, it is common to mount TARGET below
- ;; MOUNT-POINT rather than the root directory.
- (bootloader-target (if (file-exists? mount-point/target)
- mount-point/target
- target))
- (store (string-append mount-point (%store-prefix)))
- (store-link (string-append bootloader-target (%store-prefix)))
- (grub-cfg (string-append mount-point #$grub-cfg))
- (grub-cfg-link (string-append bootloader-target
- #$subdir "/"
- (basename grub-cfg))))
- ;; Copy the bootloader into the bootloader-target directory.
- ;; Should we beforehand recursively delete any existing file?
- (copy-recursively bootloader bootloader-target
- #:follow-symlinks? #t
- #:log (%make-void-port "w"))
- ;; For TFTP we need to install additional relative symlinks.
- ;; If we install on an EFI System Partition (ESP) or some other FAT
- ;; file-system, then symlinks cannot be created and are not needed.
- ;; Therefore we ignore exceptions when trying.
- ;; Prepare the symlink to the grub.cfg.
- (mkdir-p (dirname grub-cfg-link))
- (false-if-exception (delete-file grub-cfg-link))
- (if (unspecified?
- (false-if-exception (symlink-relative grub-cfg grub-cfg-link)))
- ;; Symlinks are supported.
- (begin
- ;; Prepare the symlink to the store.
- (mkdir-p (dirname store-link))
- (false-if-exception (delete-file store-link))
- (symlink-relative store store-link))
- ;; Creating symlinks does not seem to be supported. Probably
- ;; an ESP is used. Add a script to search and load the actual
- ;; grub.cfg.
- (let* ((probe #$(file-append grub-efi "/sbin/grub-probe"))
- (port (open-pipe* OPEN_READ probe "--target=fs_uuid"
- grub-cfg))
- (search-root
- (match (read-line port)
- ((? eof-object?)
- ;; There is no UUID available. As a fallback search
- ;; everywhere for the grub.cfg.
- (string-append "search --file --set " #$grub-cfg))
- (fs-uuid
- ;; The UUID to load the grub.cfg from is known.
- (string-append "search --fs-uuid --set " fs-uuid))))
- (load-grub-cfg (string-append "configfile " #$grub-cfg)))
- (close-pipe port)
- (with-output-to-file grub-cfg-link
- (lambda ()
- (display (string-join (list search-root
- load-grub-cfg)
- "\n")))))))))))
+(define* (install-grub.dir grub #:key bootloader-config
+ #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('install => (path :path))
+ #~(copy-recursively #$(apply grub.dir grub args) #$path
+ #:log (%make-void-port "w")
+ #:follow-symlinks? #t
+ #:copy-file atomic-copy))))
+
+(define (install-grub-bios grub)
+ "Returns an installer for the bios-bootable grub package GRUB."
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (gbegin (apply install-grub.dir grub args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ (('disk => (device :device))
+ #~(invoke #$(file-append grub "/sbin/grub-bios-setup") "-v" "-v"
+ "--directory" "/" ; can't be blank
+ "--device-map" "" ; no dev map - need to specify
+ "--boot-image"
+ #$(file-append grub "/lib/grub/i386-pc/boot.img")
+ "--core-image" #$(apply core.img grub "pc" args)
+ "--root-device" #$(string-append "hostdisk/" device)
+ #$device))))))
+
+(define* (install-grub-efi #:key bootloader-config #:allow-other-keys . args)
+ "Installs grub into the system's uefi bootloader, taking into account
+user-specified requirements for a 32-bit or fallback bootloader."
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (grub (if 32? grub-efi32 grub-efi))
+ (core (apply core.img grub "efi" args))
+ (copy #~(lambda (dest) (copy-file #$core dest))))
+ (gbegin (apply install-grub.dir grub args)
+ (install-efi bootloader-config #~`((,#$copy "grub.efi" . "GNU GRUB"))))))
+
-\f
+\f
;;;
-;;; Bootloader definitions.
+;;; Bootloaders.
;;;
-;;; For all these grub-bootloader variables the path to /boot/grub/grub.cfg
-;;; is fixed. Inheriting and overwriting the field 'configuration-file' will
-;;; break 'guix system delete-generations', 'guix system switch-generation',
-;;; and 'guix system roll-back'.
+
+(define %grub-default-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))))
(define grub-bootloader
(bootloader
- (name 'grub)
- (package grub)
- (installer install-grub)
- (disk-image-installer install-grub-disk-image)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub))))
(define grub-minimal-bootloader
(bootloader
- (inherit grub-bootloader)
- (package grub-minimal)))
+ (name 'grub)
+ (default-targets %grub-default-targets)
+ (installer (install-grub-bios grub-minimal))))
(define grub-efi-bootloader
(bootloader
- (name 'grub-efi)
- (package grub-efi)
- (installer install-grub-efi)
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-configuration-file)))
-
-(define grub-efi-removable-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (name 'grub-efi-removable-bootloader)
- (installer install-grub-efi-removable)))
+ (name 'grub-efi)
+ (default-targets (list (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))
+ (bootloader-target
+ (type 'install)
+ (offset 'esp)
+ (path "grub"))))
+ (installer install-grub-efi)))
-(define grub-efi32-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (installer install-grub-efi32)
- (name 'grub-efi32)
- (package grub-efi32)))
-(define (make-grub-efi-netboot-bootloader name subdir)
- (bootloader
- (name name)
- (package (make-grub-efi-netboot (symbol->string name) subdir))
- (installer (make-grub-efi-netboot-installer grub-efi grub-cfg subdir))
- (disk-image-installer #f)
- (configuration-file grub-cfg)
- (configuration-file-generator grub-efi-configuration-file)))
-
-(define grub-efi-netboot-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-bootloader
- "efi/Guix"))
-
-(define grub-efi-netboot-removable-bootloader
- (make-grub-efi-netboot-bootloader 'grub-efi-netboot-removable-bootloader
- "efi/boot"))
-
-(define grub-mkrescue-bootloader
- (bootloader
- (inherit grub-efi-bootloader)
- (package grub-hybrid)))
\f
;;;
-;;; Compatibility macros.
+;;; deprecated shit!
+;;; use the bootloader-config flags instead! or, in the case of netboot, set
+;;; your 'install (or parent thereof) target fs to be "tftp" or "nfs"
;;;
-(define-syntax grub-configuration
- (syntax-rules (grub)
- ((_ (grub package) fields ...)
- (if (eq? package grub)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...)
- (bootloader-configuration
- (bootloader grub-efi-bootloader)
- fields ...)))
- ((_ fields ...)
- (bootloader-configuration
- (bootloader grub-bootloader)
- fields ...))))
-
-;;; grub.scm ends here
+(define (deprecated-installer installer removable? 32?)
+ (lambda args (apply installer
+ (substitute-keyword-arguments args
+ ((#:bootloader-config conf) (bootloader-configuration
+ (inherit conf)
+ (efi-removable? removable?)
+ (32bit? 32?)))))))
+
+(define-deprecated grub-efi-removable-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #t #f))))
+
+(define-deprecated grub-efi32-bootloader grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (installer (deprecated-installer install-grub-efi #f #t))))
+
+(define %netboot-targets
+ (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot")
+ (file-system "tftp"))
+ (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+
+(define-deprecated grub-efi-netboot-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)))
+
+(define-deprecated grub-efi-netboot-removable-bootloader
+ grub-efi-bootloader
+ (bootloader
+ (inherit grub-efi-bootloader)
+ (default-targets %netboot-targets)
+ (installer (deprecated-installer install-grub-efi #t #f))))
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index c5437a7b63..7d3e202f8c 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Herman Rimm <herman_rimm@protonmail.com>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,12 +25,11 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu bootloader u-boot)
- #:use-module (gnu bootloader extlinux)
#:use-module (gnu bootloader)
+ #:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
#:use-module (guix gexp)
- #:export (u-boot-bootloader
- u-boot-a20-olinuxino-lime-bootloader
+ #:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
u-boot-bananapi-m2-ultra-bootloader
@@ -53,301 +53,172 @@ (define-module (gnu bootloader u-boot)
u-boot-ts7970-q-2g-1000mhz-c-bootloader
u-boot-wandboard-bootloader))
-(define install-u-boot
- #~(lambda (bootloader root-index image)
- (if bootloader
- (error "Failed to install U-Boot"))))
+(define (make-install-u-boot firmware installers)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('extlinux (apply install-extlinux-config args))
+ (('install => (path :path)) #~(let ((path #$path) #$firmware)))
+ (('disk => (disk :device)) #~(let ((disk #$disk)) #f #$@installers)))))
+
+(define-syntax-rule (define-u-bootloader def-name package firmware
+ (file size doffset) ...)
+ "Defines a u-boot installer DEF-NAME, using u-boot PACKAGE. Installs each
+given FILE of SIZE (or #f to autodetect) to the targetted disk at OFFSET.
+FIRMWARE is ran on the u-boot firmware directory for installation of supporting
+files, with the variable path set to the dir path."
+ (define def-name
+ (bootloader
+ (name 'u-boot)
+ (default-targets (list (bootloader-target
+ (type 'install)
+ (offset 'root)
+ (path "boot"))
+ (bootloader-target
+ (type 'extlinux)
+ (offset 'install)
+ (path "extlinux"))))
+ (installer (make-install-u-boot firmware
+ (list #~(let ((fw #$(file-append package "/libexec/" file)))
+ (write-file-on-device fw
+ #$(or size #~(stat:size (stat fw)))
+ disk #$doffset)) ...))))))
+
+\f
+;;;
+;;; Bootloader definitions.
+;;;
-(define install-beaglebone-black-u-boot
+(define-u-bootloader u-boot-beaglebone-black-bootloader
+ u-boot-am335x-boneblack #f
;; http://wiki.beyondlogic.org/index.php?title=BeagleBoneBlack_Upgrading_uBoot
;; This first stage bootloader called MLO (U-Boot SPL) is expected at
;; 0x20000 by BBB ROM code. The second stage bootloader will be loaded by
;; the MLO and is expected at 0x60000. Write both first stage ("MLO") and
- ;; second stage ("u-boot.img") images, read in BOOTLOADER directory, to the
- ;; specified DEVICE.
- #~(lambda (bootloader root-index image)
- (let ((mlo (string-append bootloader "/libexec/MLO"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device mlo (* 256 512)
- image (* 256 512))
- (write-file-on-device u-boot (* 1024 512)
- image (* 768 512)))))
-
-(define install-allwinner-u-boot
- #~(lambda (bootloader root-index image)
- (let ((u-boot (string-append bootloader
- "/libexec/u-boot-sunxi-with-spl.bin")))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 8 1024)))))
-
-(define install-allwinner64-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/u-boot-sunxi-with-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot-sunxi-with-spl.fit.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 8 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 40 1024)))))
-
-(define install-imx-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/SPL"))
- (u-boot (string-append bootloader "/libexec/u-boot.img")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 1 1024))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 69 1024)))))
-
-(define install-orangepi-r1-plus-lts-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-puma-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 512 512)))))
-
-(define install-firefly-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rock64-rk3328-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-rockpro64-rk3399-u-boot
- #~(lambda (bootloader root-index image)
- (let ((idb (string-append bootloader "/libexec/idbloader.img"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device idb (stat:size (stat idb))
- image (* 64 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 16384 512)))))
-
-(define install-pinebook-pro-rk3399-u-boot install-rockpro64-rk3399-u-boot)
-
-(define install-u-boot-ts7970-q-2g-1000mhz-c-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.imx (string-append bootloader "/libexec/u-boot.imx"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.imx install-dir))))
-
-(define install-sifive-unmatched-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append bootloader "/libexec/spl/u-boot-spl.bin"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-u-boot
- #~(lambda (bootloader root-index image)
- (let ((spl (string-append
- bootloader "/libexec/spl/u-boot-spl.bin.normal.out"))
- (u-boot (string-append bootloader "/libexec/u-boot.itb")))
- (write-file-on-device spl (stat:size (stat spl))
- image (* 34 512))
- (write-file-on-device u-boot (stat:size (stat u-boot))
- image (* 2082 512)))))
-
-(define install-starfive-visionfive2-uEnv.txt
- #~(lambda (bootloader device mount-point)
- (mkdir-p (string-append mount-point "/boot"))
- (call-with-output-file (string-append mount-point "/boot/uEnv.txt")
+ ;; second stage ("u-boot.img") images to the target.
+ ("MLO" (* 256 512) (* 256 512))
+ ("u-boot.img" (* 1024 512) (* 768 512)))
+
+(define-u-bootloader u-boot-sifive-unmatched-bootloader
+ u-boot-sifive-unmatched #f
+ ("spl/u-boot-spl.bin" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+(define-u-bootloader u-boot-starfive-visionfive2-bootloader
+ u-boot-starfive-visionfive2
+ #~(begin (mkdir-p path)
+ (call-with-output-file (string-append path "/uEnv.txt")
(lambda (port)
(format port
- ;; if board SPI use vender's u-boot, will find
- ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
- ;; that users will update this u-boot, so set it.
- "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%")))))
+ ;; if board SPI use vender's u-boot, will find
+ ;; ""starfive/starfive_visionfive2.dtb"", We cannot guarantee
+ ;; that users will update this u-boot, so set it.
+ "fdtfile=starfive/jh7110-starfive-visionfive-2-v1.3b.dtb~%"))))
+ ("spl/u-boot-spl.bin.normal.out" #f (* 34 512))
+ ("u-boot.itb" #f (* 2082 512)))
+
+\f
+;;;
+;;; Allwinner bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))))
+
-(define install-qemu-riscv64-u-boot
- #~(lambda (bootloader device mount-point)
- (let ((u-boot.bin (string-append bootloader "/libexec/u-boot.bin"))
- (install-dir (string-append mount-point "/boot")))
- (install-file u-boot.bin install-dir))))
+(define-u-bootloader-allwinner u-boot-nintendo-nes-classic-edition-bootloader
+ u-boot-nintendo-nes-classic-edition)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime-bootloader
+ u-boot-a20-olinuxino-lime)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-lime2-bootloader
+ u-boot-a20-olinuxino-lime2)
+
+(define-u-bootloader-allwinner u-boot-a20-olinuxino-micro-bootloader
+ u-boot-a20-olinuxino-micro)
+
+(define-u-bootloader-allwinner u-boot-bananapi-m2-ultra-bootloader
+ u-boot-bananapi-m2-ultra)
+
+(define-u-bootloader-allwinner u-boot-cubietruck-bootloader u-boot-cubietruck)
+
+(define-u-bootloader-allwinner u-boot-pine64-lts-bootloader u-boot-pine64-lts)
\f
+;;;
+;;; Allwinner64 bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-allwinner64 def-name package)
+ (define-u-bootloader def-name package #f
+ ("u-boot-sunxi-with-spl.bin" #f (* 8 1024))
+ ("u-boot-sunxi-with-spl.fit.itb" #f (* 40 1024))))
+
+
+(define-u-bootloader-allwinner64 u-boot-pine64-plus-bootloader
+ u-boot-pine64-plus)
+
+(define-u-bootloader-allwinner64 u-boot-pinebook-bootloader u-boot-pinebook)
+\f
;;;
-;;; Bootloader definitions.
+;;; IMX bootloader definitions.
;;;
+(define-syntax-rule (define-u-bootloader-imx def-name package)
+ (define-u-bootloader def-name package #f
+ ("SPL" #f (* 8 1024))
+ ("u-boot.img" #f (* 40 1024))))
-(define u-boot-bootloader
- (bootloader
- (inherit extlinux-bootloader)
- (name 'u-boot)
- (package #f)
- (installer #f)
- (disk-image-installer install-u-boot)))
-
-(define u-boot-beaglebone-black-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-am335x-boneblack)
- (disk-image-installer install-beaglebone-black-u-boot)))
-
-(define u-boot-allwinner-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner-u-boot)))
-
-(define u-boot-allwinner64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-allwinner64-u-boot)))
-
-(define u-boot-imx-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (disk-image-installer install-imx-u-boot)))
-
-(define u-boot-nintendo-nes-classic-edition-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-nintendo-nes-classic-edition)))
-
-(define u-boot-a20-olinuxino-lime-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime)))
-
-(define u-boot-a20-olinuxino-lime2-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-lime2)))
-
-(define u-boot-a20-olinuxino-micro-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-a20-olinuxino-micro)))
-
-(define u-boot-bananapi-m2-ultra-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-bananapi-m2-ultra)))
-
-(define u-boot-cubietruck-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-cubietruck)))
-
-(define u-boot-firefly-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-firefly-rk3399)
- (disk-image-installer install-firefly-rk3399-u-boot)))
-
-(define u-boot-mx6cuboxi-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-mx6cuboxi)))
-
-(define u-boot-wandboard-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-wandboard)))
-
-(define u-boot-novena-bootloader
- (bootloader
- (inherit u-boot-imx-bootloader)
- (package u-boot-novena)))
-
-(define u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-orangepi-r1-plus-lts-rk3328)
- (disk-image-installer install-orangepi-r1-plus-lts-rk3328-u-boot)))
-
-(define u-boot-pine64-plus-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pine64-plus)))
-
-(define u-boot-pine64-lts-bootloader
- (bootloader
- (inherit u-boot-allwinner-bootloader)
- (package u-boot-pine64-lts)))
-
-(define u-boot-pinebook-bootloader
- (bootloader
- (inherit u-boot-allwinner64-bootloader)
- (package u-boot-pinebook)))
-
-(define u-boot-puma-rk3399-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-puma-rk3399)
- (disk-image-installer install-puma-rk3399-u-boot)))
-
-(define u-boot-rock64-rk3328-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rock64-rk3328)
- (disk-image-installer install-rock64-rk3328-u-boot)))
-(define u-boot-rockpro64-rk3399-bootloader
- ;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-rockpro64-rk3399)
- (disk-image-installer install-rockpro64-rk3399-u-boot)))
+(define-u-bootloader-imx u-boot-mx6cuboxi-bootloader u-boot-mx6cuboxi)
+
+(define-u-bootloader-imx u-boot-wandboard-bootloader u-boot-wandboard)
-(define u-boot-pinebook-pro-rk3399-bootloader
+(define-u-bootloader-imx u-boot-novena-bootloader u-boot-novena)
+
+\f
+;;;
+;;; Rockchip bootloader definitions.
+;;;
+(define-syntax-rule (define-u-bootloader-rockchip def-name package)
;; SD and eMMC use the same format
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-pinebook-pro-rk3399)
- (disk-image-installer install-pinebook-pro-rk3399-u-boot)))
-
-(define u-boot-ts7970-q-2g-1000mhz-c-bootloader
- ;; This bootloader doesn't really need to be installed, as it is read from
- ;; an SPI memory chip, not the SD card. It is copied to /boot/u-boot.imx
- ;; for convenience and should be manually flashed at the U-Boot prompt.
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-ts7970-q-2g-1000mhz-c)
- (installer install-u-boot-ts7970-q-2g-1000mhz-c-u-boot)
- (disk-image-installer #f)))
-
-(define u-boot-sifive-unmatched-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-sifive-unmatched)
- (disk-image-installer install-sifive-unmatched-u-boot)))
-
-(define u-boot-starfive-visionfive2-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-starfive-visionfive2)
- (installer install-starfive-visionfive2-uEnv.txt)
- (disk-image-installer install-starfive-visionfive2-u-boot)))
-
-(define u-boot-qemu-riscv64-bootloader
- (bootloader
- (inherit u-boot-bootloader)
- (package u-boot-qemu-riscv64)
- (installer install-qemu-riscv64-u-boot)
- (disk-image-installer #f)))
+ (define-u-bootloader def-name package #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 16384 512))))
+
+(define-u-bootloader-rockchip u-boot-firefly-rk3399-bootloader
+ u-boot-firefly-rk3399)
+
+(define-u-bootloader-rockchip u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+ u-boot-orangepi-r1-plus-lts-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rock64-rk3328-bootloader
+ u-boot-rock64-rk3328)
+
+(define-u-bootloader-rockchip u-boot-rockpro64-rk3399-bootloader
+ u-boot-rockpro64-rk3399)
+
+(define-u-bootloader-rockchip u-boot-pinebook-pro-rk3399-bootloader
+ u-boot-pinebook-pro-rk3399)
+
+(define-u-bootloader u-boot-puma-rk3399-bootloader u-boot-puma-rk3399 #f
+ ("idbloader.img" #f (* 64 512))
+ ("u-boot.itb" #f (* 512 512)))
+
+\f
+;;;
+;;; Copy-only bootloader definitions.
+;;;
+
+;; These bootloaders don't really need to be installed, as they are read from
+;; an SPI memory chip or directly from the FS, not the disk.
+(define-syntax-rule (define-u-bootloader-copy def-name package file)
+ (define-u-bootloader def-name package
+ #~(install-file #$(file-append package "/libexec/" file) path)))
+
+;; user should manually install this to SPI flash
+;; TODO: write directly to SPI flash? unless wear issues are a problem.
+(define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
+ u-boot-ts7970-q-2g-1000mhz-c "u-boot.imx")
+
+(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
+ u-boot-qemu-riscv64 "u-boot.bin")
diff --git a/gnu/build/bootloader.scm b/gnu/build/bootloader.scm
index af6063a884..b59287d759 100644
--- a/gnu/build/bootloader.scm
+++ b/gnu/build/bootloader.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2022 Timothy Sample <samplet@ngyro.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,20 +21,45 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build bootloader)
+ #:autoload (guix build syscalls) (free-disk-space)
#:use-module (guix build utils)
- #:use-module (guix utils)
- #:use-module (ice-9 binary-ports)
+ #: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)
- #:export (write-file-on-device
- install-efi-loader))
+ #: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))
\f
;;;
;;; 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 block ...)
+ "Run blocks... while chdir'd into a temporary directory."
+ ;; mkdtemp under POSIX.1-2008 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 () block ...)
+ (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
@@ -56,57 +82,78 @@ (define (write-file-on-device file size device offset)
;;; EFI bootloader.
;;;
-(define* (install-efi grub grub-config esp #:key targets)
- "Write a self-contained GRUB EFI loader to the mounted ESP using
-GRUB-CONFIG.
-
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let* ((system %host-type)
- ;; Hard code the output location to a well-known path recognized by
- ;; compliant firmware. See "3.5.1.1 Removable Media Boot Behaviour":
- ;; http://www.uefi.org/sites/default/files/resources/UEFI%20Spec%202_6.pdf
- (grub-mkstandalone (string-append grub "/bin/grub-mkstandalone"))
- (efi-directory (string-append esp "/EFI/BOOT"))
- ;; Map grub target names to boot file names.
- (efi-targets (or targets
- (cond ((string-prefix? "x86_64" system)
- '("x86_64-efi" . "BOOTX64.EFI"))
- ((string-prefix? "i686" system)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((string-prefix? "armhf" system)
- '("arm-efi" . "BOOTARM.EFI"))
- ((string-prefix? "aarch64" system)
- '("arm64-efi" . "BOOTAA64.EFI"))))))
- ;; grub-mkstandalone requires a TMPDIR to prepare the firmware image.
- (setenv "TMPDIR" esp)
-
- (mkdir-p efi-directory)
- (invoke grub-mkstandalone "-O" (car efi-targets)
- "-o" (string-append efi-directory "/"
- (cdr efi-targets))
- ;; Graft the configuration file onto the image.
- (string-append "boot/grub/grub.cfg=" grub-config))))
+(define parse-bootnums
+ (make-regexp "^Boot([0-9a-fA-F]+).*[^A-Za-z]File\\(([^)]+)\\)$" regexp/newline))
-(define* (install-efi-loader grub-efi esp #:key targets)
- "Install in ESP directory the given GRUB-EFI bootloader. Configure it to
-load the Grub bootloader located in the 'Guix_image' root partition.
+;; 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))))
+ (unless (zero? status)
+ (raise-exception
+ (formatted-message (G_ "efibootmgr exited with error code ~a") status)))
+ (fold-matches parse-bootnums text '()
+ (lambda (match acc)
+ (let* ((path (match:substring match 2))
+ (bootnum (match:substring match 1)))
+ (cons (cons path bootnum) acc))))))
-If TARGETS is set, use its car as the GRUB image format and its cdr as
-the output filename. Otherwise, use defaults for the host platform."
- (let ((grub-config "grub.cfg"))
- (call-with-output-file grub-config
- (lambda (port)
- ;; Create a tiny configuration file telling the embedded grub where to
- ;; load the real thing. XXX This is quite fragile, and can prevent
- ;; the image from booting when there's more than one volume with this
- ;; label present. Reproducible almost-UUIDs could reduce the risk
- ;; (not eliminate it).
- (format port
- "insmod part_msdos~@
- insmod part_gpt~@
- search --set=root --label Guix_image~@
- configfile /boot/grub/grub.cfg~%")))
- (install-efi grub-efi grub-config esp #:targets targets)
- (delete-file grub-config)))
+(define (install-efi efibootmgr vendir loader* disk plan)
+ "See 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)))))
+ (builder name) ; build to a tmp file so we can check size
+ ;; 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))
+ ;; esp 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 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!~%")))
+ ;; boot order. recall efi-bootnums to get fresh list with new installs
+ ;; 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"
+ (let ((num (cute assoc-ref (efi-bootnums efibootmgr) <>))) ; cute is eager
+ (string-join (filter-map (compose num loaderof) plan-files) ",")))))
diff --git a/gnu/build/image.scm b/gnu/build/image.scm
index 49dc01c0d1..b1abc99bba 100644
--- a/gnu/build/image.scm
+++ b/gnu/build/image.scm
@@ -28,6 +28,7 @@ (define-module (gnu build image)
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
+ #:use-module (guix deprecation)
#:use-module (guix store database)
#:use-module (guix utils)
#:use-module (gnu build bootloader)
@@ -181,30 +182,13 @@ (define* (register-closure prefix closure
#:prefix prefix
#:registration-time %epoch)))))
-(define* (initialize-efi-partition root
- #:key
- grub-efi
- #:allow-other-keys)
- "Install in ROOT directory, an EFI loader using GRUB-EFI."
- (install-efi-loader grub-efi root))
-
-(define* (initialize-efi32-partition root
- #:key
- grub-efi32
- #:allow-other-keys)
- "Install in ROOT directory, an EFI 32bit loader using GRUB-EFI32."
- (install-efi-loader grub-efi32 root
- #:targets (cond ((target-x86?)
- '("i386-efi" . "BOOTIA32.EFI"))
- ((target-arm?)
- '("arm-efi" . "BOOTARM.EFI")))))
+(define (initialize-efi-partition root . rest)
+ (mkdir-p (string-append root "/EFI")))
+
+(define-deprecated/alias initialize-efi32-partition initialize-efi-partition)
(define* (initialize-root-partition root
#:key
- bootcfg
- bootcfg-location
- bootloader-package
- bootloader-installer
(copy-closures? #t)
(deduplicate? #t)
references-graphs
@@ -251,18 +235,10 @@ (define* (initialize-root-partition root
(unless copy-closures?
(delete-file root-store)
- (rename-file tmp-store root-store)))
-
- ;; There's no point installing a bootloader if we do not populate the store.
- (when copy-closures?
- (when bootloader-installer
- (display "installing bootloader...\n")
- (bootloader-installer bootloader-package #f root))
- (when bootcfg
- (install-boot-config bootcfg bootcfg-location root))))
+ (rename-file tmp-store root-store))))
(define* (make-iso9660-image xorriso grub-mkrescue-environment
- grub bootcfg system-directory root target
+ grub grub.dir system-directory root target
#:key (volume-id "Guix_image") (volume-uuid #f)
register-closures? (references-graphs '())
(compression? #t))
@@ -321,7 +297,7 @@ (define* (make-iso9660-image xorriso grub-mkrescue-environment
(apply invoke grub-mkrescue
(string-append "--xorriso=" grub-mkrescue-sed.sh)
"-o" target
- (string-append "boot/grub/grub.cfg=" bootcfg)
+ (string-append "boot/grub=" grub.dir)
root
"--"
;; Set all timestamps to 1.
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 0aa227b4d8..6b5435f13c 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -25,8 +25,7 @@ (define-module (gnu build install)
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
- #:export (install-boot-config
- evaluate-populate-directive
+ #:export (evaluate-populate-directive
populate-root-file-system
install-database-and-gc-roots
populate-single-profile-directory
@@ -42,19 +41,6 @@ (define-module (gnu build install)
;;;
;;; Code:
-(define (install-boot-config bootcfg bootcfg-location mount-point)
- "Atomically copy BOOTCFG into BOOTCFG-LOCATION on the MOUNT-POINT. Note
-that the caller must make sure that BOOTCFG is registered as a GC root so
-that the fonts, background images, etc. referred to by BOOTCFG are not GC'd."
- (let* ((target (string-append mount-point bootcfg-location))
- (pivot (string-append target ".new")))
- (mkdir-p (dirname target))
-
- ;; Copy BOOTCFG instead of just symlinking it, because symlinks won't
- ;; work when /boot is on a separate partition. Do that atomically.
- (copy-file bootcfg pivot)
- (rename-file pivot target)))
-
(define* (evaluate-populate-directive directive target
#:key
(default-gid 0)
diff --git a/gnu/image.scm b/gnu/image.scm
index 7fb06dec10..6a3251014f 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -35,6 +35,7 @@ (define-module (gnu image)
partition-label
partition-uuid
partition-flags
+ partition-target
partition-initializer
image
@@ -131,6 +132,8 @@ (define-record-type* <partition> partition make-partition
(flags partition-flags
(default '()) ;list of symbols
(sanitize validate-partition-flags))
+ (target partition-target ; bootloader target type: symbol | #f
+ (default #f))
(initializer partition-initializer
(default #false))) ;gexp | #false
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 51fa7cf9d9..83682ea539 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -1454,15 +1454,19 @@ (define (root-user-partition? partition)
(define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
- (let* ((root-partition (find root-user-partition?
- user-partitions))
+ (let* ((root-partition (find root-user-partition? user-partitions))
(root-partition-disk (user-partition-disk-file-name root-partition)))
`((bootloader-configuration
,@(if (efi-installation?)
`((bootloader grub-efi-bootloader)
- (targets (list ,(default-esp-mount-point))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path ,(default-esp-mount-point))))))
`((bootloader grub-bootloader)
- (targets (list ,root-partition-disk))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ ;; TODO: we should provide a uuid or label here
+ (device ,root-partition-disk))))))
;; XXX: Assume we defined the 'keyboard-layout' field of
;; <operating-system> right above.
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 8dd8c342a0..4a9d3faee1 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -505,18 +505,15 @@ (define (deploy-managed-host machine)
(machine-ssh-session machine)
(machine-become-command machine)))
- (mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-alternatives (machine->boot-alternatives machine)))
+ (mlet %store-monad ((_ (check-deployment-sanity machine)))
;; Make sure code that check %CURRENT-SYSTEM, such as
;; %BASE-INITRD-MODULES, gets to see the right value.
(parameterize ((%current-system system)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry
- (map boot-alternative-parameters boot-alternatives)))
- (bootloader-configuration (operating-system-bootloader os))
- (bootcfg (operating-system-bootcfg os menu-entries)))
+ (bootloader-config (operating-system-bootloader os))
+ (bootmeta (operating-system-bootmeta os)))
(define-syntax-rule (eval/error-handling condition handler ...)
;; Return a wrapper around EVAL such that HANDLER is evaluated if an
;; exception is raised.
@@ -548,13 +545,15 @@ (define (deploy-managed-host machine)
(inferior-exception-arguments
c)))
os)
- (install-bootloader (eval/error-handling c
- (raise (formatted-message
- (G_ "\
+ (mlet %store-monad
+ ((boot-alternatives (machine->boot-alternatives machine)))
+ (apply install-bootloader
+ (eval/error-handling c
+ (raise (formatted-message
+ (G_ "\
failed to install bootloader on '~a':~%~{~s ~}~%")
- host
- (inferior-exception-arguments c))))
- bootloader-configuration bootcfg)))))))))
+ host (inferior-exception-arguments c))))
+ bootloader-config boot-alternatives bootmeta))))))))))
\f
;;;
@@ -585,32 +584,28 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
- (_ -> (if (< (length boot-alternatives) 2)
- (raise roll-back-failure)))
- (chosen-alternative (second boot-alternatives))
- (parameters (boot-alternative-parameters chosen-alternative))
- (entries -> (list (boot-parameters->menu-entry parameters)))
- (locale -> (boot-parameters-locale parameters))
- (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
- (store-dir -> (boot-parameters-store-directory-prefix parameters))
- (old-entries -> (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (drop boot-alternatives 2))))
- (bootloader -> (operating-system-bootloader
- (machine-operating-system machine)))
- (bootcfg (lower-object
- ((bootloader-configuration-file-generator
- (bootloader-configuration-bootloader
- bootloader))
- bootloader entries
- #:locale locale
- #:store-crypto-devices crypto-dev
- #:store-directory-prefix store-dir
- #:old-entries old-entries)))
- (remote-result (machine-remote-eval machine remote-exp)))
- (when (eqv? 'error remote-result)
- (raise roll-back-failure))))
+ (mlet %store-monad ((boot-alternatives (machine->boot-alternatives machine)))
+ (when (< (length boot-alternatives) 2) (raise roll-back-failure))
+ (mlet* %store-monad ((remote-result (machine-remote-eval machine remote-exp)))
+ (mwhen (eqv? 'error remote-result)
+ (raise roll-back-failure)))
+
+ (mlet* %store-monad ((os -> (machine-operating-system machine))
+ (chosen -> (cadr boot-alternatives))
+ (alts -> (cons* chosen (car boot-alternatives)
+ (cddr boot-alternatives)))
+ (params -> (boot-alternative-parameters chosen))
+ (locale -> (boot-parameters-locale chosen))
+ (crypto-dev -> (boot-parameters-store-crypto-devices
+ chosen))
+ (store-pre -> (boot-parameters-store-directory-prefix
+ chosen)))
+ (install-bootloader (cute machine-remote-eval machine <>)
+ (operating-system-bootloader os)
+ alts
+ #:locale locale
+ #:store-crypto-devices crypto-dev
+ #:store-directory-prefix store-pre))))
\f
;;;
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 4072df50d7..12f918a123 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -498,92 +498,6 @@ (define-public grub-hybrid
basename))))
(scandir input-dir)))))))))))
-(define-public (make-grub-efi-netboot name subdir)
- "Make a grub-efi-netboot package named NAME, which will be able to boot over
-network via TFTP by accessing its files in the SUBDIR of a TFTP root directory.
-This package is also able to boot from local storage devices.
-
-A bootloader-installer basically needs to copy the package content into the
-bootloader-target directory, which will usually be the TFTP root, as
-'grub-mknetdir' will be invoked already during the package creation.
-
-Alternatively the bootloader-target directory can be a mounted EFI System
-Partition (ESP), or a similar partition with a FAT file system, for booting
-from local storage devices.
-
-The name of the GRUB EFI binary will conform to the UEFI specification for
-removable media. Depending on the system it will be e.g. bootx64.efi or
-bootaa64.efi below SUBDIR.
-
-The SUBDIR argument needs to be set to \"efi/boot\" to create a package which
-conforms to the UEFI specification for removable media.
-
-The SUBDIR argument defaults to \"efi/Guix\", as it is also the case for
-'grub-efi-bootloader'."
- (package
- (name name)
- (version (package-version grub-efi))
- ;; Source is not needed, but it cannot be omitted.
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (let* ((system (string-split (nix-system->gnu-triplet
- (or (%current-target-system)
- (%current-system)))
- #\-))
- (arch (first system))
- (boot-efi
- (match system
- ;; These are the supportend systems and the names defined by
- ;; the UEFI standard for removable media.
- (("i686" _ ...) "/bootia32.efi")
- (("x86_64" _ ...) "/bootx64.efi")
- (("arm" _ ...) "/bootarm.efi")
- (("aarch64" _ ...) "/bootaa64.efi")
- (("riscv" _ ...) "/bootriscv32.efi")
- (("riscv64" _ ...) "/bootriscv64.efi")
- ;; Other systems are not supported, although defined.
- ;; (("riscv128" _ ...) "/bootriscv128.efi")
- ;; (("ia64" _ ...) "/bootia64.efi")
- ((_ ...) #f)))
- (core-efi (string-append
- ;; This is the arch dependent file name of GRUB, e.g.
- ;; i368-efi/core.efi or arm64-efi/core.efi.
- (match arch
- ("i686" "i386")
- ("aarch64" "arm64")
- ("riscv" "riscv32")
- (_ arch))
- "-efi/core.efi")))
- (list
- #:modules '((guix build utils))
- #:builder
- #~(begin
- (use-modules (guix build utils))
- (let* ((bootloader #$(this-package-input "grub-efi"))
- (net-dir #$output)
- (sub-dir (string-append net-dir "/" #$subdir "/"))
- (boot-efi (string-append sub-dir #$boot-efi))
- (core-efi (string-append sub-dir #$core-efi)))
- ;; Install GRUB, which refers to the grub.cfg, with support for
- ;; encrypted partitions,
- (setenv "GRUB_ENABLE_CRYPTODISK" "y")
- (invoke/quiet (string-append bootloader "/bin/grub-mknetdir")
- (string-append "--net-directory=" net-dir)
- (string-append "--subdir=" #$subdir)
- ;; These modules must be pre-loaded to allow booting
- ;; from an ESP or a similar partition with a FAT
- ;; file system.
- (string-append "--modules=part_msdos part_gpt fat"))
- ;; Move GRUB's core.efi to the removable media name.
- (false-if-exception (delete-file boot-efi))
- (rename-file core-efi boot-efi))))))
- (inputs (list grub-efi))
- (synopsis (package-synopsis grub-efi))
- (description (package-description grub-efi))
- (home-page (package-home-page grub-efi))
- (license (package-license grub-efi))))
-
(define-public syslinux
(let ((commit "bb41e935cc83c6242de24d2271e067d76af3585c"))
(package
diff --git a/gnu/packages/raspberry-pi.scm b/gnu/packages/raspberry-pi.scm
index c4f03c3ed9..66f980dd79 100644
--- a/gnu/packages/raspberry-pi.scm
+++ b/gnu/packages/raspberry-pi.scm
@@ -19,8 +19,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages raspberry-pi)
- #:use-module (gnu bootloader)
- #:use-module (gnu bootloader grub)
#:use-module (gnu packages)
#:use-module (gnu packages admin)
#:use-module (gnu packages algebra)
@@ -328,22 +326,6 @@ (define (make-raspi-bcm28-dtbs linux)
(format #f "The device-tree files for Raspberry Pi models from ~a."
(package-name linux)))))
-(define-public grub-efi-bootloader-chain-raspi-64
- ;; A bootloader capable to boot a Raspberry Pi over network via TFTP or from
- ;; a local storage like a micro SD card. It neither installs firmware nor
- ;; device-tree files for the Raspberry Pi. It just assumes them to be
- ;; existing in boot/efi in the same way that some UEFI firmware with ACPI
- ;; data is usually assumed to be existing on PCs. It creates firmware
- ;; configuration files and a bootloader-chain with U-Boot to provide an EFI
- ;; API for the final GRUB bootloader. It also serves as a blue-print to
- ;; create an a custom bootloader-chain with firmware and device-tree
- ;; packages or files.
- (efi-bootloader-chain grub-efi-netboot-removable-bootloader
- #:packages (list u-boot-rpi-arm64-efi-bin)
- #:files (list %raspi-config-txt
- %raspi-bcm27-dtb-txt
- %raspi-u-boot-bootloader-txt)))
-
(define (make-raspi-defconfig arch defconfig sha256-as-base32)
"Make for the architecture ARCH a file-like object from the DEFCONFIG file
with the hash SHA256-AS-BASE32. This object can be used as the #:defconfig
diff --git a/gnu/system.scm b/gnu/system.scm
index 4a084b2ecf..a345b52d55 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -140,10 +140,11 @@ (define-module (gnu system)
operating-system-derivation
operating-system-profile
- operating-system-bootcfg
+ operating-system-bootmeta
operating-system-etc-directory
operating-system-locale-directory
operating-system-boot-script
+ operating-system-boot-parameters
operating-system-uuid
operating-system-with-gc-roots
@@ -171,6 +172,9 @@ (define-module (gnu system)
;;;
;;; Code:
+(define (convert-bootloader-field bootloader)
+ (if (list? bootloader) bootloader (list bootloader)))
+
(define-with-syntax-properties (warn-hosts-file-field-deprecation
(value properties))
(when value
@@ -193,7 +197,9 @@ (define-record-type* <operating-system> operating-system
(default %default-kernel-arguments)) ; list of gexps/strings
(hurd operating-system-hurd
(default #f)) ; package
- (bootloader operating-system-bootloader) ; <bootloader-configuration>
+ (bootloader operating-system-bootloader ; <bootloader-configuration>
+ (default '())
+ (sanitize convert-bootloader-field))
(label operating-system-label ; string
(thunked)
(default (operating-system-default-label this-operating-system)))
@@ -1208,30 +1214,17 @@ (define (operating-system-store-file-system os)
"Return the file system that contains the store of OS."
(store-file-system (operating-system-file-systems os)))
-(define* (operating-system-bootcfg os #:optional (old-entries '()))
- "Return the bootloader configuration file for OS. Use OLD-ENTRIES,
-a list of <menu-entry>, to populate the \"old entries\" menu."
+(define (operating-system-bootmeta os)
+ "Return operating system information to be passed to the bootloader
+installers."
(let* ((file-systems (operating-system-file-systems os))
+ (store-root (btrfs-store-subvolume-file-name file-systems))
(root-fs (operating-system-root-file-system os))
- (root-device (file-system-device root-fs))
(locale (operating-system-locale os))
- (crypto-devices (operating-system-bootloader-crypto-devices os))
- (params (operating-system-boot-parameters
- os root-device
- #:system-kernel-arguments? #t))
- (entry (boot-parameters->menu-entry params))
- (bootloader-conf (operating-system-bootloader os)))
-
- (define generate-config-file
- (bootloader-configuration-file-generator
- (bootloader-configuration-bootloader bootloader-conf)))
-
- (generate-config-file bootloader-conf (list entry)
- #:old-entries old-entries
- #:locale locale
- #:store-crypto-devices crypto-devices
- #:store-directory-prefix
- (btrfs-store-subvolume-file-name file-systems))))
+ (crypto-devices (operating-system-bootloader-crypto-devices os)))
+ (list #:store-crypto-devices crypto-devices
+ #:store-directory-prefix store-root
+ #:locale locale)))
(define (operating-system-multiboot-modules os)
(if (operating-system-hurd os) (hurd-multiboot-modules os) '()))
@@ -1295,9 +1288,9 @@ (define* (operating-system-boot-parameters os root-device
(file-systems (operating-system-file-systems os))
(crypto-devices (operating-system-bootloader-crypto-devices os))
(locale (operating-system-locale os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os)))
- (bootloader-name (bootloader-name bootloader))
+ (bootloader (map bootloader-configuration-bootloader
+ (operating-system-bootloader os)))
+ (bootloader-name (map bootloader-name bootloader))
(label (operating-system-label os))
(multiboot-modules (operating-system-multiboot-modules os)))
(boot-parameters
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 833caef496..2b5302ce5f 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -81,6 +81,7 @@ (define-module (gnu system boot)
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
+ boot-alternative->menu-entry
ensure-not-/dev
system-linux-image-file-name))
@@ -171,7 +172,8 @@ (define (read-boot-parameters port)
(bootloader-name
(match (assq 'bootloader-name rest)
- ((_ args) args)
+ ((_ (args ...)) args)
+ ((_ args) (list args))
(#f 'grub))) ; for compatibility reasons.
(bootloader-menu-entries
@@ -340,6 +342,7 @@ (define (boot-parameters->menu-entry conf)
(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)
@@ -353,6 +356,9 @@ (define (boot-parameters->menu-entry conf)
(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
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index b0c96c60f0..050f5b578b 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -6,6 +6,7 @@
;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,6 +24,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu system image)
+ #:use-module (guix deprecation)
#:use-module (guix diagnostics)
#:use-module (guix discovery)
#:use-module (guix gexp)
@@ -42,6 +44,7 @@ (define-module (gnu system image)
#:use-module (gnu services base)
#:use-module (gnu system)
#:use-module (gnu system accounts)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system linux-container)
#:use-module (gnu system uuid)
@@ -133,12 +136,10 @@ (define esp-partition
;; FAT-ness is based on file system size (16 in this case).
(file-system "vfat")
(flags '(esp))
- (initializer (gexp initialize-efi-partition))))
+ (target 'esp)
+ (initializer #~initialize-efi-partition)))
-(define esp32-partition
- (partition
- (inherit esp-partition)
- (initializer (gexp initialize-efi32-partition))))
+(define-deprecated/alias esp32-partition esp-partition)
(define root-partition
(partition
@@ -149,6 +150,7 @@ (define root-partition
;; with U-Boot.
(file-system-options (list "-O" "^metadata_csum,^64bit"))
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))
(define mbr-disk-image
@@ -173,11 +175,7 @@ (define efi-disk-image
(partition-table-type 'gpt)
(partitions (list esp-partition root-partition))))
-(define efi32-disk-image
- (image-without-os
- (format 'disk-image)
- (partition-table-type 'gpt)
- (partitions (list esp32-partition root-partition))))
+(define-deprecated/alias efi32-disk-image efi-disk-image)
(define iso9660-image
(image-without-os
@@ -238,10 +236,7 @@ (define efi-raw-image-type
(name 'efi-raw)
(constructor (cut image-with-os efi-disk-image <>))))
-(define efi32-raw-image-type
- (image-type
- (name 'efi32-raw)
- (constructor (cut image-with-os efi32-disk-image <>))))
+(define-deprecated/alias efi32-raw-image-type efi-raw-image-type)
(define qcow2-image-type
(image-type
@@ -350,10 +345,6 @@ (define (find-root-partition image)
(raise (formatted-message
(G_ "image lacks a partition with the 'boot' flag")))))
-(define (root-partition-index image)
- "Return the index of the root partition of the given IMAGE."
- (1+ (srfi-1:list-index root-partition? (image-partitions image))))
-
\f
;;
;; Disk image.
@@ -362,8 +353,8 @@ (define (root-partition-index image)
(define* (system-disk-image image
#:key
(name "disk-image")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '()))
"Return as a file-like object, the disk-image described by IMAGE. Said
@@ -380,6 +371,28 @@ (define* (system-disk-image image
(define genimage-name "image")
+ (define (targets current)
+ ;; provides list of target overrides for a given CURRENT partition, which
+ ;; may be #f for the full-disk targets.
+
+ ;; XXX: how we pass paths is v much a hack
+ (cons (bootloader-target
+ (type 'disk)
+ (device (and (not current) (string-append "images/" genimage-name)))
+ (expected? (->bool current)))
+ (map (lambda (partition)
+ (let ((current? (and current (eq? (partition-target partition)
+ (partition-target current)))))
+ (bootloader-target
+ (type (partition-target partition))
+ (expected? (not current?))
+ (path (and current? "tmp-root"))
+ (offset #f)
+ (file-system (partition-file-system partition))
+ (label (partition-label partition))
+ (uuid (partition-uuid partition)))))
+ (filter partition-target (image-partitions image)))))
+
(define (image->genimage-cfg image)
;; Return as a file-like object, the genimage configuration file
;; describing the given IMAGE.
@@ -460,7 +473,8 @@ (define* (system-disk-image image
(list dosfstools fakeroot mtools))
(else
'())))
- (image-root "tmp-root"))
+ (image-root (string-append (getcwd) "/tmp-root"))
+ (copy-closures? (not #$(image-shared-store? image))))
(sql-schema #$schema)
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
@@ -476,18 +490,13 @@ (define* (system-disk-image image
(initializer image-root
#:references-graphs '#$graph
#:deduplicate? #f
- #:copy-closures? (not
- #$(image-shared-store? image))
- #:system-directory #$os
- #:grub-efi #+grub-efi
- #:grub-efi32 #+grub-efi32
- #:bootloader-package
- #+(bootloader-package bootloader)
- #:bootloader-installer
- #+(bootloader-installer bootloader)
- #:bootcfg #$bootcfg
- #:bootcfg-location
- #$(bootloader-configuration-file bootloader))
+ #:copy-closures? copy-closures?
+ #:system-directory #$os)
+ ;; no point installing a bootloader if we don't populate store
+ (when copy-closures?
+ ;; root-offset isn't necessary - we override 'root
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets partition)))
(make-partition-image #$(partition->gexp partition)
#$output
image-root)))))
@@ -534,14 +543,6 @@ (define* (system-disk-image image
(image-partition-table-type image)))
(else "")))
- (when (and (memq (bootloader-name bootloader)
- '(grub-efi grub-efi32 grub-efi-removable-bootloader))
- (not
- (gpt-image? image)))
- (raise
- (formatted-message
- (G_ "EFI bootloader required with GPT partitioning"))))
-
(let* ((format (image-format image))
(image-type (format->image-type format))
(image-type-options (genimage-type-options image-type image))
@@ -552,13 +553,15 @@ (define* (system-disk-image image
(let ((format (@ (ice-9 format) format)))
(call-with-output-file #$output
(lambda (port)
- (format port
- "\
+ (format port "\
image ~a {
~/~a {~a}
~{~a~^~%~}
-}~%" #$genimage-name #$image-type #$image-type-options
- (list #$@partitions-config))))))))
+}~%"
+ #$genimage-name
+ #$image-type
+ #$image-type-options
+ (list #$@partitions-config))))))))
(computed-file "genimage.cfg" builder)))
(let* ((image-name (image-name image))
@@ -570,17 +573,13 @@ (define* (system-disk-image image
(builder
(with-imported-modules*
(let ((inputs '#+(list genimage coreutils findutils qemu-minimal))
- (bootloader-installer
- #+(bootloader-disk-image-installer bootloader))
(out-image (string-append "images/" #$genimage-name)))
(set-path-environment-variable "PATH" '("bin" "sbin") inputs)
(genimage #$(image->genimage-cfg image))
- ;; Install the bootloader directly on the disk-image.
- (when bootloader-installer
- (bootloader-installer
- #+(bootloader-package bootloader)
- #$(root-partition-index image)
- out-image))
+ ;; don't install bootloader unless installing store
+ (unless #$(image-shared-store? image)
+ #$(bootloader-configurations->gexp bootloader-config bootmeta
+ #:overrides (targets #f)))
(convert-disk-image out-image '#$format #$output)))))
(computed-file name builder
#:local-build? #f ;too I/O-intensive
@@ -600,8 +599,8 @@ (define (has-guix-service-type? os)
(define* (system-iso9660-image image
#:key
(name "image.iso")
- bootcfg
- bootloader
+ bootloader-config
+ bootmeta
register-closures?
(inputs '())
(grub-mkrescue-environment '()))
@@ -621,7 +620,6 @@ (define* (system-iso9660-image image
(uuid-bytevector (partition-uuid partition)))))
(let* ((os (image-operating-system image))
- (bootloader (bootloader-package bootloader))
(compression? (image-compression? image))
(substitutable? (image-substitutable? image))
(schema (local-file (search-path %load-path
@@ -629,6 +627,14 @@ (define* (system-iso9660-image image
(graph (match inputs
(((names . _) ...)
names)))
+ (config (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list (bootloader-target
+ (type 'root)
+ (path "tmp-root"))
+ (bootloader-target
+ (type 'install)
+ (path "boot/grub"))))))
(builder
(with-imported-modules*
(let* ((inputs '#$(list parted e2fsprogs dosfstools xorriso
@@ -649,10 +655,12 @@ (define* (system-iso9660-image image
#:references-graphs '#$graph
#:deduplicate? #f
#:system-directory #$os)
+
(make-iso9660-image #$xorriso
'#$grub-mkrescue-environment
- #$bootloader
- #$bootcfg
+ #$grub-hybrid
+ #$(apply grub.dir grub-hybrid
+ #:bootloader-config config bootmeta)
#$os
image-root
#$output
@@ -954,11 +962,7 @@ (define (operating-system-for-image image)
file-systems
#:volatile-root? volatile-root?
rest)))
- (bootloader (if (eq? format 'iso9660)
- (bootloader-configuration
- (inherit
- (operating-system-bootloader base-os))
- (bootloader grub-mkrescue-bootloader))
+ (bootloader (if (eq? format 'iso9660) '()
(operating-system-bootloader base-os)))
(file-systems (cons (file-system
(mount-point "/")
@@ -1007,17 +1011,28 @@ (define* (system-image image)
(image* (image-with-os* image os))
(image-format (image-format image))
(register-closures? (has-guix-service-type? os))
- (bootcfg (operating-system-bootcfg os))
- (bootloader (bootloader-configuration-bootloader
- (operating-system-bootloader os))))
+ ;; force removable - images don't have efivarfs
+ (bootloader-config (map (lambda (c) (bootloader-configuration
+ (inherit c)
+ (efi-removable? #t)))
+ (operating-system-bootloader os)))
+ (alt (boot-alternative
+ (generation 1)
+ (system-path "/var/guix/profiles/system-1-link")
+ (epoch 0)
+ (parameters (operating-system-boot-parameters os
+ (partition-uuid (find-root-partition image*))
+ #:system-kernel-arguments? #t))))
+ (bootmeta (cons* #:current-boot-alternative alt
+ #:old-boot-alternatives '()
+ (operating-system-bootmeta os))))
(cond
((memq image-format '(disk-image compressed-qcow2))
(system-disk-image image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))))
+ #:inputs `(("system" ,os))))
((memq image-format '(docker))
(system-docker-image image*))
((memq image-format '(tarball))
@@ -1027,11 +1042,10 @@ (define* (system-image image)
((memq image-format '(iso9660))
(system-iso9660-image
image*
- #:bootcfg bootcfg
- #:bootloader bootloader
+ #:bootloader-config bootloader-config
+ #:bootmeta bootmeta
#:register-closures? register-closures?
- #:inputs `(("system" ,os)
- ("bootcfg" ,bootcfg))
+ #:inputs `(("system" ,os))
;; Make sure to use a mode that does no imply
;; HFS+ tree creation that may fail with:
;;
diff --git a/gnu/system/images/hurd.scm b/gnu/system/images/hurd.scm
index 9b618f7dc6..8fb00a6903 100644
--- a/gnu/system/images/hurd.scm
+++ b/gnu/system/images/hurd.scm
@@ -41,9 +41,7 @@ (define-module (gnu system images hurd)
(define hurd-barebones-os
(operating-system
(inherit %hurd-default-operating-system)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/images/novena.scm b/gnu/system/images/novena.scm
index 810e2bed5f..a7a1f499dd 100644
--- a/gnu/system/images/novena.scm
+++ b/gnu/system/images/novena.scm
@@ -39,8 +39,7 @@ (define novena-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-novena-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-novena-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm-generic)
(kernel-arguments '("console=ttymxc1,115200"))
diff --git a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
index 6ec644f113..a3dae24377 100644
--- a/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
+++ b/gnu/system/images/orangepi-r1-plus-lts-rk3328.scm
@@ -39,8 +39,7 @@ (define orangepi-r1-plus-lts-rk3328-barebones-os
(timezone "Europe/Amsterdam")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-orangepi-r1-plus-lts-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pine64.scm b/gnu/system/images/pine64.scm
index 457ff4345f..b166838ddd 100644
--- a/gnu/system/images/pine64.scm
+++ b/gnu/system/images/pine64.scm
@@ -41,8 +41,7 @@ (define pine64-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pine64-lts-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pine64-lts-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/pinebook-pro.scm b/gnu/system/images/pinebook-pro.scm
index 3a0f3abf1f..b26adfb7b9 100644
--- a/gnu/system/images/pinebook-pro.scm
+++ b/gnu/system/images/pinebook-pro.scm
@@ -38,8 +38,7 @@ (define pinebook-pro-barebones-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-pinebook-pro-rk3399-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-pinebook-pro-rk3399-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/rock64.scm b/gnu/system/images/rock64.scm
index b3dcfc6193..0b243662d6 100644
--- a/gnu/system/images/rock64.scm
+++ b/gnu/system/images/rock64.scm
@@ -39,8 +39,7 @@ (define rock64-barebones-os
(timezone "Europe/Oslo")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-rock64-rk3328-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader u-boot-rock64-rk3328-bootloader)))
(initrd-modules '())
(kernel linux-libre-arm64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/unmatched.scm b/gnu/system/images/unmatched.scm
index d40a32f184..7eb147bbab 100644
--- a/gnu/system/images/unmatched.scm
+++ b/gnu/system/images/unmatched.scm
@@ -39,8 +39,7 @@ (define unmatched-barebones-os
(timezone "Asia/Jerusalem")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-sifive-unmatched-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader u-boot-sifive-unmatched-bootloader)))
(initrd-modules '())
(kernel linux-libre-riscv64-generic)
(file-systems (cons (file-system
diff --git a/gnu/system/images/visionfive2.scm b/gnu/system/images/visionfive2.scm
index 26f70afbc1..a1c0733692 100644
--- a/gnu/system/images/visionfive2.scm
+++ b/gnu/system/images/visionfive2.scm
@@ -62,8 +62,7 @@ (define visionfive2-barebones-os
(timezone "Etc/UTC")
(locale "en_US.utf8")
(bootloader (bootloader-configuration
- (bootloader u-boot-starfive-visionfive2-bootloader)
- (targets '("/dev/mmcblk0"))))
+ (bootloader u-boot-starfive-visionfive2-bootloader)))
(file-systems (cons (file-system
(device (file-system-label "Guix_image"))
(mount-point "/")
diff --git a/gnu/system/images/wsl2.scm b/gnu/system/images/wsl2.scm
index d9aaa1a271..1501cb9a90 100644
--- a/gnu/system/images/wsl2.scm
+++ b/gnu/system/images/wsl2.scm
@@ -127,16 +127,6 @@ (define dummy-package
(description #f)
(license (fsdg-compatible "dummy"))))
-(define dummy-bootloader
- (bootloader
- (name 'dummy-bootloader)
- (package dummy-package)
- (configuration-file "/dev/null")
- (configuration-file-generator
- (lambda (. _rest)
- (plain-file "dummy-bootloader" "")))
- (installer #~(const #t))))
-
(define dummy-kernel dummy-package)
(define (dummy-initrd . _rest)
@@ -146,9 +136,7 @@ (define-public wsl-os
(operating-system
(host-name "gnu")
(timezone "Etc/UTC")
- (bootloader
- (bootloader-configuration
- (bootloader dummy-bootloader)))
+ ;; no bootloader
(kernel dummy-kernel)
(initrd dummy-initrd)
(initrd-modules '())
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 0195a0804d..e76d12e95a 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -77,8 +77,7 @@ (define-module (gnu system install)
rock64-installation-os
rockpro64-installation-os
rk3399-puma-installation-os
- wandboard-installation-os
- os-with-u-boot))
+ wandboard-installation-os))
;;; Commentary:
;;;
@@ -503,9 +502,7 @@ (define installation-os
(timezone "Europe/Paris")
(locale "en_US.utf8")
(name-service-switch %mdns-host-lookup-nss)
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("/dev/sda"))))
+ (bootloader (bootloader-configuration (bootloader grub-bootloader)))
(label (string-append "GNU Guix installation "
(or (getenv "GUIX_DISPLAYED_VERSION")
(package-version guix))))
@@ -555,30 +552,14 @@ (define installation-os
%installer-disk-utilities
%base-packages))))
-(define* (os-with-u-boot os board #:key (bootloader-target "/dev/mmcblk0")
- (triplet "arm-linux-gnueabihf"))
- "Given OS, amend it with the u-boot bootloader for BOARD,
-installed to BOOTLOADER-TARGET (a drive), compiled for TRIPLET.
-
-If you want a serial console, make sure to specify one in your
-operating-system's kernel-arguments (\"console=ttyS0\" or similar)."
- (operating-system (inherit os)
- (bootloader (bootloader-configuration
- (bootloader (bootloader (inherit u-boot-bootloader)
- (package (make-u-boot-package board triplet))))
- (targets (list bootloader-target))))))
-
-(define* (embedded-installation-os bootloader bootloader-target tty
- #:key (extra-modules '()))
+(define* (embedded-installation-os bootloader tty #:key (extra-modules '()))
"Return an installation os for embedded systems.
The initrd gets the extra modules EXTRA-MODULES.
A getty is provided on TTY.
The bootloader BOOTLOADER is installed to BOOTLOADER-TARGET."
(operating-system
(inherit installation-os)
- (bootloader (bootloader-configuration
- (bootloader bootloader)
- (targets (list bootloader-target))))
+ (bootloader (bootloader-configuration (bootloader bootloader)))
(kernel linux-libre)
(kernel-arguments
(cons (string-append "console=" tty)
@@ -587,7 +568,6 @@ (define* (embedded-installation-os bootloader bootloader-target tty
(define beaglebone-black-installation-os
(embedded-installation-os u-boot-beaglebone-black-bootloader
- "/dev/sda"
"ttyO0"
#:extra-modules
;; This module is required to mount the sd card.
@@ -596,77 +576,62 @@ (define beaglebone-black-installation-os
(define a20-olinuxino-lime-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define a20-olinuxino-lime2-emmc-installation-os
(embedded-installation-os u-boot-a20-olinuxino-lime2-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define a20-olinuxino-micro-installation-os
(embedded-installation-os u-boot-a20-olinuxino-micro-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define bananapi-m2-ultra-installation-os
(embedded-installation-os u-boot-bananapi-m2-ultra-bootloader
- "/dev/mmcblk1" ; eMMC storage
"ttyS0"))
(define firefly-rk3399-installation-os
(embedded-installation-os u-boot-firefly-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define mx6cuboxi-installation-os
(embedded-installation-os u-boot-mx6cuboxi-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
(define novena-installation-os
(embedded-installation-os u-boot-novena-bootloader
- "/dev/mmcblk1" ; SD card storage
"ttymxc1"))
(define nintendo-nes-classic-edition-installation-os
(embedded-installation-os u-boot-nintendo-nes-classic-edition-bootloader
- "/dev/mmcblk0" ; SD card (solder it yourself)
"ttyS0"))
(define orangepi-r1-plus-lts-rk3328-installation-os
(embedded-installation-os u-boot-orangepi-r1-plus-lts-rk3328-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pine64-plus-installation-os
(embedded-installation-os u-boot-pine64-plus-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define pinebook-installation-os
(embedded-installation-os u-boot-pinebook-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define rock64-installation-os
(embedded-installation-os u-boot-rock64-rk3328-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rockpro64-installation-os
(embedded-installation-os u-boot-rockpro64-rk3399-bootloader
- "/dev/mmcblk0" ; SD card/eMMC (SD priority) storage
"ttyS2")) ; UART2 connected on the Pi2 bus
(define rk3399-puma-installation-os
(embedded-installation-os u-boot-puma-rk3399-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttyS0"))
(define wandboard-installation-os
(embedded-installation-os u-boot-wandboard-bootloader
- "/dev/mmcblk0" ; SD card storage
"ttymxc0"))
;; Return the default os here so 'guix system' can consume it directly.
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index a2743453e7..be12ae6b6c 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -172,17 +172,6 @@ (define* (virtualized-operating-system os
(operating-system
(inherit os)
- ;; XXX: Until we run QEMU with UEFI support (with the OVMF firmware),
- ;; force the traditional i386/BIOS method.
- ;; See <https://bugs.gnu.org/28768>.
- (bootloader (bootloader-configuration
- (inherit (operating-system-bootloader os))
- (bootloader
- (if (target-riscv64? (or target system))
- u-boot-qemu-riscv64-bootloader
- grub-bootloader))
- (targets '("/dev/vda"))))
-
(initrd (lambda (file-systems . rest)
(apply (operating-system-initrd os)
file-systems
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 36dbd9111f..18a2fc119b 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -140,7 +140,7 @@ (define-os-with-source (%minimal-extlinux-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
- (bootloader extlinux-bootloader-gpt)
+ (bootloader extlinux-gpt-bootloader)
(targets (list "/dev/vdb"))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1464,9 +1464,11 @@ (define-os-with-source (%btrfs-raid10-root-os
(host-name "hurd")
(timezone "Europe/Paris")
(locale "en_US.UTF-8")
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets (list "/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde"))))
+ (bootloader (map (lambda (targ)
+ (bootloader-configuration
+ (bootloader grub-bootloader)
+ (targets (list targ))))
+ '("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (uuid "16ff18e2-eb41-4324-8df5-80d3b53c411b"))
diff --git a/gnu/tests/reconfigure.scm b/gnu/tests/reconfigure.scm
index bcc7645fa3..8aa5311171 100644
--- a/gnu/tests/reconfigure.scm
+++ b/gnu/tests/reconfigure.scm
@@ -30,8 +30,7 @@ (define-module (gnu tests reconfigure)
#:use-module (guix scripts system reconfigure)
#:use-module (guix store)
#:export (%test-switch-to-system
- %test-upgrade-services
- %test-install-bootloader))
+ %test-upgrade-services))
;;; Commentary:
;;;
@@ -178,83 +177,6 @@ (define* (run-upgrade-services-test)
(disable (upgrade-services-program '() '() '(dummy) '())))
(test enable disable))))
-(define* (run-install-bootloader-test)
- "Run a test of an OS running INSTALL-BOOTLOADER-PROGRAM, which installs a
-bootloader's configuration file."
- (define os
- (marionette-operating-system
- (simple-operating-system)
- #:imported-modules '((gnu services herd)
- (guix combinators))))
-
- (define vm (virtual-machine
- (operating-system os)
- (volatile? #f)))
-
- (define (test script)
- (with-imported-modules '((gnu build marionette))
- #~(begin
- (use-modules (gnu build marionette)
- (ice-9 regex)
- (srfi srfi-1)
- (srfi srfi-64))
-
- (define marionette
- (make-marionette (list #$vm)))
-
- ;; Return the system generation paths that have GRUB menu entries.
- (define (generations-in-grub-cfg marionette)
- (let ((grub-cfg (marionette-eval
- '(begin
- (use-modules (rnrs io ports))
- (call-with-input-file "/boot/grub/grub.cfg"
- get-string-all))
- marionette)))
- (map (lambda (parameter)
- (second (string-split (match:substring parameter) #\=)))
- (list-matches "system=[^ ]*" grub-cfg))))
-
- (test-runner-current (system-test-runner #$output))
- (test-begin "install-bootloader")
-
- (test-assert "no prior menu entry for system generation"
- (not (member #$os (generations-in-grub-cfg marionette))))
-
- (test-assert "script successfully evaluated"
- (marionette-eval
- '(primitive-load #$script)
- marionette))
-
- (test-assert "menu entry created for system generation"
- (member #$os (generations-in-grub-cfg marionette)))
-
- (test-end))))
-
- (let* ((bootloader ((compose bootloader-configuration-bootloader
- operating-system-bootloader)
- os))
- ;; The typical use-case for 'install-bootloader-program' is to read
- ;; the boot parameters for the existing menu entries on the system,
- ;; parse them with 'boot-parameters->menu-entry', and pass the
- ;; results to 'operating-system-bootcfg'. However, to obtain boot
- ;; parameters, we would need to start the marionette, which we should
- ;; ideally avoid doing outside of the 'test' G-Expression. Thus, we
- ;; generate a bootloader configuration for the script as if there
- ;; were no existing menu entries. In the grand scheme of things, this
- ;; matters little -- these tests should not make assertions about the
- ;; behavior of 'operating-system-bootcfg'.
- (bootcfg (operating-system-bootcfg os '()))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (gexp->derivation
- "install-bootloader"
- ;; Due to the read-only nature of the virtual machines used in the system
- ;; test suite, the bootloader installer script is omitted. 'grub-install'
- ;; would attempt to write directly to the virtual disk if the
- ;; installation script were run.
- (test
- (install-bootloader-program #f #f #f bootcfg bootcfg-file '(#f) "/")))))
-
-
(define %test-switch-to-system
(system-test
(name "switch-to-system")
@@ -267,9 +189,3 @@ (define %test-upgrade-services
(description "Upgrade the Shepherd by unloading obsolete services and
loading new services.")
(value (run-upgrade-services-test))))
-
-(define %test-install-bootloader
- (system-test
- (name "install-bootloader")
- (description "Install a bootloader and its configuration file.")
- (value (run-install-bootloader-test))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 344bb74151..aba637f6e3 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -209,7 +209,7 @@ (define* (copy-closure item target
(define* (install os-drv target
#:key (log-port (current-output-port))
- install-bootloader? bootloader bootcfg)
+ install-bootloader? bootloaders bootmeta)
"Copy the closure of BOOTCFG, which includes the output of OS-DRV, to
directory TARGET. TARGET must be an absolute directory name since that's what
'register-path' expects.
@@ -247,24 +247,27 @@ (define* (install os-drv target
(chmod target #o755)
(let ((os-dir (derivation->output-path os-drv))
(format (lift format %store-monad))
- (populate (lift2 populate-root-file-system %store-monad)))
-
- (mlet %store-monad ((bootcfg (lower-object bootcfg)))
- (mbegin %store-monad
- ;; Copy the closure of BOOTCFG, which includes OS-DIR,
- ;; eventual background image and so on.
- (maybe-copy (derivation->output-path bootcfg))
-
- ;; Create a bunch of additional files.
- (format log-port "populating '~a'...~%" target)
- (populate os-dir target)
-
+ (populate (lift2 populate-root-file-system %store-monad))
+ (profile (string-append target "/var/guix/profiles/system")))
+
+ (mbegin %store-monad
+ ;; Create a bunch of system files.
+ (format log-port "populating '~a'...~%" target)
+ (populate os-dir target)
+
+ ;; Copy the bootloader's closure, which includes OS-DIR,
+ ;; eventual background image and so on.
+ (mlet* %store-monad
+ ((alt -> (generation->boot-alternative profile 1))
+ (inst (apply install-bootloader local-eval bootloaders
+ (list alt) #:dry-run (not install-bootloader?)
+ #:root-offset target bootmeta)))
+ (maybe-copy (derivation->output-path inst)))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target target)
(return
(info (G_ "bootloader successfully installed on~{ ~a~}~%")
- (bootloader-configuration-targets bootloader))))))))
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))))
\f
;;;
@@ -389,20 +392,13 @@ (define (install-bootloader-from-provenance store number)
(let* ((generation (generation-file-name %system-profile number))
(os (receive (_ os) (system-provenance generation)
(and=> os read-operating-system)))
- (bootloader-config (operating-system-bootloader os))
- (bootloader (bootloader-configuration-bootloader bootloader-config))
+ (new (generation->boot-alternative %system-profile number))
(numbers (delv number (reverse (generation-numbers %system-profile))))
(old (profile->boot-alternatives %system-profile numbers)))
(if os
(run-with-store store
- (mlet* %store-monad
- ((bootcfg (lower-object (operating-system-bootcfg os old)))
- (drvs -> (list bootcfg)))
- (mbegin %store-monad
- (built-derivations drvs)
- ;; Only install bootloader configuration file.
- (install-bootloader local-eval bootloader-config bootcfg
- #:run-installer? #f))))
+ (apply install-bootloader local-eval (operating-system-bootloader os)
+ (cons new old) (operating-system-bootmeta os)))
(leave (G_ "cannot rollback to provenanceless generation '~a'~%")
number))))
@@ -489,7 +485,8 @@ (define* (display-system-generation number
(format #t (G_ " canonical file name: ~a~%") (readlink* generation))
;; TRANSLATORS: Please preserve the two-space indentation.
(format #t (G_ " label: ~a~%") label)
- (format #t (G_ " bootloader: ~a~%") bootloader-name)
+ (format #t (G_ " bootloader: ~a~%")
+ (string-join (map symbol->string bootloader-name)))
;; TRANSLATORS: The '~[', '~;', and '~]' sequences in this string must
;; be preserved. They denote conditionals, such that the result will
@@ -775,18 +772,11 @@ (define* (perform-action action image
(define os
(image-operating-system image))
- (define bootloader
+ (define bootloaders
(operating-system-bootloader os))
- (define bootcfg
- (and (memq action '(init reconfigure))
- (operating-system-bootcfg
- os
- (if (eq? action 'init)
- '()
- (map boot-parameters->menu-entry
- (map boot-alternative-parameters
- (profile->boot-alternatives)))))))
+ (define bootmeta
+ (operating-system-bootmeta os))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
@@ -817,10 +807,7 @@ (define* (perform-action action image
;; For 'init' and 'reconfigure', always build BOOTCFG, even if
;; --no-bootloader is passed, because we then use it as a GC root.
;; See <http://bugs.gnu.org/21068>.
- (drvs (mapm/accumulate-builds lower-object
- (if (memq action '(init reconfigure))
- (list sys bootcfg)
- (list sys))))
+ (drvs (mapm/accumulate-builds lower-object (list sys)))
(% (if derivations-only?
(return (for-each (compose println derivation-file-name)
drvs))
@@ -838,12 +825,16 @@ (define* (perform-action action image
(format #t (G_ "activating system...~%"))
(mbegin %store-monad
(switch-to-system local-eval os)
+ (apply install-bootloader local-eval bootloaders
+ (profile->boot-alternatives)
+ #:dry-run? (not install-bootloader?)
+ (if target (cons* #:root-offset target bootmeta) bootmeta))
(mwhen install-bootloader?
- (install-bootloader local-eval bootloader bootcfg
- #:target (or target "/"))
(return
(info (G_ "bootloader successfully installed on '~a'~%")
- (bootloader-configuration-targets bootloader))))
+ (map bootloader-target-path
+ (fold append '()
+ (map bootloader-configuration-targets bootloaders))))))
(with-shepherd-error-handling
(upgrade-shepherd-services local-eval os)
(return (format #t (G_ "\
@@ -857,8 +848,8 @@ (define* (perform-action action image
target)
(install sys (canonicalize-path target)
#:install-bootloader? install-bootloader?
- #:bootloader bootloader
- #:bootcfg bootcfg))
+ #:bootloaders bootloaders
+ #:bootmeta bootmeta))
(else
;; All we had to do was to build SYS and maybe register an
;; indirect GC root.
@@ -1254,11 +1245,7 @@ (define (process-action action args opts)
(G_ "image lacks an operating-system")))))
(target-file (match args
((first second) second)
- (_ #f)))
- (bootloader-targets
- (and bootloader?
- (bootloader-configuration-targets
- (operating-system-bootloader os)))))
+ (_ #f))))
(define (graph-backend)
(lookup-backend (assoc-ref opts 'graph-backend)))
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 604ba08fee..8add639e6a 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -7,6 +7,7 @@
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
;;; Copyright © 2022 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -209,101 +210,83 @@ (define* (upgrade-shepherd-services eval os)
;;; Bootloader configuration.
;;;
-(define (install-bootloader-program installer disk-installer
- bootloader-package bootcfg
- bootcfg-file devices target)
+(define (install-bootloader-program configs offset chosen-alt old-alts locale
+ store-crypto-devices store-directory-prefix)
"Return an executable store item that, upon being evaluated, will install
BOOTCFG to BOOTCFG-FILE, a target file name, on DEVICES, a list of file system
devices, at TARGET, a mount point, and subsequently run INSTALLER from
BOOTLOADER-PACKAGE."
(program-file
- "install-bootloader.scm"
- (with-extensions (list guile-gcrypt)
- (with-imported-modules `(,@(source-module-closure
- '((gnu build bootloader)
- (gnu build install)
- (guix store)
- (guix utils))
- #:select? not-config?)
- ((guix config) => ,(make-config.scm)))
- #~(begin
- (use-modules (gnu build bootloader)
- (gnu build install)
- (guix build utils)
- (guix store)
- (guix utils)
- (ice-9 binary-ports)
- (ice-9 match)
- (srfi srfi-34)
- (srfi srfi-35))
-
- (let* ((gc-root (string-append #$target %gc-roots-directory "/bootcfg"))
- (new-gc-root (string-append gc-root ".new")))
- ;; #$bootcfg has dependencies.
- ;; The bootloader magically loads the configuration from
- ;; (string-append #$target #$bootcfg-file) (for example
- ;; "/boot/grub/grub.cfg").
- ;; If we didn't do something special, the garbage collector
- ;; would remove the dependencies of #$bootcfg.
- ;; Register #$bootcfg as a GC root.
- ;; Preserve the previous activation's garbage collector root
- ;; until the bootloader installer has run, so that a failure in
- ;; the bootloader's installer script doesn't leave the user with
- ;; a broken installation.
- (switch-symlinks new-gc-root #$bootcfg)
- (install-boot-config #$bootcfg #$bootcfg-file #$target)
- (when (or #$installer #$disk-installer)
- (catch #t
- (lambda ()
- ;; The bootloader might not support installation on a
- ;; mounted directory using the BOOTLOADER-INSTALLER
- ;; procedure. In that case, fallback to installing the
- ;; bootloader directly on DEVICES using the
- ;; BOOTLOADER-DISK-IMAGE-INSTALLER procedure.
- (if #$installer
- (for-each (lambda (device)
- (#$installer #$bootloader-package device
- #$target))
- '#$devices)
- (for-each (lambda (device)
- (#$disk-installer #$bootloader-package
- 0 device))
- '#$devices)))
- (lambda args
- (delete-file new-gc-root)
- (match args
- (('%exception exception) ;Guile 3 SRFI-34 or similar
- (raise-exception exception))
- ((key . args)
- (apply throw key args))))))
- ;; We are sure that the installation of the bootloader
- ;; succeeded, so we can replace the old GC root by the new
- ;; GC root now.
- (rename-file new-gc-root gc-root)))))))
+ "install-bootloader.scm"
+ ;; three sources of boot entries: bootloader-configuration-menu-entries,
+ ;; current-boot-alternative, and old-boot-alternatives.
+ (let ((args (list #:current-boot-alternative chosen-alt
+ #:old-boot-alternatives old-alts
+ #:locale locale
+ #:store-directory-prefix store-directory-prefix
+ #:store-crypto-devices store-crypto-devices)))
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules
+ `(,@(source-module-closure '((gnu build bootloader)
+ (gnu build install)
+ (guix store)
+ (guix utils))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (gnu build bootloader)
+ (gnu build install)
+ (guix build utils)
+ (guix store)
+ (guix utils)
+ (ice-9 binary-ports)
+ (ice-9 match)
+ (srfi srfi-34)
+ (srfi srfi-35))
+ ;; bootloader-installer is passed an additional #:target argument
+ ;; denoting the specific target currently being installed to.
+ ;; bootloaders should determine when to fully reinstall themselves.
+ #$(bootloader-configurations->gexp configs args
+ #:root-offset offset)))))))
-(define* (install-bootloader eval configuration bootcfg
- #:key
- (run-installer? #t)
- (target "/"))
+(define* (install-bootloader eval configs alts #:key locale
+ store-crypto-devices store-directory-prefix
+ (root-offset "/") (dry-run? #f))
"Using EVAL, a monadic procedure taking a single G-Expression as an argument,
-configure the bootloader on TARGET such that OS will be booted by default and
-additional configurations specified by MENU-ENTRIES can be selected."
- (let* ((bootloader (bootloader-configuration-bootloader configuration))
- (installer (and run-installer?
- (bootloader-installer bootloader)))
- (disk-installer (and run-installer?
- (bootloader-disk-image-installer bootloader)))
- (package (bootloader-package bootloader))
- (devices (bootloader-configuration-targets configuration))
- (bootcfg-file (bootloader-configuration-file bootloader)))
- (eval #~(parameterize ((current-warning-port (%make-void-port "w")))
- (primitive-load #$(install-bootloader-program installer
- disk-installer
- package
- bootcfg
- bootcfg-file
- devices
- target))))))
+configure the bootloader with bootloader-configuration CONFIG such that
+ALTS may be selected, with the first element being the default. If QUICK? only
+the bootloader config is reinstalled. Returns the config installer drv."
+ (mlet* %store-monad
+ ((program (lower-object
+ (install-bootloader-program configs root-offset
+ (car alts) (cdr alts) locale
+ store-crypto-devices store-directory-prefix))))
+ (mbegin %store-monad
+ (eval
+ (with-imported-modules `(,@(source-module-closure '((guix build utils)
+ (guix store))
+ #:select? not-config?)
+ ((guix config) => ,(make-config.scm)))
+ #~(begin
+ (use-modules (guix build utils) (guix store))
+ (parameterize ((current-warning-port (%make-void-port "w")))
+ (let* ((gc-root (string-append
+ #$root-offset %gc-roots-directory "/bootcfg"))
+ (new-gc-root (string-append gc-root ".new")))
+ ;; since the installers are gexps directly included, we add
+ ;; the installer runner as a gc root. this should make sure
+ ;; no bootloader files get gc'd. only remove the old one on
+ ;; success.
+ ;; XXX: is this still necessary?
+ (switch-symlinks new-gc-root #$program)
+ (dynamic-wind (const #t)
+ (lambda ()
+ (unless #$dry-run? (primitive-load #$program))
+ (rename-file new-gc-root gc-root))
+ (lambda () ; delete new root if failed
+ (when (file-exists? new-gc-root)
+ (delete-file new-gc-root)))))))))
+ (return program))))
\f
;;;
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 05/15] gnu: system: Remove useless boot parameters.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (3 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 04/15] gnu: Core bootloader changes Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
` (11 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
* gnu/system.scm (operating-system-boot-parameters,
operating-system-boot-parameters-file): Delete
bootloader-menu-entries.
* gnu/system/boot.scm (boot-parameters)[bootloader-menu-entries]: Delete
fields.
(read-boot-parameters): Don't read bootloader-menu-entries.
* tests/boot-parameters.scm (%grub-boot-parameters,
test-read-boot-parameters, test-read-boot-parameters): Don't include
bootloader-menu-entries.
("read, bootloader-menu-entries, default value"): Delete test.
Change-Id: I46d9cff4604dbfcf654b0820fdb77e72aecffbb4
---
gnu/system.scm | 7 -------
gnu/system/boot.scm | 8 --------
tests/boot-parameters.scm | 14 ++------------
3 files changed, 2 insertions(+), 27 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index a345b52d55..66c1a80733 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -1304,8 +1304,6 @@ (define* (operating-system-boot-parameters os root-device
(initrd initrd)
(multiboot-modules multiboot-modules)
(bootloader-name bootloader-name)
- (bootloader-menu-entries
- (bootloader-configuration-menu-entries (operating-system-bootloader os)))
(locale locale)
(store-device (ensure-not-/dev (file-system-device store)))
(store-directory-prefix (btrfs-store-subvolume-file-name file-systems))
@@ -1347,11 +1345,6 @@ (define* (operating-system-boot-parameters-file os)
#$(boot-parameters-multiboot-modules params)))
#~())
(bootloader-name #$(boot-parameters-bootloader-name params))
- (bootloader-menu-entries
- #$(map menu-entry->sexp
- (or (and=> (operating-system-bootloader os)
- bootloader-configuration-menu-entries)
- '())))
(locale #$(boot-parameters-locale params))
(store
(device
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 2b5302ce5f..4d89827ced 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -54,7 +54,6 @@ (define-module (gnu system boot)
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
@@ -113,8 +112,6 @@ (define-record-type* <boot-parameters>
;; 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)
@@ -176,11 +173,6 @@ (define (read-boot-parameters port)
((_ args) (list 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))
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 2e7976aa6c..f214de360d 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -64,7 +64,6 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
@@ -107,7 +106,6 @@ (define* (test-read-boot-parameters
#:key
(version %boot-parameters-version)
(bootloader-name 'grub)
- (bootloader-menu-entries '())
(label %default-label)
(root-device (quote-uuid %default-root-device))
(kernel %default-kernel)
@@ -127,7 +125,7 @@ (define* (test-read-boot-parameters
(cond ((eq? 'false val) (format #false fmt #false))
(val (format #false fmt val))
(else "")))
- (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a~a)"
+ (format #false "(boot-parameters~a~a~a~a~a~a~a~a~a)"
(sexp-or-nothing " (version ~S)" version)
(sexp-or-nothing " (label ~S)" label)
(sexp-or-nothing " (root-device ~S)" root-device)
@@ -145,9 +143,7 @@ (define* (test-read-boot-parameters
store-crypto-devices))
"")
(sexp-or-nothing " (locale ~S)" locale)
- (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)
- (sexp-or-nothing " (bootloader-menu-entries ~S)"
- bootloader-menu-entries)))
+ (sexp-or-nothing " (bootloader-name ~a)" bootloader-name)))
(let ((str (generate-boot-parameters)))
(call-with-input-string str read-boot-parameters)))
@@ -170,7 +166,6 @@ (define* (test-read-boot-parameters
(test-assert "read, construction, optional fields"
(and (test-read-boot-parameters #:bootloader-name #false)
- (test-read-boot-parameters #:bootloader-menu-entries #false)
(test-read-boot-parameters #:kernel-arguments #false)
(test-read-boot-parameters #:with-store #false)
(test-read-boot-parameters #:store-device #false)
@@ -223,11 +218,6 @@ (define* (test-read-boot-parameters
(boot-parameters-bootloader-name
(test-read-boot-parameters #:bootloader-name #false)))
-(test-eq "read, bootloader-menu-entries, default value"
- '()
- (boot-parameters-bootloader-menu-entries
- (test-read-boot-parameters #:bootloader-menu-entries #false)))
-
(test-eq "read, kernel-arguments, default value"
'()
(boot-parameters-kernel-arguments
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 06/15] gnu: bootloader: Add raspberry pi bootloader.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (4 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 05/15] gnu: system: Remove useless boot parameters Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
` (10 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Efraim Flashner,
Lilah Tascheter, Vagrant Cascadian
Less adding and more making it an actual bootloader rather than some
weirdly specified packages.
* gnu/bootloader/u-boot.scm (rpi-config, install-rpi): New procedures.
(define-u-bootloader-rpi): New macro.
(u-boot-rpi-2-bootloader, u-boot-rpi-3-bootloader,
u-boot-rpi-4-bootloader, u-boot-rpi-bootloader): New variables.
* gnu/packages/bootloaders.scm (make-u-boot-bin-package): Delete
procedure.
(%u-boot-rpi-efi-description, %u-boot-rpi-efi-description-32-bit,
u-boot-rpi-2-efi, u-boot-rpi-3-32b-efi, u-boot-rpi-4-32b-efi,
u-boot-rpi-arm64-efi, u-boot-rpi-2-bin, u-boot-rpi-3_32b-bin,
u-boot-rpi-4_32b-bin, u-boot-rpi-arm64-bin, u-boot-rpi-2-efi-bin,
u-boot-rpi-3-32b-efi-bin, u-boot-rpi-4-32b-efi-bin,
u-boot-rpi-arm64-efi-bin): Delete variables.
Change-Id: I5139a0b00ec89189e8e7c84e06a7a3b7240259cd
---
gnu/bootloader/u-boot.scm | 66 ++++++++++++++++++++++++-
gnu/packages/bootloaders.scm | 94 +++---------------------------------
2 files changed, 71 insertions(+), 89 deletions(-)
diff --git a/gnu/bootloader/u-boot.scm b/gnu/bootloader/u-boot.scm
index 7d3e202f8c..e8dfe9b3a2 100644
--- a/gnu/bootloader/u-boot.scm
+++ b/gnu/bootloader/u-boot.scm
@@ -28,7 +28,10 @@ (define-module (gnu bootloader u-boot)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader extlinux)
#:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages raspberry-pi)
+ #:use-module (gnu system boot)
#:use-module (guix gexp)
+ #:use-module (guix utils)
#:export (u-boot-a20-olinuxino-lime-bootloader
u-boot-a20-olinuxino-lime2-bootloader
u-boot-a20-olinuxino-micro-bootloader
@@ -51,7 +54,11 @@ (define-module (gnu bootloader u-boot)
u-boot-qemu-riscv64-bootloader
u-boot-starfive-visionfive2-bootloader
u-boot-ts7970-q-2g-1000mhz-c-bootloader
- u-boot-wandboard-bootloader))
+ u-boot-wandboard-bootloader
+ u-boot-rpi-2-bootloader
+ u-boot-rpi-3-bootloader
+ u-boot-rpi-4-bootloader
+ u-boot-rpi-bootloader))
(define (make-install-u-boot firmware installers)
(lambda* (#:key bootloader-config #:allow-other-keys . args)
@@ -222,3 +229,60 @@ (define-u-bootloader-copy u-boot-ts7970-q-2g-1000mhz-c-bootloader
(define-u-bootloader-copy u-boot-qemu-riscv64-bootloader
u-boot-qemu-riscv64 "u-boot.bin")
+
+\f
+;;;
+;;; RasPi bootloader definitions.
+;;;
+
+(define (rpi-config 32?)
+ ;; allows a user-specified custom.txt
+ (plain-file "config.txt"
+ (format #f
+ "arm_64bit=~a~%enable_uart=1~%kernel=u-boot.bin~%include custom.txt~%"
+ (if (or 32? (not (target-64bit?))) "0" "1"))))
+
+(define (install-rpi u-boot-32 u-boot-64)
+ (lambda* (#:key bootloader-config #:allow-other-keys . args)
+ (with-targets (bootloader-configuration-targets bootloader-config)
+ ('install (apply install-extlinux-config args))
+ (('firmware => (firmware :path))
+ (let* ((32? (bootloader-configuration-32bit? bootloader-config))
+ (use-32? (or 32? (not (target-64bit?)) (not u-boot-64))))
+ #~(begin
+ (atomic-copy #$(file-append (if use-32? u-boot-32 u-boot-64)
+ "/libexec/u-boot.bin")
+ (string-append #$firmware "/u-boot.bin"))
+ (atomic-copy #$(rpi-config use-32?)
+ (string-append #$firmware "/config.txt"))))))))
+
+(define-syntax-rule (define-u-bootloader-rpi def-name u-boot-32 u-boot-64)
+ (define def-name
+ (bootloader (name 'u-boot)
+ (default-targets
+ (list (bootloader-target (type 'install)
+ (offset 'firmware)
+ (path "extlinux"))
+ (bootloader-target (type 'firmware)
+ (offset 'root)
+ (path "boot"))))
+ (installer (install-rpi u-boot-32 u-boot-64)))))
+
+
+;; These neither install firmware nor device-tree files for the Raspberry Pi.
+;; They just assume them to be existing in 'install in the same way that some
+;; UEFI firmware with ACPI data is usually assumed to be existing on PCs.
+;; They can be used with either extlinux or as UEFI firmware (alongside, eg,
+;; GRUB).
+(define-u-bootloader-rpi u-boot-rpi-2-bootloader
+ u-boot-rpi-2 #f)
+
+(define-u-bootloader-rpi u-boot-rpi-3-bootloader
+ u-boot-rpi-3-32b u-boot-rpi-arm64)
+
+(define-u-bootloader-rpi u-boot-rpi-4-bootloader
+ u-boot-rpi-4-32b u-boot-rpi-arm64)
+
+;; Usable for any 64-bit raspberry pi.
+(define-u-bootloader-rpi u-boot-rpi-bootloader
+ #f u-boot-rpi-arm64)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 12f918a123..e78602379d 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -1409,40 +1409,8 @@ (define-public u-boot-pinebook-pro-rk3399
(modify-inputs (package-inputs base)
(append arm-trusted-firmware-rk3399))))))
-(define*-public (make-u-boot-bin-package u-boot-package
- #:key
- (u-boot-bin "u-boot.bin"))
- "Return a package with a single U-BOOT-BIN file from the U-BOOT-PACKAGE.
-The package name will be that of the U-BOOT package suffixed with \"-bin\"."
- (package
- (name (string-append (package-name u-boot-package) "-bin"))
- (version (package-version u-boot-package))
- (source #f)
- (build-system trivial-build-system)
- (arguments
- (list
- #:builder
- (with-imported-modules '((guix build utils))
- #~(begin
- (use-modules (guix build utils))
- (mkdir #$output)
- (symlink (search-input-file %build-inputs
- (string-append "libexec/" #$u-boot-bin))
- (string-append #$output "/" #$u-boot-bin))))))
- (inputs (list u-boot-package))
- (home-page (package-home-page u-boot-package))
- (synopsis (package-synopsis u-boot-package))
- (description (string-append
- (package-description u-boot-package)
- "\n\n"
- (format #f
- "This package only contains the file ~a."
- u-boot-bin)))
- (license (package-license u-boot-package))))
-
-(define-public %u-boot-rpi-efi-configs
- '("CONFIG_OF_EMBED"
- "CONFIG_OF_BOARD=y"))
+;; get dtbs from firmware to support dtoverlays
+(define-public %u-boot-rpi-configs '("CONFIG_OF_EMBED" "CONFIG_OF_BOARD=y"))
(define %u-boot-rpi-description-32-bit
"This is a 32-bit build of U-Boot.")
@@ -1451,76 +1419,26 @@ (define %u-boot-rpi-description-64-bit
"This is a common 64-bit build of U-Boot for all 64-bit capable Raspberry Pi
variants.")
-(define %u-boot-rpi-efi-description
- "It allows network booting and uses the device-tree from the firmware,
-allowing the usage of overlays. It can act as an EFI firmware for the
-grub-efi-netboot-removable-bootloader.")
-
-(define %u-boot-rpi-efi-description-32-bit
- (string-append %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-32-bit))
-
(define-public u-boot-rpi-2
(make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-3-32b
(make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-4-32b
(make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-32-bit))
(define-public u-boot-rpi-arm64
(make-u-boot-package "rpi_arm64" "aarch64-linux-gnu"
+ #:configs %u-boot-rpi-configs
#:append-description %u-boot-rpi-description-64-bit))
-(define-public u-boot-rpi-2-efi
- (make-u-boot-package "rpi_2" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-3-32b-efi
- (make-u-boot-package "rpi_3_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-4-32b-efi
- (make-u-boot-package "rpi_4_32b" "arm-linux-gnueabihf"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description %u-boot-rpi-efi-description-32-bit))
-
-(define-public u-boot-rpi-arm64-efi
- (make-u-boot-package "rpi_arm64""aarch64-linux-gnu"
- #:name-suffix "-efi"
- #:configs %u-boot-rpi-efi-configs
- #:append-description (string-append
- %u-boot-rpi-efi-description " "
- %u-boot-rpi-description-64-bit)))
-
-(define-public u-boot-rpi-2-bin (make-u-boot-bin-package u-boot-rpi-2))
-
-(define-public u-boot-rpi-3_32b-bin (make-u-boot-bin-package u-boot-rpi-3-32b))
-
-(define-public u-boot-rpi-4_32b-bin (make-u-boot-bin-package u-boot-rpi-4-32b))
-
-(define-public u-boot-rpi-arm64-bin (make-u-boot-bin-package u-boot-rpi-arm64))
-
-(define-public u-boot-rpi-2-efi-bin (make-u-boot-bin-package u-boot-rpi-2-efi))
-
-(define-public u-boot-rpi-3-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-3-32b-efi))
-
-(define-public u-boot-rpi-4-32b-efi-bin
- (make-u-boot-bin-package u-boot-rpi-4-32b-efi))
-
-(define-public u-boot-rpi-arm64-efi-bin
- (make-u-boot-bin-package u-boot-rpi-arm64-efi))
-
(define u-boot-ts-mx6
;; There is no release; use the latest commit of the
;; 'imx_v2015.04_3.14.52_1.1.0_ga' branch.
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 07/15] gnu: system: Fix bootloader crypto device recognition.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (5 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 06/15] gnu: bootloader: Add raspberry pi bootloader Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
` (9 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
* gnu/system.scm (operating-system-bootloader-crypto-devices): Check for
luks-device-mapping-with-options in addition to luks-device-mapping.
Change-Id: Iafc9afe608640b97083c4d559c9240846330472a
---
gnu/system.scm | 10 ++++++----
1 file changed, 6 insertions(+), 4 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 66c1a80733..093c8fa350 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -400,10 +400,12 @@ (define operating-system-bootloader-crypto-devices
(mlambdaq (os) ;to avoid duplicated output
"Return the sources of the LUKS mapped devices specified by UUID."
;; XXX: Device ordering is important, we trust the returned one.
- (let* ((luks-devices (filter (lambda (m)
- (eq? luks-device-mapping
- (mapped-device-type m)))
- (operating-system-boot-mapped-devices os)))
+ ;; Check against the close-luks-device procedure to get both maptypes
+ (let* ((close (mapped-device-kind-close luks-device-mapping))
+ (luks? (lambda (m) (let ((t (mapped-device-type m)))
+ (eq? (mapped-device-kind-close t) close))))
+ (luks-devices (filter luks?
+ (operating-system-boot-mapped-devices os)))
(uuid-crypto-devices non-uuid-crypto-devices
(partition (compose uuid? mapped-device-source)
luks-devices)))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 08/15] gnu: packages: Add pesign.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (6 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 07/15] gnu: system: Fix bootloader crypto device recognition Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
` (8 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
* gnu/packages/efi.scm (pesign): New variable.
Change-Id: I00fcc679d9514c85d508183b9ec7e121e0a814db
---
gnu/packages/efi.scm | 47 ++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 47 insertions(+)
diff --git a/gnu/packages/efi.scm b/gnu/packages/efi.scm
index 499745eba1..417b70d91b 100644
--- a/gnu/packages/efi.scm
+++ b/gnu/packages/efi.scm
@@ -24,8 +24,10 @@ (define-module (gnu packages efi)
#:use-module (gnu packages bash)
#:use-module (gnu packages linux)
#:use-module (gnu packages man)
+ #:use-module (gnu packages nss)
#:use-module (gnu packages perl)
#:use-module (gnu packages pkg-config)
+ #:use-module (gnu packages popt)
#:use-module (gnu packages tls)
#:use-module ((guix licenses) #:prefix license:)
#:use-module (guix build-system gnu)
@@ -153,6 +155,51 @@ (define-public sbsigntools
(home-page "https://git.kernel.org/pub/scm/linux/kernel/git/jejb/sbsigntools.git/")
(license license:gpl3+)))
+(define-public pesign
+ (package
+ (name "pesign")
+ (version "116")
+ (source (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/rhboot/pesign")
+ (commit version)))
+ (snippet #~(substitute* "Make.defaults"
+ (("pkg-config-ccldflags") "pkg-config-ldflags")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "0fnqfiivj46bha4hsnwiqy8vq8b4i3w2dig0h9h2k4j7yq7r5qvj"))))
+ (build-system gnu-build-system)
+ (arguments
+ (list #:tests? #f
+ #:modules '((guix build gnu-build-system)
+ (guix build utils)
+ (ice-9 match))
+ #:phases #~(modify-phases %standard-phases (delete 'configure))
+ #:make-flags
+ (let ((system (%current-system)) (target (%current-target-system)))
+ (define (arch s) (match (string-split s #\-)
+ (("i386" _ ...) "ia32")
+ (("i486" _ ...) "ia32")
+ (("i586" _ ...) "ia32")
+ (("i686" _ ...) "ia32")
+ ((x _ ...) x)))
+ #~(list "prefix=/" "libdir=/lib/"
+ (string-append "DESTDIR=" #$output)
+ (string-append "HOSTARCH=" #$(arch system))
+ (string-append "ARCH=" #$(arch (or target system)))
+ (string-append "CROSS_COMPILE="
+ #$@(if target (list target "-gcc") '()))))))
+ (inputs (list efivar nspr nss popt `(,util-linux "lib")))
+ (native-inputs (list mandoc pkg-config))
+ (synopsis "PE-COFF binary signing tools")
+ (description "Supports EFI keygen and subsequent signing of PE-COFF
+binaries. Contains the tools authvar, efikeygen, pesigcheck, pesign,
+pesign-client, and pesum.")
+ (home-page "https://github.com/rhboot/pesign")
+ (license license:gpl2+)))
+
(define-public efitools
(package
(name "efitools")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 09/15] gnu: packages: Add ukify.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (7 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 08/15] gnu: packages: Add pesign Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
` (7 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov, Efraim Flashner,
Vagrant Cascadian
* gnu/packages/bootloaders.scm
(systemd-version,systemd-source,ukify): New variables.
Change-Id: Icde59b7266529c8002331ff0375e0a35af3a2add
---
gnu/packages/bootloaders.scm | 54 ++++++++++++++++++++++++++++++++++++
1 file changed, 54 insertions(+)
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index e78602379d..04bb1b06f0 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -20,6 +20,7 @@
;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Herman Rimm <herman@rimm.ee>
;;; Copyright © 2024 Zheng Junjie <873216071@qq.com>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -47,6 +48,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages compression)
#:use-module (gnu packages cross-base)
#:use-module (gnu packages disk)
+ #:use-module (gnu packages efi)
#:use-module (gnu packages firmware)
#:use-module (gnu packages flex)
#:use-module (gnu packages fontutils)
@@ -73,11 +75,13 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages valgrind)
#:use-module (gnu packages virtualization)
#:use-module (gnu packages xorg)
+ #:use-module (gnu packages python-crypto)
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz)
#:use-module (guix build-system gnu)
#:use-module (guix build-system meson)
#:use-module (guix build-system pyproject)
+ #:use-module (guix build-system python)
#:use-module (guix build-system trivial)
#:use-module (guix download)
#:use-module (guix gexp)
@@ -573,6 +577,56 @@ (define-public syslinux
;; Also contains:
license:expat license:isc license:zlib)))))
+(define systemd-version "255")
+(define systemd-source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url "https://github.com/systemd/systemd")
+ (commit (string-append "v" systemd-version))))
+ (file-name (git-file-name "systemd" systemd-version))
+ (snippet #~(substitute* "src/ukify/ukify.py" ; remove after python 3.11
+ (("datetime\\.UTC") "datetime.timezone.utc")))
+ (modules '((guix build utils)))
+ (sha256
+ (base32
+ "1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+
+(define-public ukify
+ (package
+ (name "ukify")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system python-build-system)
+ (arguments
+ (list #:phases
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key inputs #:allow-other-keys)
+ (define (get-tool tool)
+ (search-input-file inputs (string-append "bin/" tool)))
+
+ (substitute* "src/ukify/ukify.py" ; hardcode tool paths
+ (("(find_tool\\(')(readelf|sbsign|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',"))
+ (("('name': ')(sbverify|pesign)'," _ ctx tool)
+ (string-append ctx (get-tool tool) "',")))))
+ (delete 'check)
+ (replace 'install
+ (lambda* (#:key inputs #:allow-other-keys)
+ (let* ((bin (string-append #$output "/bin"))
+ (file (string-append bin "/ukify")))
+ (mkdir-p bin)
+ (copy-file "src/ukify/ukify.py" file)))))))
+ (inputs
+ (list binutils pesign python-cryptography python-pefile sbsigntools))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI tool")
+ (description "@command{ukify} joins together a UKI stub, linux kernel, initrd,
+kernel arguments, and optional secure boot signatures into a single, UEFI-bootable
+image.")
+ (license license:lgpl2.1+)))
+
(define-public dtc
(package
(name "dtc")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 10/15] gnu: packages: Add systemd-stub.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (8 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 09/15] gnu: packages: Add ukify Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
` (6 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Efraim Flashner,
Lilah Tascheter, Vagrant Cascadian
* gnu/bootloader.scm (%efi-supported-systems, lazy-efibootmgr): New variable.
(install-efi): Use lazy-efibootmgr.
* gnu/packages/bootloaders.scm (systemd-stub): New variable.
Change-Id: I974bad9ff7a52f736286d05de53f7c5ccb60b9d6
---
gnu/bootloader.scm | 13 +++++++++--
gnu/packages/bootloaders.scm | 43 ++++++++++++++++++++++++++++++++++++
2 files changed, 54 insertions(+), 2 deletions(-)
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 97305265b7..3a58d74a47 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -28,7 +28,6 @@ (define-module (gnu bootloader)
#:autoload (gnu build file-systems)
(read-partition-label read-partition-uuid
find-partition-by-label find-partition-by-uuid)
- #:use-module (gnu packages linux)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:autoload (guix build syscalls)
@@ -115,6 +114,7 @@ (define-module (gnu bootloader)
bootloader-configuration->gexp
bootloader-configurations->gexp
+ %efi-supported-systems
efi-arch
install-efi))
@@ -651,6 +651,11 @@ (define (bootloader-configurations->gexp bootloader-configs . rest)
;;; EFI shit
;;;
+;; systems currently supported by efi-arch. should be used for packages relying
+;; on it.
+(define %efi-supported-systems
+ '("i686-linux" "x86_64-linux" "armhf-linux" "aarch64-linux" "riscv64-linux"))
+
(define* (efi-arch #:key (target (or (%current-target-system) (%current-system)))
(32? #f))
"Returns the UEFI architecture name for the current target, in lowercase."
@@ -662,6 +667,10 @@ (define* (efi-arch #:key (target (or (%current-target-system) (%current-system))
(else (raise (formatted-message (G_ "no UEFI standard arch for ~a!")
target)))))
+(define (lazy-efibootmgr)
+ "Lazy-loaded efibootmgr package, in order to prevent circular refs."
+ (module-ref (resolve-interface '(gnu packages linux)) 'efibootmgr))
+
(define (install-efi bootloader-config plan)
"Returns a gexp installing PLAN to the ESP, as denoted by the 'vendir target.
PLAN is a gexp of a list of '(BUILDER DEST-BASENAME . LABEL) triples, that
@@ -684,5 +693,5 @@ (define (install-efi bootloader-config plan)
;; normal install when not doing a removable config
(with-targets targets
(('vendir => (vendir :path) (loader :devpath) (disk :device))
- #~(install-efi #+(file-append efibootmgr "/sbin/efibootmgr")
+ #~(install-efi #+(file-append (lazy-efibootmgr) "/sbin/efibootmgr")
#$vendir #$loader #$disk #$plan))))))
diff --git a/gnu/packages/bootloaders.scm b/gnu/packages/bootloaders.scm
index 04bb1b06f0..2bc04059d2 100644
--- a/gnu/packages/bootloaders.scm
+++ b/gnu/packages/bootloaders.scm
@@ -38,6 +38,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu packages bootloaders)
+ #:use-module (gnu bootloader)
#:use-module (gnu packages)
#:use-module (gnu packages assembly)
#:use-module (gnu packages base)
@@ -54,6 +55,7 @@ (define-module (gnu packages bootloaders)
#:use-module (gnu packages fontutils)
#:use-module (gnu packages gcc)
#:use-module (gnu packages gettext)
+ #:use-module (gnu packages gperf)
#:use-module (gnu packages linux)
#:use-module (gnu packages llvm)
#:use-module (gnu packages man)
@@ -592,6 +594,47 @@ (define systemd-source
(base32
"1qdyw9g3jgvsbc1aryr11gpc3075w5pg00mqv4pyf3hwixxkwaq6"))))
+(define-public systemd-stub
+ (package
+ (name "systemd-stub")
+ (version systemd-version)
+ (source systemd-source)
+ (build-system meson-build-system)
+ (arguments
+ (list #:configure-flags
+ #~(list "-Dmode=release" "-Defi=true" "-Dsbat-distro=guix"
+ "-Dsbat-distro-generation=1" ; package revision!
+ "-Dsbat-distro-summary=Guix System"
+ "-Dsbat-distro-url=https://guix.gnu.org"
+ #$(string-append "-Dsbat-distro-pkgname="
+ (package-name this-package))
+ #$(string-append "-Dsbat-distro-version="
+ (package-version this-package)))
+ #:phases
+ ;; TODO: 32bit support
+ (let* ((stub (string-append
+ "src/boot/efi/linux" (efi-arch) ".efi.stub")))
+ #~(modify-phases %standard-phases
+ (replace 'build
+ (lambda* (#:key parallel-build? #:allow-other-keys)
+ (invoke "ninja" #$stub
+ "-j" (if parallel-build?
+ (number->string (parallel-job-count)) "1"))))
+ (replace 'install
+ (lambda _
+ (let ((libexec (string-append #$output "/libexec")))
+ (install-file #$stub libexec))))
+ (delete 'check)))))
+ (supported-systems %efi-supported-systems)
+ (inputs (list libcap python-pyelftools `(,util-linux "lib")))
+ (native-inputs (list gperf pkg-config python-3 python-jinja2))
+ (home-page "https://systemd.io/")
+ (synopsis "Unified kernel image UEFI stub")
+ (description "Simple UEFI boot stub that loads a conjoined kernel image and
+supporting data to their proper locations, before chainloading to the kernel.
+Supports measured and/or verified boot environments.")
+ (license license:lgpl2.1+)))
+
(define-public ukify
(package
(name "ukify")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 11/15] gnu: bootloaders: Add uki-efi-bootloader.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (9 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 10/15] gnu: packages: Add systemd-stub Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
` (5 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov, Lilah Tascheter
* gnu/bootloader.scm (<bootloader-configuration>): New keypair field.
* gnu/bootloader/uki.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add bootloader/uki.scm.
Change-Id: I2097da9f3dd35137b3419f6d0545de26d53cb6da
---
gnu/bootloader.scm | 3 ++
gnu/bootloader/uki.scm | 96 ++++++++++++++++++++++++++++++++++++++++++
gnu/local.mk | 1 +
3 files changed, 100 insertions(+)
create mode 100644 gnu/bootloader/uki.scm
diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index 3a58d74a47..cb0919940f 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -101,6 +101,7 @@ (define-module (gnu bootloader)
bootloader-configuration-default-entry
bootloader-configuration-efi-removable?
bootloader-configuration-32bit?
+ bootloader-configuration-keypair
bootloader-configuration-timeout
bootloader-configuration-keyboard-layout
bootloader-configuration-theme
@@ -527,6 +528,8 @@ (define-record-type* <bootloader-configuration>
(default #f)) ;bool
(32bit? bootloader-configuration-32bit?
(default #f)) ;bool
+ (keypair bootloader-configuration-keypair
+ (default #f)) ;(cert . priv) pair
(timeout bootloader-configuration-timeout
(default 5)) ;seconds as integer
(keyboard-layout bootloader-configuration-keyboard-layout
diff --git a/gnu/bootloader/uki.scm b/gnu/bootloader/uki.scm
new file mode 100644
index 0000000000..4871dbe037
--- /dev/null
+++ b/gnu/bootloader/uki.scm
@@ -0,0 +1,96 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; 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 bootloader uki)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu packages bootloaders)
+ #:use-module (gnu packages efi)
+ #:use-module (gnu packages linux)
+ #:use-module (gnu system boot)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:export (uki-efi-bootloader))
+
+;; TODO: support 32bit/mixed-mode UEFI.
+;; https://github.com/systemd/systemd/issues/17056 may be relevant
+(define bootcfg->menu-entry->builder
+ (match-record-lambda <bootloader-configuration> (32bit? theme keypair)
+ (match-record-lambda <menu-entry>
+ (label linux linux-arguments initrd chain-loader)
+ ;; support chainloader in order to allow arbitrary signed EFI binaries
+ (cond
+ ((and chain-loader keypair)
+ #~(lambda (dest)
+ (invoke/quiet #+(sbsigntools "/bin/sbsign")
+ "--cert" #$(car keypair) "--key" #$(cdr keypair)
+ "--output" dest #$chain-loader)
+ (invoke/quiet #+(sbsigntools "/bin/sbverify")
+ "--cert" #$(car keypair) dest)))
+ (chain-loader #~(lambda (dest) (copy-file #$chain-loader dest)))
+ (linux
+ (let* ((arch (efi-arch #:32? 32bit?))
+ (stub (file-append systemd-stub
+ "/libexec/linux" arch ".efi.stub")))
+ #~(lambda (dest)
+ (invoke/quiet #+(file-append ukify "/bin/ukify")
+ "build" "--output" dest
+ "--linux" #$linux "--initrd" #$initrd
+ "--cmdline" (string-join (list #$@linux-arguments))
+ "--os-release" #$label "--stub" #$stub "--efi-arch" #$arch
+ #$@(if theme #~("--splash" #$theme) '())
+ #$@(if keypair #~("--secureboot-certificate" #$(car keypair)
+ "--secureboot-private-key" #$(cdr keypair))
+ '())))))
+ (else (leave (G_ "uki-efi-bootloader doesn't support multiboot")))))))
+
+;; we cannot use guix's build system to make UKI images for two reasons:
+;; 1. signing is necessarily non-reproducable, especially since keys should not
+;; be in the store, or else risk being publically accessible.
+;; 2. menu-entries may reference files which do not exist in the store.
+(define* (install-uki #:key bootloader-config
+ current-boot-alternative
+ old-boot-alternatives
+ #:allow-other-keys)
+ (define* (menu-entry->plan entry num #:optional (prefix "menu-entry"))
+ #~(cons* #$((bootcfg->menu-entry->builder bootloader-config) entry)
+ #$(string-append prefix "-" (number->string num) ".efi")
+ #$(menu-entry-label entry)))
+
+ (define (boot-alternative->plan alt)
+ (menu-entry->plan (boot-alternative->menu-entry alt)
+ (boot-alternative-generation alt)
+ "generation"))
+
+ (install-efi bootloader-config
+ (let ((entries (bootloader-configuration-menu-entries bootloader-config)))
+ #~(list #$(boot-alternative->plan current-boot-alternative)
+ #$@(map menu-entry->plan entries (iota (length entries)))
+ #$@(map boot-alternative->plan old-boot-alternatives)))))
+
+
+
+(define uki-efi-bootloader
+ (bootloader
+ (name 'uki-efi)
+ (default-targets (list (bootloader-target
+ (type 'vendir)
+ (offset 'esp)
+ (path "EFI/Guix"))))
+ (installer install-uki)))
diff --git a/gnu/local.mk b/gnu/local.mk
index 8375e13709..32ed753ee2 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -93,6 +93,7 @@ GNU_SYSTEM_MODULES = \
%D%/bootloader/extlinux.scm \
%D%/bootloader/u-boot.scm \
%D%/bootloader/depthcharge.scm \
+ %D%/bootloader/uki.scm \
%D%/ci.scm \
%D%/compression.scm \
%D%/home.scm \
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 12/15] gnu: system: Update examples.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (10 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 11/15] gnu: bootloaders: Add uki-efi-bootloader Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
` (4 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Florian Pelz, Ludovic Court??s,
Matthew Trzcinski, Maxim Cournoyer
* gnu/system/examples/asus-c201.tmpl (bootloader): Use new depthcharge
bootloader name scheme and update to new target system.
* gnu/system/examples/bare-bones.tmpl (bootloader),
gnu/system/examples/bare-hurd.tmpl (bootloader),
gnu/system/examples/beaglebone-black.tmpl (bootloader),
gnu/system/examples/desktop.tmpl (bootloader),
gnu/system/examples/lightweight-desktop.tmpl (bootloader),
gnu/system/examples/plasma.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64-nfs-root.tmpl (bootloader),
gnu/system/examples/raspberry-pi-64.tmpl (bootloader): Use new target system.
* gnu/system/examples/docker-image.tmpl (bootloader): Delete.
* gnu/system/examples/vm-image.tmpl (bootloader): Use auto image target.
Change-Id: I3675f17ae9cd94cff99328762600fb4e491bc9f2
---
gnu/system/examples/asus-c201.tmpl | 6 +++--
gnu/system/examples/bare-bones.tmpl | 7 ++++--
gnu/system/examples/bare-hurd.tmpl | 4 +++-
gnu/system/examples/beaglebone-black.tmpl | 6 +++--
gnu/system/examples/desktop.tmpl | 4 +++-
gnu/system/examples/docker-image.tmpl | 6 ++---
gnu/system/examples/lightweight-desktop.tmpl | 4 +++-
gnu/system/examples/plasma.tmpl | 4 +++-
.../examples/raspberry-pi-64-nfs-root.tmpl | 23 ++++++++++++-------
gnu/system/examples/raspberry-pi-64.tmpl | 18 ++++++++-------
gnu/system/examples/vm-image.tmpl | 5 ++--
11 files changed, 54 insertions(+), 33 deletions(-)
diff --git a/gnu/system/examples/asus-c201.tmpl b/gnu/system/examples/asus-c201.tmpl
index 019111c167..eec185eebf 100644
--- a/gnu/system/examples/asus-c201.tmpl
+++ b/gnu/system/examples/asus-c201.tmpl
@@ -14,8 +14,10 @@
;; Assuming /dev/mmcblk0p1 is the kernel partition, and
;; "my-root" is the label of the target root file system.
(bootloader (bootloader-configuration
- (bootloader depthcharge-bootloader)
- (targets '("/dev/mmcblk0p1"))))
+ (bootloader depthcharge-veyron-speedy-bootloader)
+ (targets (list (bootloader-target
+ (type 'part)
+ (device "/dev/mmcblk0p1"))))))
;; The ASUS C201PA requires a very particular kernel to boot,
;; as well as the following arguments.
diff --git a/gnu/system/examples/bare-bones.tmpl b/gnu/system/examples/bare-bones.tmpl
index 7b6a4b09b0..9eed05f2e0 100644
--- a/gnu/system/examples/bare-bones.tmpl
+++ b/gnu/system/examples/bare-bones.tmpl
@@ -13,10 +13,13 @@
;; Boot in "legacy" BIOS mode, assuming /dev/sdX is the
;; target hard disk, and "my-root" is the label of the target
- ;; root file system.
+ ;; root file system. If you're just building an image, the
+ ;; 'targets' field may be omitted.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
;; It's fitting to support the equally bare bones ‘-nographic’
;; QEMU option, which also nicely sidesteps forcing QWERTY.
(kernel-arguments (list "console=ttyS0,115200"))
diff --git a/gnu/system/examples/bare-hurd.tmpl b/gnu/system/examples/bare-hurd.tmpl
index 463c7ee798..8dd700cd9d 100644
--- a/gnu/system/examples/bare-hurd.tmpl
+++ b/gnu/system/examples/bare-hurd.tmpl
@@ -32,7 +32,9 @@
(inherit %hurd-default-operating-system)
(bootloader (bootloader-configuration
(bootloader grub-minimal-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/system/examples/beaglebone-black.tmpl b/gnu/system/examples/beaglebone-black.tmpl
index 18bbb2723c..99963ef2fe 100644
--- a/gnu/system/examples/beaglebone-black.tmpl
+++ b/gnu/system/examples/beaglebone-black.tmpl
@@ -11,11 +11,13 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
- ;; Assuming /dev/mmcblk1 is the eMMC, and "my-root" is
+ ;; Assuming /dev/mmcblk1 is the eMMC. and "my-root" is
;; the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader u-boot-beaglebone-black-bootloader)
- (targets '("/dev/mmcblk1"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/mmcblk1"))))))
;; This module is required to mount the SD card.
(initrd-modules (cons "omap_hsmmc" %base-initrd-modules))
diff --git a/gnu/system/examples/desktop.tmpl b/gnu/system/examples/desktop.tmpl
index 2d65f22294..30dbdeea31 100644
--- a/gnu/system/examples/desktop.tmpl
+++ b/gnu/system/examples/desktop.tmpl
@@ -20,7 +20,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout)))
;; Specify a mapped device for the encrypted root partition.
diff --git a/gnu/system/examples/docker-image.tmpl b/gnu/system/examples/docker-image.tmpl
index 7123917af4..6d3114a0bc 100644
--- a/gnu/system/examples/docker-image.tmpl
+++ b/gnu/system/examples/docker-image.tmpl
@@ -9,6 +9,8 @@
(timezone "Europe/Berlin")
(locale "en_US.utf8")
+ ;; Bootloader can be left blank!
+
;; This is where user accounts are specified. The "root" account is
;; implicit, and is initially created with the empty password.
(users (cons (user-account
@@ -34,10 +36,6 @@
;; similar services for us.
;; This will be ignored.
- (bootloader (bootloader-configuration
- (bootloader grub-bootloader)
- (targets '("does-not-matter"))))
- ;; This will be ignored, too.
(file-systems (list (file-system
(device "does-not-matter")
(mount-point "/")
diff --git a/gnu/system/examples/lightweight-desktop.tmpl b/gnu/system/examples/lightweight-desktop.tmpl
index c061284ba8..0964238cb0 100644
--- a/gnu/system/examples/lightweight-desktop.tmpl
+++ b/gnu/system/examples/lightweight-desktop.tmpl
@@ -17,7 +17,9 @@
;; Partition mounted on /boot/efi.
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))
;; Assume the target root file system is labelled "my-root",
;; and the EFI System Partition has UUID 1234-ABCD.
diff --git a/gnu/system/examples/plasma.tmpl b/gnu/system/examples/plasma.tmpl
index c3850ffe37..a81916ffe9 100644
--- a/gnu/system/examples/plasma.tmpl
+++ b/gnu/system/examples/plasma.tmpl
@@ -15,7 +15,9 @@
;; is the label of the target root file system.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device "my-root")
diff --git a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
index 1baca02491..85476854f3 100644
--- a/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
+++ b/gnu/system/examples/raspberry-pi-64-nfs-root.tmpl
@@ -25,14 +25,21 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi")))))
+ (bootloader-configuration
+ (bootloader grub-efi-bootloader)
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel-arguments '("ip=dhcp"))
(kernel (customize-linux #:linux linux-libre-arm64-generic
#:extra-version "arm64-generic-netboot"
diff --git a/gnu/system/examples/raspberry-pi-64.tmpl b/gnu/system/examples/raspberry-pi-64.tmpl
index 414d8ac7a5..d5b90b9705 100644
--- a/gnu/system/examples/raspberry-pi-64.tmpl
+++ b/gnu/system/examples/raspberry-pi-64.tmpl
@@ -24,14 +24,16 @@
(operating-system
(host-name "raspberrypi-guix")
(timezone "Europe/Berlin")
- (bootloader (bootloader-configuration
- (bootloader grub-efi-bootloader-chain-raspi-64)
- (targets (list "/boot/efi"))
- (theme (grub-theme
- (resolution '(1920 . 1080))
- (image (file-append
- %artwork-repository
- "/grub/GuixSD-fully-black-16-9.svg"))))))
+ (bootloader (list (bootloader-configuration
+ (bootloader u-boot-rpi-bootloader)
+ (targets (list (bootloader-target
+ (type 'install)
+ (path "/boot/efi"))))
+ (theme
+ (grub-theme
+ (resolution '(1920 . 1080))
+ (image (file-append %artwork-repository
+ "/grub/GuixSD-fully-black-16-9.svg")))))))
(kernel (customize-linux #:linux linux-libre-arm64-generic
;; It is possible to use a specific defconfig
;; file, for example the "bcmrpi3_defconfig" with
diff --git a/gnu/system/examples/vm-image.tmpl b/gnu/system/examples/vm-image.tmpl
index 589de493b1..050c0bb971 100644
--- a/gnu/system/examples/vm-image.tmpl
+++ b/gnu/system/examples/vm-image.tmpl
@@ -38,11 +38,10 @@ accounts.\x1b[0m
(firmware '())
- ;; Below we assume /dev/vda is the VM's hard disk.
- ;; Adjust as needed.
+ ;; Images automatically get the 'root, 'esp, and 'disk targets configured as
+ ;; needed.
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 13/15] doc: Update bootloader documentation.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (11 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 12/15] gnu: system: Update examples Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
` (3 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457
Cc: Lilah Tascheter, Sergey Trofimov, Florian Pelz, Ludovic Court??s,
Matthew Trzcinski, Maxim Cournoyer
* doc/guix.texi
(Manual Installation)[Proceeding with the Installation]: Offload
target reference.
(System Installation)[Building the Installation Image]: Use beaglebone
as the example, and don't reference deleted variables.
(System Configuration)[Using the Configuration System]: Update
example.
[operating-system Reference]<bootloader>: Can use multiple
bootloaders.
[Keyboard Layout]: Update example.
[Bootloader Configuration]<bootloader>: Update documentation for all
bootloaders, and add new ones. Document new fields efi-removable?,
32bit?, and keypair. Update terminal-outputs and terminal-outputs to
not be GRUB-specific.
<bootloader-target>: New record.
<menu-entry>: Remove now-unsupported GRUB specifics in linux. Move
device documentation and add some for device-mount-point and
device-subvol. Fix typo in multiboot-arguments. Document chain-loader
for arbitrary bootloaders.
[Invoking guix system]<switch-generation>: Bootloaders are now
reinstalled.
<image> Other bootloaders may be used.
[Invoking guix deploy]: Update template.
(Creating System Images)[image Reference]<partition Reference>: Add
target field.
[Instantiate an Image]: Update examples and update formatting.
<efi32-disk-image, efi32-raw-image-type>: Delete.
[image-type Reference]<pinebook-pro-image-type, rock64-image-type>:
Reword slightly.
Change-Id: I45ac9d5ad3cb491c693e9a4b2f0b44b527478ee7
---
doc/guix.texi | 458 +++++++++++++++++++++++++++++---------------------
1 file changed, 262 insertions(+), 196 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 41814042f5..b5f35a9066 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -2516,12 +2516,9 @@ Proceeding with the Installation
Make sure the @code{bootloader-configuration} form refers to the targets
you want to install GRUB on. It should mention @code{grub-bootloader}
if you are installing GRUB in the legacy way, or
-@code{grub-efi-bootloader} for newer UEFI systems. For legacy systems,
-the @code{targets} field contain the names of the devices, like
-@code{(list "/dev/sda")}; for UEFI systems it names the paths to mounted
-EFI partitions, like @code{(list "/boot/efi")}; do make sure the paths
-are currently mounted and a @code{file-system} entry is specified in
-your configuration.
+@code{grub-efi-bootloader} for newer UEFI systems.
+@xref{Bootloader Configuration} for information on how to format the
+@code{targets} field.
@item
Be sure that your file system labels match the value of their respective
@@ -2653,11 +2650,13 @@ Building the Installation Image
includes the bootloader, specifically:
@example
-guix system image --system=armhf-linux -e '((@@ (gnu system install) os-with-u-boot) (@@ (gnu system install) installation-os) "A20-OLinuXino-Lime2")'
+guix system image --system=armhf-linux -e '(@ (gnu system install) beaglebone-black-installation-os)'
@end example
-@code{A20-OLinuXino-Lime2} is the name of the board. If you specify an invalid
-board, a list of possible boards will be printed.
+@code{beaglebone-black} is the name of the board. Similar
+@code{installation-os} variables exist for most other supported boards.
+Otherwise, you can use @code{embedded-installation-os}, passing it a u-boot
+bootloader and the desired console tty.
@c *********************************************************************
@@ -17229,7 +17228,9 @@ Using the Configuration System
@lisp
(bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi")))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi")))))
@end lisp
@xref{Bootloader Configuration}, for more information on the available
@@ -17535,8 +17536,10 @@ operating-system Reference
List of strings or gexps representing additional arguments to pass on
the command-line of the kernel---e.g., @code{("console=ttyS0")}.
-@item @code{bootloader}
-The system bootloader configuration object. @xref{Bootloader Configuration}.
+@item @code{bootloader} (default: '())
+The system bootloader configuration object. Can either be a single
+@code{bootloader-configuration} or a list of them, to install multiple or no
+bootloaders. @xref{Bootloader Configuration}.
@item @code{label}
This is the label (a string) as it appears in the bootloader's menu entry.
@@ -18731,7 +18734,9 @@ Keyboard Layout
(keyboard-layout (keyboard-layout "tr")) ;for the console
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))
(keyboard-layout keyboard-layout))) ;for GRUB
(services (cons (set-xorg-configuration
(xorg-configuration ;for Xorg
@@ -42119,132 +42124,124 @@ Bootloader Configuration
@cindex EFI, bootloader
@cindex UEFI, bootloader
@cindex BIOS, bootloader
-The bootloader to use, as a @code{bootloader} object. For now
-@code{grub-bootloader}, @code{grub-efi-bootloader},
-@code{grub-efi-removable-bootloader}, @code{grub-efi-netboot-bootloader},
-@code{grub-efi-netboot-removable-bootloader}, @code{extlinux-bootloader}
-and @code{u-boot-bootloader} are supported.
+The bootloader to use, as a @code{bootloader} object. Available bootloaders, in
+addition to what target types they require, are as follows:
-@cindex ARM, bootloaders
-@cindex AArch64, bootloaders
-Available bootloaders are described in @code{(gnu bootloader @dots{})}
-modules. In particular, @code{(gnu bootloader u-boot)} contains definitions
-of bootloaders for a wide range of ARM and AArch64 systems, using the
-@uref{https://www.denx.de/wiki/U-Boot/, U-Boot bootloader}.
+@itemize
+@vindex depthcharge-veyron-speedy-bootloader
+@item @code{depthcharge-veyron-speedy-bootloader}
+For the Asus C201. Requires a @code{'part} target, denoting the partition to
+install the kernel blob as a @code{device}, @code{label}, or @code{uuid}.
@vindex grub-bootloader
-@code{grub-bootloader} allows you to boot in particular Intel-based machines
-in ``legacy'' BIOS mode.
+@item @code{grub-bootloader}
+GRUB2 for BIOS systems. Requires a @code{'disk} target providing either a
+@code{device}, @code{label}, or @code{uuid}. If root is mounted over NFS, it
+will load its files and the Guix System over
+@acronym{PXE, Preboot eXecution Environment}.
+
+@vindex grub-minimal-bootloader
+@item @code{grub-minimal-bootloader}
+As above, but using a minimal build of GRUB.
@vindex grub-efi-bootloader
-@code{grub-efi-bootloader} allows to boot on modern systems using the
-@dfn{Unified Extensible Firmware Interface} (UEFI). This is what you should
-use if the installation image contains a @file{/sys/firmware/efi} directory
-when you boot it on your system.
-
-@vindex grub-efi-removable-bootloader
-@code{grub-efi-removable-bootloader} allows you to boot your system from
-removable media by writing the GRUB file to the UEFI-specification location of
-@file{/EFI/BOOT/BOOTX64.efi} of the boot directory, usually @file{/boot/efi}.
-This is also useful for some UEFI firmwares that ``forget'' their configuration
-from their non-volatile storage. Like @code{grub-efi-bootloader}, this can only
-be used if the @file{/sys/firmware/efi} directory is available.
+@item @code{grub-efi-bootloader}
+GRUB2 for "modern" systems using the @dfn{Unified Extensible Firmware Interface}
+(UEFI). Requires an @code{'esp} target providing a @code{path} to the mount
+point of the EFI System Partition. If root is mounted over NFS, it will load
+its files and the Guix System over a
+@acronym{TFTP, Trivial File Transfer Protocol} server as configured over
+@acronym{DHCP, Dynamic Host Configuration Protocol} as per PXE.
+
+@vindex extlinux-bootloader
+@item @code{extlinux-bootloader}
+Extlinux for "legacy" BIOS systems. Requires a @code{'disk} target providing
+either a @code{device}, @code{label}, or @code{uuid}.
+
+@vindex extlinux-gpt-bootloader
+@item @code{extlinux-gpt-bootloader}
+As above, but for systems using the GPT instead of MBR partition table.
+
+@cindex Secure Boot, UEFI
+@vindex uki-efi-bootloader
+@item @code{uki-efi-bootloader}
+Makes and installs UKI images for UEFI systems. Requires an @code{'esp} target
+providing a @code{path} to the mount point of the EFI System Partition. Not all
+system generations may be available with this option, as UKI images contain the
+entire kernel and initramfs, and ESPs tend to be small.
+
+Full disk encryption with @code{uki-efi-bootloader} only requires a single
+password entry with fast decryption, in contrast to GRUB2 requiring a second
+password entry with slow, LUKS1-only decryption.
+
+This is the only bootloader to currently support UEFI secure boot, when
+configured as below.
-@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
-@end quotation
+@cindex ARM, bootloaders
+@cindex AArch64, bootloaders
+@vindex u-boot-a20-olinuxino-lime-bootloader
+@vindex u-boot-a20-olinuxino-lime2-bootloader
+@vindex u-boot-a20-olinuxino-micro-bootloader
+@vindex u-boot-bananapi-m2-ultra-bootloader
+@vindex u-boot-beaglebone-black-bootloader
+@vindex u-boot-cubietruck-bootloader
+@vindex u-boot-firefly-rk3399-bootloader
+@vindex u-boot-mx6cuboxi-bootloader
+@vindex u-boot-nintendo-nes-classic-edition-bootloader
+@vindex u-boot-novena-bootloader
+@vindex u-boot-orangepi-r1-plus-lts-rk3328-bootloader
+@vindex u-boot-pine64-plus-bootloader
+@vindex u-boot-pine64-lts-bootloader
+@vindex u-boot-pinebook-bootloader
+@vindex u-boot-pinebook-pro-rk3399-bootloader
+@vindex u-boot-puma-rk3399-bootloader
+@vindex u-boot-rock64-rk3328-bootloader
+@vindex u-boot-rockpro64-rk3399-bootloader
+@vindex u-boot-sifive-unmatched-bootloader
+@vindex u-boot-qemu-riscv64-bootloader
+@vindex u-boot-starfive-visionfive2-bootloader
+@vindex u-boot-ts7970-q-2g-1000mhz-c-bootloader
+@vindex u-boot-wandboard-bootloader
+@vindex u-boot-rpi-2-bootloader
+@vindex u-boot-rpi-3-bootloader
+@vindex u-boot-rpi-4-bootloader
+@vindex u-boot-rpi-bootloader
+@item U-Boot
+U-Boot has individual bootloaders @code{u-boot-board-bootloader} for each
+of the following @code{board}s: @code{a20-olinuxino-lime},
+@code{a20-olinuxino-lime2}, @code{a20-olinuxino-micro},
+@code{bananapi-m2-ultra}, @code{beaglebone-black}, @code{cubietruck},
+@code{firefly-rk3399}, @code{mx6cuboxi}, @code{nintendo-nes-classic-edition},
+@code{novena}, @code{orangepi-r1-plus-lts-rk3328}, @code{pine64-plus},
+@code{pine64-lts}, @code{pinebook}, @code{pinebook-pro-rk3399},
+@code{puma-rk3399}, @code{rock64-rk3328}, @code{rockpro64-rk3399},
+@code{rpi-2}, @code{rpi-3}, @code{rpi-4}, @code{rpi}, @code{sifive-unmatched},
+@code{ts7970-q-2g-1000mhz-c}, @code{qemu-riscv64}, and @code{wandboard}.
+
+Each of these requires a @code{'disk} target providing either a @code{device},
+@code{label}, or @code{uuid}, except for @code{ts7970-q-2g-1000mhz-c} and
+@code{qemu-riscv64}, in which the bootloader just copies U-Boot to
+@file{/boot/u-boot.imx} or @file{/boot/u-boot.bin}, respectively. You should
+then manually flash it to the SPI flash at the U-Boot prompt.
+
+By default Guix configures U-Boot to boot using a generated extlinux config, but
+U-Boot does support loading UEFI bootloaders, if you want to combine it with
+another.
+@end itemize
-@vindex grub-efi-netboot-bootloader
-@code{grub-efi-netboot-bootloader} allows you to boot your system over network
-through TFTP@. In combination with an NFS root file system this allows you to
-build a diskless Guix system.
-
-The installation of the @code{grub-efi-netboot-bootloader} generates the
-content of the TFTP root directory at @code{targets} (@pxref{Bootloader
-Configuration, @code{targets}}) below the sub-directory @file{efi/Guix}, to be
-served by a TFTP server. You may want to mount your TFTP server directories
-onto the @code{targets} to move the required files to the TFTP server
-automatically during installation.
-
-If you plan to use an NFS root file system as well (actually if you mount the
-store from an NFS share), then the TFTP server needs to serve the file
-@file{/boot/grub/grub.cfg} and other files from the store (like GRUBs background
-image, the kernel (@pxref{operating-system Reference, @code{kernel}}) and the
-initrd (@pxref{operating-system Reference, @code{initrd}})), too. All these
-files from the store will be accessed by GRUB through TFTP with their normal
-store path, for example as
-@file{tftp://tftp-server/gnu/store/…-initrd/initrd.cpio.gz}.
-
-Two symlinks are created to make this possible. For each target in the
-@code{targets} field, the first symlink is
-@samp{target}@file{/efi/Guix/boot/grub/grub.cfg} pointing to
-@file{../../../boot/grub/grub.cfg}, where @samp{target} may be
-@file{/boot}. In this case the link is not leaving the served TFTP root
-directory, but otherwise it does. The second link is
-@samp{target}@file{/gnu/store} and points to @file{../gnu/store}. This
-link is leaving the served TFTP root directory.
-
-The assumption behind all this is that you have an NFS server exporting
-the root file system for your Guix system, and additionally a TFTP
-server exporting your @code{targets} directories—usually a single
-@file{/boot}—from that same root file system for your Guix system. In
-this constellation the symlinks will work.
-
-For other constellations you will have to program your own bootloader
-installer, which then takes care to make necessary files from the store
-accessible through TFTP, for example by copying them into the TFTP root
-directory for your @code{targets}.
-
-It is important to note that symlinks pointing outside the TFTP root directory
-may need to be allowed in the configuration of your TFTP server. Further the
-store link exposes the whole store through TFTP@. Both points need to be
-considered carefully for security aspects. It is advised to disable any TFTP
-write access!
-
-Please note, that this bootloader will not modify the ‘UEFI Boot Manager’ of
-the system.
-
-Beside the @code{grub-efi-netboot-bootloader}, the already mentioned TFTP and
-NFS servers, you also need a properly configured DHCP server to make the booting
-over netboot possible. For all this we can currently only recommend you to look
-for instructions about @acronym{PXE, Preboot eXecution Environment}.
-
-If a local EFI System Partition (ESP) or a similar partition with a FAT
-file system is mounted in @code{targets}, then symlinks cannot be
-created. In this case everything will be prepared for booting from
-local storage, matching the behavior of @code{grub-efi-bootloader}, with
-the difference that all GRUB binaries are copied to @code{targets},
-necessary for booting over the network.
-
-@vindex grub-efi-netboot-removable-bootloader
-@code{grub-efi-netboot-removable-bootloader} is identical to
-@code{grub-efi-netboot-bootloader} with the exception that the
-sub-directory @file{efi/boot} will be used instead of @file{efi/Guix} to
-comply with the UEFI specification for removable media.
+@item @code{targets}
+This is a list of @code{bootloader-target} (see below) structures denoting
+where the bootloader should install itself. Interpretation of specific target
+types and target requirements depend on the specific @code{bootloader} used.
@quotation Note
-This @emph{will} overwrite the GRUB file from any other operating systems that
-also place their GRUB file in the UEFI-specification location; making them
-unbootable.
+Bootloaders have a set of default targets, that can interact with user-specified
+targets. For UEFI bootloaders using the @code{'esp} target, this typically
+includes a @code{'vendir} target. If you configure multiple UEFI bootloaders,
+you should set different @code{'vendir} target @code{path}s for each, each
+@code{offset} from @code{'esp}.
@end quotation
-@item @code{targets}
-This is a list of strings denoting the targets onto which to install the
-bootloader.
-
-The interpretation of targets depends on the bootloader in question.
-For @code{grub-bootloader}, for example, they should be device names
-understood by the bootloader @command{installer} command, such as
-@code{/dev/sda} or @code{(hd0)} (@pxref{Invoking grub-install,,, grub,
-GNU GRUB Manual}). For @code{grub-efi-bootloader} and
-@code{grub-efi-removable-bootloader} they should be mount
-points of the EFI file system, usually @file{/boot/efi}. For
-@code{grub-efi-netboot-bootloader}, @code{targets} should be the mount
-points corresponding to TFTP root directories served by your TFTP
-server.
-
@item @code{menu-entries} (default: @code{'()})
A possibly empty list of @code{menu-entry} objects (see below), denoting
entries to appear in the bootloader menu, in addition to the current
@@ -42254,6 +42251,29 @@ Bootloader Configuration
The index of the default boot menu entry. Index 0 is for the entry of the
current system.
+@item @code{efi-removable?} (default: @var{#f})
+Used by all UEFI bootloaders to determine whether they should be installed to
+the UEFI standard fallback bootloader path (on x86_64,
+@file{/EFI/BOOT/BOOTX64.EFI}). This allows it to be booted from removable media
+or otherwise in cases where the system has not been booted from UEFI already.
+
+@quotation Warning
+This will override any other bootloaders installed to the same path!
+@end quotation
+
+@item @code{32bit?} (default: @var{#f})
+Some 64-bit systems require their bootloaders to be 32-bit, including some early
+UEFI systems and some Raspberry Pis. If that is the case, and the bootloader
+supports it, setting this option will force the bootloader to install as if it
+were on a 32-bit system.
+
+@item @code{keypair} (default: @var{#f})
+Designates a keypair to be used by bootloaders that support some kind of
+cryptographic signature, such as UEFI Secure Boot. This must be a pair
+@code{'(cert . priv)} of paths to the public key (@code{cert}) and private key
+(@code{priv}). The keys these paths point to should be owned by root with 600
+permissions for security purposes.
+
@item @code{timeout} (default: @code{5})
The number of seconds to wait for keyboard input before booting. Set to
0 to boot immediately, and to -1 to wait indefinitely.
@@ -42276,19 +42296,20 @@ Bootloader Configuration
is provided, some bootloaders might use a default theme, that's true
for GRUB.
-@item @code{terminal-outputs} (default: @code{'(gfxterm)})
+@item @code{terminal-outputs} (default: @var{#f})
The output terminals used for the bootloader boot menu, as a list of
-symbols. GRUB accepts the values: @code{console}, @code{serial},
-@code{serial_@{0-3@}}, @code{gfxterm}, @code{vga_text},
-@code{mda_text}, @code{morse}, and @code{pkmodem}. This field
-corresponds to the GRUB variable @code{GRUB_TERMINAL_OUTPUT} (@pxref{Simple
-configuration,,, grub,GNU GRUB manual}).
-
-@item @code{terminal-inputs} (default: @code{'()})
+symbols. When @var{#f}, the default is used. For GRUB this is @code{gfxterm}.
+GRUB accepts the values: @code{console}, @code{serial}, @code{serial_@{0-3@}},
+@code{gfxterm}, @code{vga_text}, @code{mda_text}, @code{morse}, and
+@code{pkmodem}. This field corresponds to the GRUB variable
+@code{GRUB_TERMINAL_OUTPUT}
+(@pxref{Simple configuration,,, grub,GNU GRUB manual}).
+
+@item @code{terminal-inputs} (default: @var{#f})
The input terminals used for the bootloader boot menu, as a list of
-symbols. For GRUB, the default is the native platform terminal as
-determined at run-time. GRUB accepts the values: @code{console},
-@code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
+symbols. When @var{#f}, the default is used. For GRUB, this is the native
+platform terminal as determined at run-time. GRUB accepts the values:
+@code{console}, @code{serial}, @code{serial_@{0-3@}}, @code{at_keyboard}, and
@code{usb_keyboard}. This field corresponds to the GRUB variable
@code{GRUB_TERMINAL_INPUT} (@pxref{Simple configuration,,, grub,GNU GRUB
manual}).
@@ -42364,6 +42385,53 @@ Bootloader Configuration
@end deftp
+@vindex bootloader-target
+Configuring bootloader targets uses a specialized record designed for clarity
+and to abstract the varying user-supplied paths bootloaders may need. Only the
+@code{type} field is required; Guix will attempt to extrapolate as needed from
+what information you provide, though at least one of @code{path}, @code{device},
+@code{label}, or @code{uuid} is required to do so.
+
+@deftp {Data Type} bootloader-target
+The type of a target as used in @code{bootloader-configuration}.
+
+@table @asis
+
+@item @code{type}
+What target this record is describing. Must be a symbol, for example @code{'esp}
+or @code{'disk}.
+
+@item @code{path} (default: @var{#f})
+@code{path} denotes a string path, usually interpreted by the bootloader to
+signify a mount point (such as in the case of @code{'esp}). This value is
+automatically offset from the target denoted by @code{offset}, even if the path
+given is absolute. This allows for bootloaders to know what device or partition
+a @code{path} is actually stored on, and how to locate it.
+
+@item @code{offset} (default: @code{'root} when @code{path}, otherwise @var{#f})
+All @code{path} values, even if absolute, are automatically offset from another.
+@code{offset} is a symbol denoting which target type the path should be offset
+from. This allows for bootloaders to know what device or partition a
+@code{path} is actually stored on, and how to locate it.
+
+For most setups, you don't need to deal with this.
+
+@item @code{device} (default: @var{#f})
+@itemx @code{label} (default: @var{#f})
+@itemx @code{uuid} (default: @var{#f})
+These all work as a way of defining some kind of physical device or partition.
+@code{uuid} (taking a @code{uuid} record) and @code{label} (taking a string) are
+vastly preferred over device (a string denoting a filesystem path to a block
+device), as block device names are inconsistant and unrecognized at boot-time.
+
+@item @code{file-system} (default: @var{#f})
+A string denoting a file system type, as used in @ref{File Systems}. Unless
+your filesystem isn't being detected properly, or is unmounted at bootloader
+install-time, you shouldn't need to specify this.
+
+@end table
+@end deftp
+
@cindex dual boot
@cindex boot menu
Should you want to list additional boot menu entries @i{via} the
@@ -42375,6 +42443,8 @@ Bootloader Configuration
@lisp
(menu-entry
(label "The Other Distro")
+ (device (file-system-label "boot"))
+ (device-mount-point "/boot")
(linux "/boot/old/vmlinux-2.6.32")
(linux-arguments '("root=/dev/sda2"))
(initrd "/boot/old/initrd"))
@@ -42390,6 +42460,28 @@ Bootloader Configuration
@item @code{label}
The label to show in the menu---e.g., @code{"GNU"}.
+@item @code{device} (default: @var{#f})
+The device where any files specified below are to be found--eg, for GRUB,
+@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
+
+This may be a file system label (a string), a file system UUID (a
+bytevector, @pxref{File Systems}), or @code{#f}, in which case
+the bootloader will search the device containing the file specified by
+the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
+must @emph{not} be an OS device name such as @file{/dev/sda1}.
+
+@item @code{device-mount-point} (default: @var{#f})
+This is where @code{device} is mounted onto your file system. If provided, it
+allows for you to specify full paths for provided files, which will be
+automatically realized into paths local to their device.
+
+This is not necessary if specified files are already referring to files local to
+@code{device}, including if they're on your root filesystem.
+
+@item @code{device-subvol} (default: @var{#f})
+This is a btrfs subvolume name, useful in case you wish to access files from a
+btrfs subvolume on a device. @xref{Btrfs file system}.
+
@item @code{linux} (default: @code{#f})
The Linux kernel image to boot, for example:
@@ -42397,17 +42489,6 @@ Bootloader Configuration
(file-append linux-libre "/bzImage")
@end lisp
-For GRUB, it is also possible to specify a device explicitly in the
-file path using GRUB's device naming convention (@pxref{Naming
-convention,,, grub, GNU GRUB manual}), for example:
-
-@example
-"(hd0,msdos1)/boot/vmlinuz"
-@end example
-
-If the device is specified explicitly as above, then the @code{device}
-field is ignored entirely.
-
@item @code{linux-arguments} (default: @code{'()})
The list of extra Linux kernel command-line arguments---e.g.,
@code{'("console=ttyS0")}.
@@ -42416,16 +42497,6 @@ Bootloader Configuration
A G-Expression or string denoting the file name of the initial RAM disk
to use (@pxref{G-Expressions}).
-@item @code{device} (default: @code{#f})
-The device where the kernel and initrd are to be found---i.e., for GRUB,
-@dfn{root} for this menu entry (@pxref{root,,, grub, GNU GRUB manual}).
-
-This may be a file system label (a string), a file system UUID (a
-bytevector, @pxref{File Systems}), or @code{#f}, in which case
-the bootloader will search the device containing the file specified by
-the @code{linux} field (@pxref{search,,, grub, GNU GRUB manual}). It
-must @emph{not} be an OS device name such as @file{/dev/sda1}.
-
@item @code{multiboot-kernel} (default: @code{#f})
The kernel to boot in Multiboot-mode (@pxref{multiboot,,, grub, GNU GRUB
manual}). When this field is set, a Multiboot menu-entry is generated.
@@ -42448,7 +42519,7 @@ Bootloader Configuration
To use the new and still experimental
@uref{https://darnassus.sceen.net/~hurd-web/rump_kernel/, rumpdisk
user-level disk driver} instead of GNU@tie{}Mach's in-kernel IDE driver,
-set @code{kernel-arguments} to:
+set @code{multiboot-arguments} to:
@lisp
'("noide")
@@ -42471,10 +42542,11 @@ Bootloader Configuration
@end lisp
@item @code{chain-loader} (default: @code{#f})
-A string that can be accepted by @code{grub}'s @code{chainloader}
-directive. This has no effect if either @code{linux} or
-@code{multiboot-kernel} fields are specified. The following is an
-example of chainloading a different GNU/Linux system.
+Varies slightly depending on bootloader. For @code{grub}, this is anything that
+the @code{chainloader} directive can accept
+(@pxref{Chain-loading,,, grub, GNU GRUB manual}). For @code{uki-efi}, this is
+any efi binary to be installed alongside the system. The following is an example
+of chainloading a different GNU/Linux system.
@lisp
(bootloader
@@ -42682,10 +42754,6 @@ Invoking guix system
supported by the bootloader being used. The next time the system
boots, it will use the specified system generation.
-The bootloader itself is not being reinstalled when using this
-command. Thus, the installed bootloader is used with an updated
-configuration file.
-
The target generation can be specified explicitly by its generation
number. For example, the following invocation would switch to system
generation 7:
@@ -42706,11 +42774,10 @@ Invoking guix system
@end example
Currently, the effect of invoking this action is @emph{only} to switch
-the system profile to an existing generation and rearrange the
-bootloader menu entries. To actually start using the target system
-generation, you must reboot after running this action. In the future,
-it will be updated to do the same things as @command{reconfigure},
-like activating and deactivating services.
+the system profile to an existing generation and reinstall the bootloader. To
+actually start using the target system generation, you must reboot after
+running this action. In the future, it will be updated to do the same things
+as @command{reconfigure}, like activating and deactivating services.
This action will fail if the specified generation does not exist.
@@ -42886,11 +42953,9 @@ Invoking guix system
When using the @code{qcow2} image type, the returned image is in qcow2
format, which the QEMU emulator can efficiently use. @xref{Running Guix
in a VM}, for more information on how to run the image in a virtual
-machine. The @code{grub-bootloader} bootloader is always used
-independently of what is declared in the @code{operating-system} file
-passed as argument. This is to make it easier to work with QEMU, which
-uses the SeaBIOS BIOS by default, expecting a bootloader to be installed
-in the Master Boot Record (MBR).
+machine. Currently, QEMU as packaged in Guix does not have UEFI support,
+so you should select a bootloader for BIOS systems in your
+@code{operating-system} configuration.
@cindex docker-image, creating docker images
When using the @code{docker} image type, a Docker image is produced.
@@ -43208,7 +43273,6 @@ Invoking guix deploy
;; forwarded to the host's loopback interface.
(use-service-modules networking ssh)
-(use-package-modules bootloaders)
(define %system
(operating-system
@@ -43216,7 +43280,9 @@ Invoking guix deploy
(timezone "Etc/UTC")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sda"))))
(terminal-outputs '(console))))
(file-systems (cons (file-system
(mount-point "/")
@@ -47800,6 +47866,12 @@ partition Reference
this flag set, usually the root one. The @code{'esp} flag identifies a
UEFI System Partition.
+@item @code{target} (default: @var{#f})
+If provided, this partition provides itself as a bootloader target
+(@pxref{Bootloader Configuration}). Most commonly, this is used to provide the
+@code{'root} and @code{'esp} targets, with the root partition and EFI System
+Partition, respectively, though this can provide any target necessary.
+
@item @code{initializer} (default: @code{#false})
The partition initializer procedure as a gexp. This procedure is called
to populate a partition. If no initializer is passed, the
@@ -47848,6 +47920,7 @@ Instantiate an Image
(label "GNU-ESP")
(file-system "vfat")
(flags '(esp))
+ (target 'esp)
(initializer (gexp initialize-efi-partition)))
(partition
(size (* 50 MiB))
@@ -47864,14 +47937,15 @@ Instantiate an Image
(label root-label)
(file-system "ext4")
(flags '(boot))
+ (target 'root)
(initializer (gexp initialize-root-partition))))))
@end lisp
-Note that the first and third partitions use generic initializers
-procedures, initialize-efi-partition and initialize-root-partition
-respectively. The initialize-efi-partition installs a GRUB EFI loader
-that is loading the GRUB bootloader located in the root partition. The
-initialize-root-partition instantiates a complete system as defined by
+Note that the first and third partitions use generic initializer
+procedures, @code{initialize-efi-partition} and @code{initialize-root-partition}
+respectively. @code{initialize-efi-partition} simply creates the directory
+structure for an EFI bootloader to install itself to.
+@code{initialize-root-partition} instantiates a complete system as defined by
the @code{%simple-os} operating-system.
You can now run:
@@ -47929,10 +48003,6 @@ Instantiate an Image
@code{i686} machines, supporting BIOS or UEFI booting.
@end defvar
-@defvar efi32-disk-image
-Same as @code{efi-disk-image} but with a 32 bits EFI partition.
-@end defvar
-
@defvar iso9660-image
An ISO-9660 image composed of a single bootable partition. This image
can also be used on most @code{x86_64} and @code{i686} machines.
@@ -48023,10 +48093,6 @@ image-type Reference
Build an image based on the @code{efi-disk-image} image.
@end defvar
-@defvar efi32-raw-image-type
-Build an image based on the @code{efi32-disk-image} image.
-@end defvar
-
@defvar qcow2-image-type
Build an image based on the @code{mbr-disk-image} image but with the
@code{compressed-qcow2} image format.
@@ -48054,14 +48120,14 @@ image-type Reference
@defvar pinebook-pro-image-type
Build an image that is targeting the Pinebook Pro machine. The MBR
image contains a single partition starting at a @code{9MiB} offset. The
-@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader will be
+@code{u-boot-pinebook-pro-rk3399-bootloader} bootloader can be
installed in this gap.
@end defvar
@defvar rock64-image-type
Build an image that is targeting the Rock64 machine. The MBR image
contains a single partition starting at a @code{16MiB} offset. The
-@code{u-boot-rock64-rk3328-bootloader} bootloader will be installed in
+@code{u-boot-rock64-rk3328-bootloader} bootloader can be installed in
this gap.
@end defvar
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 14/15] gnu: tests: Update tests to new targets system.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (12 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 13/15] doc: Update bootloader documentation Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 0:11 ` [bug#72457] [PATCH v5 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
` (2 subsequent siblings)
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov, Maxim Cournoyer
* gnu/services/virtualization.scm
(%virtual-build-machine-operating-system): Remove bootloader.
(%hurd-vm-operating-system): Remove targets.
* gnu/system/hurd.scm (%hurd-default-operating-system): Remove targets.
* gnu/tests.scm (%simple-os), gnu/tests/ganeti.scm (%ganeti-os),
gnu/tests/image.scm (%simple-efi-os),
gnu/tests/install.scm (%minimal-os, %minimal-extlinux-os,
%minimal-os-on-vda, %separate-home-os, %separate-store-os, %raid-root-os,
%encrypted-root-os, %lvm-separate-home-os, %encrypted-home-os,
%encrypted-home-os-key-file, %encrypted-root-not-boot-os,
%btrfs-root-os-source, %btrfs-raid-root-os-source,
%btrfs-root-on-subvolume-os, %btrfs-raid10-root-os, %jfs-root-os,
%f2fs-root-os, %xfs-root-os), gnu/tests/nfs.scm (%base-os),
gnu/tests/telephony.scm (make-jami-os), gnu/tests/vnc.scm (%xvnc-os):
Update bootloader targets.
Change-Id: I3d66a839a9b2a73b8b65946950728b1e0155ca1e
---
gnu/services/virtualization.scm | 11 ++---
gnu/system/hurd.scm | 4 +-
gnu/tests.scm | 4 +-
gnu/tests/ganeti.scm | 4 +-
gnu/tests/image.scm | 4 +-
gnu/tests/install.scm | 72 ++++++++++++++++++++++++---------
gnu/tests/nfs.scm | 4 +-
gnu/tests/telephony.scm | 4 +-
gnu/tests/vnc.scm | 4 +-
tests/boot-parameters.scm | 2 +-
10 files changed, 77 insertions(+), 36 deletions(-)
diff --git a/gnu/services/virtualization.scm b/gnu/services/virtualization.scm
index d87e494348..f698532a94 100644
--- a/gnu/services/virtualization.scm
+++ b/gnu/services/virtualization.scm
@@ -1191,17 +1191,13 @@ (define %minimal-vm-syslog-config
(define %virtual-build-machine-operating-system
(operating-system
(host-name "build-machine")
-
(locale "en_US.utf8")
(locale-definitions
;; Save space by providing only one locale.
(list (locale-definition (name "en_US.utf8")
(source "en_US")
(charset "UTF-8"))))
-
- (bootloader (bootloader-configuration ;unused
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/null"))))
+ ;; no bootloader
(file-systems (cons (file-system ;unused
(mount-point "/")
(device "none")
@@ -1624,9 +1620,8 @@ (define %hurd-vm-operating-system
(host-name "childhurd")
(timezone "Europe/Amsterdam")
(bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))
- (timeout 0)))
+ (bootloader grub-minimal-bootloader)
+ (timeout 0)))
(packages (cons* gdb-minimal
(operating-system-packages
%hurd-default-operating-system)))
diff --git a/gnu/system/hurd.scm b/gnu/system/hurd.scm
index cbe0081382..af04e82485 100644
--- a/gnu/system/hurd.scm
+++ b/gnu/system/hurd.scm
@@ -119,9 +119,7 @@ (define %hurd-default-operating-system
(kernel %hurd-default-operating-system-kernel)
(kernel-arguments '())
(hurd hurd)
- (bootloader (bootloader-configuration
- (bootloader grub-minimal-bootloader)
- (targets '("/dev/vda"))))
+ (bootloader (bootloader-configuration (bootloader grub-minimal-bootloader)))
(initrd #f)
(initrd-modules '())
(firmware '())
diff --git a/gnu/tests.scm b/gnu/tests.scm
index 5ff9db82fc..f46ccf5174 100644
--- a/gnu/tests.scm
+++ b/gnu/tests.scm
@@ -237,7 +237,9 @@ (define %simple-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device"/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/ganeti.scm b/gnu/tests/ganeti.scm
index 29eb354044..789879b26f 100644
--- a/gnu/tests/ganeti.scm
+++ b/gnu/tests/ganeti.scm
@@ -40,7 +40,9 @@ (define %ganeti-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/image.scm b/gnu/tests/image.scm
index be6852cae0..8d960cf7b8 100644
--- a/gnu/tests/image.scm
+++ b/gnu/tests/image.scm
@@ -55,7 +55,9 @@ (define %simple-efi-os
(inherit %simple-os)
(bootloader (bootloader-configuration
(bootloader grub-efi-bootloader)
- (targets '("/boot/efi"))))))
+ (targets (list (bootloader-target
+ (type 'esp)
+ (path "/boot/efi"))))))))
;; An MBR disk image with a single ext4 partition.
(define i1
diff --git a/gnu/tests/install.scm b/gnu/tests/install.scm
index 18a2fc119b..d67a71f12e 100644
--- a/gnu/tests/install.scm
+++ b/gnu/tests/install.scm
@@ -103,7 +103,9 @@ (define-os-with-source (%minimal-os %minimal-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -141,7 +143,9 @@ (define-os-with-source (%minimal-extlinux-os
(bootloader (bootloader-configuration
(bootloader extlinux-gpt-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -434,7 +438,9 @@ (define-os-with-source (%minimal-os-on-vda %minimal-os-on-vda-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vda"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vda"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -510,7 +516,9 @@ (define-os-with-source (%separate-home-os %separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "my-root"))
@@ -565,7 +573,9 @@ (define-os-with-source (%separate-store-os %separate-store-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "root-fs"))
@@ -642,7 +652,9 @@ (define-os-with-source (%raid-root-os %raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
;; Add a kernel module for RAID-1 (aka. "mirror").
@@ -725,7 +737,9 @@ (define-os-with-source (%encrypted-root-os %encrypted-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -858,7 +872,9 @@ (define-os-with-source (%lvm-separate-home-os %lvm-separate-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(mapped-devices (list (mapped-device
@@ -943,7 +959,9 @@ (define-os-with-source (%encrypted-home-os %encrypted-home-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
;; Note: Do not pass "console=ttyS0" so we can use our passphrase prompt
;; detection logic in 'enter-luks-passphrase'.
@@ -1070,7 +1088,9 @@ (define-os-with-source (%encrypted-home-os-key-file
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))
(extra-initrd "/key-file.cpio")))
(kernel-arguments '("console=ttyS0"))
@@ -1130,7 +1150,9 @@ (define-os-with-source (%encrypted-root-not-boot-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(mapped-devices (list (mapped-device
(source
@@ -1232,7 +1254,9 @@ (define-os-with-source (%btrfs-root-os %btrfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1306,7 +1330,9 @@ (define-os-with-source (%btrfs-raid-root-os %btrfs-raid-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
@@ -1374,7 +1400,9 @@ (define-os-with-source (%btrfs-root-on-subvolume-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
(device (file-system-label "btrfs-pool"))
@@ -1467,7 +1495,9 @@ (define-os-with-source (%btrfs-raid10-root-os
(bootloader (map (lambda (targ)
(bootloader-configuration
(bootloader grub-bootloader)
- (targets (list targ))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device targ))))))
'("/dev/vdb" "/dev/vdc" "/dev/vdd" "/dev/vde")))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons* (file-system
@@ -1577,7 +1607,9 @@ (define-os-with-source (%jfs-root-os %jfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1650,7 +1682,9 @@ (define-os-with-source (%f2fs-root-os %f2fs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
@@ -1723,7 +1757,9 @@ (define-os-with-source (%xfs-root-os %xfs-root-os-source)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets (list "/dev/vdb"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/vdb"))))))
(kernel-arguments '("console=ttyS0"))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 0d9972e0e9..2f97126df7 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -51,7 +51,9 @@ (define %base-os
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems %base-file-systems)
(users %base-user-accounts)
(packages (cons*
diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index f03ea963f7..ee858d9c91 100644
--- a/gnu/tests/telephony.scm
+++ b/gnu/tests/telephony.scm
@@ -90,7 +90,9 @@ (define* (make-jami-os #:key provisioning? partial?)
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/gnu/tests/vnc.scm b/gnu/tests/vnc.scm
index ab1c2749f3..cba9c565e0 100644
--- a/gnu/tests/vnc.scm
+++ b/gnu/tests/vnc.scm
@@ -51,7 +51,9 @@ (define %xvnc-os
(locale "en_US.UTF-8")
(bootloader (bootloader-configuration
(bootloader grub-bootloader)
- (targets '("/dev/sdX"))))
+ (targets (list (bootloader-target
+ (type 'disk)
+ (device "/dev/sdX"))))))
(file-systems (cons (file-system
(device (file-system-label "my-root"))
(mount-point "/")
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index f214de360d..f343dbdfdb 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -63,7 +63,7 @@ (define %root-path "/")
(define %grub-boot-parameters
(boot-parameters
- (bootloader-name 'grub)
+ (bootloader-name '(grub))
(root-device %default-root-device)
(label %default-label)
(kernel %default-kernel)
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 15/15] teams: Add bootloading team.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (13 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 14/15] gnu: tests: Update tests to new targets system Lilah Tascheter via Guix-patches
@ 2024-08-07 0:11 ` Lilah Tascheter via Guix-patches
2024-08-07 4:52 ` [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem Sergey Trofimov
2024-09-06 22:15 ` guix-patches--- via
16 siblings, 0 replies; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-08-07 0:11 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Sergey Trofimov
Might as well, to help ease the transition.
* etc/teams.scm (bootloaders): New team.
(Lilah Tascheter): Create add to above.
Change-Id: I63620f4e3151bb8e3d0bdf619fc70501af6397a0
---
etc/teams.scm | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/etc/teams.scm b/etc/teams.scm
index 408ebbf3d9..d9af4ad7bb 100755
--- a/etc/teams.scm
+++ b/etc/teams.scm
@@ -328,6 +328,12 @@ (define-team embedded
#:scope (list "gnu/packages/bootloaders.scm"
"gnu/packages/firmware.scm")))
+(define-team bootloaders
+ (team 'bootloaders
+ #:name "Bootloaders"
+ #:scope (list "gnu/bootloader.scm"
+ (make-regexp* "^gnu/bootloader/"))))
+
(define-team rust
(team 'rust
#:name "Rust"
@@ -746,6 +752,10 @@ (define-member (person "Nicolas Goaziou"
"guix@nicolasgoaziou.fr")
tex)
+(define-member (person "Lilah Tascheter"
+ "lilah@lunabee.space")
+ bootloaders)
+
\f
(define (find-team name)
(or (hash-ref %teams (string->symbol name))
--
2.45.2
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (14 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 15/15] teams: Add bootloading team Lilah Tascheter via Guix-patches
@ 2024-08-07 4:52 ` Sergey Trofimov
2024-09-06 22:15 ` guix-patches--- via
16 siblings, 0 replies; 95+ messages in thread
From: Sergey Trofimov @ 2024-08-07 4:52 UTC (permalink / raw)
To: Lilah Tascheter; +Cc: 72457
Hi Lilah,
Lilah Tascheter <lilah@lunabee.space> writes:
> Alright, hopefully this works then!
>
It works with the following patch applied! I'll test other bootloaders
later in the week.
--8<---------------cut here---------------start------------->8---
diff --git a/gnu/bootloader/grub.scm b/gnu/bootloader/grub.scm
index 7bb7e4eefa..cb68744135 100644
--- a/gnu/bootloader/grub.scm
+++ b/gnu/bootloader/grub.scm
@@ -259,7 +259,7 @@ (define* (core.img grub format #:key bootloader-config store-crypto-devices
'#$(if tftp? '() '("part_msdos" "part_gpt"))
;; file systems
'#$(cond ((member fs '("ext2" "ext3" "ext4")) '("ext2"))
- ((member fs "vfat" "fat32") '("fat"))
+ ((member fs '("vfat" "fat32")) '("fat"))
((and tftp? efi?) '("efinet"))
((and tftp? bios?) '("pxe"))
(else (list fs)))
--8<---------------cut here---------------end--------------->8---
^ permalink raw reply related [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem.
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
` (15 preceding siblings ...)
2024-08-07 4:52 ` [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem Sergey Trofimov
@ 2024-09-06 22:15 ` guix-patches--- via
2024-09-07 5:48 ` Sergey Trofimov
16 siblings, 1 reply; 95+ messages in thread
From: guix-patches--- via @ 2024-09-06 22:15 UTC (permalink / raw)
To: Lilah Tascheter; +Cc: 72457, Sergey Trofimov
Good evening.
I am a Guix user who wants to learn patch review. Next week I am not
going to have any job assignments, so this is a great opportunity to
install guix on my newly purchased fanless mini computer. This means I
could also spend some time fearlessly checking out the new bootloader
implementation.
The plan is to patch a clone of the guix repository, and issue
./pre-inst-env guix system init command. Let me know if there is
something wrong with this assumption.
Also, I noticed this issue is not tracked on Guix QA. I am still
learning the review process — is it not bad that the patches are not in
QA?
^ permalink raw reply [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem.
2024-09-06 22:15 ` guix-patches--- via
@ 2024-09-07 5:48 ` Sergey Trofimov
2024-09-07 7:15 ` guix-patches--- via
0 siblings, 1 reply; 95+ messages in thread
From: Sergey Trofimov @ 2024-09-07 5:48 UTC (permalink / raw)
To: Marek Paśnikowski; +Cc: Lilah Tascheter, 72457
Marek Paśnikowski <marek@marekpasnikowski.pl> writes:
> Good evening.
>
> I am a Guix user who wants to learn patch review. Next week I am not
> going to have any job assignments, so this is a great opportunity to
> install guix on my newly purchased fanless mini computer. This means I
> could also spend some time fearlessly checking out the new bootloader
> implementation.
>
> The plan is to patch a clone of the guix repository, and issue
> ./pre-inst-env guix system init command. Let me know if there is
> something wrong with this assumption.
>
That should do the job, however in my case I did `reconfigure` and not
`init`. For patching I recommend you to use `mumi`.
>
> Also, I noticed this issue is not tracked on Guix QA. I am still
> learning the review process — is it not bad that the patches are not in
> QA?
>
QA is still pretty much Work In Progress, it is not reliable atm.
^ permalink raw reply [flat|nested] 95+ messages in thread
* [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem.
2024-09-07 5:48 ` Sergey Trofimov
@ 2024-09-07 7:15 ` guix-patches--- via
0 siblings, 0 replies; 95+ messages in thread
From: guix-patches--- via @ 2024-09-07 7:15 UTC (permalink / raw)
To: Sergey Trofimov; +Cc: Lilah Tascheter, 72457
Sergey Trofimov <sarg@sarg.org.ru> writes:
> Marek Paśnikowski <marek@marekpasnikowski.pl> writes:
>
>> Good evening.
>>
>> I am a Guix user who wants to learn patch review. Next week I am not
>> going to have any job assignments, so this is a great opportunity to
>> install guix on my newly purchased fanless mini computer. This means I
>> could also spend some time fearlessly checking out the new bootloader
>> implementation.
>>
>> The plan is to patch a clone of the guix repository, and issue
>> ./pre-inst-env guix system init command. Let me know if there is
>> something wrong with this assumption.
>>
>
> That should do the job, however in my case I did `reconfigure` and not
> `init`. For patching I recommend you to use `mumi`.
Yes, yesterday I have watched jgart’s introduction to mumi and I am
halfway there with integration of mumi into my workflow. I plan to 'init'
the system because the target is an empty device.
Thirty minutes ago I ensured that my local clone of guix is reset to
master, updated and issued the ~mumi am -- -s~ command. It failed to
apply on the first patch to =guix/scripts/system.scm=.
I was unsure because this issue has five versions of the patches. I
tried ~mumi am 5 -- -s~, which errored, and then ~mumi am v5 -- -s~,
which worked and proceeded to fail to apply.
I investigated a little and found that the last change to the file was
commited on June 1 2024, most likely merged with the recent core update.
I am still not 100% sure that this not a problem with my usage of mumi,
as the tool’s documentation as too poor, but seeing as it accepted the
=v5= spec argument, I feel confident enough to send this report.
^ permalink raw reply [flat|nested] 95+ messages in thread
* [bug#72457] [PATCH v5 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (19 preceding siblings ...)
2024-08-07 0:11 ` [bug#72457] [PATCH v5 " Lilah Tascheter via Guix-patches
@ 2024-09-12 18:08 ` Herman Rimm via Guix-patches via
2024-09-13 7:56 ` Herman Rimm via Guix-patches via
2024-09-15 9:11 ` [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem Herman Rimm via Guix-patches via
21 siblings, 1 reply; 95+ messages in thread
From: Herman Rimm via Guix-patches via @ 2024-09-12 18:08 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Marek Paśnikowski, Sergey Trofimov
Hello all,
I revised [PATCH v5 01/15], see issue #73202. I had already begun
making similar changes to the other patches, have a look at [1]. I
rebase it often, and in that case you may find 'git fetch [remote for
[1]] bootloader', 'git reset [remote for [1]]/bootloader' and 'git
restore -p' helpful to keep track with a local branch. If you have any
(small) changes feel free to send me a patch or repository URL.
Also, a compatibility macro would be worth looking into, see for example
origin-compatibility-helper in (guix packages). A macro for the targets
field of bootloader-configuration could use each string as a path for
bootloader-target and make an educated guess for the type field based on
that path, or the bootloader itself. Would that leave your existing
configuration(s) intact? Anyway, I don't plan to work on that this
week, so feel free to.
Cheers,
Herman
[1]: https://codeberg.org/herman_rimm/guix/src/branch/bootloader
^ permalink raw reply [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data.
2024-09-12 18:08 ` [bug#72457] [PATCH v5 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Herman Rimm via Guix-patches via
@ 2024-09-13 7:56 ` Herman Rimm via Guix-patches via
0 siblings, 0 replies; 95+ messages in thread
From: Herman Rimm via Guix-patches via @ 2024-09-13 7:56 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Marek Paśnikowski, Sergey Trofimov
Hello,
On Thu, Sep 12, 2024 at 08:08:50PM +0200, Herman Rimm wrote:
> Also, a compatibility macro would be worth looking into, see for example
> origin-compatibility-helper in (guix packages). A macro for the targets
> field of bootloader-configuration could use each string as a path for
> bootloader-target and make an educated guess for the type field based on
> that path, or the bootloader itself.
So it would make more sense to use a field sanitizer to do that, and
looking at warn-update-targets in (gnu bootloader), it already does
that. Sorry for the noise.
Cheers,
Herman
^ permalink raw reply [flat|nested] 95+ messages in thread
* [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem.
2024-08-04 3:50 [bug#72457] [PATCH 00/15] Rewrite bootloader subsystem Lilah Tascheter via Guix-patches
` (20 preceding siblings ...)
2024-09-12 18:08 ` [bug#72457] [PATCH v5 01/15] guix: scripts: Rewrite reinstall-bootloader to use provenance data Herman Rimm via Guix-patches via
@ 2024-09-15 9:11 ` Herman Rimm via Guix-patches via
2024-09-17 22:20 ` Lilah Tascheter via Guix-patches
21 siblings, 1 reply; 95+ messages in thread
From: Herman Rimm via Guix-patches via @ 2024-09-15 9:11 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter, Marek Paśnikowski, Sergey Trofimov
Hi,
I dislike that so few patches change from revision to revision,
according to the diffstat. I like the ratio of discussion to patch
submission messages in #68524 more, and I think splitting the patches
over multiple series will result in fewer patch submissions overall and
discussion that is relevant to every patch in a series.
I would like to submit a rewritten patch series. Basically, it would
consist of patches #4, #6, #12, #13, and #14. I want to submit #1, #2,
#3, #5 and #15 to issue #73202, and #7, #8, #9, #10 (excl. efibootmgr)
and #11 to #68524.
Parts of patch #4 which fit better with #73202 or function standalone
would be submitted to #73202. Finally, #4 will be split into seven to
ten patches, hopefully making referring to changes easier and review
less demanding.
Please let me know what you think about the proposed patch series.
By the way, assuming 'herman' is the remote for [1], you can see the
current changes of my rewrite by running: git diff herman/bootloader-v5
herman/uki-efi-bootloader.
Aside from that, %test-installed-os is broken for (at least) the v5
patch series. It results in [2], after having fixed
guix/scripts/system.scm like so:
(mlet* %store-monad
((alt -> (generation->boot-alternative profile 1))
(inst (apply install-bootloader local-eval bootloaders
- (list alt) #:dry-run (not install-bootloader?)
+ (list alt) #:dry-run? (not install-bootloader?)
#:root-offset target bootmeta)))
(maybe-copy (derivation->output-path inst)))
The steps I took to get [2] are: create channels.scm for my bootloader
branch, git checkout the branch, append %test-installed-os to
gnu/tests/install.scm, and run guix time-machine -C channels.scm --
build -f gnu/tests/install.scm.
On master (or issue #69343) it seems grub.cfg is built together with the
system and provenance derivations, before 'initializing operating system
under /mnt'. If anything, let me know if you fail to reproduce [2] with
the fixed v5 series or on my branch. I will try fix [2] next weekend,
so feel free to look into it this week.
Cheers,
Herman
[1]: https://codeberg.org/herman_rimm/guix
[2]:
...
guix (GNU Guix) 1022e6330f17bd5fa2cddbc29c7f9bebb9c1fe0e
Copyright (C) 2024 the Guix authors
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
+ export GUIX_BUILD_OPTIONS=--no-grafts
+ GUIX_BUILD_OPTIONS=--no-grafts
+ guix build isc-dhcp
/gnu/store/xai38dx802al26bnxcb788y027r5y7m5-isc-dhcp-4.4.3-P1
[1m[0m+ parted --script /dev/vdb mklabel gpt mkpart primary ext2 1M 3M mkpart primary ext2 3M 1.6G set 1 boot on set 1 bios_grub on
[ 62.769814] vdb: vdb1 vdb2
+ mkfs.ext4 -L my-root /dev/vdb2
mke2fs 1.47.0 (5-Feb-2023)
Discarding device blocks: 0/389888\b\b\b\b\b\b\b\b\b\b\b\b\b \b\b\b\b\b\b\b\b\b\b\b\b\bdone
Creating filesystem with 389888 4k blocks and 97536 inodes
Filesystem UUID: 043cc525-a895-466f-9265-b5aeea921454
Superblock backups stored on blocks:
32768, 98304, 163840, 229376, 294912
Allocating group tables: 0/12\b\b\b\b\b \b\b\b\b\bdone
Writing inode tables: 0/12\b\b\b\b\b \b\b\b\b\bdone
Creating journal (8192 blocks): done
Writing superblocks and filesystem accounting information: 0/12\b\b\b\b\b \b\b\b\b\bdone
+ mount /dev/vdb2 /mnt
[ 63.052091] EXT4-fs (vdb2): mounted filesystem 043cc525-a895-466f-9265-b5aeea921454 r/w with ordered data mode. Quota mode: none.
+ df -h /mnt
Filesystem Size Used Avail Use% Mounted on
/dev/vdb2 1.5G 404K 1.4G 1% /mnt
+ herd start cow-store /mnt
Service user-homes has been started.
Starting service cow-store...
Service cow-store has been started.
+ mkdir /mnt/etc
+ cp /etc/target-config.scm /mnt/etc/config.scm
+ guix system init /mnt/etc/config.scm /mnt --no-substitutes
[1;35mThe following derivations will be built:
[0m [2m/gnu/store/gs0rca6bwf8q6qd3x1k01bsp55g2i3hr-[0msystem.drv
[2m/gnu/store/xvzfxgrsjch583l28davaz2wi80nzvkj-[0mprovenance.drv
[1m[0m
[Kbuilding /gnu/store/xvzfxgrsjch583l28davaz2wi80nzvkj-provenance.drv...
[K
[Kbuilding /gnu/store/gs0rca6bwf8q6qd3x1k01bsp55g2i3hr-system.drv...
[K/gnu/store/77pr7kifgjypha2hy0r1yxwmcg8aq9jn-system
initializing operating system under '/mnt'...
populating '/mnt'...
[1;35mThe following derivations will be built:
[0m [2m/gnu/store/zvn5lrkaxfv4nj60v8h1fqqy4g1akybh-[0mmodule-import.drv
[2m/gnu/store/k93g3ifqka252zb72kl433wh7fw8nicq-[0mmodule-import-compiled.drv
[2m/gnu/store/1sgmdnq6zpdsmycbmssd7980fs8y45s8-[0minstall-bootloader.scm.drv
[2m/gnu/store/5r4h565d6i8kx1ym0w2ynnzidggk0yg1-[0mmodule-import.drv
[2m/gnu/store/6pmgvmr1hwj7pz7k4nxl899rjpn5g259-[0mmodule-import-compiled.drv
[2m/gnu/store/hdv9h1ncyadn4k3vl0ls5mlzh75d16ka-[0mcore.img.drv
[2m/gnu/store/3ik7z6x0kd140rdzsp9g6kd8dpk22syp-[0mcore.cfg.drv
[2m/gnu/store/ln9848cyw0dkvnihvxkxbs05sakqd8la-[0mgrub.dir.drv
[2m/gnu/store/3vl0qggja79733r1dsc5mjfj888cj13y-[0mgrub.cfg.drv
[2m/gnu/store/a6vnyj0s34w9ad962h8g2g98ihkql7zm-[0mgrub-image.png.drv
[2m/gnu/store/53fady56y14p4y0a7aw8rypc3qwbb1xs-[0mguile-cairo-1.11.2.drv
[2m/gnu/store/09cwfzjgg02zcf66361qhxsfcanim7zl-[0mmake-4.4.1.drv
[2m/gnu/store/09kis2ig2xk8xrgwzh2y42ya0jwkmc4a-[0mbzip2-boot0-1.0.8.drv
[2m/gnu/store/0vnv3n7vllwb4672rxsd6xkfx50lz2is-[0mxz-mesboot-5.4.5.drv
...
[1m[0m
[Kbuilding /gnu/store/zvn5lrkaxfv4nj60v8h1fqqy4g1akybh-module-import.drv...
[K
[Kbuilding /gnu/store/hx1w3j5icxgrhjhvkvs8cc00iag88cay-CPAN-Meta-2.150010.tar.gz.drv...
[K\
[K|
...
[K/builder for `/gnu/store/hx1w3j5icxgrhjhvkvs8cc00iag88cay-CPAN-Meta-2.150010.tar.gz.drv' failed to produce output path `/gnu/store/vbcdsc51aypfxaw6nf2qcdn3kyfx4ixb-CPAN-Meta-2.150010.tar.gz'
[K[31;1mbuild of /gnu/store/hx1w3j5icxgrhjhvkvs8cc00iag88cay-CPAN-Meta-2.150010.tar.gz.drv failed[0m
[1mView build log at '/var/log/guix/drvs/hx/1w3j5icxgrhjhvkvs8cc00iag88cay-CPAN-Meta-2.150010.tar.gz.drv.gz'.[0m
[Kbuilding /gnu/store/1498qsnrk07npvl4sblvlrpc1nhssjj9-CPAN-Meta-Requirements-2.140.tar.gz.drv...
cannot build derivation `/gnu/store/6lxv0agdrs4xfg4kjw4fakmsdsy83l5i-perl-cpan-meta-2.150010.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/acys5h6lbbrf66jssw3081saxc9g1mn4-perl-parse-cpan-meta-2.150010.drv': 1 dependencies couldn't be built
[Kbuilding /gnu/store/qnrf3grnxbb3z9a05jd77lbjry7xk5mv-Cython-0.29.32.tar.gz.drv...
cannot build derivation `/gnu/store/5qnifhvpm2zlm7wic44z06qih5mw337h-perl-test-pod-1.52.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/wikxyp9h4a21j3k0wvpl8pq0wzfz4zmd-perl-unicode-utf8-0.62.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/j0bv34d7z1wi0w79ggvmrq71yjklv46x-perl-path-tiny-0.118.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/4064nhqy89x4va9dryq9mi5fprp8b61d-perl-xml-xpath-1.48.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/103sn6krasxcca0wm4s1w4lhvqhj8j44-docbook-xsl-1.79.2-0.fe16c90.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/c8pfxw2akqj6za5vs1xdhci1zvjfjiji-vala-0.56.16.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/68i1misqx2w581cylh3hzkr7v6a0hws7-librsvg-2.56.4.drv': 1 dependencies couldn't be built
[Kbuilding /gnu/store/83y4zf06iqv3xjz3pjzhmdim76bs53p2-Python-3.10.7.tar.xz.drv...
cannot build derivation `/gnu/store/6csl2268yhidg8vddy6nb32623fxkypk-guile-rsvg-2.18.1-0.05c6a2f.drv': 1 dependencies couldn't be built
[Kbuilding /gnu/store/3ik7z6x0kd140rdzsp9g6kd8dpk22syp-core.cfg.drv...
cannot build derivation `/gnu/store/a6vnyj0s34w9ad962h8g2g98ihkql7zm-grub-image.png.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/ln9848cyw0dkvnihvxkxbs05sakqd8la-grub.dir.drv': 1 dependencies couldn't be built
cannot build derivation `/gnu/store/1sgmdnq6zpdsmycbmssd7980fs8y45s8-install-bootloader.scm.drv': 1 dependencies couldn't be built
guix system: [1;31merror: [0mbuild of `/gnu/store/1sgmdnq6zpdsmycbmssd7980fs8y45s8-install-bootloader.scm.drv' failed
environment variable `PATH' set to `/gnu/store/h6n705ghnl1qi7p4xm7z796nx7cl7dv0-qemu-minimal-8.2.2/bin'
QEMU runs as PID 22
connected to QEMU's monitor
read QEMU monitor prompt
connected to guest REPL
marionette is ready
;;; (uname #("Linux" "gnu" "6.10.7-gnu" "#1 SMP PREEMPT_DYNAMIC 1" "x86_64"))
^ permalink raw reply [flat|nested] 95+ messages in thread* [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem.
2024-09-15 9:11 ` [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem Herman Rimm via Guix-patches via
@ 2024-09-17 22:20 ` Lilah Tascheter via Guix-patches
2024-09-19 15:35 ` Herman Rimm via Guix-patches via
0 siblings, 1 reply; 95+ messages in thread
From: Lilah Tascheter via Guix-patches @ 2024-09-17 22:20 UTC (permalink / raw)
To: 72457; +Cc: Herman Rimm
> I dislike that so few patches change from revision to revision,
> according to the diffstat.
yeah, didn't feel the best to have to re-send the whole series for each
small change.
> I would like to submit a rewritten patch series. Basically, it would
> consist of patches #4, #6, #12, #13, and #14.
since efi's getting split out, would it make sense to split #6 out too?
though, that could pose issues if it gets forgotten and the others get
merged. your choice!
> I want to submit #1, #2, #3, #5 and #15 to issue #73202
so, #73202'd end up being a general cleanup of the current bootloader
system, right? I feel #2 wouldn't quite fit there, seeing as it just
adds the infastructure needed for #4.
> #7, #8, #9, #10 (excl. efibootmgr) and #11 to #68524.
I'll send an unmerge to #68524 then!
> Parts of patch #4 which fit better with #73202 or function standalone
> would be submitted to #73202. Finally, #4 will be split into seven
> to ten patches, hopefully making referring to changes easier and
> review less demanding.
this sounds great! but,
good fucking luck splitting up #4. a ton of the changes are
interconnected, and it'll be a pain to do so if you don't want some
commits to just not compile. if you can pull it off, that'd be amazing!
> [1]: https://codeberg.org/herman_rimm/guix
typo in gnu/build/bootloader.scm "thtat", also
gnu/system/install.scm(embedded-installation-os) operating-system-
bootloader's default is '(), not #f. otherwise, this looks great!!!
I'm also thinking now, since you mentioned the operating-system-
bootloader sanitizer in a previous email, it'd probably be a good idea
to expand the sanitizer to detect for 'part type targets too. a simple
/dev/.*[0-9] regex should work well? I can write a quick patch up for
you, or you can just include that when making the new patch series if
you'd prefer?
> [2]: ...
looks like the failure here was caused by cpan failing to build, which
shouldn't be (hopefully isn't) a result of this patchset. what does the
build log mentioned say?
thanks so much for all the help, by the way :)
- lilah
^ permalink raw reply [flat|nested] 95+ messages in thread
* [bug#72457] [PATCH v5 00/15] Rewrite bootloader subsystem.
2024-09-17 22:20 ` Lilah Tascheter via Guix-patches
@ 2024-09-19 15:35 ` Herman Rimm via Guix-patches via
0 siblings, 0 replies; 95+ messages in thread
From: Herman Rimm via Guix-patches via @ 2024-09-19 15:35 UTC (permalink / raw)
To: 72457; +Cc: Lilah Tascheter
On Tue, Sep 17, 2024 at 05:20:05PM -0500, Lilah Tascheter wrote:
> > I would like to submit a rewritten patch series. Basically, it would
> > consist of patches #4, #6, #12, #13, and #14.
> since efi's getting split out, would it make sense to split #6 out too?
> though, that could pose issues if it gets forgotten and the others get
> merged. your choice!
I would rather not adapt the existing Raspberry Pi bootloader to the new
system.
> > I want to submit #1, #2, #3, #5 and #15 to issue #73202
> so, #73202'd end up being a general cleanup of the current bootloader
> system, right? I feel #2 wouldn't quite fit there, seeing as it just
> adds the infastructure needed for #4.
#73202 is also preparation for this issue. I think #2 is big enough for
it to reviewed on its own outside of this issue, and that #73202 is
small enough to fit #2.
> > #7, #8, #9, #10 (excl. efibootmgr) and #11 to #68524.
> I'll send an unmerge to #68524 then!
Thanks.
> > Parts of patch #4 which fit better with #73202 or function standalone
> > would be submitted to #73202. Finally, #4 will be split into seven
> > to ten patches, hopefully making referring to changes easier and
> > review less demanding.
> this sounds great! but,
> good fucking luck splitting up #4. a ton of the changes are
> interconnected, and it'll be a pain to do so if you don't want some
> commits to just not compile. if you can pull it off, that'd be amazing!
I don't intend for the commits to compile. It's to adequately describe
the changes while fitting each commit message on a monitor and to give
reviewers the choice of squashing them together into one working commit.
> > [1]: https://codeberg.org/herman_rimm/guix
> typo in gnu/build/bootloader.scm "thtat", also
> gnu/system/install.scm(embedded-installation-os) operating-system-
> bootloader's default is '(), not #f. otherwise, this looks great!!!
Fixed, thanks.
> I'm also thinking now, since you mentioned the operating-system-
> bootloader sanitizer in a previous email, it'd probably be a good idea
> to expand the sanitizer to detect for 'part type targets too. a simple
> /dev/.*[0-9] regex should work well? I can write a quick patch up for
> you, or you can just include that when making the new patch series if
> you'd prefer?
I had stashed the changes I made to warn-update-targets. I do try to
create branches and fixup commits instead to better track changes.
Anyway, maybe you can send a diff based on/relative to:
;; Based on report-duplicate-field-specifier from (guix records).
(define (report-duplicate-type-field targets)
"Report the first target with duplicate type among TARGETS."
(let loop ((targets targets)
(seen '()))
(match targets
((target rest ...)
(let (type (bootloader-target-type target)))
(when (memq type seen)
(error loc (G_ "target with duplicate type~%") duplicate))
(loop rest (cons type seen)))
(() #t))))
(define-with-syntax-properties (warn-update-targets (targets properties))
(let ((targets (if (list? targets) targets (list targets)))
(loc (source-properties->location properties)))
(define string->target
(match-lambda
((? bootloader-target? target) target)
((? string? s) (if (string-prefix? "/dev" s)
(bootloader-target
(type 'disk)
(device s))
(bootloader-target
(type 'esp)
(offset 'root)
(path s))))
(x (error loc (G_ "invalid target '~a'~%") x))))
;; XXX: Should this be an error?
(when (any string? targets)
(warning loc (G_ "the 'targets' field should now contain \
<bootloader-target> records, inferring a best guess, this might break!~%")))
(let* ((targets (map string->target targets)))
(report-duplicate-type-field targets)
targets)))
> > [2]: ...
> looks like the failure here was caused by cpan failing to build, which
> shouldn't be (hopefully isn't) a result of this patchset. what does the
> build log mentioned say?
I think because the build log was on a VFS I couldn't access it
directly. But why do these packages need to be built at all?
> thanks so much for all the help, by the way :)
No problem.
Cheers,
Herman
^ permalink raw reply [flat|nested] 95+ messages in thread