Package: guix-patches;
Reported by: Felix Lechner <felix.lechner <at> lease-up.com>
Date: Sat, 24 Feb 2024 01:09:02 UTC
Severity: normal
Tags: patch
To reply to this bug, email your comments to 69343 AT debbugs.gnu.org.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 01:09:02 GMT) Full text and rfc822 format available.Felix Lechner <felix.lechner <at> lease-up.com>:guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org.
(Sat, 24 Feb 2024 01:09:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: guix-patches <at> gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 00/12] Simplify bootloader data structures and procedures Date: Fri, 23 Feb 2024 17:05:59 -0800
The bootloader data structures are hard to understand because the
boot-parameter records are modified on the fly. It happened because those
records are versioned when stored on disk, and changing the data structure was
deemed to difficult. (I agree with that assessment.)
This commit series uses a new record type to separate the on-disk and the
in-memory concerns.
As for the bug fix, I never actually saw the bug but believe from reading the
code that a bug existed. The existence was not verified.
Felix Lechner (12):
Fix bug where the extra menu entries for a bootloader were shown
twice.
Move <boot-parameters> record to a separate file.
Also move boot-parameters->menu-entry.
Rename seconds->string procedure to epoch->date-string.
Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.
Offer a uniform decorated-boot-label and use it.
Rename boot-parameters to boot-alternatives when appropriate.
Rename two remote variables confusingly named 'generations'.
Give a separate name to a commonly used expression.
Simplify profile->boot-alternatives.
Split generation->boot-parameters out of profile->boot-alternatives.
Encapsulate <boot-parameters> to retain generation, system-path and
epoch.
gnu/machine/ssh.scm | 74 ++++-----
gnu/system.scm | 252 +---------------------------
gnu/system/boot.scm | 336 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 71 ++++----
tests/boot-parameters.scm | 1 +
5 files changed, 412 insertions(+), 322 deletions(-)
create mode 100644 gnu/system/boot.scm
base-commit: c0f88cd18649c31c75bcddf8247b14ef3e3a66a5
--
2.41.0
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:02 GMT) Full text and rfc822 format available.Message #8 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 03/12] Also move boot-parameters->menu-entry. Date: Fri, 23 Feb 2024 17:51:36 -0800
Change-Id: I794198e074b6d3012526a3056599ee3db1f1cdba
---
gnu/system.scm | 28 ----------------------------
gnu/system/boot.scm | 24 ++++++++++++++++++++++++
2 files changed, 24 insertions(+), 28 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index a438137731..e748066e16 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -150,8 +150,6 @@ (define-module (gnu system)
hurd-default-essential-services
- boot-parameters->menu-entry
-
local-host-aliases ;deprecated
%root-account
%setuid-programs
@@ -304,32 +302,6 @@ (define* (operating-system-kernel-arguments
(append (bootable-kernel-arguments os root-device version)
(operating-system-user-kernel-arguments os)))
-
-;;;
-;;; Boot parameters
-;;;
-
-(define (boot-parameters->menu-entry conf)
- "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
- (let* ((kernel (boot-parameters-kernel conf))
- (multiboot-modules (boot-parameters-multiboot-modules conf))
- (multiboot? (pair? multiboot-modules)))
- (menu-entry
- (label (boot-parameters-label conf))
- (device (boot-parameters-store-device conf))
- (device-mount-point (boot-parameters-store-mount-point conf))
- (linux (and (not multiboot?) kernel))
- (linux-arguments (if (not multiboot?)
- (boot-parameters-kernel-arguments conf)
- '()))
- (initrd (boot-parameters-initrd conf))
- (multiboot-kernel (and multiboot? kernel))
- (multiboot-arguments (if multiboot?
- (boot-parameters-kernel-arguments conf)
- '()))
- (multiboot-modules (if multiboot?
- (boot-parameters-multiboot-modules conf)
- '())))))
;;;
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 87b0184f98..d3f58e1ade 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -64,6 +64,8 @@ (define-module (gnu system boot)
read-boot-parameters
read-boot-parameters-file
+ boot-parameters->menu-entry
+
ensure-not-/dev))
;;;
@@ -274,4 +276,26 @@ (define (ensure-not-/dev device)
#f
device))
+(define (boot-parameters->menu-entry conf)
+ "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
+ (let* ((kernel (boot-parameters-kernel conf))
+ (multiboot-modules (boot-parameters-multiboot-modules conf))
+ (multiboot? (pair? multiboot-modules)))
+ (menu-entry
+ (label (boot-parameters-label conf))
+ (device (boot-parameters-store-device conf))
+ (device-mount-point (boot-parameters-store-mount-point conf))
+ (linux (and (not multiboot?) kernel))
+ (linux-arguments (if (not multiboot?)
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (initrd (boot-parameters-initrd conf))
+ (multiboot-kernel (and multiboot? kernel))
+ (multiboot-arguments (if multiboot?
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (multiboot-modules (if multiboot?
+ (boot-parameters-multiboot-modules conf)
+ '())))))
+
;;; boot.scm ends here
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:03 GMT) Full text and rfc822 format available.Message #11 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 01/12] Fix bug where the extra menu entries for a bootloader were shown twice. Date: Fri, 23 Feb 2024 17:51:34 -0800
The extra menu entries are already being added in each bootloaders, as
applicable.
---
guix/scripts/system.scm | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bf3d2f9044..955dfa618d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -407,8 +407,7 @@ (define (reinstall-bootloader store number)
(delv number (reverse (generation-numbers %system-profile))))
(old-params (profile-boot-parameters
%system-profile old-generations))
- (entries (cons (boot-parameters->menu-entry params)
- (boot-parameters-bootloader-menu-entries params)))
+ (entries (list (boot-parameters->menu-entry params)))
(old-entries (map boot-parameters->menu-entry old-params)))
(run-with-store store
(mlet* %store-monad
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:04 GMT) Full text and rfc822 format available.Message #14 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 04/12] Rename seconds->string procedure to epoch->date-string. Date: Fri, 23 Feb 2024 17:51:37 -0800
Change-Id: I2b9aaa816b3ca84c32f7d6fa690245b149228310
---
guix/scripts/system.scm | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 40df166fd7..86ee2ddc76 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,9 +323,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (seconds->string seconds)
- "Return a string representing the date for SECONDS."
- (let ((time (make-time time-utc 0 seconds)))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
@@ -343,7 +343,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (seconds->string time) ")"))))))
+ (epoch->date-string time) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:05 GMT) Full text and rfc822 format available.Message #17 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 06/12] Offer a uniform decorated-boot-label and use it. Date: Fri, 23 Feb 2024 17:51:39 -0800
Change-Id: Id348c3047df2353f76b1bad0eb2a3e0fa17e474c
---
gnu/machine/ssh.scm | 8 ++------
gnu/system/boot.scm | 13 +++++++++++++
guix/scripts/system.scm | 8 +++-----
3 files changed, 18 insertions(+), 11 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 449b65dbfb..fe47474470 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -459,15 +459,11 @@ (define (machine-boot-parameters machine)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
- (label (boot-parameters-label params))
+ (text (boot-parameters-label params))
(version (boot-parameters-version params)))
(boot-parameters
(inherit params)
- (label
- (string-append label " (#"
- (number->string generation) ", "
- (epoch->date-string epoch)
- ")"))
+ (label (decorated-boot-label text generation epoch))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index df04ef92da..f5342e06ca 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -66,6 +66,7 @@ (define-module (gnu system boot)
read-boot-parameters-file
epoch->date-string
+ decorated-boot-label
boot-parameters->menu-entry
ensure-not-/dev))
@@ -284,6 +285,18 @@ (define (epoch->date-string epoch)
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
+(define (decorated-boot-label text generation epoch)
+ "Return a string for a nice boot label that includes TEXT, a numbered GENERATION,
+and a timestamp derived from EPOCH seconds."
+ (let* ((numbered (lambda (number) (string-append "#" (number->string number))))
+ (count (and=> generation numbered))
+ (timestamp (and=> epoch epoch->date-string))
+ (extras (filter identity (list count timestamp)))
+ (helpful (if (null? extras)
+ ""
+ (string-append "(" (string-join extras ", ") ")"))))
+ (string-join (list text helpful))))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 47c072ba5c..09d29dbbb1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -332,12 +332,10 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
- (label (boot-parameters-label params)))
+ (text (boot-parameters-label params)))
(boot-parameters
- (inherit params)
- (label (string-append label " (#"
- (number->string number) ", "
- (epoch->date-string epoch) ")"))))))
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.41.0
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:05 GMT) Full text and rfc822 format available.Message #20 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 08/12] Rename two remote variables confusingly named 'generations'. Date: Fri, 23 Feb 2024 17:51:41 -0800
Both refer to data sets returned from the remote expression, and one of them
shadowed an element of itself.
Change-Id: Ibd8a3036126d9da1215cfc191884c0f54df637df
---
gnu/machine/ssh.scm | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 11534c6740..9adb5e79b9 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -451,10 +451,10 @@ (define (machine->boot-alternatives machine)
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
- (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp)))
+ (mlet* %store-monad ((remote-results (machine-remote-eval machine remote-exp)))
(return
- (map (lambda (generation)
- (match generation
+ (map (lambda (remote-result)
+ (match remote-result
((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
@@ -467,7 +467,7 @@ (define (machine->boot-alternatives machine)
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
- generations))))
+ remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
"Catch exceptions that arise when binding MBODY, a monadic expression in
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:06 GMT) Full text and rfc822 format available.Message #23 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 05/12] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere. Date: Fri, 23 Feb 2024 17:51:38 -0800
Change-Id: I6a5f793567221f81edd7b2d8d9f0f3e801d1b113
---
gnu/machine/ssh.scm | 10 ++++------
gnu/system/boot.scm | 8 ++++++++
guix/scripts/system.scm | 10 ++--------
3 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 0ffe71367c..449b65dbfb 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -444,10 +444,10 @@ (define (machine-boot-parameters machine)
generation))
(boot-parameters-path (string-append system-path
"/parameters"))
- (time (stat:mtime (lstat system-path))))
+ (epoch (stat:mtime (lstat system-path))))
(list generation
system-path
- time
+ epoch
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
@@ -455,7 +455,7 @@ (define (machine-boot-parameters machine)
(return
(map (lambda (generation)
(match generation
- ((generation system-path time serialized-params)
+ ((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
@@ -466,9 +466,7 @@ (define (machine-boot-parameters machine)
(label
(string-append label " (#"
(number->string generation) ", "
- (let ((time (make-time time-utc 0 time)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M"))
+ (epoch->date-string epoch)
")"))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index d3f58e1ade..df04ef92da 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -41,6 +41,7 @@ (define-module (gnu system boot)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
#:export (boot-parameters
@@ -64,6 +65,7 @@ (define-module (gnu system boot)
read-boot-parameters
read-boot-parameters-file
+ epoch->date-string
boot-parameters->menu-entry
ensure-not-/dev))
@@ -276,6 +278,12 @@ (define (ensure-not-/dev device)
#f
device))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
+ (date->string (time-utc->date time)
+ "~Y-~m-~d ~H:~M")))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 86ee2ddc76..47c072ba5c 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,19 +323,13 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (epoch->date-string epoch)
- "Return a string representing the date for EPOCH seconds."
- (let ((time (make-time time-utc 0 epoch)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M")))
-
(define* (profile-boot-parameters #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number time)
+ (define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
(label (boot-parameters-label params)))
@@ -343,7 +337,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (epoch->date-string time) ")"))))))
+ (epoch->date-string epoch) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:07 GMT) Full text and rfc822 format available.Message #26 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 12/12] Encapsulate <boot-parameters> to retain generation, system-path and epoch. Date: Fri, 23 Feb 2024 17:51:45 -0800
Change-Id: Iaef0b0a3fa9240ca8315a9699bcf4a7bfe908e33
---
gnu/machine/ssh.scm | 32 ++++++++++++++++++++------------
gnu/system/boot.scm | 14 ++++++++++++++
guix/scripts/system.scm | 32 +++++++++++++++++++++-----------
3 files changed, 55 insertions(+), 23 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 45ab8b9868..61125dddce 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -415,8 +415,8 @@ (define not-config?
(_ #f)))
(define (machine->boot-alternatives machine)
- "Monadic procedure returning a list of 'boot-parameters' for the generations
-of MACHINE's system profile, ordered from most recent to oldest."
+ "Monadic procedure returning a list of <boot-alternative> records for the
+generations of MACHINE's system profile, ordered from most recent to oldest."
(define bootable-kernel-arguments
(@@ (gnu system) bootable-kernel-arguments))
@@ -460,13 +460,18 @@ (define (machine->boot-alternatives machine)
read-boot-parameters))
(root (boot-parameters-root-device params))
(text (boot-parameters-label params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text generation epoch))
- (kernel-arguments
- (append (bootable-kernel-arguments system-path root version)
- (boot-parameters-kernel-arguments params))))))))
+ (version (boot-parameters-version params))
+ (parameters (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text generation epoch))
+ (kernel-arguments
+ (append (bootable-kernel-arguments system-path root version)
+ (boot-parameters-kernel-arguments params))))))
+ (boot-alternative
+ (generation generation)
+ (system-path system-path)
+ (epoch epoch)
+ (parameters parameters))))))
remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
@@ -510,7 +515,8 @@ (define (deploy-managed-host machine)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry boot-alternatives))
+ (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)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -584,13 +590,15 @@ (define (roll-back-managed-host machine)
(mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
(_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
- (parameters (second boot-alternatives))
+ (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
- (drop boot-alternatives 2)))
+ (map boot-alternative-parameters
+ (drop boot-alternatives 2))))
(bootloader -> (operating-system-bootloader
(machine-operating-system machine)))
(bootcfg (lower-object
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index f5342e06ca..46aad7eeaa 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -65,6 +65,13 @@ (define-module (gnu system boot)
read-boot-parameters
read-boot-parameters-file
+ boot-alternative
+ boot-alternative?
+ boot-alternative-generation
+ boot-alternative-system-path
+ boot-alternative-epoch
+ boot-alternative-parameters
+
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
@@ -271,6 +278,13 @@ (define (read-boot-parameters-file system)
(kernel-arguments (append (bootable-kernel-arguments system root version)
(boot-parameters-kernel-arguments params))))))
+(define-record-type* <boot-alternative>
+ boot-alternative make-boot-alternative boot-alternative?
+ (generation boot-alternative-generation)
+ (system-path boot-alternative-system-path)
+ (epoch boot-alternative-epoch)
+ (parameters boot-alternative-parameters))
+
(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/guix/scripts/system.scm b/guix/scripts/system.scm
index 7f6ba20ef9..8e1f6e8f06 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,26 +323,31 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (generation->boot-parameters profile number)
- "Return the 'boot-parameters' for the generation of PROFILE specified
+(define (generation->boot-alternative profile number)
+ "Return the 'boot-alternative' for the generation of PROFILE specified
by NUMBER."
(unless-file-not-found
(let* ((system (generation-file-name profile number))
(params (read-boot-parameters-file system))
(epoch (stat:mtime (lstat system)))
- (text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
+ (text (boot-parameters-label params))
+ (parameters (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch)))))
+ (boot-alternative
+ (generation generation)
+ (system-path system-path)
+ (epoch epoch)
+ (parameters parameters)))))
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
- "Return a list of 'boot-parameters' for the generations of PROFILE specified
+ "Return a list of 'boot-alternative' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
(filter-map (lambda (number)
- (generation->boot-parameters profile number))
+ (generation->boot-alternative profile number))
numbers))
@@ -391,7 +396,9 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (generation->boot-parameters %system-profile number))
+ (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
@@ -402,7 +409,8 @@ (define (reinstall-bootloader store number)
%system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
(old-entries (map boot-parameters->menu-entry
- previous-boot-alternatives)))
+ (map boot-alternative-parameters
+ previous-boot-alternatives))))
(run-with-store store
(mlet* %store-monad
((bootcfg (lower-object
@@ -818,7 +826,9 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile->boot-alternatives))))))
+ (map boot-parameters->menu-entry
+ (map boot-alternative-parameters
+ (profile->boot-alternatives)))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.41.0
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:07 GMT) Full text and rfc822 format available.Message #29 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 09/12] Give a separate name to a commonly used expression. Date: Fri, 23 Feb 2024 17:51:42 -0800
Change-Id: I8d70684142bea736042d6c9dc8276ea7bdb9c181
---
gnu/machine/ssh.scm | 13 +++++--------
1 file changed, 5 insertions(+), 8 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 9adb5e79b9..45ab8b9868 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -584,14 +584,11 @@ (define (roll-back-managed-host machine)
(mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
(_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
- (entries -> (map boot-parameters->menu-entry
- (list (second boot-alternatives))))
- (locale -> (boot-parameters-locale
- (second boot-alternatives)))
- (crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-alternatives)))
- (store-dir -> (boot-parameters-store-directory-prefix
- (second boot-alternatives)))
+ (parameters (second boot-alternatives))
+ (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
(drop boot-alternatives 2)))
(bootloader -> (operating-system-bootloader
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:08 GMT) Full text and rfc822 format available.Message #32 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 11/12] Split generation->boot-parameters out of profile->boot-alternatives. Date: Fri, 23 Feb 2024 17:51:44 -0800
Change-Id: I51ef1a4fa8fd18104d28a6a845707d7dedde3782
---
guix/scripts/system.scm | 28 ++++++++++++++++------------
1 file changed, 16 insertions(+), 12 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3df37e5510..7f6ba20ef9 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,22 +323,27 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
+(define (generation->boot-parameters profile number)
+ "Return the 'boot-parameters' for the generation of PROFILE specified
+by NUMBER."
+ (unless-file-not-found
+ (let* ((system (generation-file-name profile number))
+ (params (read-boot-parameters-file system))
+ (epoch (stat:mtime (lstat system)))
+ (text (boot-parameters-label params)))
+ (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
+
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (generation->boot-parameters number)
- (unless-file-not-found
- (let* ((system (generation-file-name profile number))
- (params (read-boot-parameters-file system))
- (epoch (stat:mtime (lstat system)))
- (text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
- (filter-map generation->boot-parameters numbers))
+ (filter-map (lambda (number)
+ (generation->boot-parameters profile number))
+ numbers))
;;;
@@ -386,8 +391,7 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile->boot-alternatives %system-profile
- (list number))))
+ (params (generation->boot-parameters %system-profile number))
(locale (boot-parameters-locale params))
(store-crypto-devices (boot-parameters-store-crypto-devices params))
(store-directory-prefix
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:09 GMT) Full text and rfc822 format available.Message #35 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 10/12] Simplify profile->boot-alternatives. Date: Fri, 23 Feb 2024 17:51:43 -0800
Change-Id: If31eeb4cef4f5a107a0ee5ad3f117bf38629ac38
---
guix/scripts/system.scm | 14 +++++---------
1 file changed, 5 insertions(+), 9 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index fd9f0727ee..3df37e5510 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -329,20 +329,16 @@ (define* (profile->boot-alternatives #:optional (profile %system-profile)
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number epoch)
+ (define (generation->boot-parameters number)
(unless-file-not-found
- (let* ((params (read-boot-parameters-file system))
+ (let* ((system (generation-file-name profile number))
+ (params (read-boot-parameters-file system))
+ (epoch (stat:mtime (lstat system)))
(text (boot-parameters-label params)))
(boot-parameters
(inherit params)
(label (decorated-boot-label text number epoch))))))
- (let* ((systems (map (cut generation-file-name profile <>)
- numbers))
- (times (map (lambda (system)
- (unless-file-not-found
- (stat:mtime (lstat system))))
- systems)))
- (filter-map system->boot-parameters systems numbers times)))
+ (filter-map generation->boot-parameters numbers))
;;;
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:00:09 GMT) Full text and rfc822 format available.Message #38 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 07/12] Rename boot-parameters to boot-alternatives when appropriate. Date: Fri, 23 Feb 2024 17:51:40 -0800
Throughout the code base, the token 'boot-parameters' refers to collection of
data that is stored on disk for each system generation. It was confusing to
use it for a list of such records. This comment imposes an alternative name.
Change-Id: Iabb04dbb39f42f989692bede7304f20a69bef9fb
---
gnu/machine/ssh.scm | 20 ++++++++++----------
guix/scripts/system.scm | 19 ++++++++++---------
2 files changed, 20 insertions(+), 19 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index fe47474470..11534c6740 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -414,7 +414,7 @@ (define not-config?
(('gnu _ ...) #t)
(_ #f)))
-(define (machine-boot-parameters machine)
+(define (machine->boot-alternatives machine)
"Monadic procedure returning a list of 'boot-parameters' for the generations
of MACHINE's system profile, ordered from most recent to oldest."
(define bootable-kernel-arguments
@@ -503,14 +503,14 @@ (define (deploy-managed-host machine)
(machine-become-command machine)))
(mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-parameters (machine-boot-parameters machine)))
+ (boot-alternatives (machine->boot-alternatives 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 boot-parameters))
+ (menu-entries (map boot-parameters->menu-entry boot-alternatives))
(bootloader-configuration (operating-system-bootloader os))
(bootcfg (operating-system-bootcfg os menu-entries)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -581,19 +581,19 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))
- (_ -> (if (< (length boot-parameters) 2)
+ (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
+ (_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
(entries -> (map boot-parameters->menu-entry
- (list (second boot-parameters))))
+ (list (second boot-alternatives))))
(locale -> (boot-parameters-locale
- (second boot-parameters)))
+ (second boot-alternatives)))
(crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-parameters)))
+ (second boot-alternatives)))
(store-dir -> (boot-parameters-store-directory-prefix
- (second boot-parameters)))
+ (second boot-alternatives)))
(old-entries -> (map boot-parameters->menu-entry
- (drop boot-parameters 2)))
+ (drop boot-alternatives 2)))
(bootloader -> (operating-system-bootloader
(machine-operating-system machine)))
(bootcfg (lower-object
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 09d29dbbb1..fd9f0727ee 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,9 +323,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define* (profile-boot-parameters #:optional (profile %system-profile)
- (numbers
- (reverse (generation-numbers profile))))
+(define* (profile->boot-alternatives #:optional (profile %system-profile)
+ (numbers
+ (reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
@@ -390,18 +390,19 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile-boot-parameters %system-profile
- (list number))))
+ (params (first (profile->boot-alternatives %system-profile
+ (list number))))
(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))))
- (old-params (profile-boot-parameters
- %system-profile old-generations))
+ (previous-boot-alternatives (profile->boot-alternatives
+ %system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry old-params)))
+ (old-entries (map boot-parameters->menu-entry
+ previous-boot-alternatives)))
(run-with-store store
(mlet* %store-monad
((bootcfg (lower-object
@@ -817,7 +818,7 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile-boot-parameters))))))
+ (map boot-parameters->menu-entry (profile->boot-alternatives))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 24 Feb 2024 02:11:02 GMT) Full text and rfc822 format available.Message #41 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH 02/12] Move <boot-parameters> record to a separate file. Date: Fri, 23 Feb 2024 17:51:35 -0800
Without it, the following commit following this one causes 'guix pull' to fail
with this message:
[ 0/ 50] loading... 0.0% of 25 files
[ 1/ 50] loading... 4.0% of 25 files
[ 2/ 50] loading... 8.0% of 25 files
[ 3/ 50] loading... 12.0% of 25 files
[ 4/ 50] loading... 16.0% of 25 files
[ 5/ 50] loading... 20.0% of 25 files
[ 6/ 50] loading... 24.0% of 25 files
[ 7/ 50] loading... 28.0% of 25 files
[ 8/ 50] loading... 32.0% of 25 files
[ 9/ 50] loading... 36.0% of 25 files
[ 10/ 50] loading... 40.0% of 25 files
[ 11/ 50] loading... 44.0% of 25 files
[ 12/ 50] loading... 48.0% of 25 files
[ 13/ 50] loading... 52.0% of 25 files
[ 14/ 50] loading... 56.0% of 25 files
[ 15/ 50] loading... 60.0% of 25 files
[ 16/ 50] loading... 64.0% of 25 files
[ 17/ 50] loading... 68.0% of 25 files
[ 18/ 50] loading... 72.0% of 25 files
[ 19/ 50] loading... 76.0% of 25 files
[ 20/ 50] loading... 80.0% of 25 files
[ 21/ 50] loading... 84.0% of 25 files
[ 22/ 50] loading... 88.0% of 25 files
[ 23/ 50] loading... 92.0% of 25 files
[ 24/ 50] loading... 96.0% of 25 files
[ 25/ 50] loading... 100.0% of 25 files
[ 25/ 50] compiling... 0.0% of 25 files
[ 26/ 50] compiling... 4.0% of 25 files
[ 27/ 50] compiling... 8.0% of 25 files
[ 28/ 50] compiling... 12.0% of 25 files
[ 29/ 50] compiling... 16.0% of 25 files
[ 30/ 50] compiling... 20.0% of 25 files
[ 31/ 50] compiling... 24.0% of 25 files
[ 32/ 50] compiling... 28.0% of 25 files
[ 33/ 50] compiling... 32.0% of 25 files
[ 34/ 50] compiling... 36.0% of 25 files
[ 35/ 50] compiling... 40.0% of 25 files
[ 36/ 50] compiling... 44.0% of 25 files
[ 37/ 50] compiling... 48.0% of 25 files
[ 38/ 50] compiling... 52.0% of 25 files
[ 39/ 50] compiling... 56.0% of 25 files
[ 40/ 50] compiling... 60.0% of 25 files
[ 41/ 50] compiling... 64.0% of 25 files
[ 42/ 50] compiling... 68.0% of 25 files
[ 43/ 50] compiling... 72.0% of 25 files
[ 44/ 50] compiling... 76.0% of 25 files
[ 45/ 50] compiling... 80.0% of 25 files
[ 46/ 50] compiling... 84.0% of 25 files
[ 47/ 50] compiling... 88.0% of 25 files
[ 48/ 50] compiling... 92.0% of 25 files
[ 49/ 50] compiling... 96.0% of 25 files
[ 50/ 50] compiling... 100.0% of 25 files
[ 0/ 50] loading... 0.0% of 25 files
[ 1/ 50] loading... 4.0% of 25 files
[ 2/ 50] loading... 8.0% of 25 files
[ 3/ 50] loading... 12.0% of 25 files
[ 4/ 50] loading... 16.0% of 25 files
[ 5/ 50] loading... 20.0% of 25 files
[ 6/ 50] loading... 24.0% of 25 files
[ 7/ 50] loading... 28.0% of 25 files
[ 8/ 50] loading... 32.0% of 25 files
[ 9/ 50] loading... 36.0% of 25 files
[ 10/ 50] loading... 40.0% of 25 files
[ 11/ 50] loading... 44.0% of 25 files
[ 12/ 50] loading... 48.0% of 25 files
[ 13/ 50] loading... 52.0% of 25 files
[ 14/ 50] loading... 56.0% of 25 files
[ 15/ 50] loading... 60.0% of 25 files
[ 16/ 50] loading... 64.0% of 25 files
[ 17/ 50] loading... 68.0% of 25 files
[ 18/ 50] loading... 72.0% of 25 files
[ 19/ 50] loading... 76.0% of 25 files
[ 20/ 50] loading... 80.0% of 25 files
[ 21/ 50] loading... 84.0% of 25 files
[ 22/ 50] loading... 88.0% of 25 files
[ 23/ 50] loading... 92.0% of 25 files
[ 24/ 50] loading... 96.0% of 25 files
[ 25/ 50] loading... 100.0% of 25 files
[ 25/ 50] compiling... 0.0% of 25 files
[ 26/ 50] compiling... 4.0% of 25 files
[ 27/ 50] compiling... 8.0% of 25 files
[ 28/ 50] compiling... 12.0% of 25 files
[ 29/ 50] compiling... 16.0% of 25 files
[ 30/ 50] compiling... 20.0% of 25 files
[ 31/ 50] compiling... 24.0% of 25 files
[ 32/ 50] compiling... 28.0% of 25 files
[ 33/ 50] compiling... 32.0% of 25 files
[ 34/ 50] compiling... 36.0% of 25 files
[ 35/ 50] compiling... 40.0% of 25 files
[ 36/ 50] compiling... 44.0% of 25 files
[ 37/ 50] compiling... 48.0% of 25 files
[ 38/ 50] compiling... 52.0% of 25 files
[ 39/ 50] compiling... 56.0% of 25 files
[ 40/ 50] compiling... 60.0% of 25 files
[ 41/ 50] compiling... 64.0% of 25 files
[ 42/ 50] compiling... 68.0% of 25 files
[ 43/ 50] compiling... 72.0% of 25 files
[ 44/ 50] compiling... 76.0% of 25 files
[ 45/ 50] compiling... 80.0% of 25 files
[ 46/ 50] compiling... 84.0% of 25 files
[ 47/ 50] compiling... 88.0% of 25 files
[ 48/ 50] compiling... 92.0% of 25 files
[ 49/ 50] compiling... 96.0% of 25 files
[ 50/ 50] compiling... 100.0% of 25 files
[ 0/ 50] loading... 0.0% of 25 files
[ 1/ 50] loading... 4.0% of 25 files
[ 2/ 50] loading... 8.0% of 25 files
[ 3/ 50] loading... 12.0% of 25 files
[ 4/ 50] loading... 16.0% of 25 files
[ 5/ 50] loading... 20.0% of 25 files
[ 6/ 50] loading... 24.0% of 25 files
[ 7/ 50] loading... 28.0% of 25 files
[ 8/ 50] loading... 32.0% of 25 files
[ 9/ 50] loading... 36.0% of 25 files
[ 10/ 50] loading... 40.0% of 25 files
[ 11/ 50] loading... 44.0% of 25 files
[ 12/ 50] loading... 48.0% of 25 files
[ 13/ 50] loading... 52.0% of 25 files
[ 14/ 50] loading... 56.0% of 25 files
[ 15/ 50] loading... 60.0% of 25 files
[ 16/ 50] loading... 64.0% of 25 files
[ 17/ 50] loading... 68.0% of 25 files
[ 18/ 50] loading... 72.0% of 25 files
[ 19/ 50] loading... 76.0% of 25 files
[ 20/ 50] loading... 80.0% of 25 files
[ 21/ 50] loading... 84.0% of 25 files
[ 22/ 50] loading... 88.0% of 25 files
[ 23/ 50] loading... 92.0% of 25 files
[ 24/ 50] loading... 96.0% of 25 files
[ 25/ 50] loading... 100.0% of 25 files
[ 25/ 50] compiling... 0.0% of 25 files
[ 26/ 50] compiling... 4.0% of 25 files
[ 27/ 50] compiling... 8.0% of 25 files
[ 28/ 50] compiling... 12.0% of 25 files
[ 29/ 50] compiling... 16.0% of 25 files
[ 30/ 50] compiling... 20.0% of 25 files
[ 31/ 50] compiling... 24.0% of 25 files
[ 32/ 50] compiling... 28.0% of 25 files
[ 33/ 50] compiling... 32.0% of 25 files
[ 34/ 50] compiling... 36.0% of 25 files
[ 35/ 50] compiling... 40.0% of 25 files
[ 36/ 50] compiling... 44.0% of 25 files
[ 37/ 50] compiling... 48.0% of 25 files
[ 38/ 50] compiling... 52.0% of 25 files
[ 39/ 50] compiling... 56.0% of 25 files
[ 40/ 50] compiling... 60.0% of 25 files
[ 41/ 50] compiling... 64.0% of 25 files
[ 42/ 50] compiling... 68.0% of 25 files
[ 43/ 50] compiling... 72.0% of 25 files
[ 44/ 50] compiling... 76.0% of 25 files
[ 45/ 50] compiling... 80.0% of 25 files
[ 46/ 50] compiling... 84.0% of 25 files
[ 47/ 50] compiling... 88.0% of 25 files
[ 48/ 50] compiling... 92.0% of 25 files
[ 49/ 50] compiling... 96.0% of 25 files
[ 50/ 50] compiling... 100.0% of 25 files
[ 0/ 50] loading... 0.0% of 25 files
[ 1/ 50] loading... 4.0% of 25 files
[ 2/ 50] loading... 8.0% of 25 files
[ 3/ 50] loading... 12.0% of 25 files
[ 4/ 50] loading... 16.0% of 25 files
[ 5/ 50] loading... 20.0% of 25 files
[ 6/ 50] loading... 24.0% of 25 files
[ 7/ 50] loading... 28.0% of 25 files
[ 8/ 50] loading... 32.0% of 25 files
[ 9/ 50] loading... 36.0% of 25 files
[ 10/ 50] loading... 40.0% of 25 files
[ 11/ 50] loading... 44.0% of 25 files
[ 12/ 50] loading... 48.0% of 25 files
[ 13/ 50] loading... 52.0% of 25 files
[ 14/ 50] loading... 56.0% of 25 files
[ 15/ 50] loading... 60.0% of 25 files
[ 16/ 50] loading... 64.0% of 25 files
[ 17/ 50] loading... 68.0% of 25 files
[ 18/ 50] loading... 72.0% of 25 files
[ 19/ 50] loading... 76.0% of 25 files
[ 20/ 50] loading... 80.0% of 25 files
[ 21/ 50] loading... 84.0% of 25 files
[ 22/ 50] loading... 88.0% of 25 files
[ 23/ 50] loading... 92.0% of 25 files
[ 24/ 50] loading... 96.0% of 25 files
[ 25/ 50] loading... 100.0% of 25 files
[ 25/ 50] compiling... 0.0% of 25 files
[ 26/ 50] compiling... 4.0% of 25 files
[ 27/ 50] compiling... 8.0% of 25 files
[ 28/ 50] compiling... 12.0% of 25 files
[ 29/ 50] compiling... 16.0% of 25 files
[ 30/ 50] compiling... 20.0% of 25 files
[ 31/ 50] compiling... 24.0% of 25 files
[ 32/ 50] compiling... 28.0% of 25 files
[ 33/ 50] compiling... 32.0% of 25 files
[ 34/ 50] compiling... 36.0% of 25 files
[ 35/ 50] compiling... 40.0% of 25 files
[ 36/ 50] compiling... 44.0% of 25 files
[ 37/ 50] compiling... 48.0% of 25 files
[ 38/ 50] compiling... 52.0% of 25 files
[ 39/ 50] compiling... 56.0% of 25 files
[ 40/ 50] compiling... 60.0% of 25 files
[ 41/ 50] compiling... 64.0% of 25 files
[ 42/ 50] compiling... 68.0% of 25 files
[ 43/ 50] compiling... 72.0% of 25 files
[ 44/ 50] compiling... 76.0% of 25 files
[ 45/ 50] compiling... 80.0% of 25 files
[ 46/ 50] compiling... 84.0% of 25 files
[ 47/ 50] compiling... 88.0% of 25 files
[ 48/ 50] compiling... 92.0% of 25 files
[ 49/ 50] compiling... 96.0% of 25 files
[ 50/ 50] compiling... 100.0% of 25 files
[ 0/ 50] loading... 0.0% of 25 files
[ 1/ 50] loading... 4.0% of 25 files
[ 2/ 50] loading... 8.0% of 25 files
[ 3/ 50] loading... 12.0% of 25 files
[ 4/ 50] loading... 16.0% of 25 files
[ 5/ 50] loading... 20.0% of 25 files
[ 6/ 50] loading... 24.0% of 25 files
[ 7/ 50] loading... 28.0% of 25 files
[ 8/ 50] loading... 32.0% of 25 files
[ 9/ 50] loading... 36.0% of 25 files
[ 10/ 50] loading... 40.0% of 25 files
[ 11/ 50] loading... 44.0% of 25 files
[ 12/ 50] loading... 48.0% of 25 files
[ 13/ 50] loading... 52.0% of 25 files
[ 14/ 50] loading... 56.0% of 25 files
[ 15/ 50] loading... 60.0% of 25 files
[ 16/ 50] loading... 64.0% of 25 files
[ 17/ 50] loading... 68.0% of 25 files
[ 18/ 50] loading... 72.0% of 25 files
[ 19/ 50] loading... 76.0% of 25 files
[ 20/ 50] loading... 80.0% of 25 files
[ 21/ 50] loading... 84.0% of 25 files
[ 22/ 50] loading... 88.0% of 25 files
[ 23/ 50] loading... 92.0% of 25 files
[ 24/ 50] loading... 96.0% of 25 files
[ 25/ 50] loading... 100.0% of 25 files
[ 25/ 50] compiling... 0.0% of 25 files
[ 26/ 50] compiling... 4.0% of 25 files
[ 27/ 50] compiling... 8.0% of 25 files
[ 28/ 50] compiling... 12.0% of 25 files
[ 29/ 50] compiling... 16.0% of 25 files
[ 30/ 50] compiling... 20.0% of 25 files
[ 31/ 50] compiling... 24.0% of 25 files
[ 32/ 50] compiling... 28.0% of 25 files
[ 33/ 50] compiling... 32.0% of 25 files
[ 34/ 50] compiling... 36.0% of 25 files
[ 35/ 50] compiling... 40.0% of 25 files
[ 36/ 50] compiling... 44.0% of 25 files
[ 37/ 50] compiling... 48.0% of 25 files
[ 38/ 50] compiling... 52.0% of 25 files
[ 39/ 50] compiling... 56.0% of 25 files
[ 40/ 50] compiling... 60.0% of 25 files
[ 41/ 50] compiling... 64.0% of 25 files
[ 42/ 50] compiling... 68.0% of 25 files
[ 43/ 50] compiling... 72.0% of 25 files
[ 44/ 50] compiling... 76.0% of 25 files
[ 45/ 50] compiling... 80.0% of 25 files
[ 46/ 50] compiling... 84.0% of 25 files
[ 47/ 50] compiling... 88.0% of 25 files
[ 48/ 50] compiling... 92.0% of 25 files
[ 49/ 50] compiling... 96.0% of 25 files
[ 50/ 50] compiling... 100.0% of 25 files
[ 0/ 50] loading... 0.0% of 25 files
[ 1/ 50] loading... 4.0% of 25 files
[ 2/ 50] loading... 8.0% of 25 files
[ 3/ 50] loading... 12.0% of 25 files
[ 4/ 50] loading... 16.0% of 25 files
[ 5/ 50] loading... 20.0% of 25 files
[ 6/ 50] loading... 24.0% of 25 files
[ 7/ 50] loading... 28.0% of 25 files
[ 8/ 50] loading... 32.0% of 25 files
[ 9/ 50] loading... 36.0% of 25 files
[ 10/ 50] loading... 40.0% of 25 files
[ 11/ 50] loading... 44.0% of 25 files
[ 12/ 50] loading... 48.0% of 25 files
[ 13/ 50] loading... 52.0% of 25 files
[ 14/ 50] loading... 56.0% of 25 files
[ 15/ 50] loading... 60.0% of 25 files
[ 16/ 50] loading... 64.0% of 25 files
[ 17/ 50] loading... 68.0% of 25 files
[ 18/ 50] loading... 72.0% of 25 files
[ 19/ 50] loading... 76.0% of 25 files
[ 20/ 50] loading... 80.0% of 25 files
[ 21/ 50] loading... 84.0% of 25 files
[ 22/ 50] loading... 88.0% of 25 files
[ 23/ 50] loading... 92.0% of 25 files
[ 24/ 50] loading... 96.0% of 25 files
[ 25/ 50] loading... 100.0% of 25 files
[ 25/ 50] compiling... 0.0% of 25 files
[ 26/ 50] compiling... 4.0% of 25 files
[ 27/ 50] compiling... 8.0% of 25 files
[ 28/ 50] compiling... 12.0% of 25 files
[ 29/ 50] compiling... 16.0% of 25 files
[ 30/ 50] compiling... 20.0% of 25 files
[ 31/ 50] compiling... 24.0% of 25 files
[ 32/ 50] compiling... 28.0% of 25 files
[ 33/ 50] compiling... 32.0% of 25 files
[ 34/ 50] compiling... 36.0% of 25 files
[ 35/ 50] compiling... 40.0% of 25 files
[ 36/ 50] compiling... 44.0% of 25 files
[ 37/ 50] compiling... 48.0% of 25 files
[ 38/ 50] compiling... 52.0% of 25 files
[ 39/ 50] compiling... 56.0% of 25 files
[ 40/ 50] compiling... 60.0% of 25 files
[ 41/ 50] compiling... 64.0% of 25 files
[ 42/ 50] compiling... 68.0% of 25 files
[ 43/ 50] compiling... 72.0% of 25 files
[ 44/ 50] compiling... 76.0% of 25 files
[ 45/ 50] compiling... 80.0% of 25 files
[ 46/ 50] compiling... 84.0% of 25 files
[ 47/ 50] compiling... 88.0% of 25 files
[ 48/ 50] compiling... 92.0% of 25 files
[ 49/ 50] compiling... 96.0% of 25 files
[ 50/ 50] compiling... 100.0% of 25 files
[ 0/ 50] loading... 0.0% of 25 files
[ 1/ 50] loading... 4.0% of 25 filesBacktrace:
In ice-9/boot-9.scm:
222:29 19 (map1 (((gnu packages nano)) ((gnu packages nvi)) ((gnu packages package-management)) ((gnu packages pciutils)) ((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu # wget)) ?))
222:29 18 (map1 (((gnu packages nvi)) ((gnu packages package-management)) ((gnu packages pciutils)) ((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu packages wget)) ((gnu #)) ((?)) ?))
222:29 17 (map1 (((gnu packages package-management)) ((gnu packages pciutils)) ((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu packages wget)) ((gnu services)) ((gnu services #)) ?))
222:29 16 (map1 (((gnu packages pciutils)) ((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu packages wget)) ((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((# ?)) ?))
222:29 15 (map1 (((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu packages wget)) ((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((gnu bootloader)) ((gnu # #)) # ?))
222:29 14 (map1 (((gnu packages text-editors)) ((gnu packages wget)) ((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((gnu bootloader)) ((gnu system shadow)) ((gnu system #)) ?))
222:29 13 (map1 (((gnu packages wget)) ((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((gnu bootloader)) ((gnu system shadow)) ((gnu system nss)) ((gnu system locale)) ((?)) ?))
222:17 12 (map1 (((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((gnu bootloader)) ((gnu system shadow)) ((gnu system nss)) ((gnu system locale)) ((gnu system pam)) ((gnu ?)) ?))
3327:17 11 (resolve-interface (gnu services) #:select _ #:hide _ #:prefix _ #:renamer _ #:version _)
In ice-9/threads.scm:
390:8 10 (_ _)
In ice-9/boot-9.scm:
3253:13 9 (_)
In ice-9/threads.scm:
390:8 8 (_ _)
In ice-9/boot-9.scm:
3544:20 7 (_)
2836:4 6 (save-module-excursion #<procedure 7fffdd1c7660 at ice-9/boot-9.scm:3545:21 ()>)
3564:26 5 (_)
In unknown file:
4 (primitive-load-path "gnu/services" #<procedure 7fffde800600 at ice-9/boot-9.scm:3551:37 ()>)
In ice-9/eval.scm:
626:19 3 (_ #<directory (gnu services) 7fffe2b5daa0>)
159:9 2 (_ #<directory (gnu services) 7fffe2b5daa0>)
213:37 1 (_ #<directory (gnu services) 7fffe2b5daa0>)
In guix/modules.scm:
157:28 0 (loop ((gnu build hurd-boot) (guix build syscalls)) ((guix build utils)) #<<set> vhash: #<vhash 7fffdcb533e0 1 pairs> insert: #<procedure %insert (t-5ce36f5c768e728-57f t-5ce36f5c768e?>)
guix/modules.scm:157:28: In procedure loop:
ERROR:
1. &missing-dependency-error:
module: (gnu build hurd-boot)
search-path: ("." "/gnu/store/11i4vribdynrxkp4ppilkjp9y9jshaxq-guix-core-source" "/gnu/store/avd0dsg9rixk3djls8ikzphfjbl227za-guix-extra-source" "/gnu/store/vdi10jyhr1igrkdgnsjj09krjx1jkzkm-guix-packages-base-source" "/gnu/store/l8sdgq6cpnxyk732w23p7mhq6sial0vm-guile-gcrypt-0.4.0/share/guile/site/3.0" "/gnu/store/0i81lpfnn05pmjc5f43q4nfvd27r08f7-guile-gnutls-3.7.12/share/guile/site/3.0" "/gnu/store/rm803mxjvr9zamg1226dl9zf2275yjzg-guile-git-0.5.2/share/guile/site/3.0" "/gnu/store/bxvl7w7q66gbk7qkkhsiq30vl69jj4x7-guile-bytestructures-1.0.10/share/guile/site/3.0" "/gnu/store/q91hbi8yc2jnx0hlk6zb6vlkrw3xm0yx-guile-avahi-0.4.1/share/guile/site/3.0" "/gnu/store/p5f006jcr83jc7m731vhvjdkr2j0hnp3-guile-json-4.7.3/share/guile/site/3.0" "/gnu/store/d75xpk3qxw7na6zgbf2dw3asqhwifd6a-guile-semver-0.1.1/share/guile/site/3.0" "/gnu/store/19m9xm33jq34nb64z11q5bph85ff6gyd-guile-ssh-0.16.3/share/guile/site/3.0" "/gnu/store/r8izi6mi1mjl7s1kn20q1hxmy3jg2bxc-guile-sqlite3-0.1.3/share/guile/site/3.0" "/gnu/store/bc3zzjych6jyp4ph2af9k3w8qcs3nsn2-guile-lib-0.2.7/share/guile/site/3.0" "/gnu/store/w6gpivr3421wbzkjg6qlc95sv1srz15a-guile-zlib-0.1.0/share/guile/site/3.0" "/gnu/store/1zlqd5240mq0dwwig9bv1cg4zjf092h9-guile-lzlib-0.0.2/share/guile/site/3.0" "/gnu/store/rqd5wpa09fizcb211p78g6f2f5jb2lwg-guile-zstd-0.1.1/share/guile/site/3.0" "/gnu/store/xfd68fq6vmali9wqivg84baqp4n4maqx-guix-packages-source" "/gnu/store/a7sykpl77z61sr0dv034rpwby9bz8zwm-module-import" "/gnu/store/4gvgcfdiz67wv04ihqfa8pqwzsb0qpv5-guile-3.0.9/share/guile/3.0" "/gnu/store/4gvgcfdiz67wv04ihqfa8pqwzsb0qpv5-guile-3.0.9/share/guile/site/3.0" "/gnu/store/4gvgcfdiz67wv04ihqfa8pqwzsb0qpv5-guile-3.0.9/share/guile/site" "/gnu/store/4gvgcfdiz67wv04ihqfa8pqwzsb0qpv5-guile-3.0.9/share/guile")
Change-Id: I6944ffd4c323c776005b0cef23218bffae59be23
---
gnu/machine/ssh.scm | 1 +
gnu/system.scm | 224 +-----------------------------
gnu/system/boot.scm | 277 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 1 +
tests/boot-parameters.scm | 1 +
5 files changed, 281 insertions(+), 223 deletions(-)
create mode 100644 gnu/system/boot.scm
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index b47ce7c225..0ffe71367c 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -23,6 +23,7 @@ (define-module (gnu machine ssh)
#:use-module (gnu machine)
#:autoload (gnu packages gnupg) (guile-gcrypt)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((gnu services) #:select (sexp->system-provenance))
diff --git a/gnu/system.scm b/gnu/system.scm
index aede35775e..a438137731 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -70,6 +70,7 @@ (define-module (gnu system)
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system shadow)
#:use-module (gnu system nss)
#:use-module (gnu system locale)
@@ -149,25 +150,6 @@ (define-module (gnu system)
hurd-default-essential-services
- boot-parameters
- boot-parameters?
- boot-parameters-label
- boot-parameters-root-device
- boot-parameters-bootloader-name
- boot-parameters-bootloader-menu-entries
- boot-parameters-store-crypto-devices
- boot-parameters-store-device
- boot-parameters-store-directory-prefix
- boot-parameters-store-mount-point
- boot-parameters-locale
- boot-parameters-kernel
- boot-parameters-kernel-arguments
- boot-parameters-initrd
- boot-parameters-multiboot-modules
- boot-parameters-version
- %boot-parameters-version
- read-boot-parameters
- read-boot-parameters-file
boot-parameters->menu-entry
local-host-aliases ;deprecated
@@ -327,210 +309,6 @@ (define* (operating-system-kernel-arguments
;;; Boot parameters
;;;
-;;; Version 1 was introduced early 2022 to mark the departure from long option
-;;; names such as '--load' to the more conventional initrd option names like
-;;; 'gnu.load'.
-;;;
-;;; When bumping the boot-parameters version, increment it by one (1).
-(define %boot-parameters-version 1)
-
-(define-record-type* <boot-parameters>
- boot-parameters make-boot-parameters boot-parameters?
- (label boot-parameters-label)
- ;; Because we will use the 'store-device' to create the GRUB search command,
- ;; the 'store-device' has slightly different semantics than 'root-device'.
- ;; The 'store-device' can be a file system uuid, a file system label, or #f,
- ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
- ;; not understand that. The 'root-device', on the other hand, corresponds
- ;; exactly to the device field of the <file-system> object representing the
- ;; OS's root file system, so it might be a device file name like
- ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
- ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
- ;; contain "/storefs" if the store is located in that subvolume of a btrfs
- ;; partition.
- (root-device boot-parameters-root-device)
- (bootloader-name boot-parameters-bootloader-name)
- (bootloader-menu-entries ;list of <menu-entry>
- boot-parameters-bootloader-menu-entries)
- (store-device boot-parameters-store-device)
- (store-mount-point boot-parameters-store-mount-point)
- (store-directory-prefix boot-parameters-store-directory-prefix)
- (store-crypto-devices boot-parameters-store-crypto-devices
- (default '()))
- (locale boot-parameters-locale)
- (kernel boot-parameters-kernel)
- (kernel-arguments boot-parameters-kernel-arguments)
- (initrd boot-parameters-initrd)
- (multiboot-modules boot-parameters-multiboot-modules)
- (version boot-parameters-version ;positive integer
- (default %boot-parameters-version)))
-
-(define (ensure-not-/dev device)
- "If DEVICE starts with a slash, return #f. This is meant to filter out
-Linux device names such as /dev/sda, and to preserve GRUB device names and
-file system labels."
- (if (and (string? device) (string-prefix? "/" device))
- #f
- device))
-
-(define (read-boot-parameters port)
- "Read boot parameters from PORT and return the corresponding
-<boot-parameters> object. Raise an error if the format is unrecognized."
- (define device-sexp->device
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (('file-system-label (? string? label))
- (file-system-label label))
- ((? bytevector? bv) ;old format
- (bytevector->uuid bv 'dce))
- ((? string? device)
- (if (string-contains device ":/")
- device ; nfs-root
- ;; It used to be that we would not distinguish between labels and
- ;; device names. Try to infer the right thing here.
- (if (string-prefix? "/" device)
- device
- (file-system-label device))))))
- (define uuid-sexp->uuid
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (x
- (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
- #f)))
-
- ;; New versions are not backward-compatible, so only accept past and current
- ;; versions, not future ones.
- (define (version? n)
- (member n (iota (1+ %boot-parameters-version))))
-
- (match (read port)
- (('boot-parameters ('version (? version? version))
- ('label label) ('root-device root)
- ('kernel kernel)
- rest ...)
- (boot-parameters
- (version version)
- (label label)
- (root-device (device-sexp->device root))
-
- (bootloader-name
- (match (assq 'bootloader-name rest)
- ((_ args) args)
- (#f 'grub))) ; for compatibility reasons.
-
- (bootloader-menu-entries
- (match (assq 'bootloader-menu-entries rest)
- ((_ entries) (map sexp->menu-entry entries))
- (#f '())))
-
- ;; In the past, we would store the directory name of linux instead of
- ;; the absolute file name of its image. Detect that and correct it.
- (kernel (if (string=? kernel (direct-store-path kernel))
- (string-append kernel "/"
- (system-linux-image-file-name))
- kernel))
-
- (kernel-arguments
- (match (assq 'kernel-arguments rest)
- ((_ args) args)
- (#f '()))) ;the old format
-
- (initrd
- (match (assq 'initrd rest)
- (('initrd ('string-append directory file)) ;the old format
- (string-append directory file))
- (('initrd (? string? file))
- file)
- (#f #f)))
-
- (multiboot-modules
- (match (assq 'multiboot-modules rest)
- ((_ args) args)
- (#f '())))
-
- (locale
- (match (assq 'locale rest)
- ((_ locale) locale)
- (#f #f)))
-
- (store-device
- ;; Linux device names like "/dev/sda1" are not suitable GRUB device
- ;; identifiers, so we just filter them out.
- (ensure-not-/dev
- (match (assq 'store rest)
- (('store ('device #f) _ ...)
- root-device)
- (('store ('device device) _ ...)
- (device-sexp->device device))
- (_ ;the old format
- root-device))))
-
- (store-directory-prefix
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'directory-prefix store-data)
- (('directory-prefix prefix) prefix)
- ;; No directory-prefix found.
- (_ #f)))
- (_
- ;; No store found, old format.
- #f)))
-
- (store-crypto-devices
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'crypto-devices store-data)
- (('crypto-devices (devices ...))
- (map uuid-sexp->uuid devices))
- (('crypto-devices dev)
- (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
- dev (port-filename port))
- '())
- (_
- ;; No crypto-devices found.
- '())))
- (_
- ;; No store found, old format.
- '())))
-
- (store-mount-point
- (match (assq 'store rest)
- (('store ('device _) ('mount-point mount-point) _ ...)
- mount-point)
- (_ ;the old format
- "/")))))
- (x ;unsupported format
- (raise
- (make-compound-condition
- (formatted-message
- (G_ "unrecognized boot parameters at '~a'~%")
- (port-filename port))
- (condition
- (&fix-hint (hint (format #f (G_ "This probably means that this version
-of Guix is older than the one that created @file{~a}. To address this, you
-need to update Guix:
-
-@example
-guix pull
-@end example")
- (port-filename port))))))))))
-
-(define (read-boot-parameters-file system)
- "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
-file and returns the corresponding <boot-parameters> object or #f if the
-format is unrecognized.
-The object has its kernel-arguments extended in order to make it bootable."
- (let* ((file (string-append system "/parameters"))
- (params (call-with-input-file file read-boot-parameters))
- (root (boot-parameters-root-device params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (kernel-arguments (append (bootable-kernel-arguments system root version)
- (boot-parameters-kernel-arguments params))))))
-
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
new file mode 100644
index 0000000000..87b0184f98
--- /dev/null
+++ b/gnu/system/boot.scm
@@ -0,0 +1,277 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw <at> netris.org>
+;;; Copyright © 2015, 2016 Alex Kost <alezost <at> gmail.com>
+;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo.peng <at> gmail.com>
+;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835 <at> gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym <at> scratchpost.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2020 Florian Pelz <pelzflorian <at> pelzflorian.de>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <jannek <at> gnu.org>
+;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il>
+;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner <at> lease-up.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system boot)
+ #:use-module (guix store)
+ #:use-module (guix gexp)
+ #:use-module (guix records)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu system file-systems)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
+ #:export (boot-parameters
+ boot-parameters?
+ boot-parameters-label
+ boot-parameters-root-device
+ boot-parameters-bootloader-name
+ boot-parameters-bootloader-menu-entries
+ boot-parameters-store-crypto-devices
+ boot-parameters-store-device
+ boot-parameters-store-directory-prefix
+ boot-parameters-store-mount-point
+ boot-parameters-locale
+ boot-parameters-kernel
+ boot-parameters-kernel-arguments
+ boot-parameters-initrd
+ boot-parameters-multiboot-modules
+ boot-parameters-version
+ %boot-parameters-version
+
+ read-boot-parameters
+ read-boot-parameters-file
+
+ ensure-not-/dev))
+
+;;;
+;;; Boot parameters
+;;;
+
+;;; Version 1 was introduced early 2022 to mark the departure from long option
+;;; names such as '--load' to the more conventional initrd option names like
+;;; 'gnu.load'.
+;;;
+;;; When bumping the boot-parameters version, increment it by one (1).
+(define %boot-parameters-version 1)
+
+(define-record-type* <boot-parameters>
+ boot-parameters make-boot-parameters boot-parameters?
+ (label boot-parameters-label)
+ ;; Because we will use the 'store-device' to create the GRUB search command,
+ ;; the 'store-device' has slightly different semantics than 'root-device'.
+ ;; The 'store-device' can be a file system uuid, a file system label, or #f,
+ ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
+ ;; not understand that. The 'root-device', on the other hand, corresponds
+ ;; exactly to the device field of the <file-system> object representing the
+ ;; OS's root file system, so it might be a device file name like
+ ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
+ ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
+ ;; contain "/storefs" if the store is located in that subvolume of a btrfs
+ ;; partition.
+ (root-device boot-parameters-root-device)
+ (bootloader-name boot-parameters-bootloader-name)
+ (bootloader-menu-entries ;list of <menu-entry>
+ boot-parameters-bootloader-menu-entries)
+ (store-device boot-parameters-store-device)
+ (store-mount-point boot-parameters-store-mount-point)
+ (store-directory-prefix boot-parameters-store-directory-prefix)
+ (store-crypto-devices boot-parameters-store-crypto-devices
+ (default '()))
+ (locale boot-parameters-locale)
+ (kernel boot-parameters-kernel)
+ (kernel-arguments boot-parameters-kernel-arguments)
+ (initrd boot-parameters-initrd)
+ (multiboot-modules boot-parameters-multiboot-modules)
+ (version boot-parameters-version ;positive integer
+ (default %boot-parameters-version)))
+
+(define (read-boot-parameters port)
+ "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object. Raise an error if the format is unrecognized."
+ (define device-sexp->device
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (('file-system-label (? string? label))
+ (file-system-label label))
+ ((? bytevector? bv) ;old format
+ (bytevector->uuid bv 'dce))
+ ((? string? device)
+ (if (string-contains device ":/")
+ device ; nfs-root
+ ;; It used to be that we would not distinguish between labels and
+ ;; device names. Try to infer the right thing here.
+ (if (string-prefix? "/" device)
+ device
+ (file-system-label device))))))
+ (define uuid-sexp->uuid
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (x
+ (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
+ #f)))
+
+ ;; New versions are not backward-compatible, so only accept past and current
+ ;; versions, not future ones.
+ (define (version? n)
+ (member n (iota (1+ %boot-parameters-version))))
+
+ (match (read port)
+ (('boot-parameters ('version (? version? version))
+ ('label label) ('root-device root)
+ ('kernel kernel)
+ rest ...)
+ (boot-parameters
+ (version version)
+ (label label)
+ (root-device (device-sexp->device root))
+
+ (bootloader-name
+ (match (assq 'bootloader-name rest)
+ ((_ args) args)
+ (#f 'grub))) ; for compatibility reasons.
+
+ (bootloader-menu-entries
+ (match (assq 'bootloader-menu-entries rest)
+ ((_ entries) (map sexp->menu-entry entries))
+ (#f '())))
+
+ ;; In the past, we would store the directory name of linux instead of
+ ;; the absolute file name of its image. Detect that and correct it.
+ (kernel (if (string=? kernel (direct-store-path kernel))
+ (string-append kernel "/"
+ (system-linux-image-file-name))
+ kernel))
+
+ (kernel-arguments
+ (match (assq 'kernel-arguments rest)
+ ((_ args) args)
+ (#f '()))) ;the old format
+
+ (initrd
+ (match (assq 'initrd rest)
+ (('initrd ('string-append directory file)) ;the old format
+ (string-append directory file))
+ (('initrd (? string? file))
+ file)
+ (#f #f)))
+
+ (multiboot-modules
+ (match (assq 'multiboot-modules rest)
+ ((_ args) args)
+ (#f '())))
+
+ (locale
+ (match (assq 'locale rest)
+ ((_ locale) locale)
+ (#f #f)))
+
+ (store-device
+ ;; Linux device names like "/dev/sda1" are not suitable GRUB device
+ ;; identifiers, so we just filter them out.
+ (ensure-not-/dev
+ (match (assq 'store rest)
+ (('store ('device #f) _ ...)
+ root-device)
+ (('store ('device device) _ ...)
+ (device-sexp->device device))
+ (_ ;the old format
+ root-device))))
+
+ (store-directory-prefix
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'directory-prefix store-data)
+ (('directory-prefix prefix) prefix)
+ ;; No directory-prefix found.
+ (_ #f)))
+ (_
+ ;; No store found, old format.
+ #f)))
+
+ (store-crypto-devices
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'crypto-devices store-data)
+ (('crypto-devices (devices ...))
+ (map uuid-sexp->uuid devices))
+ (('crypto-devices dev)
+ (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
+ dev (port-filename port))
+ '())
+ (_
+ ;; No crypto-devices found.
+ '())))
+ (_
+ ;; No store found, old format.
+ '())))
+
+ (store-mount-point
+ (match (assq 'store rest)
+ (('store ('device _) ('mount-point mount-point) _ ...)
+ mount-point)
+ (_ ;the old format
+ "/")))))
+ (x ;unsupported format
+ (raise
+ (make-compound-condition
+ (formatted-message
+ (G_ "unrecognized boot parameters at '~a'~%")
+ (port-filename port))
+ (condition
+ (&fix-hint (hint (format #f (G_ "This probably means that this version
+of Guix is older than the one that created @file{~a}. To address this, you
+need to update Guix:
+
+@example
+guix pull
+@end example")
+ (port-filename port))))))))))
+
+(define (read-boot-parameters-file system)
+ "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
+file and returns the corresponding <boot-parameters> object or #f if the
+format is unrecognized.
+The object has its kernel-arguments extended in order to make it bootable."
+ (let* ((file (string-append system "/parameters"))
+ (params (call-with-input-file file read-boot-parameters))
+ (root (boot-parameters-root-device params))
+ (version (boot-parameters-version params)))
+ (boot-parameters
+ (inherit params)
+ (kernel-arguments (append (bootable-kernel-arguments system root version)
+ (boot-parameters-kernel-arguments params))))))
+
+(define (ensure-not-/dev device)
+ "If DEVICE starts with a slash, return #f. This is meant to filter out
+Linux device names such as /dev/sda, and to preserve GRUB device names and
+file system labels."
+ (if (and (string? device) (string-prefix? "/" device))
+ #f
+ device))
+
+;;; boot.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 955dfa618d..40df166fd7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -66,6 +66,7 @@ (define-module (guix scripts system)
#:use-module (gnu image)
#:use-module (gnu system)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system image)
#:use-module (gnu system mapped-devices)
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 03a1d01aff..2e7976aa6c 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -27,6 +27,7 @@ (define-module (test-boot-parameters)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((guix diagnostics) #:select (formatted-message?))
--
2.41.0
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 02 Mar 2024 23:47:02 GMT) Full text and rfc822 format available.Message #44 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: Re: Simplify bootloader data structures and procedures Date: Sat, 02 Mar 2024 17:46:04 -0600
In guix/scripts/system.scm(generation->boot-alternative) system-path isn't defined. Assuming system is supposed to be that?
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:25:02 GMT) Full text and rfc822 format available.Message #47 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Lilah Tascheter <lilah <at> lunabee.space>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 00/12] Simplify bootloader data structures and procedures Date: Fri, 8 Mar 2024 02:11:56 -0600
hey!
this is really useful!! love having access to generation numbers alongside
boot params, and the terminology fixing's great too :)
noticed a few problems - took the liberty to fix them in this v2 patch series:
* (gnu system boot) was missing a few imports that it needs to work.
* (gnu system boot) requires the procedure system-linux-image-file-name, which
is defined in (gnu system). I moved it over to (gnu system boot).
* generation->boot-alternative in (guix scripts system) had typos in variables
resulting in them not being used.
* commit messages didn't have relevant gnu changelog info.
* one of those commit messages had a wholeass log that's Way too much extraneous
information and just got in the way when trying to look at the actual patch
this v2 passes all relevant unit tests, but could still definately use some
verification that the modified paths function properly before I'd say this is
ready to be merged. notably, system reconfigure and ssh managed machine
reconfigure should be verified, but then it should be good?
thanks ya!!
- lilah
Felix Lechner (12):
Fix bug where the extra menu entries for a bootloader were shown
twice.
Move <boot-parameters> record to a separate file.
Also move boot-parameters->menu-entry.
Rename seconds->string procedure to epoch->date-string.
Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.
Offer a uniform decorated-boot-label and use it.
Rename boot-parameters to boot-alternatives when appropriate.
Rename two remote variables confusingly named 'generations'.
Give a separate name to a commonly used expression.
Simplify profile->boot-alternatives.
Split generation->boot-parameters out of profile->boot-alternatives.
Encapsulate <boot-parameters> to retain generation, system-path and
epoch.
gnu/machine/ssh.scm | 74 ++++----
gnu/system.scm | 264 +---------------------------
gnu/system/boot.scm | 354 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 71 ++++----
tests/boot-parameters.scm | 1 +
5 files changed, 430 insertions(+), 334 deletions(-)
create mode 100644 gnu/system/boot.scm
base-commit: 9038a46751c5090246e64b63ff752064833c435b
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:01 GMT) Full text and rfc822 format available.Message #50 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 01/12] Fix bug where the extra menu entries for a bootloader were shown twice. Date: Fri, 8 Mar 2024 02:11:57 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
The extra menu entries are already being added in each bootloaders, as
applicable.
* guix/scripts/system.scm (reinstall-bootloader)[entries]: Don't
extraneously include bootloader-configuration-menu-entries here.
Change-Id: I8a600f2a5836ab4f7db5e27e25b0b8f432c3e1e0
---
guix/scripts/system.scm | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bf3d2f9044..955dfa618d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -407,8 +407,7 @@ (define (reinstall-bootloader store number)
(delv number (reverse (generation-numbers %system-profile))))
(old-params (profile-boot-parameters
%system-profile old-generations))
- (entries (cons (boot-parameters->menu-entry params)
- (boot-parameters-bootloader-menu-entries params)))
+ (entries (list (boot-parameters->menu-entry params)))
(old-entries (map boot-parameters->menu-entry old-params)))
(run-with-store store
(mlet* %store-monad
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:02 GMT) Full text and rfc822 format available.Message #53 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 02/12] Move <boot-parameters> record to a separate file. Date: Fri, 8 Mar 2024 02:11:58 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
Required to avoid a missing dependency error on build-side.
* gnu/system.scm (<boot-parameters>): Move this record, and...
(system-linux-image-file-name, %boot-parameters-version,
ensure-not-/dev, read-boot-parameters,
read-boot-parameters-file): ...these procedures, to...
* gnu/system/boot.scm: ...this new file.
* gnu/machine/ssh.scm, gnu/system.scm, guix/scripts/system.scm,
tests/boot-parameters.scm: Use new module above.
Change-Id: I6944ffd4c323c776005b0cef23218bffae59be23
---
gnu/machine/ssh.scm | 1 +
gnu/system.scm | 236 +-----------------------------
gnu/system/boot.scm | 296 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 1 +
tests/boot-parameters.scm | 1 +
5 files changed, 300 insertions(+), 235 deletions(-)
create mode 100644 gnu/system/boot.scm
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index b47ce7c225..0ffe71367c 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -23,6 +23,7 @@ (define-module (gnu machine ssh)
#:use-module (gnu machine)
#:autoload (gnu packages gnupg) (guile-gcrypt)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((gnu services) #:select (sexp->system-provenance))
diff --git a/gnu/system.scm b/gnu/system.scm
index aede35775e..048f9090e0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -70,6 +70,7 @@ (define-module (gnu system)
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system shadow)
#:use-module (gnu system nss)
#:use-module (gnu system locale)
@@ -143,31 +144,11 @@ (define-module (gnu system)
operating-system-boot-script
operating-system-uuid
- system-linux-image-file-name
operating-system-with-gc-roots
operating-system-with-provenance
hurd-default-essential-services
- boot-parameters
- boot-parameters?
- boot-parameters-label
- boot-parameters-root-device
- boot-parameters-bootloader-name
- boot-parameters-bootloader-menu-entries
- boot-parameters-store-crypto-devices
- boot-parameters-store-device
- boot-parameters-store-directory-prefix
- boot-parameters-store-mount-point
- boot-parameters-locale
- boot-parameters-kernel
- boot-parameters-kernel-arguments
- boot-parameters-initrd
- boot-parameters-multiboot-modules
- boot-parameters-version
- %boot-parameters-version
- read-boot-parameters
- read-boot-parameters-file
boot-parameters->menu-entry
local-host-aliases ;deprecated
@@ -327,210 +308,6 @@ (define* (operating-system-kernel-arguments
;;; Boot parameters
;;;
-;;; Version 1 was introduced early 2022 to mark the departure from long option
-;;; names such as '--load' to the more conventional initrd option names like
-;;; 'gnu.load'.
-;;;
-;;; When bumping the boot-parameters version, increment it by one (1).
-(define %boot-parameters-version 1)
-
-(define-record-type* <boot-parameters>
- boot-parameters make-boot-parameters boot-parameters?
- (label boot-parameters-label)
- ;; Because we will use the 'store-device' to create the GRUB search command,
- ;; the 'store-device' has slightly different semantics than 'root-device'.
- ;; The 'store-device' can be a file system uuid, a file system label, or #f,
- ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
- ;; not understand that. The 'root-device', on the other hand, corresponds
- ;; exactly to the device field of the <file-system> object representing the
- ;; OS's root file system, so it might be a device file name like
- ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
- ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
- ;; contain "/storefs" if the store is located in that subvolume of a btrfs
- ;; partition.
- (root-device boot-parameters-root-device)
- (bootloader-name boot-parameters-bootloader-name)
- (bootloader-menu-entries ;list of <menu-entry>
- boot-parameters-bootloader-menu-entries)
- (store-device boot-parameters-store-device)
- (store-mount-point boot-parameters-store-mount-point)
- (store-directory-prefix boot-parameters-store-directory-prefix)
- (store-crypto-devices boot-parameters-store-crypto-devices
- (default '()))
- (locale boot-parameters-locale)
- (kernel boot-parameters-kernel)
- (kernel-arguments boot-parameters-kernel-arguments)
- (initrd boot-parameters-initrd)
- (multiboot-modules boot-parameters-multiboot-modules)
- (version boot-parameters-version ;positive integer
- (default %boot-parameters-version)))
-
-(define (ensure-not-/dev device)
- "If DEVICE starts with a slash, return #f. This is meant to filter out
-Linux device names such as /dev/sda, and to preserve GRUB device names and
-file system labels."
- (if (and (string? device) (string-prefix? "/" device))
- #f
- device))
-
-(define (read-boot-parameters port)
- "Read boot parameters from PORT and return the corresponding
-<boot-parameters> object. Raise an error if the format is unrecognized."
- (define device-sexp->device
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (('file-system-label (? string? label))
- (file-system-label label))
- ((? bytevector? bv) ;old format
- (bytevector->uuid bv 'dce))
- ((? string? device)
- (if (string-contains device ":/")
- device ; nfs-root
- ;; It used to be that we would not distinguish between labels and
- ;; device names. Try to infer the right thing here.
- (if (string-prefix? "/" device)
- device
- (file-system-label device))))))
- (define uuid-sexp->uuid
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (x
- (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
- #f)))
-
- ;; New versions are not backward-compatible, so only accept past and current
- ;; versions, not future ones.
- (define (version? n)
- (member n (iota (1+ %boot-parameters-version))))
-
- (match (read port)
- (('boot-parameters ('version (? version? version))
- ('label label) ('root-device root)
- ('kernel kernel)
- rest ...)
- (boot-parameters
- (version version)
- (label label)
- (root-device (device-sexp->device root))
-
- (bootloader-name
- (match (assq 'bootloader-name rest)
- ((_ args) args)
- (#f 'grub))) ; for compatibility reasons.
-
- (bootloader-menu-entries
- (match (assq 'bootloader-menu-entries rest)
- ((_ entries) (map sexp->menu-entry entries))
- (#f '())))
-
- ;; In the past, we would store the directory name of linux instead of
- ;; the absolute file name of its image. Detect that and correct it.
- (kernel (if (string=? kernel (direct-store-path kernel))
- (string-append kernel "/"
- (system-linux-image-file-name))
- kernel))
-
- (kernel-arguments
- (match (assq 'kernel-arguments rest)
- ((_ args) args)
- (#f '()))) ;the old format
-
- (initrd
- (match (assq 'initrd rest)
- (('initrd ('string-append directory file)) ;the old format
- (string-append directory file))
- (('initrd (? string? file))
- file)
- (#f #f)))
-
- (multiboot-modules
- (match (assq 'multiboot-modules rest)
- ((_ args) args)
- (#f '())))
-
- (locale
- (match (assq 'locale rest)
- ((_ locale) locale)
- (#f #f)))
-
- (store-device
- ;; Linux device names like "/dev/sda1" are not suitable GRUB device
- ;; identifiers, so we just filter them out.
- (ensure-not-/dev
- (match (assq 'store rest)
- (('store ('device #f) _ ...)
- root-device)
- (('store ('device device) _ ...)
- (device-sexp->device device))
- (_ ;the old format
- root-device))))
-
- (store-directory-prefix
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'directory-prefix store-data)
- (('directory-prefix prefix) prefix)
- ;; No directory-prefix found.
- (_ #f)))
- (_
- ;; No store found, old format.
- #f)))
-
- (store-crypto-devices
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'crypto-devices store-data)
- (('crypto-devices (devices ...))
- (map uuid-sexp->uuid devices))
- (('crypto-devices dev)
- (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
- dev (port-filename port))
- '())
- (_
- ;; No crypto-devices found.
- '())))
- (_
- ;; No store found, old format.
- '())))
-
- (store-mount-point
- (match (assq 'store rest)
- (('store ('device _) ('mount-point mount-point) _ ...)
- mount-point)
- (_ ;the old format
- "/")))))
- (x ;unsupported format
- (raise
- (make-compound-condition
- (formatted-message
- (G_ "unrecognized boot parameters at '~a'~%")
- (port-filename port))
- (condition
- (&fix-hint (hint (format #f (G_ "This probably means that this version
-of Guix is older than the one that created @file{~a}. To address this, you
-need to update Guix:
-
-@example
-guix pull
-@end example")
- (port-filename port))))))))))
-
-(define (read-boot-parameters-file system)
- "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
-file and returns the corresponding <boot-parameters> object or #f if the
-format is unrecognized.
-The object has its kernel-arguments extended in order to make it bootable."
- (let* ((file (string-append system "/parameters"))
- (params (call-with-input-file file read-boot-parameters))
- (root (boot-parameters-root-device params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (kernel-arguments (append (bootable-kernel-arguments system root version)
- (boot-parameters-kernel-arguments params))))))
-
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
@@ -692,17 +469,6 @@ (define (swap-services os)
(map (compose swap-service filter-deps)
(operating-system-swap-devices os)))
-(define* (system-linux-image-file-name #:optional
- (target (or (%current-target-system)
- (%current-system))))
- "Return the basename of the kernel image file for TARGET."
- (cond
- ((string-prefix? "arm" target) "zImage")
- ((string-prefix? "mips" target) "vmlinuz")
- ((string-prefix? "aarch64" target) "Image")
- ((string-prefix? "riscv64" target) "Image")
- (else "bzImage")))
-
(define (operating-system-kernel-file os)
"Return an object representing the absolute file name of the kernel image of
OS."
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
new file mode 100644
index 0000000000..3f227ab801
--- /dev/null
+++ b/gnu/system/boot.scm
@@ -0,0 +1,296 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw <at> netris.org>
+;;; Copyright © 2015, 2016 Alex Kost <alezost <at> gmail.com>
+;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo.peng <at> gmail.com>
+;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835 <at> gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym <at> scratchpost.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2020 Florian Pelz <pelzflorian <at> pelzflorian.de>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <jannek <at> gnu.org>
+;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il>
+;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner <at> lease-up.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system boot)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (guix store)
+ #:use-module (guix utils)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system uuid)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
+ #:export (boot-parameters
+ boot-parameters?
+ boot-parameters-label
+ boot-parameters-root-device
+ boot-parameters-bootloader-name
+ boot-parameters-bootloader-menu-entries
+ boot-parameters-store-crypto-devices
+ boot-parameters-store-device
+ boot-parameters-store-directory-prefix
+ boot-parameters-store-mount-point
+ boot-parameters-locale
+ boot-parameters-kernel
+ boot-parameters-kernel-arguments
+ boot-parameters-initrd
+ boot-parameters-multiboot-modules
+ boot-parameters-version
+ %boot-parameters-version
+
+ read-boot-parameters
+ read-boot-parameters-file
+
+ ensure-not-/dev
+ system-linux-image-file-name))
+
+;;;
+;;; Boot parameters
+;;;
+
+;;; Version 1 was introduced early 2022 to mark the departure from long option
+;;; names such as '--load' to the more conventional initrd option names like
+;;; 'gnu.load'.
+;;;
+;;; When bumping the boot-parameters version, increment it by one (1).
+(define %boot-parameters-version 1)
+
+(define-record-type* <boot-parameters>
+ boot-parameters make-boot-parameters boot-parameters?
+ (label boot-parameters-label)
+ ;; Because we will use the 'store-device' to create the GRUB search command,
+ ;; the 'store-device' has slightly different semantics than 'root-device'.
+ ;; The 'store-device' can be a file system uuid, a file system label, or #f,
+ ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
+ ;; not understand that. The 'root-device', on the other hand, corresponds
+ ;; exactly to the device field of the <file-system> object representing the
+ ;; OS's root file system, so it might be a device file name like
+ ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
+ ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
+ ;; contain "/storefs" if the store is located in that subvolume of a btrfs
+ ;; partition.
+ (root-device boot-parameters-root-device)
+ (bootloader-name boot-parameters-bootloader-name)
+ (bootloader-menu-entries ;list of <menu-entry>
+ boot-parameters-bootloader-menu-entries)
+ (store-device boot-parameters-store-device)
+ (store-mount-point boot-parameters-store-mount-point)
+ (store-directory-prefix boot-parameters-store-directory-prefix)
+ (store-crypto-devices boot-parameters-store-crypto-devices
+ (default '()))
+ (locale boot-parameters-locale)
+ (kernel boot-parameters-kernel)
+ (kernel-arguments boot-parameters-kernel-arguments)
+ (initrd boot-parameters-initrd)
+ (multiboot-modules boot-parameters-multiboot-modules)
+ (version boot-parameters-version ;positive integer
+ (default %boot-parameters-version)))
+
+(define (read-boot-parameters port)
+ "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object. Raise an error if the format is unrecognized."
+ (define device-sexp->device
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (('file-system-label (? string? label))
+ (file-system-label label))
+ ((? bytevector? bv) ;old format
+ (bytevector->uuid bv 'dce))
+ ((? string? device)
+ (if (string-contains device ":/")
+ device ; nfs-root
+ ;; It used to be that we would not distinguish between labels and
+ ;; device names. Try to infer the right thing here.
+ (if (string-prefix? "/" device)
+ device
+ (file-system-label device))))))
+ (define uuid-sexp->uuid
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (x
+ (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
+ #f)))
+
+ ;; New versions are not backward-compatible, so only accept past and current
+ ;; versions, not future ones.
+ (define (version? n)
+ (member n (iota (1+ %boot-parameters-version))))
+
+ (match (read port)
+ (('boot-parameters ('version (? version? version))
+ ('label label) ('root-device root)
+ ('kernel kernel)
+ rest ...)
+ (boot-parameters
+ (version version)
+ (label label)
+ (root-device (device-sexp->device root))
+
+ (bootloader-name
+ (match (assq 'bootloader-name rest)
+ ((_ args) args)
+ (#f 'grub))) ; for compatibility reasons.
+
+ (bootloader-menu-entries
+ (match (assq 'bootloader-menu-entries rest)
+ ((_ entries) (map sexp->menu-entry entries))
+ (#f '())))
+
+ ;; In the past, we would store the directory name of linux instead of
+ ;; the absolute file name of its image. Detect that and correct it.
+ (kernel (if (string=? kernel (direct-store-path kernel))
+ (string-append kernel "/"
+ (system-linux-image-file-name))
+ kernel))
+
+ (kernel-arguments
+ (match (assq 'kernel-arguments rest)
+ ((_ args) args)
+ (#f '()))) ;the old format
+
+ (initrd
+ (match (assq 'initrd rest)
+ (('initrd ('string-append directory file)) ;the old format
+ (string-append directory file))
+ (('initrd (? string? file))
+ file)
+ (#f #f)))
+
+ (multiboot-modules
+ (match (assq 'multiboot-modules rest)
+ ((_ args) args)
+ (#f '())))
+
+ (locale
+ (match (assq 'locale rest)
+ ((_ locale) locale)
+ (#f #f)))
+
+ (store-device
+ ;; Linux device names like "/dev/sda1" are not suitable GRUB device
+ ;; identifiers, so we just filter them out.
+ (ensure-not-/dev
+ (match (assq 'store rest)
+ (('store ('device #f) _ ...)
+ root-device)
+ (('store ('device device) _ ...)
+ (device-sexp->device device))
+ (_ ;the old format
+ root-device))))
+
+ (store-directory-prefix
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'directory-prefix store-data)
+ (('directory-prefix prefix) prefix)
+ ;; No directory-prefix found.
+ (_ #f)))
+ (_
+ ;; No store found, old format.
+ #f)))
+
+ (store-crypto-devices
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'crypto-devices store-data)
+ (('crypto-devices (devices ...))
+ (map uuid-sexp->uuid devices))
+ (('crypto-devices dev)
+ (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
+ dev (port-filename port))
+ '())
+ (_
+ ;; No crypto-devices found.
+ '())))
+ (_
+ ;; No store found, old format.
+ '())))
+
+ (store-mount-point
+ (match (assq 'store rest)
+ (('store ('device _) ('mount-point mount-point) _ ...)
+ mount-point)
+ (_ ;the old format
+ "/")))))
+ (x ;unsupported format
+ (raise
+ (make-compound-condition
+ (formatted-message
+ (G_ "unrecognized boot parameters at '~a'~%")
+ (port-filename port))
+ (condition
+ (&fix-hint (hint (format #f (G_ "This probably means that this version
+of Guix is older than the one that created @file{~a}. To address this, you
+need to update Guix:
+
+@example
+guix pull
+@end example")
+ (port-filename port))))))))))
+
+(define (read-boot-parameters-file system)
+ "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
+file and returns the corresponding <boot-parameters> object or #f if the
+format is unrecognized.
+The object has its kernel-arguments extended in order to make it bootable."
+ (let* ((file (string-append system "/parameters"))
+ (params (call-with-input-file file read-boot-parameters))
+ (root (boot-parameters-root-device params))
+ (version (boot-parameters-version params)))
+ (boot-parameters
+ (inherit params)
+ (kernel-arguments (append (bootable-kernel-arguments system root version)
+ (boot-parameters-kernel-arguments params))))))
+
+(define (ensure-not-/dev device)
+ "If DEVICE starts with a slash, return #f. This is meant to filter out
+Linux device names such as /dev/sda, and to preserve GRUB device names and
+file system labels."
+ (if (and (string? device) (string-prefix? "/" device))
+ #f
+ device))
+
+;; XXX: defined here instead of (gnu system) to prevent dependency loop
+(define* (system-linux-image-file-name #:optional
+ (target (or (%current-target-system)
+ (%current-system))))
+ "Return the basename of the kernel image file for TARGET."
+ (cond
+ ((string-prefix? "arm" target) "zImage")
+ ((string-prefix? "mips" target) "vmlinuz")
+ ((string-prefix? "aarch64" target) "Image")
+ ((string-prefix? "riscv64" target) "Image")
+ (else "bzImage")))
+
+
+;;; boot.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 955dfa618d..40df166fd7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -66,6 +66,7 @@ (define-module (guix scripts system)
#:use-module (gnu image)
#:use-module (gnu system)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system image)
#:use-module (gnu system mapped-devices)
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 03a1d01aff..2e7976aa6c 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -27,6 +27,7 @@ (define-module (test-boot-parameters)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((guix diagnostics) #:select (formatted-message?))
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:02 GMT) Full text and rfc822 format available.Message #56 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 04/12] Rename seconds->string procedure to epoch->date-string. Date: Fri, 8 Mar 2024 02:12:00 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm (seconds->string): Rename to
epoch->date-string.
(profile-boot-parameters)[boot-parameters]: Update as above.
Change-Id: I2b9aaa816b3ca84c32f7d6fa690245b149228310
---
guix/scripts/system.scm | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 40df166fd7..86ee2ddc76 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,9 +323,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (seconds->string seconds)
- "Return a string representing the date for SECONDS."
- (let ((time (make-time time-utc 0 seconds)))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
@@ -343,7 +343,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (seconds->string time) ")"))))))
+ (epoch->date-string time) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.41.0
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:03 GMT) Full text and rfc822 format available.Message #59 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 03/12] Also move boot-parameters->menu-entry. Date: Fri, 8 Mar 2024 02:11:59 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system.scm (boot-parameters->menu-entry): Move to...
* gnu/system/boot.scm (boot-parameters->menu-entry): ...here.
Change-Id: I794198e074b6d3012526a3056599ee3db1f1cdba
---
gnu/system.scm | 28 ----------------------------
gnu/system/boot.scm | 25 ++++++++++++++++++++++++-
2 files changed, 24 insertions(+), 29 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 048f9090e0..11f8e06cc0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -149,8 +149,6 @@ (define-module (gnu system)
hurd-default-essential-services
- boot-parameters->menu-entry
-
local-host-aliases ;deprecated
%root-account
%setuid-programs
@@ -303,32 +301,6 @@ (define* (operating-system-kernel-arguments
(append (bootable-kernel-arguments os root-device version)
(operating-system-user-kernel-arguments os)))
-
-;;;
-;;; Boot parameters
-;;;
-
-(define (boot-parameters->menu-entry conf)
- "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
- (let* ((kernel (boot-parameters-kernel conf))
- (multiboot-modules (boot-parameters-multiboot-modules conf))
- (multiboot? (pair? multiboot-modules)))
- (menu-entry
- (label (boot-parameters-label conf))
- (device (boot-parameters-store-device conf))
- (device-mount-point (boot-parameters-store-mount-point conf))
- (linux (and (not multiboot?) kernel))
- (linux-arguments (if (not multiboot?)
- (boot-parameters-kernel-arguments conf)
- '()))
- (initrd (boot-parameters-initrd conf))
- (multiboot-kernel (and multiboot? kernel))
- (multiboot-arguments (if multiboot?
- (boot-parameters-kernel-arguments conf)
- '()))
- (multiboot-modules (if multiboot?
- (boot-parameters-multiboot-modules conf)
- '())))))
;;;
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 3f227ab801..a3b9cce7d2 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -69,6 +69,8 @@ (define-module (gnu system boot)
read-boot-parameters
read-boot-parameters-file
+ boot-parameters->menu-entry
+
ensure-not-/dev
system-linux-image-file-name))
@@ -272,6 +274,28 @@ (define (read-boot-parameters-file system)
(kernel-arguments (append (bootable-kernel-arguments system root version)
(boot-parameters-kernel-arguments params))))))
+(define (boot-parameters->menu-entry conf)
+ "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
+ (let* ((kernel (boot-parameters-kernel conf))
+ (multiboot-modules (boot-parameters-multiboot-modules conf))
+ (multiboot? (pair? multiboot-modules)))
+ (menu-entry
+ (label (boot-parameters-label conf))
+ (device (boot-parameters-store-device conf))
+ (device-mount-point (boot-parameters-store-mount-point conf))
+ (linux (and (not multiboot?) kernel))
+ (linux-arguments (if (not multiboot?)
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (initrd (boot-parameters-initrd conf))
+ (multiboot-kernel (and multiboot? kernel))
+ (multiboot-arguments (if multiboot?
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (multiboot-modules (if multiboot?
+ (boot-parameters-multiboot-modules conf)
+ '())))))
+
(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
@@ -292,5 +316,4 @@ (define* (system-linux-image-file-name #:optional
((string-prefix? "riscv64" target) "Image")
(else "bzImage")))
-
;;; boot.scm ends here
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:03 GMT) Full text and rfc822 format available.Message #62 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 06/12] Offer a uniform decorated-boot-label and use it. Date: Fri, 8 Mar 2024 02:12:02 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system/boot.scm (decorated-boot-label): New procedure.
* gnu/machine/ssh.scm (machine-boot-parameters): Use
decorated-boot-label.
* guix/scripts/system.scm
(profile-boot-parameters)[system->boot-parameters]: Use
decorated-boot-label.
Change-Id: Id348c3047df2353f76b1bad0eb2a3e0fa17e474c
---
gnu/machine/ssh.scm | 8 ++------
gnu/system/boot.scm | 13 +++++++++++++
guix/scripts/system.scm | 8 +++-----
3 files changed, 18 insertions(+), 11 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 449b65dbfb..fe47474470 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -459,15 +459,11 @@ (define (machine-boot-parameters machine)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
- (label (boot-parameters-label params))
+ (text (boot-parameters-label params))
(version (boot-parameters-version params)))
(boot-parameters
(inherit params)
- (label
- (string-append label " (#"
- (number->string generation) ", "
- (epoch->date-string epoch)
- ")"))
+ (label (decorated-boot-label text generation epoch))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 972f83febc..b39e7d8610 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -71,6 +71,7 @@ (define-module (gnu system boot)
read-boot-parameters-file
epoch->date-string
+ decorated-boot-label
boot-parameters->menu-entry
ensure-not-/dev
@@ -282,6 +283,18 @@ (define (epoch->date-string epoch)
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
+(define (decorated-boot-label text generation epoch)
+ "Return a string for a nice boot label that includes TEXT, a numbered GENERATION,
+and a timestamp derived from EPOCH seconds."
+ (let* ((numbered (lambda (number) (string-append "#" (number->string number))))
+ (count (and=> generation numbered))
+ (timestamp (and=> epoch epoch->date-string))
+ (extras (filter identity (list count timestamp)))
+ (helpful (if (null? extras)
+ ""
+ (string-append "(" (string-join extras ", ") ")"))))
+ (string-join (list text helpful))))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 47c072ba5c..09d29dbbb1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -332,12 +332,10 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
- (label (boot-parameters-label params)))
+ (text (boot-parameters-label params)))
(boot-parameters
- (inherit params)
- (label (string-append label " (#"
- (number->string number) ", "
- (epoch->date-string epoch) ")"))))))
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.41.0
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:04 GMT) Full text and rfc822 format available.Message #65 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 08/12] Rename two remote variables confusingly named 'generations'. Date: Fri, 8 Mar 2024 02:12:04 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
Both refer to data sets returned from the remote expression, and one of them
shadowed an element of itself.
* gnu/machine/ssh.scm (machine->boot-alternatives): Rename generations
to remote-results.
Change-Id: Ibd8a3036126d9da1215cfc191884c0f54df637df
---
gnu/machine/ssh.scm | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 11534c6740..9adb5e79b9 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -451,10 +451,10 @@ (define (machine->boot-alternatives machine)
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
- (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp)))
+ (mlet* %store-monad ((remote-results (machine-remote-eval machine remote-exp)))
(return
- (map (lambda (generation)
- (match generation
+ (map (lambda (remote-result)
+ (match remote-result
((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
@@ -467,7 +467,7 @@ (define (machine->boot-alternatives machine)
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
- generations))))
+ remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
"Catch exceptions that arise when binding MBODY, a monadic expression in
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:04 GMT) Full text and rfc822 format available.Message #68 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 05/12] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere. Date: Fri, 8 Mar 2024 02:12:01 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm (profile-boot-parameters): Rename time to
epoch to fit new procedure name.
(epoch->date-string): Move to...
* gnu/system/boot.scm (epoch->date-string): ...here.
* gnu/machine/ssh.scm (machine-boot-parameters): Rename time to epoch.
(machine-boot-parameters)[boot-parameters]: Use epoch->date-string.
Change-Id: I6a5f793567221f81edd7b2d8d9f0f3e801d1b113
---
gnu/machine/ssh.scm | 10 ++++------
gnu/system/boot.scm | 8 ++++++++
guix/scripts/system.scm | 10 ++--------
3 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 0ffe71367c..449b65dbfb 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -444,10 +444,10 @@ (define (machine-boot-parameters machine)
generation))
(boot-parameters-path (string-append system-path
"/parameters"))
- (time (stat:mtime (lstat system-path))))
+ (epoch (stat:mtime (lstat system-path))))
(list generation
system-path
- time
+ epoch
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
@@ -455,7 +455,7 @@ (define (machine-boot-parameters machine)
(return
(map (lambda (generation)
(match generation
- ((generation system-path time serialized-params)
+ ((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
@@ -466,9 +466,7 @@ (define (machine-boot-parameters machine)
(label
(string-append label " (#"
(number->string generation) ", "
- (let ((time (make-time time-utc 0 time)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M"))
+ (epoch->date-string epoch)
")"))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index a3b9cce7d2..972f83febc 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -45,6 +45,7 @@ (define-module (gnu system boot)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
@@ -69,6 +70,7 @@ (define-module (gnu system boot)
read-boot-parameters
read-boot-parameters-file
+ epoch->date-string
boot-parameters->menu-entry
ensure-not-/dev
@@ -274,6 +276,12 @@ (define (read-boot-parameters-file system)
(kernel-arguments (append (bootable-kernel-arguments system root version)
(boot-parameters-kernel-arguments params))))))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
+ (date->string (time-utc->date time)
+ "~Y-~m-~d ~H:~M")))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 86ee2ddc76..47c072ba5c 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,19 +323,13 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (epoch->date-string epoch)
- "Return a string representing the date for EPOCH seconds."
- (let ((time (make-time time-utc 0 epoch)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M")))
-
(define* (profile-boot-parameters #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number time)
+ (define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
(label (boot-parameters-label params)))
@@ -343,7 +337,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (epoch->date-string time) ")"))))))
+ (epoch->date-string epoch) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:05 GMT) Full text and rfc822 format available.Message #71 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 07/12] Rename boot-parameters to boot-alternatives when appropriate. Date: Fri, 8 Mar 2024 02:12:03 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
Throughout the code base, the token 'boot-parameters' refers to collection of
data that is stored on disk for each system generation. It was confusing to
use it for a list of such records. This comment imposes an alternative name.
* gnu/machine/ssh.scm (machine-boot-parameters): Rename to
machine->boot-alternatives.
(machine->boot-alternatives, roll-back-managed-host): Use
boot-alternatives instead of boot-parameters as appropriate.
* guix/scripts/system.scm (profile-boot-parameters): Rename to
profile->boot-alternatives.
(reinstall-bootloader, perform-action): Use boot-alternatives instead
of boot-parameters as appropriate.
Change-Id: Iabb04dbb39f42f989692bede7304f20a69bef9fb
---
gnu/machine/ssh.scm | 20 ++++++++++----------
guix/scripts/system.scm | 19 ++++++++++---------
2 files changed, 20 insertions(+), 19 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index fe47474470..11534c6740 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -414,7 +414,7 @@ (define not-config?
(('gnu _ ...) #t)
(_ #f)))
-(define (machine-boot-parameters machine)
+(define (machine->boot-alternatives machine)
"Monadic procedure returning a list of 'boot-parameters' for the generations
of MACHINE's system profile, ordered from most recent to oldest."
(define bootable-kernel-arguments
@@ -503,14 +503,14 @@ (define (deploy-managed-host machine)
(machine-become-command machine)))
(mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-parameters (machine-boot-parameters machine)))
+ (boot-alternatives (machine->boot-alternatives 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 boot-parameters))
+ (menu-entries (map boot-parameters->menu-entry boot-alternatives))
(bootloader-configuration (operating-system-bootloader os))
(bootcfg (operating-system-bootcfg os menu-entries)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -581,19 +581,19 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))
- (_ -> (if (< (length boot-parameters) 2)
+ (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
+ (_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
(entries -> (map boot-parameters->menu-entry
- (list (second boot-parameters))))
+ (list (second boot-alternatives))))
(locale -> (boot-parameters-locale
- (second boot-parameters)))
+ (second boot-alternatives)))
(crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-parameters)))
+ (second boot-alternatives)))
(store-dir -> (boot-parameters-store-directory-prefix
- (second boot-parameters)))
+ (second boot-alternatives)))
(old-entries -> (map boot-parameters->menu-entry
- (drop boot-parameters 2)))
+ (drop boot-alternatives 2)))
(bootloader -> (operating-system-bootloader
(machine-operating-system machine)))
(bootcfg (lower-object
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 09d29dbbb1..fd9f0727ee 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,9 +323,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define* (profile-boot-parameters #:optional (profile %system-profile)
- (numbers
- (reverse (generation-numbers profile))))
+(define* (profile->boot-alternatives #:optional (profile %system-profile)
+ (numbers
+ (reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
@@ -390,18 +390,19 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile-boot-parameters %system-profile
- (list number))))
+ (params (first (profile->boot-alternatives %system-profile
+ (list number))))
(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))))
- (old-params (profile-boot-parameters
- %system-profile old-generations))
+ (previous-boot-alternatives (profile->boot-alternatives
+ %system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry old-params)))
+ (old-entries (map boot-parameters->menu-entry
+ previous-boot-alternatives)))
(run-with-store store
(mlet* %store-monad
((bootcfg (lower-object
@@ -817,7 +818,7 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile-boot-parameters))))))
+ (map boot-parameters->menu-entry (profile->boot-alternatives))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:05 GMT) Full text and rfc822 format available.Message #74 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 10/12] Simplify profile->boot-alternatives. Date: Fri, 8 Mar 2024 02:12:06 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm
(profile->boot-alternatives)[system->boot-parameters]: Rename to
generation->boot-parameters and factor out processing from...
(profile->boot-alternatives): ...here.
Change-Id: If31eeb4cef4f5a107a0ee5ad3f117bf38629ac38
---
guix/scripts/system.scm | 14 +++++---------
1 file changed, 5 insertions(+), 9 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index fd9f0727ee..3df37e5510 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -329,20 +329,16 @@ (define* (profile->boot-alternatives #:optional (profile %system-profile)
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number epoch)
+ (define (generation->boot-parameters number)
(unless-file-not-found
- (let* ((params (read-boot-parameters-file system))
+ (let* ((system (generation-file-name profile number))
+ (params (read-boot-parameters-file system))
+ (epoch (stat:mtime (lstat system)))
(text (boot-parameters-label params)))
(boot-parameters
(inherit params)
(label (decorated-boot-label text number epoch))))))
- (let* ((systems (map (cut generation-file-name profile <>)
- numbers))
- (times (map (lambda (system)
- (unless-file-not-found
- (stat:mtime (lstat system))))
- systems)))
- (filter-map system->boot-parameters systems numbers times)))
+ (filter-map generation->boot-parameters numbers))
;;;
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:05 GMT) Full text and rfc822 format available.Message #77 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 11/12] Split generation->boot-parameters out of profile->boot-alternatives. Date: Fri, 8 Mar 2024 02:12:07 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm
(profile->boot-alternatives)[generation->boot-parameters]: Move to...
(generation->boot-parameters): ...here.
(reinstall-bootloader): Use procedure above.
Change-Id: I51ef1a4fa8fd18104d28a6a845707d7dedde3782
---
guix/scripts/system.scm | 28 ++++++++++++++++------------
1 file changed, 16 insertions(+), 12 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3df37e5510..7f6ba20ef9 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,22 +323,27 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
+(define (generation->boot-parameters profile number)
+ "Return the 'boot-parameters' for the generation of PROFILE specified
+by NUMBER."
+ (unless-file-not-found
+ (let* ((system (generation-file-name profile number))
+ (params (read-boot-parameters-file system))
+ (epoch (stat:mtime (lstat system)))
+ (text (boot-parameters-label params)))
+ (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
+
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (generation->boot-parameters number)
- (unless-file-not-found
- (let* ((system (generation-file-name profile number))
- (params (read-boot-parameters-file system))
- (epoch (stat:mtime (lstat system)))
- (text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
- (filter-map generation->boot-parameters numbers))
+ (filter-map (lambda (number)
+ (generation->boot-parameters profile number))
+ numbers))
;;;
@@ -386,8 +391,7 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile->boot-alternatives %system-profile
- (list number))))
+ (params (generation->boot-parameters %system-profile number))
(locale (boot-parameters-locale params))
(store-crypto-devices (boot-parameters-store-crypto-devices params))
(store-directory-prefix
--
2.41.0
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:06 GMT) Full text and rfc822 format available.Message #80 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 09/12] Give a separate name to a commonly used expression. Date: Fri, 8 Mar 2024 02:12:05 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/machine/ssh.scm (roll-back-managed-host): Factor out a
subexpression into new variable parameters.
Change-Id: I8d70684142bea736042d6c9dc8276ea7bdb9c181
---
gnu/machine/ssh.scm | 13 +++++--------
1 file changed, 5 insertions(+), 8 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 9adb5e79b9..45ab8b9868 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -584,14 +584,11 @@ (define (roll-back-managed-host machine)
(mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
(_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
- (entries -> (map boot-parameters->menu-entry
- (list (second boot-alternatives))))
- (locale -> (boot-parameters-locale
- (second boot-alternatives)))
- (crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-alternatives)))
- (store-dir -> (boot-parameters-store-directory-prefix
- (second boot-alternatives)))
+ (parameters (second boot-alternatives))
+ (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
(drop boot-alternatives 2)))
(bootloader -> (operating-system-bootloader
--
2.41.0
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, rekado <at> elephly.net, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 08:26:06 GMT) Full text and rfc822 format available.Message #83 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v2 12/12] Encapsulate <boot-parameters> to retain generation, system-path and epoch. Date: Fri, 8 Mar 2024 02:12:08 -0600
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system/boot.scm (<boot-alternative>): New record.
* gnu/machine/ssh.scm (machine->boot-alternatives): Return a
boot-alternative encapsulating previous return value.
(with-roll-back, roll-back-managed-host): Get parameters from
boot-alternatives.
* guix/scripts/system.scm (generation->boot-parameters): Rename to...
(generation->boot-alternative): ...this. Return a boot-alternative
encapsulating previous return value.
(profile->boot-alternatives): Rename uses as above.
(reinstall-bootloader, perform-action): Get parameters from
boot-alternatives.
Change-Id: Iaef0b0a3fa9240ca8315a9699bcf4a7bfe908e33
---
gnu/machine/ssh.scm | 32 ++++++++++++++++++++------------
gnu/system/boot.scm | 14 ++++++++++++++
guix/scripts/system.scm | 32 +++++++++++++++++++++-----------
3 files changed, 55 insertions(+), 23 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 45ab8b9868..61125dddce 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -415,8 +415,8 @@ (define not-config?
(_ #f)))
(define (machine->boot-alternatives machine)
- "Monadic procedure returning a list of 'boot-parameters' for the generations
-of MACHINE's system profile, ordered from most recent to oldest."
+ "Monadic procedure returning a list of <boot-alternative> records for the
+generations of MACHINE's system profile, ordered from most recent to oldest."
(define bootable-kernel-arguments
(@@ (gnu system) bootable-kernel-arguments))
@@ -460,13 +460,18 @@ (define (machine->boot-alternatives machine)
read-boot-parameters))
(root (boot-parameters-root-device params))
(text (boot-parameters-label params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text generation epoch))
- (kernel-arguments
- (append (bootable-kernel-arguments system-path root version)
- (boot-parameters-kernel-arguments params))))))))
+ (version (boot-parameters-version params))
+ (parameters (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text generation epoch))
+ (kernel-arguments
+ (append (bootable-kernel-arguments system-path root version)
+ (boot-parameters-kernel-arguments params))))))
+ (boot-alternative
+ (generation generation)
+ (system-path system-path)
+ (epoch epoch)
+ (parameters parameters))))))
remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
@@ -510,7 +515,8 @@ (define (deploy-managed-host machine)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry boot-alternatives))
+ (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)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -584,13 +590,15 @@ (define (roll-back-managed-host machine)
(mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
(_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
- (parameters (second boot-alternatives))
+ (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
- (drop boot-alternatives 2)))
+ (map boot-alternative-parameters
+ (drop boot-alternatives 2))))
(bootloader -> (operating-system-bootloader
(machine-operating-system machine)))
(bootcfg (lower-object
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index b39e7d8610..edb4d213b9 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -70,6 +70,13 @@ (define-module (gnu system boot)
read-boot-parameters
read-boot-parameters-file
+ boot-alternative
+ boot-alternative?
+ boot-alternative-generation
+ boot-alternative-system-path
+ boot-alternative-epoch
+ boot-alternative-parameters
+
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
@@ -277,6 +284,13 @@ (define (read-boot-parameters-file system)
(kernel-arguments (append (bootable-kernel-arguments system root version)
(boot-parameters-kernel-arguments params))))))
+(define-record-type* <boot-alternative>
+ boot-alternative make-boot-alternative boot-alternative?
+ (generation boot-alternative-generation)
+ (system-path boot-alternative-system-path)
+ (epoch boot-alternative-epoch)
+ (parameters boot-alternative-parameters))
+
(define (epoch->date-string epoch)
"Return a string representing the date for EPOCH seconds."
(let ((time (make-time time-utc 0 epoch)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 7f6ba20ef9..97804ad736 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,26 +323,31 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (generation->boot-parameters profile number)
- "Return the 'boot-parameters' for the generation of PROFILE specified
+(define (generation->boot-alternative profile number)
+ "Return the 'boot-alternative' for the generation of PROFILE specified
by NUMBER."
(unless-file-not-found
(let* ((system (generation-file-name profile number))
(params (read-boot-parameters-file system))
(epoch (stat:mtime (lstat system)))
- (text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
+ (text (boot-parameters-label params))
+ (parameters (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch)))))
+ (boot-alternative
+ (generation number)
+ (system-path system)
+ (epoch epoch)
+ (parameters parameters)))))
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
- "Return a list of 'boot-parameters' for the generations of PROFILE specified
+ "Return a list of 'boot-alternative' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
(filter-map (lambda (number)
- (generation->boot-parameters profile number))
+ (generation->boot-alternative profile number))
numbers))
@@ -391,7 +396,9 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (generation->boot-parameters %system-profile number))
+ (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
@@ -402,7 +409,8 @@ (define (reinstall-bootloader store number)
%system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
(old-entries (map boot-parameters->menu-entry
- previous-boot-alternatives)))
+ (map boot-alternative-parameters
+ previous-boot-alternatives))))
(run-with-store store
(mlet* %store-monad
((bootcfg (lower-object
@@ -818,7 +826,9 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile->boot-alternatives))))))
+ (map boot-parameters->menu-entry
+ (map boot-alternative-parameters
+ (profile->boot-alternatives)))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.41.0
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 08 Mar 2024 16:35:03 GMT) Full text and rfc822 format available.Message #86 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Felix Lechner <felix.lechner <at> lease-up.com> To: Lilah Tascheter <lilah <at> lunabee.space> Cc: 69343 <at> patchwise.org Subject: Re: Simplify bootloader data structures and procedures Date: Fri, 08 Mar 2024 08:33:44 -0800
Hi Lilah, On Fri, Mar 08 2024, Lilah Tascheter wrote: > this is really useful!! love having access to generation numbers > alongside boot params, and the terminology fixing's great too :) Thank you for taking a closer look! Sorry I did not get back to you on the system-path question before. Of course, you were right. If you will please accept an excuse for my tardiness: My family has a new sister. Time passes when a baby cries. > * (gnu system boot) was missing a few imports that it needs to work. I regularly notice missing imports, too, but haven't figured out when they present an obstacle to running a Guile program. > * (gnu system boot) requires the procedure > system-linux-image-file-name, which is defined in (gnu system). I > moved it over to (gnu system boot). Thanks for doing that! Now you and I are co-conspirators in re-arranging the procedures. > * generation->boot-alternative in (guix scripts system) had typos in > variables resulting in them not being used. Thank you for finding those. I have poor vision and am not good with details, including speling. > * commit messages didn't have relevant gnu changelog info. Yes, I will read the GNU ChangeLog spec one more time, but all hope may be lost. > * one of those commit messages had a wholeass log that's Way too much > extraneous information and just got in the way My commit messages are widely regarded as wordy, roundabout and overly documentative. > this v2 passes all relevant unit tests, but could still definately use some > verification that the modified paths function properly before I'd say this is > ready to be merged. I use 'guix deploy' and will test your patch series shortly. (Despite the previous shortcomings, I have been using it in production.) My branch rebase is overdue. Unfortunately, I have many custom patches, including some affecting core packages. A branch rebase locally causes a full bootstrap and takes about two days. Given your attention here, I am sure your changes are fine. Folks should feel free to merge your work before I return with confirmation. Thanks! Kind regards Felix
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:02 GMT) Full text and rfc822 format available.Message #89 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Lilah Tascheter <lilah <at> lunabee.space> Subject: [PATCH v3 00/12] Simplify bootloader data structures and procedures Date: Sat, 3 Aug 2024 22:13:22 -0500
Two small changes here: add gnu/system/boot.scm to gnu/local.mk, and one other
small fix. Kinda forgot what that second fix was, sorry.
Felix Lechner (12):
Fix bug where the extra menu entries for a bootloader were shown
twice.
Move <boot-parameters> record to a separate file.
Also move boot-parameters->menu-entry.
Rename seconds->string procedure to epoch->date-string.
Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.
Offer a uniform decorated-boot-label and use it.
Rename boot-parameters to boot-alternatives when appropriate.
Rename two remote variables confusingly named 'generations'.
Give a separate name to a commonly used expression.
Simplify profile->boot-alternatives.
Split generation->boot-parameters out of profile->boot-alternatives.
Encapsulate <boot-parameters> to retain generation, system-path and
epoch.
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 77 ++++----
gnu/system.scm | 287 +----------------------------
gnu/system/boot.scm | 376 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 71 +++----
tests/boot-parameters.scm | 1 +
6 files changed, 453 insertions(+), 360 deletions(-)
create mode 100644 gnu/system/boot.scm
base-commit: f59c4126827af3d2041d49f1d0a8ce12b41470cf
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:02 GMT) Full text and rfc822 format available.Message #92 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 01/12] Fix bug where the extra menu entries for a bootloader were shown twice. Date: Sat, 3 Aug 2024 22:13:23 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
The extra menu entries are already being added in each bootloaders, as
applicable.
* guix/scripts/system.scm (reinstall-bootloader)[entries]: Don't
extraneously include bootloader-configuration-menu-entries here.
Change-Id: I8a600f2a5836ab4f7db5e27e25b0b8f432c3e1e0
---
guix/scripts/system.scm | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 99c58f3812..0305128763 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -412,8 +412,7 @@ (define (reinstall-bootloader store number)
(delv number (reverse (generation-numbers %system-profile))))
(old-params (profile-boot-parameters
%system-profile old-generations))
- (entries (cons (boot-parameters->menu-entry params)
- (boot-parameters-bootloader-menu-entries params)))
+ (entries (list (boot-parameters->menu-entry params)))
(old-entries (map boot-parameters->menu-entry old-params)))
(run-with-store store
(mlet* %store-monad
--
2.45.2
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:03 GMT) Full text and rfc822 format available.Message #95 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 03/12] Also move boot-parameters->menu-entry. Date: Sat, 3 Aug 2024 22:13:25 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system.scm (boot-parameters->menu-entry): Move to...
* gnu/system/boot.scm (boot-parameters->menu-entry): ...here.
Change-Id: I794198e074b6d3012526a3056599ee3db1f1cdba
---
gnu/system.scm | 28 ----------------------------
gnu/system/boot.scm | 25 ++++++++++++++++++++++++-
2 files changed, 24 insertions(+), 29 deletions(-)
diff --git a/gnu/system.scm b/gnu/system.scm
index 2e4b10e2fb..4a084b2ecf 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -151,8 +151,6 @@ (define-module (gnu system)
hurd-default-essential-services
- boot-parameters->menu-entry
-
local-host-aliases ;deprecated
%root-account
%setuid-programs
@@ -314,32 +312,6 @@ (define* (operating-system-kernel-arguments
(append (bootable-kernel-arguments os root-device version)
(operating-system-user-kernel-arguments os)))
-
-;;;
-;;; Boot parameters
-;;;
-
-(define (boot-parameters->menu-entry conf)
- "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
- (let* ((kernel (boot-parameters-kernel conf))
- (multiboot-modules (boot-parameters-multiboot-modules conf))
- (multiboot? (pair? multiboot-modules)))
- (menu-entry
- (label (boot-parameters-label conf))
- (device (boot-parameters-store-device conf))
- (device-mount-point (boot-parameters-store-mount-point conf))
- (linux (and (not multiboot?) kernel))
- (linux-arguments (if (not multiboot?)
- (boot-parameters-kernel-arguments conf)
- '()))
- (initrd (boot-parameters-initrd conf))
- (multiboot-kernel (and multiboot? kernel))
- (multiboot-arguments (if multiboot?
- (boot-parameters-kernel-arguments conf)
- '()))
- (multiboot-modules (if multiboot?
- (boot-parameters-multiboot-modules conf)
- '())))))
;;;
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 7bae9d2102..df27b8aea4 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -70,6 +70,8 @@ (define-module (gnu system boot)
read-boot-parameters-file
bootable-kernel-arguments
+ boot-parameters->menu-entry
+
ensure-not-/dev
system-linux-image-file-name))
@@ -294,6 +296,28 @@ (define* (bootable-kernel-arguments system root-device version)
#~(string-append (if #$version>0? "gnu.load=" "--load=")
#$system "/boot")))))
+(define (boot-parameters->menu-entry conf)
+ "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
+ (let* ((kernel (boot-parameters-kernel conf))
+ (multiboot-modules (boot-parameters-multiboot-modules conf))
+ (multiboot? (pair? multiboot-modules)))
+ (menu-entry
+ (label (boot-parameters-label conf))
+ (device (boot-parameters-store-device conf))
+ (device-mount-point (boot-parameters-store-mount-point conf))
+ (linux (and (not multiboot?) kernel))
+ (linux-arguments (if (not multiboot?)
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (initrd (boot-parameters-initrd conf))
+ (multiboot-kernel (and multiboot? kernel))
+ (multiboot-arguments (if multiboot?
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (multiboot-modules (if multiboot?
+ (boot-parameters-multiboot-modules conf)
+ '())))))
+
(define (ensure-not-/dev device)
"If DEVICE starts with a slash, return #f. This is meant to filter out
Linux device names such as /dev/sda, and to preserve GRUB device names and
@@ -314,5 +338,4 @@ (define* (system-linux-image-file-name #:optional
((string-prefix? "riscv64" target) "Image")
(else "bzImage")))
-
;;; boot.scm ends here
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:03 GMT) Full text and rfc822 format available.Message #98 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 02/12] Move <boot-parameters> record to a separate file. Date: Sat, 3 Aug 2024 22:13:24 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
Required to avoid a missing dependency error on build-side.
* gnu/system.scm (<boot-parameters>): Move this record, and...
(system-linux-image-file-name, %boot-parameters-version,
bootable-kernel-arguments, ensure-not-/dev, read-boot-parameters,
read-boot-parameters-file): ...these procedures, to...
* gnu/system/boot.scm: ...this new file.
* gnu/machine/ssh.scm, gnu/system.scm, guix/scripts/system.scm,
tests/boot-parameters.scm: Use new module above.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add new module above.
* gnu/machine/ssh.scm (machine-boot-parameters): Don't private-import
bootable-kernel-arguments.
Change-Id: I6944ffd4c323c776005b0cef23218bffae59be23
---
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 4 +-
gnu/system.scm | 259 +------------------------------
gnu/system/boot.scm | 318 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 1 +
tests/boot-parameters.scm | 1 +
6 files changed, 323 insertions(+), 261 deletions(-)
create mode 100644 gnu/system/boot.scm
diff --git a/gnu/local.mk b/gnu/local.mk
index 6d2b14e72d..8375e13709 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -758,6 +758,7 @@ GNU_SYSTEM_MODULES = \
\
%D%/system.scm \
%D%/system/accounts.scm \
+ %D%/system/boot.scm \
%D%/system/file-systems.scm \
%D%/system/hurd.scm \
%D%/system/image.scm \
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 0be9ebbc0d..749aa2b6d8 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -23,6 +23,7 @@ (define-module (gnu machine ssh)
#:use-module (gnu machine)
#:autoload (gnu packages gnupg) (guile-gcrypt)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((gnu services) #:select (sexp->system-provenance))
@@ -417,9 +418,6 @@ (define not-config?
(define (machine-boot-parameters machine)
"Monadic procedure returning a list of 'boot-parameters' for the generations
of MACHINE's system profile, ordered from most recent to oldest."
- (define bootable-kernel-arguments
- (@@ (gnu system) bootable-kernel-arguments))
-
(define remote-exp
(with-extensions (list guile-gcrypt)
(with-imported-modules `(((guix config) => ,(make-config.scm))
diff --git a/gnu/system.scm b/gnu/system.scm
index c76f4d7c50..2e4b10e2fb 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -72,6 +72,7 @@ (define-module (gnu system)
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system shadow)
#:use-module (gnu system nss)
#:use-module (gnu system locale)
@@ -145,31 +146,11 @@ (define-module (gnu system)
operating-system-boot-script
operating-system-uuid
- system-linux-image-file-name
operating-system-with-gc-roots
operating-system-with-provenance
hurd-default-essential-services
- boot-parameters
- boot-parameters?
- boot-parameters-label
- boot-parameters-root-device
- boot-parameters-bootloader-name
- boot-parameters-bootloader-menu-entries
- boot-parameters-store-crypto-devices
- boot-parameters-store-device
- boot-parameters-store-directory-prefix
- boot-parameters-store-mount-point
- boot-parameters-locale
- boot-parameters-kernel
- boot-parameters-kernel-arguments
- boot-parameters-initrd
- boot-parameters-multiboot-modules
- boot-parameters-version
- %boot-parameters-version
- read-boot-parameters
- read-boot-parameters-file
boot-parameters->menu-entry
local-host-aliases ;deprecated
@@ -192,29 +173,6 @@ (define-module (gnu system)
;;;
;;; Code:
-(define* (bootable-kernel-arguments system root-device version)
- "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE.
-VERSION is the target version of the boot-parameters record."
- ;; If the version is newer than 0, we use the new style initrd parameter
- ;; names, otherwise we use the legacy ones. This is to maintain backward
- ;; compatibility when producing bootloader configurations for older
- ;; generations.
- (define version>0? (> version 0))
- (let ((root (file-system-device->string root-device
- #:uuid-type 'dce)))
- (append
- (if (string=? root "none")
- '() ; Ignore the case where the root is "none" (typically tmpfs).
- ;; Note: Always use the DCE format because that's what
- ;; (gnu build linux-boot) expects for the 'root'
- ;; kernel command-line option.
- (list (string-append (if version>0? "root=" "--root=") root)))
- (list #~(string-append (if #$version>0? "gnu.system=" "--system=") #$system)
- #~(string-append (if #$version>0? "gnu.load=" "--load=")
- #$system "/boot")))))
-
-;; System-wide configuration.
-
(define-with-syntax-properties (warn-hosts-file-field-deprecation
(value properties))
(when value
@@ -361,210 +319,6 @@ (define* (operating-system-kernel-arguments
;;; Boot parameters
;;;
-;;; Version 1 was introduced early 2022 to mark the departure from long option
-;;; names such as '--load' to the more conventional initrd option names like
-;;; 'gnu.load'.
-;;;
-;;; When bumping the boot-parameters version, increment it by one (1).
-(define %boot-parameters-version 1)
-
-(define-record-type* <boot-parameters>
- boot-parameters make-boot-parameters boot-parameters?
- (label boot-parameters-label)
- ;; Because we will use the 'store-device' to create the GRUB search command,
- ;; the 'store-device' has slightly different semantics than 'root-device'.
- ;; The 'store-device' can be a file system uuid, a file system label, or #f,
- ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
- ;; not understand that. The 'root-device', on the other hand, corresponds
- ;; exactly to the device field of the <file-system> object representing the
- ;; OS's root file system, so it might be a device file name like
- ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
- ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
- ;; contain "/storefs" if the store is located in that subvolume of a btrfs
- ;; partition.
- (root-device boot-parameters-root-device)
- (bootloader-name boot-parameters-bootloader-name)
- (bootloader-menu-entries ;list of <menu-entry>
- boot-parameters-bootloader-menu-entries)
- (store-device boot-parameters-store-device)
- (store-mount-point boot-parameters-store-mount-point)
- (store-directory-prefix boot-parameters-store-directory-prefix)
- (store-crypto-devices boot-parameters-store-crypto-devices
- (default '()))
- (locale boot-parameters-locale)
- (kernel boot-parameters-kernel)
- (kernel-arguments boot-parameters-kernel-arguments)
- (initrd boot-parameters-initrd)
- (multiboot-modules boot-parameters-multiboot-modules)
- (version boot-parameters-version ;positive integer
- (default %boot-parameters-version)))
-
-(define (ensure-not-/dev device)
- "If DEVICE starts with a slash, return #f. This is meant to filter out
-Linux device names such as /dev/sda, and to preserve GRUB device names and
-file system labels."
- (if (and (string? device) (string-prefix? "/" device))
- #f
- device))
-
-(define (read-boot-parameters port)
- "Read boot parameters from PORT and return the corresponding
-<boot-parameters> object. Raise an error if the format is unrecognized."
- (define device-sexp->device
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (('file-system-label (? string? label))
- (file-system-label label))
- ((? bytevector? bv) ;old format
- (bytevector->uuid bv 'dce))
- ((? string? device)
- (if (string-contains device ":/")
- device ; nfs-root
- ;; It used to be that we would not distinguish between labels and
- ;; device names. Try to infer the right thing here.
- (if (string-prefix? "/" device)
- device
- (file-system-label device))))))
- (define uuid-sexp->uuid
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (x
- (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
- #f)))
-
- ;; New versions are not backward-compatible, so only accept past and current
- ;; versions, not future ones.
- (define (version? n)
- (member n (iota (1+ %boot-parameters-version))))
-
- (match (read port)
- (('boot-parameters ('version (? version? version))
- ('label label) ('root-device root)
- ('kernel kernel)
- rest ...)
- (boot-parameters
- (version version)
- (label label)
- (root-device (device-sexp->device root))
-
- (bootloader-name
- (match (assq 'bootloader-name rest)
- ((_ args) args)
- (#f 'grub))) ; for compatibility reasons.
-
- (bootloader-menu-entries
- (match (assq 'bootloader-menu-entries rest)
- ((_ entries) (map sexp->menu-entry entries))
- (#f '())))
-
- ;; In the past, we would store the directory name of linux instead of
- ;; the absolute file name of its image. Detect that and correct it.
- (kernel (if (string=? kernel (direct-store-path kernel))
- (string-append kernel "/"
- (system-linux-image-file-name))
- kernel))
-
- (kernel-arguments
- (match (assq 'kernel-arguments rest)
- ((_ args) args)
- (#f '()))) ;the old format
-
- (initrd
- (match (assq 'initrd rest)
- (('initrd ('string-append directory file)) ;the old format
- (string-append directory file))
- (('initrd (? string? file))
- file)
- (#f #f)))
-
- (multiboot-modules
- (match (assq 'multiboot-modules rest)
- ((_ args) args)
- (#f '())))
-
- (locale
- (match (assq 'locale rest)
- ((_ locale) locale)
- (#f #f)))
-
- (store-device
- ;; Linux device names like "/dev/sda1" are not suitable GRUB device
- ;; identifiers, so we just filter them out.
- (ensure-not-/dev
- (match (assq 'store rest)
- (('store ('device #f) _ ...)
- root-device)
- (('store ('device device) _ ...)
- (device-sexp->device device))
- (_ ;the old format
- root-device))))
-
- (store-directory-prefix
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'directory-prefix store-data)
- (('directory-prefix prefix) prefix)
- ;; No directory-prefix found.
- (_ #f)))
- (_
- ;; No store found, old format.
- #f)))
-
- (store-crypto-devices
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'crypto-devices store-data)
- (('crypto-devices (devices ...))
- (map uuid-sexp->uuid devices))
- (('crypto-devices dev)
- (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
- dev (port-filename port))
- '())
- (_
- ;; No crypto-devices found.
- '())))
- (_
- ;; No store found, old format.
- '())))
-
- (store-mount-point
- (match (assq 'store rest)
- (('store ('device _) ('mount-point mount-point) _ ...)
- mount-point)
- (_ ;the old format
- "/")))))
- (x ;unsupported format
- (raise
- (make-compound-condition
- (formatted-message
- (G_ "unrecognized boot parameters at '~a'~%")
- (port-filename port))
- (condition
- (&fix-hint (hint (format #f (G_ "This probably means that this version
-of Guix is older than the one that created @file{~a}. To address this, you
-need to update Guix:
-
-@example
-guix pull
-@end example")
- (port-filename port))))))))))
-
-(define (read-boot-parameters-file system)
- "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
-file and returns the corresponding <boot-parameters> object or #f if the
-format is unrecognized.
-The object has its kernel-arguments extended in order to make it bootable."
- (let* ((file (string-append system "/parameters"))
- (params (call-with-input-file file read-boot-parameters))
- (root (boot-parameters-root-device params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (kernel-arguments (append (bootable-kernel-arguments system root version)
- (boot-parameters-kernel-arguments params))))))
-
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
@@ -726,17 +480,6 @@ (define (swap-services os)
(map (compose swap-service filter-deps)
(operating-system-swap-devices os)))
-(define* (system-linux-image-file-name #:optional
- (target (or (%current-target-system)
- (%current-system))))
- "Return the basename of the kernel image file for TARGET."
- (cond
- ((string-prefix? "arm" target) "zImage")
- ((string-prefix? "mips" target) "vmlinuz")
- ((string-prefix? "aarch64" target) "Image")
- ((string-prefix? "riscv64" target) "Image")
- (else "bzImage")))
-
(define (operating-system-kernel-file os)
"Return an object representing the absolute file name of the kernel image of
OS."
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
new file mode 100644
index 0000000000..7bae9d2102
--- /dev/null
+++ b/gnu/system/boot.scm
@@ -0,0 +1,318 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw <at> netris.org>
+;;; Copyright © 2015, 2016 Alex Kost <alezost <at> gmail.com>
+;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo.peng <at> gmail.com>
+;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835 <at> gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym <at> scratchpost.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2020 Florian Pelz <pelzflorian <at> pelzflorian.de>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <jannek <at> gnu.org>
+;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il>
+;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner <at> lease-up.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system boot)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (guix store)
+ #:use-module (guix utils)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system uuid)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
+ #:export (boot-parameters
+ boot-parameters?
+ boot-parameters-label
+ boot-parameters-root-device
+ boot-parameters-bootloader-name
+ boot-parameters-bootloader-menu-entries
+ boot-parameters-store-crypto-devices
+ boot-parameters-store-device
+ boot-parameters-store-directory-prefix
+ boot-parameters-store-mount-point
+ boot-parameters-locale
+ boot-parameters-kernel
+ boot-parameters-kernel-arguments
+ boot-parameters-initrd
+ boot-parameters-multiboot-modules
+ boot-parameters-version
+ %boot-parameters-version
+
+ read-boot-parameters
+ read-boot-parameters-file
+ bootable-kernel-arguments
+
+ ensure-not-/dev
+ system-linux-image-file-name))
+
+;;;
+;;; Boot parameters
+;;;
+
+;;; Version 1 was introduced early 2022 to mark the departure from long option
+;;; names such as '--load' to the more conventional initrd option names like
+;;; 'gnu.load'.
+;;;
+;;; When bumping the boot-parameters version, increment it by one (1).
+(define %boot-parameters-version 1)
+
+(define-record-type* <boot-parameters>
+ boot-parameters make-boot-parameters boot-parameters?
+ (label boot-parameters-label)
+ ;; Because we will use the 'store-device' to create the GRUB search command,
+ ;; the 'store-device' has slightly different semantics than 'root-device'.
+ ;; The 'store-device' can be a file system uuid, a file system label, or #f,
+ ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
+ ;; not understand that. The 'root-device', on the other hand, corresponds
+ ;; exactly to the device field of the <file-system> object representing the
+ ;; OS's root file system, so it might be a device file name like
+ ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
+ ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
+ ;; contain "/storefs" if the store is located in that subvolume of a btrfs
+ ;; partition.
+ (root-device boot-parameters-root-device)
+ (bootloader-name boot-parameters-bootloader-name)
+ (bootloader-menu-entries ;list of <menu-entry>
+ boot-parameters-bootloader-menu-entries)
+ (store-device boot-parameters-store-device)
+ (store-mount-point boot-parameters-store-mount-point)
+ (store-directory-prefix boot-parameters-store-directory-prefix)
+ (store-crypto-devices boot-parameters-store-crypto-devices
+ (default '()))
+ (locale boot-parameters-locale)
+ (kernel boot-parameters-kernel)
+ (kernel-arguments boot-parameters-kernel-arguments)
+ (initrd boot-parameters-initrd)
+ (multiboot-modules boot-parameters-multiboot-modules)
+ (version boot-parameters-version ;positive integer
+ (default %boot-parameters-version)))
+
+(define (read-boot-parameters port)
+ "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object. Raise an error if the format is unrecognized."
+ (define device-sexp->device
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (('file-system-label (? string? label))
+ (file-system-label label))
+ ((? bytevector? bv) ;old format
+ (bytevector->uuid bv 'dce))
+ ((? string? device)
+ (if (string-contains device ":/")
+ device ; nfs-root
+ ;; It used to be that we would not distinguish between labels and
+ ;; device names. Try to infer the right thing here.
+ (if (string-prefix? "/" device)
+ device
+ (file-system-label device))))))
+ (define uuid-sexp->uuid
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (x
+ (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
+ #f)))
+
+ ;; New versions are not backward-compatible, so only accept past and current
+ ;; versions, not future ones.
+ (define (version? n)
+ (member n (iota (1+ %boot-parameters-version))))
+
+ (match (read port)
+ (('boot-parameters ('version (? version? version))
+ ('label label) ('root-device root)
+ ('kernel kernel)
+ rest ...)
+ (boot-parameters
+ (version version)
+ (label label)
+ (root-device (device-sexp->device root))
+
+ (bootloader-name
+ (match (assq 'bootloader-name rest)
+ ((_ args) args)
+ (#f 'grub))) ; for compatibility reasons.
+
+ (bootloader-menu-entries
+ (match (assq 'bootloader-menu-entries rest)
+ ((_ entries) (map sexp->menu-entry entries))
+ (#f '())))
+
+ ;; In the past, we would store the directory name of linux instead of
+ ;; the absolute file name of its image. Detect that and correct it.
+ (kernel (if (string=? kernel (direct-store-path kernel))
+ (string-append kernel "/"
+ (system-linux-image-file-name))
+ kernel))
+
+ (kernel-arguments
+ (match (assq 'kernel-arguments rest)
+ ((_ args) args)
+ (#f '()))) ;the old format
+
+ (initrd
+ (match (assq 'initrd rest)
+ (('initrd ('string-append directory file)) ;the old format
+ (string-append directory file))
+ (('initrd (? string? file))
+ file)
+ (#f #f)))
+
+ (multiboot-modules
+ (match (assq 'multiboot-modules rest)
+ ((_ args) args)
+ (#f '())))
+
+ (locale
+ (match (assq 'locale rest)
+ ((_ locale) locale)
+ (#f #f)))
+
+ (store-device
+ ;; Linux device names like "/dev/sda1" are not suitable GRUB device
+ ;; identifiers, so we just filter them out.
+ (ensure-not-/dev
+ (match (assq 'store rest)
+ (('store ('device #f) _ ...)
+ root-device)
+ (('store ('device device) _ ...)
+ (device-sexp->device device))
+ (_ ;the old format
+ root-device))))
+
+ (store-directory-prefix
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'directory-prefix store-data)
+ (('directory-prefix prefix) prefix)
+ ;; No directory-prefix found.
+ (_ #f)))
+ (_
+ ;; No store found, old format.
+ #f)))
+
+ (store-crypto-devices
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'crypto-devices store-data)
+ (('crypto-devices (devices ...))
+ (map uuid-sexp->uuid devices))
+ (('crypto-devices dev)
+ (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
+ dev (port-filename port))
+ '())
+ (_
+ ;; No crypto-devices found.
+ '())))
+ (_
+ ;; No store found, old format.
+ '())))
+
+ (store-mount-point
+ (match (assq 'store rest)
+ (('store ('device _) ('mount-point mount-point) _ ...)
+ mount-point)
+ (_ ;the old format
+ "/")))))
+ (x ;unsupported format
+ (raise
+ (make-compound-condition
+ (formatted-message
+ (G_ "unrecognized boot parameters at '~a'~%")
+ (port-filename port))
+ (condition
+ (&fix-hint (hint (format #f (G_ "This probably means that this version
+of Guix is older than the one that created @file{~a}. To address this, you
+need to update Guix:
+
+@example
+guix pull
+@end example")
+ (port-filename port))))))))))
+
+(define (read-boot-parameters-file system)
+ "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
+file and returns the corresponding <boot-parameters> object or #f if the
+format is unrecognized.
+The object has its kernel-arguments extended in order to make it bootable."
+ (let* ((file (string-append system "/parameters"))
+ (params (call-with-input-file file read-boot-parameters))
+ (root (boot-parameters-root-device params))
+ (version (boot-parameters-version params)))
+ (boot-parameters
+ (inherit params)
+ (kernel-arguments (append (bootable-kernel-arguments system root version)
+ (boot-parameters-kernel-arguments params))))))
+
+(define* (bootable-kernel-arguments system root-device version)
+ "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE.
+VERSION is the target version of the boot-parameters record."
+ ;; If the version is newer than 0, we use the new style initrd parameter
+ ;; names, otherwise we use the legacy ones. This is to maintain backward
+ ;; compatibility when producing bootloader configurations for older
+ ;; generations.
+ (define version>0? (> version 0))
+ (let ((root (file-system-device->string root-device
+ #:uuid-type 'dce)))
+ (append
+ (if (string=? root "none")
+ '() ; Ignore the case where the root is "none" (typically tmpfs).
+ ;; Note: Always use the DCE format because that's what
+ ;; (gnu build linux-boot) expects for the 'root'
+ ;; kernel command-line option.
+ (list (string-append (if version>0? "root=" "--root=") root)))
+ (list #~(string-append (if #$version>0? "gnu.system=" "--system=") #$system)
+ #~(string-append (if #$version>0? "gnu.load=" "--load=")
+ #$system "/boot")))))
+
+(define (ensure-not-/dev device)
+ "If DEVICE starts with a slash, return #f. This is meant to filter out
+Linux device names such as /dev/sda, and to preserve GRUB device names and
+file system labels."
+ (if (and (string? device) (string-prefix? "/" device))
+ #f
+ device))
+
+;; XXX: defined here instead of (gnu system) to prevent dependency loop
+(define* (system-linux-image-file-name #:optional
+ (target (or (%current-target-system)
+ (%current-system))))
+ "Return the basename of the kernel image file for TARGET."
+ (cond
+ ((string-prefix? "arm" target) "zImage")
+ ((string-prefix? "mips" target) "vmlinuz")
+ ((string-prefix? "aarch64" target) "Image")
+ ((string-prefix? "riscv64" target) "Image")
+ (else "bzImage")))
+
+
+;;; boot.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0305128763..7000c470ed 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -70,6 +70,7 @@ (define-module (guix scripts system)
#:use-module (gnu image)
#:use-module (gnu system)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system image)
#:use-module (gnu system mapped-devices)
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 03a1d01aff..2e7976aa6c 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -27,6 +27,7 @@ (define-module (test-boot-parameters)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((guix diagnostics) #:select (formatted-message?))
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:04 GMT) Full text and rfc822 format available.Message #101 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 04/12] Rename seconds->string procedure to epoch->date-string. Date: Sat, 3 Aug 2024 22:13:26 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm (seconds->string): Rename to
epoch->date-string.
(profile-boot-parameters)[boot-parameters]: Update as above.
Change-Id: I2b9aaa816b3ca84c32f7d6fa690245b149228310
---
guix/scripts/system.scm | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 7000c470ed..cb70d36219 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,9 +328,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (seconds->string seconds)
- "Return a string representing the date for SECONDS."
- (let ((time (make-time time-utc 0 seconds)))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
@@ -348,7 +348,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (seconds->string time) ")"))))))
+ (epoch->date-string time) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:04 GMT) Full text and rfc822 format available.Message #104 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 05/12] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere. Date: Sat, 3 Aug 2024 22:13:27 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm (profile-boot-parameters): Rename time to
epoch to fit new procedure name.
(epoch->date-string): Move to...
* gnu/system/boot.scm (epoch->date-string): ...here.
* gnu/machine/ssh.scm (machine-boot-parameters): Rename time to epoch.
(machine-boot-parameters)[boot-parameters]: Use epoch->date-string.
Change-Id: I6a5f793567221f81edd7b2d8d9f0f3e801d1b113
---
gnu/machine/ssh.scm | 10 ++++------
gnu/system/boot.scm | 8 ++++++++
guix/scripts/system.scm | 10 ++--------
3 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 749aa2b6d8..e68e64527e 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -442,10 +442,10 @@ (define (machine-boot-parameters machine)
generation))
(boot-parameters-path (string-append system-path
"/parameters"))
- (time (stat:mtime (lstat system-path))))
+ (epoch (stat:mtime (lstat system-path))))
(list generation
system-path
- time
+ epoch
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
@@ -453,7 +453,7 @@ (define (machine-boot-parameters machine)
(return
(map (lambda (generation)
(match generation
- ((generation system-path time serialized-params)
+ ((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
@@ -464,9 +464,7 @@ (define (machine-boot-parameters machine)
(label
(string-append label " (#"
(number->string generation) ", "
- (let ((time (make-time time-utc 0 time)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M"))
+ (epoch->date-string epoch)
")"))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index df27b8aea4..01e3a965e4 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -45,6 +45,7 @@ (define-module (gnu system boot)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
@@ -70,6 +71,7 @@ (define-module (gnu system boot)
read-boot-parameters-file
bootable-kernel-arguments
+ epoch->date-string
boot-parameters->menu-entry
ensure-not-/dev
@@ -296,6 +298,12 @@ (define* (bootable-kernel-arguments system root-device version)
#~(string-append (if #$version>0? "gnu.load=" "--load=")
#$system "/boot")))))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
+ (date->string (time-utc->date time)
+ "~Y-~m-~d ~H:~M")))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index cb70d36219..b197812e63 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,19 +328,13 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (epoch->date-string epoch)
- "Return a string representing the date for EPOCH seconds."
- (let ((time (make-time time-utc 0 epoch)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M")))
-
(define* (profile-boot-parameters #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number time)
+ (define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
(label (boot-parameters-label params)))
@@ -348,7 +342,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (epoch->date-string time) ")"))))))
+ (epoch->date-string epoch) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:05 GMT) Full text and rfc822 format available.Message #107 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 06/12] Offer a uniform decorated-boot-label and use it. Date: Sat, 3 Aug 2024 22:13:28 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system/boot.scm (decorated-boot-label): New procedure.
* gnu/machine/ssh.scm (machine-boot-parameters): Use
decorated-boot-label.
* guix/scripts/system.scm
(profile-boot-parameters)[system->boot-parameters]: Use
decorated-boot-label.
Change-Id: Id348c3047df2353f76b1bad0eb2a3e0fa17e474c
---
gnu/machine/ssh.scm | 8 ++------
gnu/system/boot.scm | 13 +++++++++++++
guix/scripts/system.scm | 8 +++-----
3 files changed, 18 insertions(+), 11 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index e68e64527e..3971469e33 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -457,15 +457,11 @@ (define (machine-boot-parameters machine)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
- (label (boot-parameters-label params))
+ (text (boot-parameters-label params))
(version (boot-parameters-version params)))
(boot-parameters
(inherit params)
- (label
- (string-append label " (#"
- (number->string generation) ", "
- (epoch->date-string epoch)
- ")"))
+ (label (decorated-boot-label text generation epoch))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 01e3a965e4..b1302b8786 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -72,6 +72,7 @@ (define-module (gnu system boot)
bootable-kernel-arguments
epoch->date-string
+ decorated-boot-label
boot-parameters->menu-entry
ensure-not-/dev
@@ -304,6 +305,18 @@ (define (epoch->date-string epoch)
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
+(define (decorated-boot-label text generation epoch)
+ "Return a string for a nice boot label that includes TEXT, a numbered GENERATION,
+and a timestamp derived from EPOCH seconds."
+ (let* ((numbered (lambda (number) (string-append "#" (number->string number))))
+ (count (and=> generation numbered))
+ (timestamp (and=> epoch epoch->date-string))
+ (extras (filter identity (list count timestamp)))
+ (helpful (if (null? extras)
+ ""
+ (string-append "(" (string-join extras ", ") ")"))))
+ (string-join (list text helpful))))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index b197812e63..84eb99b938 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -337,12 +337,10 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
- (label (boot-parameters-label params)))
+ (text (boot-parameters-label params)))
(boot-parameters
- (inherit params)
- (label (string-append label " (#"
- (number->string number) ", "
- (epoch->date-string epoch) ")"))))))
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:06 GMT) Full text and rfc822 format available.Message #110 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 07/12] Rename boot-parameters to boot-alternatives when appropriate. Date: Sat, 3 Aug 2024 22:13:29 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
Throughout the code base, the token 'boot-parameters' refers to collection of
data that is stored on disk for each system generation. It was confusing to
use it for a list of such records. This comment imposes an alternative name.
* gnu/machine/ssh.scm (machine-boot-parameters): Rename to
machine->boot-alternatives.
(machine->boot-alternatives, roll-back-managed-host): Use
boot-alternatives instead of boot-parameters as appropriate.
* guix/scripts/system.scm (profile-boot-parameters): Rename to
profile->boot-alternatives.
(reinstall-bootloader, perform-action): Use boot-alternatives instead
of boot-parameters as appropriate.
Change-Id: Iabb04dbb39f42f989692bede7304f20a69bef9fb
---
gnu/machine/ssh.scm | 20 ++++++++++----------
guix/scripts/system.scm | 19 ++++++++++---------
2 files changed, 20 insertions(+), 19 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 3971469e33..f3d2a77625 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -415,7 +415,7 @@ (define not-config?
(('gnu _ ...) #t)
(_ #f)))
-(define (machine-boot-parameters machine)
+(define (machine->boot-alternatives machine)
"Monadic procedure returning a list of 'boot-parameters' for the generations
of MACHINE's system profile, ordered from most recent to oldest."
(define remote-exp
@@ -501,14 +501,14 @@ (define (deploy-managed-host machine)
(machine-become-command machine)))
(mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-parameters (machine-boot-parameters machine)))
+ (boot-alternatives (machine->boot-alternatives 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 boot-parameters))
+ (menu-entries (map boot-parameters->menu-entry boot-alternatives))
(bootloader-configuration (operating-system-bootloader os))
(bootcfg (operating-system-bootcfg os menu-entries)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -579,19 +579,19 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))
- (_ -> (if (< (length boot-parameters) 2)
+ (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
+ (_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
(entries -> (map boot-parameters->menu-entry
- (list (second boot-parameters))))
+ (list (second boot-alternatives))))
(locale -> (boot-parameters-locale
- (second boot-parameters)))
+ (second boot-alternatives)))
(crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-parameters)))
+ (second boot-alternatives)))
(store-dir -> (boot-parameters-store-directory-prefix
- (second boot-parameters)))
+ (second boot-alternatives)))
(old-entries -> (map boot-parameters->menu-entry
- (drop boot-parameters 2)))
+ (drop boot-alternatives 2)))
(bootloader -> (operating-system-bootloader
(machine-operating-system machine)))
(bootcfg (lower-object
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 84eb99b938..cdd78a7849 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,9 +328,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define* (profile-boot-parameters #:optional (profile %system-profile)
- (numbers
- (reverse (generation-numbers profile))))
+(define* (profile->boot-alternatives #:optional (profile %system-profile)
+ (numbers
+ (reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
@@ -395,18 +395,19 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile-boot-parameters %system-profile
- (list number))))
+ (params (first (profile->boot-alternatives %system-profile
+ (list number))))
(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))))
- (old-params (profile-boot-parameters
- %system-profile old-generations))
+ (previous-boot-alternatives (profile->boot-alternatives
+ %system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry old-params)))
+ (old-entries (map boot-parameters->menu-entry
+ previous-boot-alternatives)))
(run-with-store store
(mlet* %store-monad
((bootcfg (lower-object
@@ -823,7 +824,7 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile-boot-parameters))))))
+ (map boot-parameters->menu-entry (profile->boot-alternatives))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.45.2
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:06 GMT) Full text and rfc822 format available.Message #113 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 08/12] Rename two remote variables confusingly named 'generations'. Date: Sat, 3 Aug 2024 22:13:30 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
Both refer to data sets returned from the remote expression, and one of them
shadowed an element of itself.
* gnu/machine/ssh.scm (machine->boot-alternatives): Rename generations
to remote-results.
Change-Id: Ibd8a3036126d9da1215cfc191884c0f54df637df
---
gnu/machine/ssh.scm | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index f3d2a77625..75b02bff50 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -449,10 +449,10 @@ (define (machine->boot-alternatives machine)
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
- (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp)))
+ (mlet* %store-monad ((remote-results (machine-remote-eval machine remote-exp)))
(return
- (map (lambda (generation)
- (match generation
+ (map (lambda (remote-result)
+ (match remote-result
((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
@@ -465,7 +465,7 @@ (define (machine->boot-alternatives machine)
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
- generations))))
+ remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
"Catch exceptions that arise when binding MBODY, a monadic expression in
--
2.45.2
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:07 GMT) Full text and rfc822 format available.Message #116 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 09/12] Give a separate name to a commonly used expression. Date: Sat, 3 Aug 2024 22:13:31 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/machine/ssh.scm (roll-back-managed-host): Factor out a
subexpression into new variable parameters.
Change-Id: I8d70684142bea736042d6c9dc8276ea7bdb9c181
---
gnu/machine/ssh.scm | 13 +++++--------
1 file changed, 5 insertions(+), 8 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 75b02bff50..fa1066b27b 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -582,14 +582,11 @@ (define (roll-back-managed-host machine)
(mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
(_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
- (entries -> (map boot-parameters->menu-entry
- (list (second boot-alternatives))))
- (locale -> (boot-parameters-locale
- (second boot-alternatives)))
- (crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-alternatives)))
- (store-dir -> (boot-parameters-store-directory-prefix
- (second boot-alternatives)))
+ (parameters (second boot-alternatives))
+ (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
(drop boot-alternatives 2)))
(bootloader -> (operating-system-bootloader
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:07 GMT) Full text and rfc822 format available.Message #119 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 10/12] Simplify profile->boot-alternatives. Date: Sat, 3 Aug 2024 22:13:32 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm
(profile->boot-alternatives)[system->boot-parameters]: Rename to
generation->boot-parameters and factor out processing from...
(profile->boot-alternatives): ...here.
Change-Id: If31eeb4cef4f5a107a0ee5ad3f117bf38629ac38
---
guix/scripts/system.scm | 14 +++++---------
1 file changed, 5 insertions(+), 9 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index cdd78a7849..a4dd7a8054 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -334,20 +334,16 @@ (define* (profile->boot-alternatives #:optional (profile %system-profile)
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number epoch)
+ (define (generation->boot-parameters number)
(unless-file-not-found
- (let* ((params (read-boot-parameters-file system))
+ (let* ((system (generation-file-name profile number))
+ (params (read-boot-parameters-file system))
+ (epoch (stat:mtime (lstat system)))
(text (boot-parameters-label params)))
(boot-parameters
(inherit params)
(label (decorated-boot-label text number epoch))))))
- (let* ((systems (map (cut generation-file-name profile <>)
- numbers))
- (times (map (lambda (system)
- (unless-file-not-found
- (stat:mtime (lstat system))))
- systems)))
- (filter-map system->boot-parameters systems numbers times)))
+ (filter-map generation->boot-parameters numbers))
;;;
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:08 GMT) Full text and rfc822 format available.Message #122 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 11/12] Split generation->boot-parameters out of profile->boot-alternatives. Date: Sat, 3 Aug 2024 22:13:33 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm
(profile->boot-alternatives)[generation->boot-parameters]: Move to...
(generation->boot-parameters): ...here.
(reinstall-bootloader): Use procedure above.
Change-Id: I51ef1a4fa8fd18104d28a6a845707d7dedde3782
---
guix/scripts/system.scm | 28 ++++++++++++++++------------
1 file changed, 16 insertions(+), 12 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index a4dd7a8054..0c69f6d90b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,22 +328,27 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
+(define (generation->boot-parameters profile number)
+ "Return the 'boot-parameters' for the generation of PROFILE specified
+by NUMBER."
+ (unless-file-not-found
+ (let* ((system (generation-file-name profile number))
+ (params (read-boot-parameters-file system))
+ (epoch (stat:mtime (lstat system)))
+ (text (boot-parameters-label params)))
+ (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
+
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (generation->boot-parameters number)
- (unless-file-not-found
- (let* ((system (generation-file-name profile number))
- (params (read-boot-parameters-file system))
- (epoch (stat:mtime (lstat system)))
- (text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
- (filter-map generation->boot-parameters numbers))
+ (filter-map (lambda (number)
+ (generation->boot-parameters profile number))
+ numbers))
;;;
@@ -391,8 +396,7 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile->boot-alternatives %system-profile
- (list number))))
+ (params (generation->boot-parameters %system-profile number))
(locale (boot-parameters-locale params))
(store-crypto-devices (boot-parameters-store-crypto-devices params))
(store-directory-prefix
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sun, 04 Aug 2024 03:17:08 GMT) Full text and rfc822 format available.Message #125 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v3 12/12] Encapsulate <boot-parameters> to retain generation, system-path and epoch. Date: Sat, 3 Aug 2024 22:13:34 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system/boot.scm (<boot-alternative>): New record.
* gnu/machine/ssh.scm (machine->boot-alternatives): Return a
boot-alternative encapsulating previous return value.
(with-roll-back, roll-back-managed-host): Get parameters from
boot-alternatives.
* guix/scripts/system.scm (generation->boot-parameters): Rename to...
(generation->boot-alternative): ...this. Return a boot-alternative
encapsulating previous return value.
(profile->boot-alternatives): Rename uses as above.
(reinstall-bootloader, perform-action): Get parameters from
boot-alternatives.
Change-Id: Iaef0b0a3fa9240ca8315a9699bcf4a7bfe908e33
---
gnu/machine/ssh.scm | 32 ++++++++++++++++++++------------
gnu/system/boot.scm | 14 ++++++++++++++
guix/scripts/system.scm | 32 +++++++++++++++++++++-----------
3 files changed, 55 insertions(+), 23 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index fa1066b27b..8dd8c342a0 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -416,8 +416,8 @@ (define not-config?
(_ #f)))
(define (machine->boot-alternatives machine)
- "Monadic procedure returning a list of 'boot-parameters' for the generations
-of MACHINE's system profile, ordered from most recent to oldest."
+ "Monadic procedure returning a list of <boot-alternative> records for the
+generations of MACHINE's system profile, ordered from most recent to oldest."
(define remote-exp
(with-extensions (list guile-gcrypt)
(with-imported-modules `(((guix config) => ,(make-config.scm))
@@ -458,13 +458,18 @@ (define (machine->boot-alternatives machine)
read-boot-parameters))
(root (boot-parameters-root-device params))
(text (boot-parameters-label params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text generation epoch))
- (kernel-arguments
- (append (bootable-kernel-arguments system-path root version)
- (boot-parameters-kernel-arguments params))))))))
+ (version (boot-parameters-version params))
+ (parameters (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text generation epoch))
+ (kernel-arguments
+ (append (bootable-kernel-arguments system-path root version)
+ (boot-parameters-kernel-arguments params))))))
+ (boot-alternative
+ (generation generation)
+ (system-path system-path)
+ (epoch epoch)
+ (parameters parameters))))))
remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
@@ -508,7 +513,8 @@ (define (deploy-managed-host machine)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry boot-alternatives))
+ (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)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -582,13 +588,15 @@ (define (roll-back-managed-host machine)
(mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
(_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
- (parameters (second boot-alternatives))
+ (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
- (drop boot-alternatives 2)))
+ (map boot-alternative-parameters
+ (drop boot-alternatives 2))))
(bootloader -> (operating-system-bootloader
(machine-operating-system machine)))
(bootcfg (lower-object
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index b1302b8786..833caef496 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -71,6 +71,13 @@ (define-module (gnu system boot)
read-boot-parameters-file
bootable-kernel-arguments
+ boot-alternative
+ boot-alternative?
+ boot-alternative-generation
+ boot-alternative-system-path
+ boot-alternative-epoch
+ boot-alternative-parameters
+
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
@@ -299,6 +306,13 @@ (define* (bootable-kernel-arguments system root-device version)
#~(string-append (if #$version>0? "gnu.load=" "--load=")
#$system "/boot")))))
+(define-record-type* <boot-alternative>
+ boot-alternative make-boot-alternative boot-alternative?
+ (generation boot-alternative-generation)
+ (system-path boot-alternative-system-path)
+ (epoch boot-alternative-epoch)
+ (parameters boot-alternative-parameters))
+
(define (epoch->date-string epoch)
"Return a string representing the date for EPOCH seconds."
(let ((time (make-time time-utc 0 epoch)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0c69f6d90b..0f7d864e06 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,26 +328,31 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (generation->boot-parameters profile number)
- "Return the 'boot-parameters' for the generation of PROFILE specified
+(define (generation->boot-alternative profile number)
+ "Return the 'boot-alternative' for the generation of PROFILE specified
by NUMBER."
(unless-file-not-found
(let* ((system (generation-file-name profile number))
(params (read-boot-parameters-file system))
(epoch (stat:mtime (lstat system)))
- (text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
+ (text (boot-parameters-label params))
+ (parameters (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch)))))
+ (boot-alternative
+ (generation number)
+ (system-path system)
+ (epoch epoch)
+ (parameters parameters)))))
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
- "Return a list of 'boot-parameters' for the generations of PROFILE specified
+ "Return a list of 'boot-alternative' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
(filter-map (lambda (number)
- (generation->boot-parameters profile number))
+ (generation->boot-alternative profile number))
numbers))
@@ -396,7 +401,9 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (generation->boot-parameters %system-profile number))
+ (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
@@ -407,7 +414,8 @@ (define (reinstall-bootloader store number)
%system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
(old-entries (map boot-parameters->menu-entry
- previous-boot-alternatives)))
+ (map boot-alternative-parameters
+ previous-boot-alternatives))))
(run-with-store store
(mlet* %store-monad
((bootcfg (lower-object
@@ -824,7 +832,9 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile->boot-alternatives))))))
+ (map boot-parameters->menu-entry
+ (map boot-alternative-parameters
+ (profile->boot-alternatives)))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.45.2
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Thu, 05 Sep 2024 07:16:02 GMT) Full text and rfc822 format available.Message #128 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Lilah Tascheter <lilah <at> lunabee.space> Subject: Re: [bug#69343] [PATCH v3 00/12] Simplify bootloader data structures and procedures Date: Thu, 5 Sep 2024 09:13:57 +0200
Hello Lilah, Booting with the EFI boot stub still works when using this patch series. Can you squash patch #3 into #2 and try to keep the lines within 78 columns in patches #6, #8, #9, #10 and #12? Also in #12, can you align all the boot-alternative-* and indicate the type of boot-alternative-parameters? Cheers, Herman
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:01 GMT) Full text and rfc822 format available.Message #131 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Lilah Tascheter <lilah <at> lunabee.space>, Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 00/11] Simplify bootloader data structures and procedures Date: Thu, 19 Sep 2024 23:15:54 -0500
Modified per Herman's review.
Felix Lechner (11):
Fix bug where the extra menu entries for a bootloader were shown
twice.
Move <boot-parameters> record to a separate file.
Rename seconds->string procedure to epoch->date-string.
Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.
Offer a uniform decorated-boot-label and use it.
Rename boot-parameters to boot-alternatives when appropriate.
Rename two remote variables confusingly named 'generations'.
Give a separate name to a commonly used expression.
Simplify profile->boot-alternatives.
Split generation->boot-parameters out of profile->boot-alternatives.
Encapsulate <boot-parameters> to retain generation, system-path and
epoch.
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 105 ++++++-----
gnu/system.scm | 287 +----------------------------
gnu/system/boot.scm | 376 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 71 +++----
tests/boot-parameters.scm | 1 +
6 files changed, 467 insertions(+), 374 deletions(-)
create mode 100644 gnu/system/boot.scm
base-commit: f59c4126827af3d2041d49f1d0a8ce12b41470cf
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:02 GMT) Full text and rfc822 format available.Message #134 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 01/11] Fix bug where the extra menu entries for a bootloader were shown twice. Date: Thu, 19 Sep 2024 23:15:55 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
The extra menu entries are already being added in each bootloaders, as
applicable.
* guix/scripts/system.scm (reinstall-bootloader)[entries]: Don't
extraneously include bootloader-configuration-menu-entries here.
Change-Id: I8a600f2a5836ab4f7db5e27e25b0b8f432c3e1e0
---
guix/scripts/system.scm | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 99c58f3812..0305128763 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -412,8 +412,7 @@ (define (reinstall-bootloader store number)
(delv number (reverse (generation-numbers %system-profile))))
(old-params (profile-boot-parameters
%system-profile old-generations))
- (entries (cons (boot-parameters->menu-entry params)
- (boot-parameters-bootloader-menu-entries params)))
+ (entries (list (boot-parameters->menu-entry params)))
(old-entries (map boot-parameters->menu-entry old-params)))
(run-with-store store
(mlet* %store-monad
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:02 GMT) Full text and rfc822 format available.Message #137 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 03/11] Rename seconds->string procedure to epoch->date-string. Date: Thu, 19 Sep 2024 23:15:57 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm (seconds->string): Rename to
epoch->date-string.
(profile-boot-parameters)[boot-parameters]: Update as above.
Change-Id: I2b9aaa816b3ca84c32f7d6fa690245b149228310
---
guix/scripts/system.scm | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 7000c470ed..cb70d36219 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,9 +328,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (seconds->string seconds)
- "Return a string representing the date for SECONDS."
- (let ((time (make-time time-utc 0 seconds)))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
@@ -348,7 +348,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (seconds->string time) ")"))))))
+ (epoch->date-string time) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:03 GMT) Full text and rfc822 format available.Message #140 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 02/11] Move <boot-parameters> record to a separate file. Date: Thu, 19 Sep 2024 23:15:56 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
Required to avoid a missing dependency error on build-side.
* gnu/system.scm (<boot-parameters>): Move this record, and...
(system-linux-image-file-name, %boot-parameters-version,
bootable-kernel-arguments, ensure-not-/dev, read-boot-parameters,
read-boot-parameters-file, boot-parameters->menu-entry):
...these procedures, to...
* gnu/system/boot.scm: ...this new file.
* gnu/machine/ssh.scm, gnu/system.scm, guix/scripts/system.scm,
tests/boot-parameters.scm: Use new module above.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add new module above.
* gnu/machine/ssh.scm (machine-boot-parameters): Don't private-import
bootable-kernel-arguments.
---
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 4 +-
gnu/system.scm | 287 +-------------------------------
gnu/system/boot.scm | 341 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 1 +
tests/boot-parameters.scm | 1 +
6 files changed, 346 insertions(+), 289 deletions(-)
create mode 100644 gnu/system/boot.scm
diff --git a/gnu/local.mk b/gnu/local.mk
index 6d2b14e72d..8375e13709 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -758,6 +758,7 @@ GNU_SYSTEM_MODULES = \
\
%D%/system.scm \
%D%/system/accounts.scm \
+ %D%/system/boot.scm \
%D%/system/file-systems.scm \
%D%/system/hurd.scm \
%D%/system/image.scm \
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 0be9ebbc0d..749aa2b6d8 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -23,6 +23,7 @@ (define-module (gnu machine ssh)
#:use-module (gnu machine)
#:autoload (gnu packages gnupg) (guile-gcrypt)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((gnu services) #:select (sexp->system-provenance))
@@ -417,9 +418,6 @@ (define not-config?
(define (machine-boot-parameters machine)
"Monadic procedure returning a list of 'boot-parameters' for the generations
of MACHINE's system profile, ordered from most recent to oldest."
- (define bootable-kernel-arguments
- (@@ (gnu system) bootable-kernel-arguments))
-
(define remote-exp
(with-extensions (list guile-gcrypt)
(with-imported-modules `(((guix config) => ,(make-config.scm))
diff --git a/gnu/system.scm b/gnu/system.scm
index c76f4d7c50..4a084b2ecf 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -72,6 +72,7 @@ (define-module (gnu system)
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system shadow)
#:use-module (gnu system nss)
#:use-module (gnu system locale)
@@ -145,33 +146,11 @@ (define-module (gnu system)
operating-system-boot-script
operating-system-uuid
- system-linux-image-file-name
operating-system-with-gc-roots
operating-system-with-provenance
hurd-default-essential-services
- boot-parameters
- boot-parameters?
- boot-parameters-label
- boot-parameters-root-device
- boot-parameters-bootloader-name
- boot-parameters-bootloader-menu-entries
- boot-parameters-store-crypto-devices
- boot-parameters-store-device
- boot-parameters-store-directory-prefix
- boot-parameters-store-mount-point
- boot-parameters-locale
- boot-parameters-kernel
- boot-parameters-kernel-arguments
- boot-parameters-initrd
- boot-parameters-multiboot-modules
- boot-parameters-version
- %boot-parameters-version
- read-boot-parameters
- read-boot-parameters-file
- boot-parameters->menu-entry
-
local-host-aliases ;deprecated
%root-account
%setuid-programs
@@ -192,29 +171,6 @@ (define-module (gnu system)
;;;
;;; Code:
-(define* (bootable-kernel-arguments system root-device version)
- "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE.
-VERSION is the target version of the boot-parameters record."
- ;; If the version is newer than 0, we use the new style initrd parameter
- ;; names, otherwise we use the legacy ones. This is to maintain backward
- ;; compatibility when producing bootloader configurations for older
- ;; generations.
- (define version>0? (> version 0))
- (let ((root (file-system-device->string root-device
- #:uuid-type 'dce)))
- (append
- (if (string=? root "none")
- '() ; Ignore the case where the root is "none" (typically tmpfs).
- ;; Note: Always use the DCE format because that's what
- ;; (gnu build linux-boot) expects for the 'root'
- ;; kernel command-line option.
- (list (string-append (if version>0? "root=" "--root=") root)))
- (list #~(string-append (if #$version>0? "gnu.system=" "--system=") #$system)
- #~(string-append (if #$version>0? "gnu.load=" "--load=")
- #$system "/boot")))))
-
-;; System-wide configuration.
-
(define-with-syntax-properties (warn-hosts-file-field-deprecation
(value properties))
(when value
@@ -356,236 +312,6 @@ (define* (operating-system-kernel-arguments
(append (bootable-kernel-arguments os root-device version)
(operating-system-user-kernel-arguments os)))
-
-;;;
-;;; Boot parameters
-;;;
-
-;;; Version 1 was introduced early 2022 to mark the departure from long option
-;;; names such as '--load' to the more conventional initrd option names like
-;;; 'gnu.load'.
-;;;
-;;; When bumping the boot-parameters version, increment it by one (1).
-(define %boot-parameters-version 1)
-
-(define-record-type* <boot-parameters>
- boot-parameters make-boot-parameters boot-parameters?
- (label boot-parameters-label)
- ;; Because we will use the 'store-device' to create the GRUB search command,
- ;; the 'store-device' has slightly different semantics than 'root-device'.
- ;; The 'store-device' can be a file system uuid, a file system label, or #f,
- ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
- ;; not understand that. The 'root-device', on the other hand, corresponds
- ;; exactly to the device field of the <file-system> object representing the
- ;; OS's root file system, so it might be a device file name like
- ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
- ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
- ;; contain "/storefs" if the store is located in that subvolume of a btrfs
- ;; partition.
- (root-device boot-parameters-root-device)
- (bootloader-name boot-parameters-bootloader-name)
- (bootloader-menu-entries ;list of <menu-entry>
- boot-parameters-bootloader-menu-entries)
- (store-device boot-parameters-store-device)
- (store-mount-point boot-parameters-store-mount-point)
- (store-directory-prefix boot-parameters-store-directory-prefix)
- (store-crypto-devices boot-parameters-store-crypto-devices
- (default '()))
- (locale boot-parameters-locale)
- (kernel boot-parameters-kernel)
- (kernel-arguments boot-parameters-kernel-arguments)
- (initrd boot-parameters-initrd)
- (multiboot-modules boot-parameters-multiboot-modules)
- (version boot-parameters-version ;positive integer
- (default %boot-parameters-version)))
-
-(define (ensure-not-/dev device)
- "If DEVICE starts with a slash, return #f. This is meant to filter out
-Linux device names such as /dev/sda, and to preserve GRUB device names and
-file system labels."
- (if (and (string? device) (string-prefix? "/" device))
- #f
- device))
-
-(define (read-boot-parameters port)
- "Read boot parameters from PORT and return the corresponding
-<boot-parameters> object. Raise an error if the format is unrecognized."
- (define device-sexp->device
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (('file-system-label (? string? label))
- (file-system-label label))
- ((? bytevector? bv) ;old format
- (bytevector->uuid bv 'dce))
- ((? string? device)
- (if (string-contains device ":/")
- device ; nfs-root
- ;; It used to be that we would not distinguish between labels and
- ;; device names. Try to infer the right thing here.
- (if (string-prefix? "/" device)
- device
- (file-system-label device))))))
- (define uuid-sexp->uuid
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (x
- (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
- #f)))
-
- ;; New versions are not backward-compatible, so only accept past and current
- ;; versions, not future ones.
- (define (version? n)
- (member n (iota (1+ %boot-parameters-version))))
-
- (match (read port)
- (('boot-parameters ('version (? version? version))
- ('label label) ('root-device root)
- ('kernel kernel)
- rest ...)
- (boot-parameters
- (version version)
- (label label)
- (root-device (device-sexp->device root))
-
- (bootloader-name
- (match (assq 'bootloader-name rest)
- ((_ args) args)
- (#f 'grub))) ; for compatibility reasons.
-
- (bootloader-menu-entries
- (match (assq 'bootloader-menu-entries rest)
- ((_ entries) (map sexp->menu-entry entries))
- (#f '())))
-
- ;; In the past, we would store the directory name of linux instead of
- ;; the absolute file name of its image. Detect that and correct it.
- (kernel (if (string=? kernel (direct-store-path kernel))
- (string-append kernel "/"
- (system-linux-image-file-name))
- kernel))
-
- (kernel-arguments
- (match (assq 'kernel-arguments rest)
- ((_ args) args)
- (#f '()))) ;the old format
-
- (initrd
- (match (assq 'initrd rest)
- (('initrd ('string-append directory file)) ;the old format
- (string-append directory file))
- (('initrd (? string? file))
- file)
- (#f #f)))
-
- (multiboot-modules
- (match (assq 'multiboot-modules rest)
- ((_ args) args)
- (#f '())))
-
- (locale
- (match (assq 'locale rest)
- ((_ locale) locale)
- (#f #f)))
-
- (store-device
- ;; Linux device names like "/dev/sda1" are not suitable GRUB device
- ;; identifiers, so we just filter them out.
- (ensure-not-/dev
- (match (assq 'store rest)
- (('store ('device #f) _ ...)
- root-device)
- (('store ('device device) _ ...)
- (device-sexp->device device))
- (_ ;the old format
- root-device))))
-
- (store-directory-prefix
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'directory-prefix store-data)
- (('directory-prefix prefix) prefix)
- ;; No directory-prefix found.
- (_ #f)))
- (_
- ;; No store found, old format.
- #f)))
-
- (store-crypto-devices
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'crypto-devices store-data)
- (('crypto-devices (devices ...))
- (map uuid-sexp->uuid devices))
- (('crypto-devices dev)
- (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
- dev (port-filename port))
- '())
- (_
- ;; No crypto-devices found.
- '())))
- (_
- ;; No store found, old format.
- '())))
-
- (store-mount-point
- (match (assq 'store rest)
- (('store ('device _) ('mount-point mount-point) _ ...)
- mount-point)
- (_ ;the old format
- "/")))))
- (x ;unsupported format
- (raise
- (make-compound-condition
- (formatted-message
- (G_ "unrecognized boot parameters at '~a'~%")
- (port-filename port))
- (condition
- (&fix-hint (hint (format #f (G_ "This probably means that this version
-of Guix is older than the one that created @file{~a}. To address this, you
-need to update Guix:
-
-@example
-guix pull
-@end example")
- (port-filename port))))))))))
-
-(define (read-boot-parameters-file system)
- "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
-file and returns the corresponding <boot-parameters> object or #f if the
-format is unrecognized.
-The object has its kernel-arguments extended in order to make it bootable."
- (let* ((file (string-append system "/parameters"))
- (params (call-with-input-file file read-boot-parameters))
- (root (boot-parameters-root-device params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (kernel-arguments (append (bootable-kernel-arguments system root version)
- (boot-parameters-kernel-arguments params))))))
-
-(define (boot-parameters->menu-entry conf)
- "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
- (let* ((kernel (boot-parameters-kernel conf))
- (multiboot-modules (boot-parameters-multiboot-modules conf))
- (multiboot? (pair? multiboot-modules)))
- (menu-entry
- (label (boot-parameters-label conf))
- (device (boot-parameters-store-device conf))
- (device-mount-point (boot-parameters-store-mount-point conf))
- (linux (and (not multiboot?) kernel))
- (linux-arguments (if (not multiboot?)
- (boot-parameters-kernel-arguments conf)
- '()))
- (initrd (boot-parameters-initrd conf))
- (multiboot-kernel (and multiboot? kernel))
- (multiboot-arguments (if multiboot?
- (boot-parameters-kernel-arguments conf)
- '()))
- (multiboot-modules (if multiboot?
- (boot-parameters-multiboot-modules conf)
- '())))))
;;;
@@ -726,17 +452,6 @@ (define (swap-services os)
(map (compose swap-service filter-deps)
(operating-system-swap-devices os)))
-(define* (system-linux-image-file-name #:optional
- (target (or (%current-target-system)
- (%current-system))))
- "Return the basename of the kernel image file for TARGET."
- (cond
- ((string-prefix? "arm" target) "zImage")
- ((string-prefix? "mips" target) "vmlinuz")
- ((string-prefix? "aarch64" target) "Image")
- ((string-prefix? "riscv64" target) "Image")
- (else "bzImage")))
-
(define (operating-system-kernel-file os)
"Return an object representing the absolute file name of the kernel image of
OS."
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
new file mode 100644
index 0000000000..df27b8aea4
--- /dev/null
+++ b/gnu/system/boot.scm
@@ -0,0 +1,341 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw <at> netris.org>
+;;; Copyright © 2015, 2016 Alex Kost <alezost <at> gmail.com>
+;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo.peng <at> gmail.com>
+;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835 <at> gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym <at> scratchpost.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice <at> waegenei.re>
+;;; Copyright © 2020 Florian Pelz <pelzflorian <at> pelzflorian.de>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <jannek <at> gnu.org>
+;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il>
+;;; Copyright © 2021 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework <at> protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai <at> makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner <at> lease-up.com>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system boot)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (guix store)
+ #:use-module (guix utils)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system uuid)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
+ #:export (boot-parameters
+ boot-parameters?
+ boot-parameters-label
+ boot-parameters-root-device
+ boot-parameters-bootloader-name
+ boot-parameters-bootloader-menu-entries
+ boot-parameters-store-crypto-devices
+ boot-parameters-store-device
+ boot-parameters-store-directory-prefix
+ boot-parameters-store-mount-point
+ boot-parameters-locale
+ boot-parameters-kernel
+ boot-parameters-kernel-arguments
+ boot-parameters-initrd
+ boot-parameters-multiboot-modules
+ boot-parameters-version
+ %boot-parameters-version
+
+ read-boot-parameters
+ read-boot-parameters-file
+ bootable-kernel-arguments
+
+ boot-parameters->menu-entry
+
+ ensure-not-/dev
+ system-linux-image-file-name))
+
+;;;
+;;; Boot parameters
+;;;
+
+;;; Version 1 was introduced early 2022 to mark the departure from long option
+;;; names such as '--load' to the more conventional initrd option names like
+;;; 'gnu.load'.
+;;;
+;;; When bumping the boot-parameters version, increment it by one (1).
+(define %boot-parameters-version 1)
+
+(define-record-type* <boot-parameters>
+ boot-parameters make-boot-parameters boot-parameters?
+ (label boot-parameters-label)
+ ;; Because we will use the 'store-device' to create the GRUB search command,
+ ;; the 'store-device' has slightly different semantics than 'root-device'.
+ ;; The 'store-device' can be a file system uuid, a file system label, or #f,
+ ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
+ ;; not understand that. The 'root-device', on the other hand, corresponds
+ ;; exactly to the device field of the <file-system> object representing the
+ ;; OS's root file system, so it might be a device file name like
+ ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
+ ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
+ ;; contain "/storefs" if the store is located in that subvolume of a btrfs
+ ;; partition.
+ (root-device boot-parameters-root-device)
+ (bootloader-name boot-parameters-bootloader-name)
+ (bootloader-menu-entries ;list of <menu-entry>
+ boot-parameters-bootloader-menu-entries)
+ (store-device boot-parameters-store-device)
+ (store-mount-point boot-parameters-store-mount-point)
+ (store-directory-prefix boot-parameters-store-directory-prefix)
+ (store-crypto-devices boot-parameters-store-crypto-devices
+ (default '()))
+ (locale boot-parameters-locale)
+ (kernel boot-parameters-kernel)
+ (kernel-arguments boot-parameters-kernel-arguments)
+ (initrd boot-parameters-initrd)
+ (multiboot-modules boot-parameters-multiboot-modules)
+ (version boot-parameters-version ;positive integer
+ (default %boot-parameters-version)))
+
+(define (read-boot-parameters port)
+ "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object. Raise an error if the format is unrecognized."
+ (define device-sexp->device
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (('file-system-label (? string? label))
+ (file-system-label label))
+ ((? bytevector? bv) ;old format
+ (bytevector->uuid bv 'dce))
+ ((? string? device)
+ (if (string-contains device ":/")
+ device ; nfs-root
+ ;; It used to be that we would not distinguish between labels and
+ ;; device names. Try to infer the right thing here.
+ (if (string-prefix? "/" device)
+ device
+ (file-system-label device))))))
+ (define uuid-sexp->uuid
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (x
+ (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
+ #f)))
+
+ ;; New versions are not backward-compatible, so only accept past and current
+ ;; versions, not future ones.
+ (define (version? n)
+ (member n (iota (1+ %boot-parameters-version))))
+
+ (match (read port)
+ (('boot-parameters ('version (? version? version))
+ ('label label) ('root-device root)
+ ('kernel kernel)
+ rest ...)
+ (boot-parameters
+ (version version)
+ (label label)
+ (root-device (device-sexp->device root))
+
+ (bootloader-name
+ (match (assq 'bootloader-name rest)
+ ((_ args) args)
+ (#f 'grub))) ; for compatibility reasons.
+
+ (bootloader-menu-entries
+ (match (assq 'bootloader-menu-entries rest)
+ ((_ entries) (map sexp->menu-entry entries))
+ (#f '())))
+
+ ;; In the past, we would store the directory name of linux instead of
+ ;; the absolute file name of its image. Detect that and correct it.
+ (kernel (if (string=? kernel (direct-store-path kernel))
+ (string-append kernel "/"
+ (system-linux-image-file-name))
+ kernel))
+
+ (kernel-arguments
+ (match (assq 'kernel-arguments rest)
+ ((_ args) args)
+ (#f '()))) ;the old format
+
+ (initrd
+ (match (assq 'initrd rest)
+ (('initrd ('string-append directory file)) ;the old format
+ (string-append directory file))
+ (('initrd (? string? file))
+ file)
+ (#f #f)))
+
+ (multiboot-modules
+ (match (assq 'multiboot-modules rest)
+ ((_ args) args)
+ (#f '())))
+
+ (locale
+ (match (assq 'locale rest)
+ ((_ locale) locale)
+ (#f #f)))
+
+ (store-device
+ ;; Linux device names like "/dev/sda1" are not suitable GRUB device
+ ;; identifiers, so we just filter them out.
+ (ensure-not-/dev
+ (match (assq 'store rest)
+ (('store ('device #f) _ ...)
+ root-device)
+ (('store ('device device) _ ...)
+ (device-sexp->device device))
+ (_ ;the old format
+ root-device))))
+
+ (store-directory-prefix
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'directory-prefix store-data)
+ (('directory-prefix prefix) prefix)
+ ;; No directory-prefix found.
+ (_ #f)))
+ (_
+ ;; No store found, old format.
+ #f)))
+
+ (store-crypto-devices
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'crypto-devices store-data)
+ (('crypto-devices (devices ...))
+ (map uuid-sexp->uuid devices))
+ (('crypto-devices dev)
+ (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
+ dev (port-filename port))
+ '())
+ (_
+ ;; No crypto-devices found.
+ '())))
+ (_
+ ;; No store found, old format.
+ '())))
+
+ (store-mount-point
+ (match (assq 'store rest)
+ (('store ('device _) ('mount-point mount-point) _ ...)
+ mount-point)
+ (_ ;the old format
+ "/")))))
+ (x ;unsupported format
+ (raise
+ (make-compound-condition
+ (formatted-message
+ (G_ "unrecognized boot parameters at '~a'~%")
+ (port-filename port))
+ (condition
+ (&fix-hint (hint (format #f (G_ "This probably means that this version
+of Guix is older than the one that created @file{~a}. To address this, you
+need to update Guix:
+
+@example
+guix pull
+@end example")
+ (port-filename port))))))))))
+
+(define (read-boot-parameters-file system)
+ "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
+file and returns the corresponding <boot-parameters> object or #f if the
+format is unrecognized.
+The object has its kernel-arguments extended in order to make it bootable."
+ (let* ((file (string-append system "/parameters"))
+ (params (call-with-input-file file read-boot-parameters))
+ (root (boot-parameters-root-device params))
+ (version (boot-parameters-version params)))
+ (boot-parameters
+ (inherit params)
+ (kernel-arguments (append (bootable-kernel-arguments system root version)
+ (boot-parameters-kernel-arguments params))))))
+
+(define* (bootable-kernel-arguments system root-device version)
+ "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE.
+VERSION is the target version of the boot-parameters record."
+ ;; If the version is newer than 0, we use the new style initrd parameter
+ ;; names, otherwise we use the legacy ones. This is to maintain backward
+ ;; compatibility when producing bootloader configurations for older
+ ;; generations.
+ (define version>0? (> version 0))
+ (let ((root (file-system-device->string root-device
+ #:uuid-type 'dce)))
+ (append
+ (if (string=? root "none")
+ '() ; Ignore the case where the root is "none" (typically tmpfs).
+ ;; Note: Always use the DCE format because that's what
+ ;; (gnu build linux-boot) expects for the 'root'
+ ;; kernel command-line option.
+ (list (string-append (if version>0? "root=" "--root=") root)))
+ (list #~(string-append (if #$version>0? "gnu.system=" "--system=") #$system)
+ #~(string-append (if #$version>0? "gnu.load=" "--load=")
+ #$system "/boot")))))
+
+(define (boot-parameters->menu-entry conf)
+ "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
+ (let* ((kernel (boot-parameters-kernel conf))
+ (multiboot-modules (boot-parameters-multiboot-modules conf))
+ (multiboot? (pair? multiboot-modules)))
+ (menu-entry
+ (label (boot-parameters-label conf))
+ (device (boot-parameters-store-device conf))
+ (device-mount-point (boot-parameters-store-mount-point conf))
+ (linux (and (not multiboot?) kernel))
+ (linux-arguments (if (not multiboot?)
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (initrd (boot-parameters-initrd conf))
+ (multiboot-kernel (and multiboot? kernel))
+ (multiboot-arguments (if multiboot?
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (multiboot-modules (if multiboot?
+ (boot-parameters-multiboot-modules conf)
+ '())))))
+
+(define (ensure-not-/dev device)
+ "If DEVICE starts with a slash, return #f. This is meant to filter out
+Linux device names such as /dev/sda, and to preserve GRUB device names and
+file system labels."
+ (if (and (string? device) (string-prefix? "/" device))
+ #f
+ device))
+
+;; XXX: defined here instead of (gnu system) to prevent dependency loop
+(define* (system-linux-image-file-name #:optional
+ (target (or (%current-target-system)
+ (%current-system))))
+ "Return the basename of the kernel image file for TARGET."
+ (cond
+ ((string-prefix? "arm" target) "zImage")
+ ((string-prefix? "mips" target) "vmlinuz")
+ ((string-prefix? "aarch64" target) "Image")
+ ((string-prefix? "riscv64" target) "Image")
+ (else "bzImage")))
+
+;;; boot.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0305128763..7000c470ed 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -70,6 +70,7 @@ (define-module (guix scripts system)
#:use-module (gnu image)
#:use-module (gnu system)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system image)
#:use-module (gnu system mapped-devices)
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 03a1d01aff..2e7976aa6c 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -27,6 +27,7 @@ (define-module (test-boot-parameters)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((guix diagnostics) #:select (formatted-message?))
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:04 GMT) Full text and rfc822 format available.Message #143 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 04/11] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere. Date: Thu, 19 Sep 2024 23:15:58 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm (profile-boot-parameters): Rename time to
epoch to fit new procedure name.
(epoch->date-string): Move to...
* gnu/system/boot.scm (epoch->date-string): ...here.
* gnu/machine/ssh.scm (machine-boot-parameters): Rename time to epoch.
(machine-boot-parameters)[boot-parameters]: Use epoch->date-string.
Change-Id: I6a5f793567221f81edd7b2d8d9f0f3e801d1b113
---
gnu/machine/ssh.scm | 10 ++++------
gnu/system/boot.scm | 8 ++++++++
guix/scripts/system.scm | 10 ++--------
3 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 749aa2b6d8..e68e64527e 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -442,10 +442,10 @@ (define (machine-boot-parameters machine)
generation))
(boot-parameters-path (string-append system-path
"/parameters"))
- (time (stat:mtime (lstat system-path))))
+ (epoch (stat:mtime (lstat system-path))))
(list generation
system-path
- time
+ epoch
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
@@ -453,7 +453,7 @@ (define (machine-boot-parameters machine)
(return
(map (lambda (generation)
(match generation
- ((generation system-path time serialized-params)
+ ((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
@@ -464,9 +464,7 @@ (define (machine-boot-parameters machine)
(label
(string-append label " (#"
(number->string generation) ", "
- (let ((time (make-time time-utc 0 time)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M"))
+ (epoch->date-string epoch)
")"))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index df27b8aea4..01e3a965e4 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -45,6 +45,7 @@ (define-module (gnu system boot)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
@@ -70,6 +71,7 @@ (define-module (gnu system boot)
read-boot-parameters-file
bootable-kernel-arguments
+ epoch->date-string
boot-parameters->menu-entry
ensure-not-/dev
@@ -296,6 +298,12 @@ (define* (bootable-kernel-arguments system root-device version)
#~(string-append (if #$version>0? "gnu.load=" "--load=")
#$system "/boot")))))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
+ (date->string (time-utc->date time)
+ "~Y-~m-~d ~H:~M")))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index cb70d36219..b197812e63 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,19 +328,13 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (epoch->date-string epoch)
- "Return a string representing the date for EPOCH seconds."
- (let ((time (make-time time-utc 0 epoch)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M")))
-
(define* (profile-boot-parameters #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number time)
+ (define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
(label (boot-parameters-label params)))
@@ -348,7 +342,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (epoch->date-string time) ")"))))))
+ (epoch->date-string epoch) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:04 GMT) Full text and rfc822 format available.Message #146 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 05/11] Offer a uniform decorated-boot-label and use it. Date: Thu, 19 Sep 2024 23:15:59 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system/boot.scm (decorated-boot-label): New procedure.
* gnu/machine/ssh.scm (machine-boot-parameters): Use
decorated-boot-label.
* guix/scripts/system.scm
(profile-boot-parameters)[system->boot-parameters]: Use
decorated-boot-label.
Change-Id: Id348c3047df2353f76b1bad0eb2a3e0fa17e474c
---
gnu/machine/ssh.scm | 8 ++------
gnu/system/boot.scm | 13 +++++++++++++
guix/scripts/system.scm | 8 +++-----
3 files changed, 18 insertions(+), 11 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index e68e64527e..3971469e33 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -457,15 +457,11 @@ (define (machine-boot-parameters machine)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
- (label (boot-parameters-label params))
+ (text (boot-parameters-label params))
(version (boot-parameters-version params)))
(boot-parameters
(inherit params)
- (label
- (string-append label " (#"
- (number->string generation) ", "
- (epoch->date-string epoch)
- ")"))
+ (label (decorated-boot-label text generation epoch))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 01e3a965e4..82ca353cb3 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -72,6 +72,7 @@ (define-module (gnu system boot)
bootable-kernel-arguments
epoch->date-string
+ decorated-boot-label
boot-parameters->menu-entry
ensure-not-/dev
@@ -304,6 +305,18 @@ (define (epoch->date-string epoch)
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
+(define (decorated-boot-label text generation epoch)
+ "Return a string for a nice boot label that includes TEXT, a numbered
+GENERATION, and a timestamp derived from EPOCH seconds."
+ (let* ((numbered (lambda (num) (string-append "#" (number->string num))))
+ (count (and=> generation numbered))
+ (timestamp (and=> epoch epoch->date-string))
+ (extras (filter identity (list count timestamp)))
+ (helpful (if (null? extras)
+ ""
+ (string-append "(" (string-join extras ", ") ")"))))
+ (string-join (list text helpful))))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index b197812e63..84eb99b938 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -337,12 +337,10 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
- (label (boot-parameters-label params)))
+ (text (boot-parameters-label params)))
(boot-parameters
- (inherit params)
- (label (string-append label " (#"
- (number->string number) ", "
- (epoch->date-string epoch) ")"))))))
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:05 GMT) Full text and rfc822 format available.Message #149 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 06/11] Rename boot-parameters to boot-alternatives when appropriate. Date: Thu, 19 Sep 2024 23:16:00 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
Throughout the code base, the token 'boot-parameters' refers to collection of
data that is stored on disk for each system generation. It was confusing to
use it for a list of such records. This comment imposes an alternative name.
* gnu/machine/ssh.scm (machine-boot-parameters): Rename to
machine->boot-alternatives.
(machine->boot-alternatives, roll-back-managed-host): Use
boot-alternatives instead of boot-parameters as appropriate.
* guix/scripts/system.scm (profile-boot-parameters): Rename to
profile->boot-alternatives.
(reinstall-bootloader, perform-action): Use boot-alternatives instead
of boot-parameters as appropriate.
Change-Id: Iabb04dbb39f42f989692bede7304f20a69bef9fb
---
gnu/machine/ssh.scm | 20 ++++++++++----------
guix/scripts/system.scm | 19 ++++++++++---------
2 files changed, 20 insertions(+), 19 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 3971469e33..f3d2a77625 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -415,7 +415,7 @@ (define not-config?
(('gnu _ ...) #t)
(_ #f)))
-(define (machine-boot-parameters machine)
+(define (machine->boot-alternatives machine)
"Monadic procedure returning a list of 'boot-parameters' for the generations
of MACHINE's system profile, ordered from most recent to oldest."
(define remote-exp
@@ -501,14 +501,14 @@ (define (deploy-managed-host machine)
(machine-become-command machine)))
(mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-parameters (machine-boot-parameters machine)))
+ (boot-alternatives (machine->boot-alternatives 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 boot-parameters))
+ (menu-entries (map boot-parameters->menu-entry boot-alternatives))
(bootloader-configuration (operating-system-bootloader os))
(bootcfg (operating-system-bootcfg os menu-entries)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -579,19 +579,19 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))
- (_ -> (if (< (length boot-parameters) 2)
+ (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
+ (_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
(entries -> (map boot-parameters->menu-entry
- (list (second boot-parameters))))
+ (list (second boot-alternatives))))
(locale -> (boot-parameters-locale
- (second boot-parameters)))
+ (second boot-alternatives)))
(crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-parameters)))
+ (second boot-alternatives)))
(store-dir -> (boot-parameters-store-directory-prefix
- (second boot-parameters)))
+ (second boot-alternatives)))
(old-entries -> (map boot-parameters->menu-entry
- (drop boot-parameters 2)))
+ (drop boot-alternatives 2)))
(bootloader -> (operating-system-bootloader
(machine-operating-system machine)))
(bootcfg (lower-object
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 84eb99b938..cdd78a7849 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,9 +328,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define* (profile-boot-parameters #:optional (profile %system-profile)
- (numbers
- (reverse (generation-numbers profile))))
+(define* (profile->boot-alternatives #:optional (profile %system-profile)
+ (numbers
+ (reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
@@ -395,18 +395,19 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile-boot-parameters %system-profile
- (list number))))
+ (params (first (profile->boot-alternatives %system-profile
+ (list number))))
(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))))
- (old-params (profile-boot-parameters
- %system-profile old-generations))
+ (previous-boot-alternatives (profile->boot-alternatives
+ %system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry old-params)))
+ (old-entries (map boot-parameters->menu-entry
+ previous-boot-alternatives)))
(run-with-store store
(mlet* %store-monad
((bootcfg (lower-object
@@ -823,7 +824,7 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile-boot-parameters))))))
+ (map boot-parameters->menu-entry (profile->boot-alternatives))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.45.2
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:06 GMT) Full text and rfc822 format available.Message #152 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 07/11] Rename two remote variables confusingly named 'generations'. Date: Thu, 19 Sep 2024 23:16:01 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
Both refer to data sets returned from the remote expression, and one of them
shadowed an element of itself.
* gnu/machine/ssh.scm (machine->boot-alternatives): Rename generations
to remote-results.
Change-Id: Ibd8a3036126d9da1215cfc191884c0f54df637df
---
gnu/machine/ssh.scm | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index f3d2a77625..a96ca68f47 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -449,10 +449,11 @@ (define (machine->boot-alternatives machine)
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
- (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp)))
+ (mlet* %store-monad
+ ((remote-results (machine-remote-eval machine remote-exp)))
(return
- (map (lambda (generation)
- (match generation
+ (map (lambda (remote-result)
+ (match remote-result
((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
@@ -465,7 +466,7 @@ (define (machine->boot-alternatives machine)
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
- generations))))
+ remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
"Catch exceptions that arise when binding MBODY, a monadic expression in
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:06 GMT) Full text and rfc822 format available.Message #155 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 09/11] Simplify profile->boot-alternatives. Date: Thu, 19 Sep 2024 23:16:03 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm
(profile->boot-alternatives)[system->boot-parameters]: Rename to
generation->boot-parameters and factor out processing from...
(profile->boot-alternatives): ...here.
Change-Id: If31eeb4cef4f5a107a0ee5ad3f117bf38629ac38
---
guix/scripts/system.scm | 14 +++++---------
1 file changed, 5 insertions(+), 9 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index cdd78a7849..a4dd7a8054 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -334,20 +334,16 @@ (define* (profile->boot-alternatives #:optional (profile %system-profile)
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number epoch)
+ (define (generation->boot-parameters number)
(unless-file-not-found
- (let* ((params (read-boot-parameters-file system))
+ (let* ((system (generation-file-name profile number))
+ (params (read-boot-parameters-file system))
+ (epoch (stat:mtime (lstat system)))
(text (boot-parameters-label params)))
(boot-parameters
(inherit params)
(label (decorated-boot-label text number epoch))))))
- (let* ((systems (map (cut generation-file-name profile <>)
- numbers))
- (times (map (lambda (system)
- (unless-file-not-found
- (stat:mtime (lstat system))))
- systems)))
- (filter-map system->boot-parameters systems numbers times)))
+ (filter-map generation->boot-parameters numbers))
;;;
--
2.45.2
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:07 GMT) Full text and rfc822 format available.Message #158 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 08/11] Give a separate name to a commonly used expression. Date: Thu, 19 Sep 2024 23:16:02 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/machine/ssh.scm (roll-back-managed-host): Factor out a
subexpression into new variable parameters.
Change-Id: I8d70684142bea736042d6c9dc8276ea7bdb9c181
---
gnu/machine/ssh.scm | 47 +++++++++++++++++++++------------------------
1 file changed, 22 insertions(+), 25 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index a96ca68f47..37806a2e1b 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -580,31 +580,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)))
- (entries -> (map boot-parameters->menu-entry
- (list (second boot-alternatives))))
- (locale -> (boot-parameters-locale
- (second boot-alternatives)))
- (crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-alternatives)))
- (store-dir -> (boot-parameters-store-directory-prefix
- (second boot-alternatives)))
- (old-entries -> (map boot-parameters->menu-entry
- (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)))
+ (mlet* %store-monad
+ ((boot-alternatives (machine->boot-alternatives machine))
+ (_ -> (if (< (length boot-alternatives) 2) (raise roll-back-failure)))
+ (parameters (second boot-alternatives))
+ (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
+ (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))))
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:07 GMT) Full text and rfc822 format available.Message #161 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 10/11] Split generation->boot-parameters out of profile->boot-alternatives. Date: Thu, 19 Sep 2024 23:16:04 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm
(profile->boot-alternatives)[generation->boot-parameters]: Move to...
(generation->boot-parameters): ...here.
(reinstall-bootloader): Use procedure above.
Change-Id: I51ef1a4fa8fd18104d28a6a845707d7dedde3782
---
guix/scripts/system.scm | 28 ++++++++++++++++------------
1 file changed, 16 insertions(+), 12 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index a4dd7a8054..0c69f6d90b 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,22 +328,27 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
+(define (generation->boot-parameters profile number)
+ "Return the 'boot-parameters' for the generation of PROFILE specified
+by NUMBER."
+ (unless-file-not-found
+ (let* ((system (generation-file-name profile number))
+ (params (read-boot-parameters-file system))
+ (epoch (stat:mtime (lstat system)))
+ (text (boot-parameters-label params)))
+ (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
+
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (generation->boot-parameters number)
- (unless-file-not-found
- (let* ((system (generation-file-name profile number))
- (params (read-boot-parameters-file system))
- (epoch (stat:mtime (lstat system)))
- (text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
- (filter-map generation->boot-parameters numbers))
+ (filter-map (lambda (number)
+ (generation->boot-parameters profile number))
+ numbers))
;;;
@@ -391,8 +396,7 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile->boot-alternatives %system-profile
- (list number))))
+ (params (generation->boot-parameters %system-profile number))
(locale (boot-parameters-locale params))
(store-crypto-devices (boot-parameters-store-crypto-devices params))
(store-directory-prefix
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Fri, 20 Sep 2024 04:18:08 GMT) Full text and rfc822 format available.Message #164 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Lilah Tascheter <lilah <at> lunabee.space> To: 69343 <at> debbugs.gnu.org Cc: Herman Rimm <herman <at> rimm.ee>, Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v4 11/11] Encapsulate <boot-parameters> to retain generation, system-path and epoch. Date: Thu, 19 Sep 2024 23:16:05 -0500
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system/boot.scm (<boot-alternative>): New record.
* gnu/machine/ssh.scm (machine->boot-alternatives): Return a
boot-alternative encapsulating previous return value.
(with-roll-back, roll-back-managed-host): Get parameters from
boot-alternatives.
* guix/scripts/system.scm (generation->boot-parameters): Rename to...
(generation->boot-alternative): ...this. Return a boot-alternative
encapsulating previous return value.
(profile->boot-alternatives): Rename uses as above.
(reinstall-bootloader, perform-action): Get parameters from
boot-alternatives.
Change-Id: Iaef0b0a3fa9240ca8315a9699bcf4a7bfe908e33
---
gnu/machine/ssh.scm | 29 ++++++++++++++++++-----------
gnu/system/boot.scm | 14 ++++++++++++++
guix/scripts/system.scm | 32 +++++++++++++++++++++-----------
3 files changed, 53 insertions(+), 22 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 37806a2e1b..ca0f3483a4 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -416,8 +416,8 @@ (define not-config?
(_ #f)))
(define (machine->boot-alternatives machine)
- "Monadic procedure returning a list of 'boot-parameters' for the generations
-of MACHINE's system profile, ordered from most recent to oldest."
+ "Monadic procedure returning a list of <boot-alternative> records for the
+generations of MACHINE's system profile, ordered from most recent to oldest."
(define remote-exp
(with-extensions (list guile-gcrypt)
(with-imported-modules `(((guix config) => ,(make-config.scm))
@@ -459,13 +459,18 @@ (define (machine->boot-alternatives machine)
read-boot-parameters))
(root (boot-parameters-root-device params))
(text (boot-parameters-label params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text generation epoch))
- (kernel-arguments
- (append (bootable-kernel-arguments system-path root version)
- (boot-parameters-kernel-arguments params))))))))
+ (version (boot-parameters-version params))
+ (parameters (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text generation epoch))
+ (kernel-arguments
+ (append (bootable-kernel-arguments system-path root version)
+ (boot-parameters-kernel-arguments params))))))
+ (boot-alternative
+ (generation generation)
+ (system-path system-path)
+ (epoch epoch)
+ (parameters parameters))))))
remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
@@ -509,7 +514,8 @@ (define (deploy-managed-host machine)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry boot-alternatives))
+ (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)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -583,7 +589,8 @@ (define (roll-back-managed-host machine)
(mlet* %store-monad
((boot-alternatives (machine->boot-alternatives machine))
(_ -> (if (< (length boot-alternatives) 2) (raise roll-back-failure)))
- (parameters (second boot-alternatives))
+ (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))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 82ca353cb3..c29e48d607 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -71,6 +71,13 @@ (define-module (gnu system boot)
read-boot-parameters-file
bootable-kernel-arguments
+ boot-alternative
+ boot-alternative?
+ boot-alternative-generation
+ boot-alternative-system-path
+ boot-alternative-epoch
+ boot-alternative-parameters
+
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
@@ -299,6 +306,13 @@ (define* (bootable-kernel-arguments system root-device version)
#~(string-append (if #$version>0? "gnu.load=" "--load=")
#$system "/boot")))))
+(define-record-type* <boot-alternative>
+ boot-alternative make-boot-alternative boot-alternative?
+ (generation boot-alternative-generation)
+ (system-path boot-alternative-system-path)
+ (epoch boot-alternative-epoch)
+ (parameters boot-alternative-parameters)) ; <boot-parameters>
+
(define (epoch->date-string epoch)
"Return a string representing the date for EPOCH seconds."
(let ((time (make-time time-utc 0 epoch)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0c69f6d90b..0f7d864e06 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,26 +328,31 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (generation->boot-parameters profile number)
- "Return the 'boot-parameters' for the generation of PROFILE specified
+(define (generation->boot-alternative profile number)
+ "Return the 'boot-alternative' for the generation of PROFILE specified
by NUMBER."
(unless-file-not-found
(let* ((system (generation-file-name profile number))
(params (read-boot-parameters-file system))
(epoch (stat:mtime (lstat system)))
- (text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
+ (text (boot-parameters-label params))
+ (parameters (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch)))))
+ (boot-alternative
+ (generation number)
+ (system-path system)
+ (epoch epoch)
+ (parameters parameters)))))
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
- "Return a list of 'boot-parameters' for the generations of PROFILE specified
+ "Return a list of 'boot-alternative' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
(filter-map (lambda (number)
- (generation->boot-parameters profile number))
+ (generation->boot-alternative profile number))
numbers))
@@ -396,7 +401,9 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (generation->boot-parameters %system-profile number))
+ (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
@@ -407,7 +414,8 @@ (define (reinstall-bootloader store number)
%system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
(old-entries (map boot-parameters->menu-entry
- previous-boot-alternatives)))
+ (map boot-alternative-parameters
+ previous-boot-alternatives))))
(run-with-store store
(mlet* %store-monad
((bootcfg (lower-object
@@ -824,7 +832,9 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile->boot-alternatives))))))
+ (map boot-parameters->menu-entry
+ (map boot-alternative-parameters
+ (profile->boot-alternatives)))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.45.2
Lilah Tascheter <lilah <at> lunabee.space>
to control <at> debbugs.gnu.org.
(Fri, 20 Sep 2024 13:43:02 GMT) Full text and rfc822 format available.guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:25:02 GMT) Full text and rfc822 format available.Message #169 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Subject: [PATCH v5 00/10] Simplify bootloader data structures and procedures. Date: Sat, 21 Sep 2024 12:23:13 +0200
Hi,
I squashed patch #10 into #9, and patch #14 from v2 of issue #73202 into
what is now patch #10, formerly #11/#12. For patch #8, I replaced an if
with when, for patch #5 I replaced an if with a match, and for patch #2
I used more relevant copyright.
By the way, there seem to be two different commit message styles used by
Guix contributors. I would never use more than 72 columns, and I would
write e.g. patch #11 without newlines between changed files, or
alignment indenation, like so:
-Encapsulate <boot-parameters> to retain generation, system-path and epoch.
+Encapsulate <boot-parameters> to retain generation, system-path, epoch.
* gnu/system/boot.scm (<boot-alternative>): New record.
- (boot-alternative->menu-entry): New procedure.
+(boot-alternative->menu-entry): New procedure.
-
* gnu/machine/ssh.scm (machine->boot-alternatives): Return a
- boot-alternative encapsulating previous return value.
- (with-roll-back, roll-back-managed-host): Get parameters from
- boot-alternatives.
+boot-alternative encapsulating previous return value.
+(with-roll-back, roll-back-managed-host): Get parameters from
+boot-alternatives.
Is there a preferred style?
Also, should the indendation increase by one column, or by two columns
after a record constructor?
Cheers,
Herman
Felix Lechner (10):
Fix bug where the extra menu entries for a bootloader were shown
twice.
Move <boot-parameters> record to a separate file.
Rename seconds->string procedure to epoch->date-string.
Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.
Offer a uniform decorated-boot-label and use it.
Rename boot-parameters to boot-alternatives when appropriate.
Rename two remote variables confusingly named 'generations'.
Give a separate name to a commonly used expression.
Split system->boot-parameters out of profile->boot-alternatives.
Encapsulate <boot-parameters> to retain generation, system-path and
epoch.
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 116 ++++++------
gnu/system.scm | 287 +----------------------------
gnu/system/boot.scm | 375 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 69 ++++---
tests/boot-parameters.scm | 1 +
6 files changed, 470 insertions(+), 379 deletions(-)
create mode 100644 gnu/system/boot.scm
base-commit: 9d75215a59629ab224154ef6b843043289291f81
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:25:02 GMT) Full text and rfc822 format available.Message #172 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 01/10] Fix bug where the extra menu entries for a bootloader were shown twice. Date: Sat, 21 Sep 2024 12:23:14 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
The extra menu entries are already being added in each bootloaders, as
applicable.
* guix/scripts/system.scm (reinstall-bootloader)[entries]: Don't
extraneously include bootloader-configuration-menu-entries here.
Change-Id: I8a600f2a5836ab4f7db5e27e25b0b8f432c3e1e0
---
guix/scripts/system.scm | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 99c58f3812..0305128763 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -412,8 +412,7 @@ (define (reinstall-bootloader store number)
(delv number (reverse (generation-numbers %system-profile))))
(old-params (profile-boot-parameters
%system-profile old-generations))
- (entries (cons (boot-parameters->menu-entry params)
- (boot-parameters-bootloader-menu-entries params)))
+ (entries (list (boot-parameters->menu-entry params)))
(old-entries (map boot-parameters->menu-entry old-params)))
(run-with-store store
(mlet* %store-monad
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:25:03 GMT) Full text and rfc822 format available.Message #175 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 02/10] Move <boot-parameters> record to a separate file. Date: Sat, 21 Sep 2024 12:23:15 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
Required to avoid a missing dependency error on build-side.
* gnu/system.scm (<boot-parameters>): Move this record, and...
(system-linux-image-file-name, %boot-parameters-version,
bootable-kernel-arguments, ensure-not-/dev, read-boot-parameters,
read-boot-parameters-file, boot-parameters->menu-entry):
...these procedures, to...
* gnu/system/boot.scm: ...this new file.
* gnu/machine/ssh.scm, gnu/system.scm, guix/scripts/system.scm,
tests/boot-parameters.scm: Use new module above.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add new module above.
* gnu/machine/ssh.scm (machine-boot-parameters): Don't private-import
bootable-kernel-arguments.
Change-Id: I50cca8d2187879cd351b8e9332e1e114ca5096ae
---
gnu/local.mk | 1 +
gnu/machine/ssh.scm | 4 +-
gnu/system.scm | 287 +-------------------------------
gnu/system/boot.scm | 335 ++++++++++++++++++++++++++++++++++++++
guix/scripts/system.scm | 1 +
tests/boot-parameters.scm | 1 +
6 files changed, 340 insertions(+), 289 deletions(-)
create mode 100644 gnu/system/boot.scm
diff --git a/gnu/local.mk b/gnu/local.mk
index 8e7abc8a47..6ba3aa3da8 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -762,6 +762,7 @@ GNU_SYSTEM_MODULES = \
\
%D%/system.scm \
%D%/system/accounts.scm \
+ %D%/system/boot.scm \
%D%/system/file-systems.scm \
%D%/system/hurd.scm \
%D%/system/image.scm \
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 3e10d984e7..863c28a13c 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -23,6 +23,7 @@ (define-module (gnu machine ssh)
#:use-module (gnu machine)
#:autoload (gnu packages gnupg) (guile-gcrypt)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((gnu services) #:select (sexp->system-provenance))
@@ -419,9 +420,6 @@ (define not-config?
(define (machine-boot-parameters machine)
"Monadic procedure returning a list of 'boot-parameters' for the generations
of MACHINE's system profile, ordered from most recent to oldest."
- (define bootable-kernel-arguments
- (@@ (gnu system) bootable-kernel-arguments))
-
(define remote-exp
(with-extensions (list guile-gcrypt)
(with-imported-modules `(((guix config) => ,(make-config.scm))
diff --git a/gnu/system.scm b/gnu/system.scm
index 44f93f91d1..25afa96295 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -72,6 +72,7 @@ (define-module (gnu system)
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system shadow)
#:use-module (gnu system nss)
#:use-module (gnu system locale)
@@ -147,33 +148,11 @@ (define-module (gnu system)
operating-system-boot-script
operating-system-uuid
- system-linux-image-file-name
operating-system-with-gc-roots
operating-system-with-provenance
hurd-default-essential-services
- boot-parameters
- boot-parameters?
- boot-parameters-label
- boot-parameters-root-device
- boot-parameters-bootloader-name
- boot-parameters-bootloader-menu-entries
- boot-parameters-store-crypto-devices
- boot-parameters-store-device
- boot-parameters-store-directory-prefix
- boot-parameters-store-mount-point
- boot-parameters-locale
- boot-parameters-kernel
- boot-parameters-kernel-arguments
- boot-parameters-initrd
- boot-parameters-multiboot-modules
- boot-parameters-version
- %boot-parameters-version
- read-boot-parameters
- read-boot-parameters-file
- boot-parameters->menu-entry
-
local-host-aliases ;deprecated
%root-account
%default-privileged-programs
@@ -195,29 +174,6 @@ (define-module (gnu system)
;;;
;;; Code:
-(define* (bootable-kernel-arguments system root-device version)
- "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE.
-VERSION is the target version of the boot-parameters record."
- ;; If the version is newer than 0, we use the new style initrd parameter
- ;; names, otherwise we use the legacy ones. This is to maintain backward
- ;; compatibility when producing bootloader configurations for older
- ;; generations.
- (define version>0? (> version 0))
- (let ((root (file-system-device->string root-device
- #:uuid-type 'dce)))
- (append
- (if (string=? root "none")
- '() ; Ignore the case where the root is "none" (typically tmpfs).
- ;; Note: Always use the DCE format because that's what
- ;; (gnu build linux-boot) expects for the 'root'
- ;; kernel command-line option.
- (list (string-append (if version>0? "root=" "--root=") root)))
- (list #~(string-append (if #$version>0? "gnu.system=" "--system=") #$system)
- #~(string-append (if #$version>0? "gnu.load=" "--load=")
- #$system "/boot")))))
-
-;; System-wide configuration.
-
(define-with-syntax-properties (warn-hosts-file-field-deprecation
(value properties))
(when value
@@ -361,236 +317,6 @@ (define* (operating-system-kernel-arguments
(append (bootable-kernel-arguments os root-device version)
(operating-system-user-kernel-arguments os)))
-
-;;;
-;;; Boot parameters
-;;;
-
-;;; Version 1 was introduced early 2022 to mark the departure from long option
-;;; names such as '--load' to the more conventional initrd option names like
-;;; 'gnu.load'.
-;;;
-;;; When bumping the boot-parameters version, increment it by one (1).
-(define %boot-parameters-version 1)
-
-(define-record-type* <boot-parameters>
- boot-parameters make-boot-parameters boot-parameters?
- (label boot-parameters-label)
- ;; Because we will use the 'store-device' to create the GRUB search command,
- ;; the 'store-device' has slightly different semantics than 'root-device'.
- ;; The 'store-device' can be a file system uuid, a file system label, or #f,
- ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
- ;; not understand that. The 'root-device', on the other hand, corresponds
- ;; exactly to the device field of the <file-system> object representing the
- ;; OS's root file system, so it might be a device file name like
- ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
- ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
- ;; contain "/storefs" if the store is located in that subvolume of a btrfs
- ;; partition.
- (root-device boot-parameters-root-device)
- (bootloader-name boot-parameters-bootloader-name)
- (bootloader-menu-entries ;list of <menu-entry>
- boot-parameters-bootloader-menu-entries)
- (store-device boot-parameters-store-device)
- (store-mount-point boot-parameters-store-mount-point)
- (store-directory-prefix boot-parameters-store-directory-prefix)
- (store-crypto-devices boot-parameters-store-crypto-devices
- (default '()))
- (locale boot-parameters-locale)
- (kernel boot-parameters-kernel)
- (kernel-arguments boot-parameters-kernel-arguments)
- (initrd boot-parameters-initrd)
- (multiboot-modules boot-parameters-multiboot-modules)
- (version boot-parameters-version ;positive integer
- (default %boot-parameters-version)))
-
-(define (ensure-not-/dev device)
- "If DEVICE starts with a slash, return #f. This is meant to filter out
-Linux device names such as /dev/sda, and to preserve GRUB device names and
-file system labels."
- (if (and (string? device) (string-prefix? "/" device))
- #f
- device))
-
-(define (read-boot-parameters port)
- "Read boot parameters from PORT and return the corresponding
-<boot-parameters> object. Raise an error if the format is unrecognized."
- (define device-sexp->device
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (('file-system-label (? string? label))
- (file-system-label label))
- ((? bytevector? bv) ;old format
- (bytevector->uuid bv 'dce))
- ((? string? device)
- (if (string-contains device ":/")
- device ; nfs-root
- ;; It used to be that we would not distinguish between labels and
- ;; device names. Try to infer the right thing here.
- (if (string-prefix? "/" device)
- device
- (file-system-label device))))))
- (define uuid-sexp->uuid
- (match-lambda
- (('uuid (? symbol? type) (? bytevector? bv))
- (bytevector->uuid bv type))
- (x
- (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
- #f)))
-
- ;; New versions are not backward-compatible, so only accept past and current
- ;; versions, not future ones.
- (define (version? n)
- (member n (iota (1+ %boot-parameters-version))))
-
- (match (read port)
- (('boot-parameters ('version (? version? version))
- ('label label) ('root-device root)
- ('kernel kernel)
- rest ...)
- (boot-parameters
- (version version)
- (label label)
- (root-device (device-sexp->device root))
-
- (bootloader-name
- (match (assq 'bootloader-name rest)
- ((_ args) args)
- (#f 'grub))) ; for compatibility reasons.
-
- (bootloader-menu-entries
- (match (assq 'bootloader-menu-entries rest)
- ((_ entries) (map sexp->menu-entry entries))
- (#f '())))
-
- ;; In the past, we would store the directory name of linux instead of
- ;; the absolute file name of its image. Detect that and correct it.
- (kernel (if (string=? kernel (direct-store-path kernel))
- (string-append kernel "/"
- (system-linux-image-file-name))
- kernel))
-
- (kernel-arguments
- (match (assq 'kernel-arguments rest)
- ((_ args) args)
- (#f '()))) ;the old format
-
- (initrd
- (match (assq 'initrd rest)
- (('initrd ('string-append directory file)) ;the old format
- (string-append directory file))
- (('initrd (? string? file))
- file)
- (#f #f)))
-
- (multiboot-modules
- (match (assq 'multiboot-modules rest)
- ((_ args) args)
- (#f '())))
-
- (locale
- (match (assq 'locale rest)
- ((_ locale) locale)
- (#f #f)))
-
- (store-device
- ;; Linux device names like "/dev/sda1" are not suitable GRUB device
- ;; identifiers, so we just filter them out.
- (ensure-not-/dev
- (match (assq 'store rest)
- (('store ('device #f) _ ...)
- root-device)
- (('store ('device device) _ ...)
- (device-sexp->device device))
- (_ ;the old format
- root-device))))
-
- (store-directory-prefix
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'directory-prefix store-data)
- (('directory-prefix prefix) prefix)
- ;; No directory-prefix found.
- (_ #f)))
- (_
- ;; No store found, old format.
- #f)))
-
- (store-crypto-devices
- (match (assq 'store rest)
- (('store . store-data)
- (match (assq 'crypto-devices store-data)
- (('crypto-devices (devices ...))
- (map uuid-sexp->uuid devices))
- (('crypto-devices dev)
- (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
- dev (port-filename port))
- '())
- (_
- ;; No crypto-devices found.
- '())))
- (_
- ;; No store found, old format.
- '())))
-
- (store-mount-point
- (match (assq 'store rest)
- (('store ('device _) ('mount-point mount-point) _ ...)
- mount-point)
- (_ ;the old format
- "/")))))
- (x ;unsupported format
- (raise
- (make-compound-condition
- (formatted-message
- (G_ "unrecognized boot parameters at '~a'~%")
- (port-filename port))
- (condition
- (&fix-hint (hint (format #f (G_ "This probably means that this version
-of Guix is older than the one that created @file{~a}. To address this, you
-need to update Guix:
-
-@example
-guix pull
-@end example")
- (port-filename port))))))))))
-
-(define (read-boot-parameters-file system)
- "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
-file and returns the corresponding <boot-parameters> object or #f if the
-format is unrecognized.
-The object has its kernel-arguments extended in order to make it bootable."
- (let* ((file (string-append system "/parameters"))
- (params (call-with-input-file file read-boot-parameters))
- (root (boot-parameters-root-device params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (kernel-arguments (append (bootable-kernel-arguments system root version)
- (boot-parameters-kernel-arguments params))))))
-
-(define (boot-parameters->menu-entry conf)
- "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
- (let* ((kernel (boot-parameters-kernel conf))
- (multiboot-modules (boot-parameters-multiboot-modules conf))
- (multiboot? (pair? multiboot-modules)))
- (menu-entry
- (label (boot-parameters-label conf))
- (device (boot-parameters-store-device conf))
- (device-mount-point (boot-parameters-store-mount-point conf))
- (linux (and (not multiboot?) kernel))
- (linux-arguments (if (not multiboot?)
- (boot-parameters-kernel-arguments conf)
- '()))
- (initrd (boot-parameters-initrd conf))
- (multiboot-kernel (and multiboot? kernel))
- (multiboot-arguments (if multiboot?
- (boot-parameters-kernel-arguments conf)
- '()))
- (multiboot-modules (if multiboot?
- (boot-parameters-multiboot-modules conf)
- '())))))
;;;
@@ -731,17 +457,6 @@ (define (swap-services os)
(map (compose swap-service filter-deps)
(operating-system-swap-devices os)))
-(define* (system-linux-image-file-name #:optional
- (target (or (%current-target-system)
- (%current-system))))
- "Return the basename of the kernel image file for TARGET."
- (cond
- ((string-prefix? "arm" target) "zImage")
- ((string-prefix? "mips" target) "vmlinuz")
- ((string-prefix? "aarch64" target) "Image")
- ((string-prefix? "riscv64" target) "Image")
- (else "bzImage")))
-
(define (operating-system-kernel-file os)
"Return an object representing the absolute file name of the kernel image of
OS."
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
new file mode 100644
index 0000000000..2c531e4ad5
--- /dev/null
+++ b/gnu/system/boot.scm
@@ -0,0 +1,335 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo <at> gnu.org>
+;;; Copyright © 2016 Chris Marusich <cmmarusich <at> gmail.com>
+;;; Copyright © 2017 David Craven <david <at> craven.ch>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe <at> gmail.com>
+;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835 <at> gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym <at> scratchpost.org>
+;;; Copyright © 2020 Stefan <stefan-guix <at> vodafonemail.de>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
+;;; Copyright © 2020 Janneke Nieuwenhuizen <jannek <at> gnu.org>
+;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il>
+;;; Copyright © 2024 Nicolas Graves <ngraves <at> ngraves.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system boot)
+ #:use-module (guix gexp)
+ #:use-module (guix diagnostics)
+ #:use-module (guix i18n)
+ #:use-module (guix records)
+ #:use-module (guix store)
+ #:use-module (guix utils)
+ #:use-module (gnu bootloader)
+ #:use-module (gnu system file-systems)
+ #:use-module (gnu system uuid)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module (rnrs bytevectors)
+ #:export (boot-parameters
+ boot-parameters?
+ boot-parameters-label
+ boot-parameters-root-device
+ boot-parameters-bootloader-name
+ boot-parameters-bootloader-menu-entries
+ boot-parameters-store-crypto-devices
+ boot-parameters-store-device
+ boot-parameters-store-directory-prefix
+ boot-parameters-store-mount-point
+ boot-parameters-locale
+ boot-parameters-kernel
+ boot-parameters-kernel-arguments
+ boot-parameters-initrd
+ boot-parameters-multiboot-modules
+ boot-parameters-version
+ %boot-parameters-version
+
+ read-boot-parameters
+ read-boot-parameters-file
+ bootable-kernel-arguments
+
+ boot-parameters->menu-entry
+
+ ensure-not-/dev
+ system-linux-image-file-name))
+
+;;;
+;;; Boot parameters
+;;;
+
+;;; Version 1 was introduced early 2022 to mark the departure from long option
+;;; names such as '--load' to the more conventional initrd option names like
+;;; 'gnu.load'.
+;;;
+;;; When bumping the boot-parameters version, increment it by one (1).
+(define %boot-parameters-version 1)
+
+(define-record-type* <boot-parameters>
+ boot-parameters make-boot-parameters boot-parameters?
+ (label boot-parameters-label)
+ ;; Because we will use the 'store-device' to create the GRUB search command,
+ ;; the 'store-device' has slightly different semantics than 'root-device'.
+ ;; The 'store-device' can be a file system uuid, a file system label, or #f,
+ ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
+ ;; not understand that. The 'root-device', on the other hand, corresponds
+ ;; exactly to the device field of the <file-system> object representing the
+ ;; OS's root file system, so it might be a device file name like
+ ;; "/dev/sda3". The 'store-directory-prefix' field contains #f or the store
+ ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
+ ;; contain "/storefs" if the store is located in that subvolume of a btrfs
+ ;; partition.
+ (root-device boot-parameters-root-device)
+ (bootloader-name boot-parameters-bootloader-name)
+ (bootloader-menu-entries ;list of <menu-entry>
+ boot-parameters-bootloader-menu-entries)
+ (store-device boot-parameters-store-device)
+ (store-mount-point boot-parameters-store-mount-point)
+ (store-directory-prefix boot-parameters-store-directory-prefix)
+ (store-crypto-devices boot-parameters-store-crypto-devices
+ (default '()))
+ (locale boot-parameters-locale)
+ (kernel boot-parameters-kernel)
+ (kernel-arguments boot-parameters-kernel-arguments)
+ (initrd boot-parameters-initrd)
+ (multiboot-modules boot-parameters-multiboot-modules)
+ (version boot-parameters-version ;positive integer
+ (default %boot-parameters-version)))
+
+(define (read-boot-parameters port)
+ "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object. Raise an error if the format is unrecognized."
+ (define device-sexp->device
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (('file-system-label (? string? label))
+ (file-system-label label))
+ ((? bytevector? bv) ;old format
+ (bytevector->uuid bv 'dce))
+ ((? string? device)
+ (if (string-contains device ":/")
+ device ; nfs-root
+ ;; It used to be that we would not distinguish between labels and
+ ;; device names. Try to infer the right thing here.
+ (if (string-prefix? "/" device)
+ device
+ (file-system-label device))))))
+ (define uuid-sexp->uuid
+ (match-lambda
+ (('uuid (? symbol? type) (? bytevector? bv))
+ (bytevector->uuid bv type))
+ (x
+ (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
+ #f)))
+
+ ;; New versions are not backward-compatible, so only accept past and current
+ ;; versions, not future ones.
+ (define (version? n)
+ (member n (iota (1+ %boot-parameters-version))))
+
+ (match (read port)
+ (('boot-parameters ('version (? version? version))
+ ('label label) ('root-device root)
+ ('kernel kernel)
+ rest ...)
+ (boot-parameters
+ (version version)
+ (label label)
+ (root-device (device-sexp->device root))
+
+ (bootloader-name
+ (match (assq 'bootloader-name rest)
+ ((_ args) args)
+ (#f 'grub))) ; for compatibility reasons.
+
+ (bootloader-menu-entries
+ (match (assq 'bootloader-menu-entries rest)
+ ((_ entries) (map sexp->menu-entry entries))
+ (#f '())))
+
+ ;; In the past, we would store the directory name of linux instead of
+ ;; the absolute file name of its image. Detect that and correct it.
+ (kernel (if (string=? kernel (direct-store-path kernel))
+ (string-append kernel "/"
+ (system-linux-image-file-name))
+ kernel))
+
+ (kernel-arguments
+ (match (assq 'kernel-arguments rest)
+ ((_ args) args)
+ (#f '()))) ;the old format
+
+ (initrd
+ (match (assq 'initrd rest)
+ (('initrd ('string-append directory file)) ;the old format
+ (string-append directory file))
+ (('initrd (? string? file))
+ file)
+ (#f #f)))
+
+ (multiboot-modules
+ (match (assq 'multiboot-modules rest)
+ ((_ args) args)
+ (#f '())))
+
+ (locale
+ (match (assq 'locale rest)
+ ((_ locale) locale)
+ (#f #f)))
+
+ (store-device
+ ;; Linux device names like "/dev/sda1" are not suitable GRUB device
+ ;; identifiers, so we just filter them out.
+ (ensure-not-/dev
+ (match (assq 'store rest)
+ (('store ('device #f) _ ...)
+ root-device)
+ (('store ('device device) _ ...)
+ (device-sexp->device device))
+ (_ ;the old format
+ root-device))))
+
+ (store-directory-prefix
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'directory-prefix store-data)
+ (('directory-prefix prefix) prefix)
+ ;; No directory-prefix found.
+ (_ #f)))
+ (_
+ ;; No store found, old format.
+ #f)))
+
+ (store-crypto-devices
+ (match (assq 'store rest)
+ (('store . store-data)
+ (match (assq 'crypto-devices store-data)
+ (('crypto-devices (devices ...))
+ (map uuid-sexp->uuid devices))
+ (('crypto-devices dev)
+ (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
+ dev (port-filename port))
+ '())
+ (_
+ ;; No crypto-devices found.
+ '())))
+ (_
+ ;; No store found, old format.
+ '())))
+
+ (store-mount-point
+ (match (assq 'store rest)
+ (('store ('device _) ('mount-point mount-point) _ ...)
+ mount-point)
+ (_ ;the old format
+ "/")))))
+ (x ;unsupported format
+ (raise
+ (make-compound-condition
+ (formatted-message
+ (G_ "unrecognized boot parameters at '~a'~%")
+ (port-filename port))
+ (condition
+ (&fix-hint (hint (format #f (G_ "This probably means that this version
+of Guix is older than the one that created @file{~a}. To address this, you
+need to update Guix:
+
+@example
+guix pull
+@end example")
+ (port-filename port))))))))))
+
+(define (read-boot-parameters-file system)
+ "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
+file and returns the corresponding <boot-parameters> object or #f if the
+format is unrecognized.
+The object has its kernel-arguments extended in order to make it bootable."
+ (let* ((file (string-append system "/parameters"))
+ (params (call-with-input-file file read-boot-parameters))
+ (root (boot-parameters-root-device params))
+ (version (boot-parameters-version params)))
+ (boot-parameters
+ (inherit params)
+ (kernel-arguments (append (bootable-kernel-arguments system root version)
+ (boot-parameters-kernel-arguments params))))))
+
+(define* (bootable-kernel-arguments system root-device version)
+ "Return a list of kernel arguments (gexps) to boot SYSTEM from ROOT-DEVICE.
+VERSION is the target version of the boot-parameters record."
+ ;; If the version is newer than 0, we use the new style initrd parameter
+ ;; names, otherwise we use the legacy ones. This is to maintain backward
+ ;; compatibility when producing bootloader configurations for older
+ ;; generations.
+ (define version>0? (> version 0))
+ (let ((root (file-system-device->string root-device
+ #:uuid-type 'dce)))
+ (append
+ (if (string=? root "none")
+ '() ; Ignore the case where the root is "none" (typically tmpfs).
+ ;; Note: Always use the DCE format because that's what
+ ;; (gnu build linux-boot) expects for the 'root'
+ ;; kernel command-line option.
+ (list (string-append (if version>0? "root=" "--root=") root)))
+ (list #~(string-append (if #$version>0? "gnu.system=" "--system=") #$system)
+ #~(string-append (if #$version>0? "gnu.load=" "--load=")
+ #$system "/boot")))))
+
+(define (boot-parameters->menu-entry conf)
+ "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
+ (let* ((kernel (boot-parameters-kernel conf))
+ (multiboot-modules (boot-parameters-multiboot-modules conf))
+ (multiboot? (pair? multiboot-modules)))
+ (menu-entry
+ (label (boot-parameters-label conf))
+ (device (boot-parameters-store-device conf))
+ (device-mount-point (boot-parameters-store-mount-point conf))
+ (linux (and (not multiboot?) kernel))
+ (linux-arguments (if (not multiboot?)
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (initrd (boot-parameters-initrd conf))
+ (multiboot-kernel (and multiboot? kernel))
+ (multiboot-arguments (if multiboot?
+ (boot-parameters-kernel-arguments conf)
+ '()))
+ (multiboot-modules (if multiboot?
+ (boot-parameters-multiboot-modules conf)
+ '())))))
+
+(define (ensure-not-/dev device)
+ "If DEVICE starts with a slash, return #f. This is meant to filter out
+Linux device names such as /dev/sda, and to preserve GRUB device names and
+file system labels."
+ (if (and (string? device) (string-prefix? "/" device))
+ #f
+ device))
+
+;; XXX: defined here instead of (gnu system) to prevent dependency loop
+(define* (system-linux-image-file-name #:optional
+ (target (or (%current-target-system)
+ (%current-system))))
+ "Return the basename of the kernel image file for TARGET."
+ (cond
+ ((string-prefix? "arm" target) "zImage")
+ ((string-prefix? "mips" target) "vmlinuz")
+ ((string-prefix? "aarch64" target) "Image")
+ ((string-prefix? "riscv64" target) "Image")
+ (else "bzImage")))
+
+;;; boot.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0305128763..7000c470ed 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -70,6 +70,7 @@ (define-module (guix scripts system)
#:use-module (gnu image)
#:use-module (gnu system)
#:use-module (gnu bootloader)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system image)
#:use-module (gnu system mapped-devices)
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 03a1d01aff..2e7976aa6c 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -27,6 +27,7 @@ (define-module (test-boot-parameters)
#:use-module (gnu bootloader)
#:use-module (gnu bootloader grub)
#:use-module (gnu system)
+ #:use-module (gnu system boot)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
#:use-module ((guix diagnostics) #:select (formatted-message?))
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:25:03 GMT) Full text and rfc822 format available.Message #178 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 03/10] Rename seconds->string procedure to epoch->date-string. Date: Sat, 21 Sep 2024 12:23:16 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm (seconds->string): Rename to
epoch->date-string.
(profile-boot-parameters)[boot-parameters]: Update as above.
Change-Id: I2b9aaa816b3ca84c32f7d6fa690245b149228310
---
guix/scripts/system.scm | 8 ++++----
1 file changed, 4 insertions(+), 4 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 7000c470ed..cb70d36219 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,9 +328,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (seconds->string seconds)
- "Return a string representing the date for SECONDS."
- (let ((time (make-time time-utc 0 seconds)))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
@@ -348,7 +348,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (seconds->string time) ")"))))))
+ (epoch->date-string time) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:25:04 GMT) Full text and rfc822 format available.Message #181 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 04/10] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere. Date: Sat, 21 Sep 2024 12:23:17 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm (profile-boot-parameters): Rename time to
epoch to fit new procedure name.
(epoch->date-string): Move to...
* gnu/system/boot.scm (epoch->date-string): ...here.
* gnu/machine/ssh.scm (machine-boot-parameters): Rename time to epoch.
(machine-boot-parameters)[boot-parameters]: Use epoch->date-string.
Change-Id: I6a5f793567221f81edd7b2d8d9f0f3e801d1b113
---
gnu/machine/ssh.scm | 10 ++++------
gnu/system/boot.scm | 8 ++++++++
guix/scripts/system.scm | 10 ++--------
3 files changed, 14 insertions(+), 14 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 863c28a13c..86c21256eb 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -444,10 +444,10 @@ (define (machine-boot-parameters machine)
generation))
(boot-parameters-path (string-append system-path
"/parameters"))
- (time (stat:mtime (lstat system-path))))
+ (epoch (stat:mtime (lstat system-path))))
(list generation
system-path
- time
+ epoch
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
@@ -455,7 +455,7 @@ (define (machine-boot-parameters machine)
(return
(map (lambda (generation)
(match generation
- ((generation system-path time serialized-params)
+ ((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
@@ -466,9 +466,7 @@ (define (machine-boot-parameters machine)
(label
(string-append label " (#"
(number->string generation) ", "
- (let ((time (make-time time-utc 0 time)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M"))
+ (epoch->date-string epoch)
")"))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 2c531e4ad5..c1d58a2743 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -39,6 +39,7 @@ (define-module (gnu system boot)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-19)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (rnrs bytevectors)
@@ -64,6 +65,7 @@ (define-module (gnu system boot)
read-boot-parameters-file
bootable-kernel-arguments
+ epoch->date-string
boot-parameters->menu-entry
ensure-not-/dev
@@ -290,6 +292,12 @@ (define* (bootable-kernel-arguments system root-device version)
#~(string-append (if #$version>0? "gnu.load=" "--load=")
#$system "/boot")))))
+(define (epoch->date-string epoch)
+ "Return a string representing the date for EPOCH seconds."
+ (let ((time (make-time time-utc 0 epoch)))
+ (date->string (time-utc->date time)
+ "~Y-~m-~d ~H:~M")))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index cb70d36219..b197812e63 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,19 +328,13 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (epoch->date-string epoch)
- "Return a string representing the date for EPOCH seconds."
- (let ((time (make-time time-utc 0 epoch)))
- (date->string (time-utc->date time)
- "~Y-~m-~d ~H:~M")))
-
(define* (profile-boot-parameters #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number time)
+ (define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
(label (boot-parameters-label params)))
@@ -348,7 +342,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(inherit params)
(label (string-append label " (#"
(number->string number) ", "
- (epoch->date-string time) ")"))))))
+ (epoch->date-string epoch) ")"))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:25:04 GMT) Full text and rfc822 format available.Message #184 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 05/10] Offer a uniform decorated-boot-label and use it. Date: Sat, 21 Sep 2024 12:23:18 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system/boot.scm (decorated-boot-label): New procedure.
* gnu/machine/ssh.scm (machine-boot-parameters): Use
decorated-boot-label.
* guix/scripts/system.scm
(profile-boot-parameters)[system->boot-parameters]: Use
decorated-boot-label.
Change-Id: Id348c3047df2353f76b1bad0eb2a3e0fa17e474c
---
gnu/machine/ssh.scm | 8 ++------
gnu/system/boot.scm | 13 +++++++++++++
guix/scripts/system.scm | 8 +++-----
3 files changed, 18 insertions(+), 11 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 86c21256eb..3a0116ac0d 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -459,15 +459,11 @@ (define (machine-boot-parameters machine)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
(root (boot-parameters-root-device params))
- (label (boot-parameters-label params))
+ (text (boot-parameters-label params))
(version (boot-parameters-version params)))
(boot-parameters
(inherit params)
- (label
- (string-append label " (#"
- (number->string generation) ", "
- (epoch->date-string epoch)
- ")"))
+ (label (decorated-boot-label text generation epoch))
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index c1d58a2743..1e0d75212f 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -10,6 +10,8 @@
;;; Copyright © 2020 Janneke Nieuwenhuizen <jannek <at> gnu.org>
;;; Copyright © 2020, 2022 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2024 Nicolas Graves <ngraves <at> ngraves.fr>
+;;; Copyright © 2024 Felix Lechner <felix.lechner <at> lease-up.com>
+;;; Copyright © 2024 Herman Rimm <herman <at> rimm.ee>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -66,6 +68,7 @@ (define-module (gnu system boot)
bootable-kernel-arguments
epoch->date-string
+ decorated-boot-label
boot-parameters->menu-entry
ensure-not-/dev
@@ -298,6 +301,16 @@ (define (epoch->date-string epoch)
(date->string (time-utc->date time)
"~Y-~m-~d ~H:~M")))
+(define (decorated-boot-label text generation epoch)
+ "Return a string for a nice boot label that includes TEXT, a numbered
+GENERATION, and a timestamp derived from EPOCH seconds."
+ (let ((count (and generation
+ (string-append "#" (number->string generation))))
+ (timestamp (and=> epoch epoch->date-string)))
+ (match (filter identity (list count timestamp))
+ (() text)
+ (extras (string-append text "(" (string-join extras ", ") ")")))))
+
(define (boot-parameters->menu-entry conf)
"Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
(let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index b197812e63..84eb99b938 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -337,12 +337,10 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
(define (system->boot-parameters system number epoch)
(unless-file-not-found
(let* ((params (read-boot-parameters-file system))
- (label (boot-parameters-label params)))
+ (text (boot-parameters-label params)))
(boot-parameters
- (inherit params)
- (label (string-append label " (#"
- (number->string number) ", "
- (epoch->date-string epoch) ")"))))))
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
(let* ((systems (map (cut generation-file-name profile <>)
numbers))
(times (map (lambda (system)
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:25:05 GMT) Full text and rfc822 format available.Message #187 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 06/10] Rename boot-parameters to boot-alternatives when appropriate. Date: Sat, 21 Sep 2024 12:23:19 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
Throughout the code base, the token 'boot-parameters' refers to collection of
data that is stored on disk for each system generation. It was confusing to
use it for a list of such records. This comment imposes an alternative name.
* gnu/machine/ssh.scm (machine-boot-parameters): Rename to
machine->boot-alternatives.
(machine->boot-alternatives, roll-back-managed-host): Use
boot-alternatives instead of boot-parameters as appropriate.
* guix/scripts/system.scm (profile-boot-parameters): Rename to
profile->boot-alternatives.
(reinstall-bootloader, perform-action): Use boot-alternatives instead
of boot-parameters as appropriate.
Change-Id: Iabb04dbb39f42f989692bede7304f20a69bef9fb
---
gnu/machine/ssh.scm | 20 ++++++++++----------
guix/scripts/system.scm | 19 ++++++++++---------
2 files changed, 20 insertions(+), 19 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 3a0116ac0d..fae42ad3ce 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -417,7 +417,7 @@ (define not-config?
(('gnu _ ...) #t)
(_ #f)))
-(define (machine-boot-parameters machine)
+(define (machine->boot-alternatives machine)
"Monadic procedure returning a list of 'boot-parameters' for the generations
of MACHINE's system profile, ordered from most recent to oldest."
(define remote-exp
@@ -503,14 +503,14 @@ (define (deploy-managed-host machine)
(machine-become-command machine)))
(mlet %store-monad ((_ (check-deployment-sanity machine))
- (boot-parameters (machine-boot-parameters machine)))
+ (boot-alternatives (machine->boot-alternatives 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 boot-parameters))
+ (menu-entries (map boot-parameters->menu-entry boot-alternatives))
(bootloader-configuration (operating-system-bootloader os))
(bootcfg (operating-system-bootcfg os menu-entries)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -581,19 +581,19 @@ (define (roll-back-managed-host machine)
(define roll-back-failure
(condition (&message (message (G_ "could not roll-back machine")))))
- (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))
- (_ -> (if (< (length boot-parameters) 2)
+ (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
+ (_ -> (if (< (length boot-alternatives) 2)
(raise roll-back-failure)))
(entries -> (map boot-parameters->menu-entry
- (list (second boot-parameters))))
+ (list (second boot-alternatives))))
(locale -> (boot-parameters-locale
- (second boot-parameters)))
+ (second boot-alternatives)))
(crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-parameters)))
+ (second boot-alternatives)))
(store-dir -> (boot-parameters-store-directory-prefix
- (second boot-parameters)))
+ (second boot-alternatives)))
(old-entries -> (map boot-parameters->menu-entry
- (drop boot-parameters 2)))
+ (drop boot-alternatives 2)))
(bootloader -> (operating-system-bootloader
(machine-operating-system machine)))
(bootcfg (lower-object
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 84eb99b938..cdd78a7849 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,9 +328,9 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define* (profile-boot-parameters #:optional (profile %system-profile)
- (numbers
- (reverse (generation-numbers profile))))
+(define* (profile->boot-alternatives #:optional (profile %system-profile)
+ (numbers
+ (reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
@@ -395,18 +395,19 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile-boot-parameters %system-profile
- (list number))))
+ (params (first (profile->boot-alternatives %system-profile
+ (list number))))
(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))))
- (old-params (profile-boot-parameters
- %system-profile old-generations))
+ (previous-boot-alternatives (profile->boot-alternatives
+ %system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry old-params)))
+ (old-entries (map boot-parameters->menu-entry
+ previous-boot-alternatives)))
(run-with-store store
(mlet* %store-monad
((bootcfg (lower-object
@@ -823,7 +824,7 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile-boot-parameters))))))
+ (map boot-parameters->menu-entry (profile->boot-alternatives))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.45.2
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:25:05 GMT) Full text and rfc822 format available.Message #190 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 07/10] Rename two remote variables confusingly named 'generations'. Date: Sat, 21 Sep 2024 12:23:20 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
Both refer to data sets returned from the remote expression, and one of them
shadowed an element of itself.
* gnu/machine/ssh.scm (machine->boot-alternatives): Rename generations
to remote-results.
Change-Id: Ibd8a3036126d9da1215cfc191884c0f54df637df
---
gnu/machine/ssh.scm | 9 +++++----
1 file changed, 5 insertions(+), 4 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index fae42ad3ce..efe056dab7 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -451,10 +451,11 @@ (define (machine->boot-alternatives machine)
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
- (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp)))
+ (mlet %store-monad
+ ((remote-results (machine-remote-eval machine remote-exp)))
(return
- (map (lambda (generation)
- (match generation
+ (map (lambda (remote-result)
+ (match remote-result
((generation system-path epoch serialized-params)
(let* ((params (call-with-input-string serialized-params
read-boot-parameters))
@@ -467,7 +468,7 @@ (define (machine->boot-alternatives machine)
(kernel-arguments
(append (bootable-kernel-arguments system-path root version)
(boot-parameters-kernel-arguments params))))))))
- generations))))
+ remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
"Catch exceptions that arise when binding MBODY, a monadic expression in
--
2.45.2
guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:26:02 GMT) Full text and rfc822 format available.Message #193 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 08/10] Give a separate name to a commonly used expression. Date: Sat, 21 Sep 2024 12:23:21 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/machine/ssh.scm (roll-back-managed-host): Factor out a
subexpression into new variable parameters.
Change-Id: I8d70684142bea736042d6c9dc8276ea7bdb9c181
---
gnu/machine/ssh.scm | 48 ++++++++++++++++++++++-----------------------
1 file changed, 23 insertions(+), 25 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index efe056dab7..eb8dba3120 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -582,31 +582,29 @@ (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)))
- (entries -> (map boot-parameters->menu-entry
- (list (second boot-alternatives))))
- (locale -> (boot-parameters-locale
- (second boot-alternatives)))
- (crypto-dev -> (boot-parameters-store-crypto-devices
- (second boot-alternatives)))
- (store-dir -> (boot-parameters-store-directory-prefix
- (second boot-alternatives)))
- (old-entries -> (map boot-parameters->menu-entry
- (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)))
+ (mlet* %store-monad
+ ((boot-alternatives (machine->boot-alternatives machine))
+ (_ -> (when (< (length boot-alternatives) 2)
+ (raise roll-back-failure)))
+ (parameters (second boot-alternatives))
+ (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
+ (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))))
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:26:02 GMT) Full text and rfc822 format available.Message #196 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 09/10] Split system->boot-parameters out of profile->boot-alternatives. Date: Sat, 21 Sep 2024 12:23:22 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
* guix/scripts/system.scm
(profile->boot-alternatives)[system->boot-parameters]: Rename, process
system and epoch, and move to...
(generation->boot-parameters): ...here.
(reinstall-bootloader): Use procedure above.
Change-Id: If31eeb4cef4f5a107a0ee5ad3f117bf38629ac38
---
guix/scripts/system.scm | 30 ++++++++++++++----------------
1 file changed, 14 insertions(+), 16 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index cdd78a7849..4ca4f1fa85 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,26 +328,25 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
+(define (generation->boot-parameters profile number)
+ "Return the 'boot-parameters' for the generation of PROFILE specified
+by NUMBER."
+ (unless-file-not-found
+ (let* ((system (generation-file-name profile number))
+ (params (read-boot-parameters-file system))
+ (epoch (stat:mtime (lstat system)))
+ (text (boot-parameters-label params)))
+ (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))
+
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
"Return a list of 'boot-parameters' for the generations of PROFILE specified
by NUMBERS, which is a list of generation numbers. The list is ordered from
the most recent to the oldest profiles."
- (define (system->boot-parameters system number epoch)
- (unless-file-not-found
- (let* ((params (read-boot-parameters-file system))
- (text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
- (let* ((systems (map (cut generation-file-name profile <>)
- numbers))
- (times (map (lambda (system)
- (unless-file-not-found
- (stat:mtime (lstat system))))
- systems)))
- (filter-map system->boot-parameters systems numbers times)))
+ (filter-map (cut generation->boot-parameters profile <>) numbers))
;;;
@@ -395,8 +394,7 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (first (profile->boot-alternatives %system-profile
- (list number))))
+ (params (generation->boot-parameters %system-profile number))
(locale (boot-parameters-locale params))
(store-crypto-devices (boot-parameters-store-crypto-devices params))
(store-directory-prefix
--
2.45.2
guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, guix-patches <at> gnu.org:bug#69343; Package guix-patches.
(Sat, 21 Sep 2024 10:26:03 GMT) Full text and rfc822 format available.Message #199 received at 69343 <at> debbugs.gnu.org (full text, mbox):
From: Herman Rimm <herman <at> rimm.ee> To: 69343 <at> debbugs.gnu.org Cc: Felix Lechner <felix.lechner <at> lease-up.com> Subject: [PATCH v5 10/10] Encapsulate <boot-parameters> to retain generation, system-path and epoch. Date: Sat, 21 Sep 2024 12:23:23 +0200
From: Felix Lechner <felix.lechner <at> lease-up.com>
* gnu/system/boot.scm (<boot-alternative>): New record.
(boot-alternative->menu-entry): New procedure.
* gnu/machine/ssh.scm (machine->boot-alternatives): Return a
boot-alternative encapsulating previous return value.
(deploy-managed-host): Get menu-entries from boot-alternatives.
(roll-back-managed-host): Get parameters from boot-alternatives.
* guix/scripts/system.scm (generation->boot-parameters): Rename to...
(generation->boot-alternative): ...this. Return a boot-alternative
encapsulating previous return value.
(profile->boot-alternatives): Rename uses as above.
(reinstall-bootloader, perform-action): Get menu-entries from
boot-alternatives.
Change-Id: Iaef0b0a3fa9240ca8315a9699bcf4a7bfe908e33
---
gnu/machine/ssh.scm | 49 ++++++++++++++++++++++++-----------------
gnu/system/boot.scm | 19 ++++++++++++++++
guix/scripts/system.scm | 32 +++++++++++++++++----------
3 files changed, 68 insertions(+), 32 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index eb8dba3120..3a0c5f45c6 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -418,8 +418,9 @@ (define not-config?
(_ #f)))
(define (machine->boot-alternatives machine)
- "Monadic procedure returning a list of 'boot-parameters' for the generations
-of MACHINE's system profile, ordered from most recent to oldest."
+ "Monadic procedure returning a list of <boot-alternative> records for
+the generations of MACHINE's system profile, ordered from most recent to
+oldest."
(define remote-exp
(with-extensions (list guile-gcrypt)
(with-imported-modules `(((guix config) => ,(make-config.scm))
@@ -451,24 +452,30 @@ (define (machine->boot-alternatives machine)
(read-file boot-parameters-path))))
(reverse (generation-numbers %system-profile)))))))
+ (define remote-result->boot-alternative
+ (match-lambda
+ ((generation system-path epoch serialized-params)
+ (boot-alternative
+ (generation generation)
+ (system-path system-path)
+ (epoch epoch)
+ (parameters
+ (let* ((params (call-with-input-string serialized-params
+ read-boot-parameters))
+ (root (boot-parameters-root-device params))
+ (text (boot-parameters-label params))
+ (version (boot-parameters-version params)))
+ (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text generation epoch))
+ (kernel-arguments
+ (append
+ (bootable-kernel-arguments system-path root version)
+ (boot-parameters-kernel-arguments params))))))))))
+
(mlet %store-monad
((remote-results (machine-remote-eval machine remote-exp)))
- (return
- (map (lambda (remote-result)
- (match remote-result
- ((generation system-path epoch serialized-params)
- (let* ((params (call-with-input-string serialized-params
- read-boot-parameters))
- (root (boot-parameters-root-device params))
- (text (boot-parameters-label params))
- (version (boot-parameters-version params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text generation epoch))
- (kernel-arguments
- (append (bootable-kernel-arguments system-path root version)
- (boot-parameters-kernel-arguments params))))))))
- remote-results))))
+ (return (map remote-result->boot-alternative remote-results))))
(define-syntax-rule (with-roll-back should-roll-back? mbody ...)
"Catch exceptions that arise when binding MBODY, a monadic expression in
@@ -511,7 +518,8 @@ (define (deploy-managed-host machine)
(%current-target-system #f))
(let* ((os (machine-operating-system machine))
(eval (cut machine-remote-eval machine <>))
- (menu-entries (map boot-parameters->menu-entry boot-alternatives))
+ (menu-entries (map boot-alternative->menu-entry
+ boot-alternatives))
(bootloader-configuration (operating-system-bootloader os))
(bootcfg (operating-system-bootcfg os menu-entries)))
(define-syntax-rule (eval/error-handling condition handler ...)
@@ -586,7 +594,8 @@ (define (roll-back-managed-host machine)
((boot-alternatives (machine->boot-alternatives machine))
(_ -> (when (< (length boot-alternatives) 2)
(raise roll-back-failure)))
- (parameters (second boot-alternatives))
+ (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))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index 1e0d75212f..de312c7208 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -12,6 +12,7 @@
;;; Copyright © 2024 Nicolas Graves <ngraves <at> ngraves.fr>
;;; Copyright © 2024 Felix Lechner <felix.lechner <at> lease-up.com>
;;; Copyright © 2024 Herman Rimm <herman <at> rimm.ee>
+;;; Copyright © 2024 Lilah Tascheter <lilah <at> lunabee.space>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -67,9 +68,17 @@ (define-module (gnu system boot)
read-boot-parameters-file
bootable-kernel-arguments
+ boot-alternative
+ boot-alternative?
+ boot-alternative-generation
+ boot-alternative-system-path
+ boot-alternative-epoch
+ boot-alternative-parameters
+
epoch->date-string
decorated-boot-label
boot-parameters->menu-entry
+ boot-alternative->menu-entry
ensure-not-/dev
system-linux-image-file-name))
@@ -295,6 +304,13 @@ (define* (bootable-kernel-arguments system root-device version)
#~(string-append (if #$version>0? "gnu.load=" "--load=")
#$system "/boot")))))
+(define-record-type* <boot-alternative>
+ boot-alternative make-boot-alternative boot-alternative?
+ (generation boot-alternative-generation)
+ (system-path boot-alternative-system-path)
+ (epoch boot-alternative-epoch)
+ (parameters boot-alternative-parameters)) ; <boot-parameters>
+
(define (epoch->date-string epoch)
"Return a string representing the date for EPOCH seconds."
(let ((time (make-time time-utc 0 epoch)))
@@ -333,6 +349,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/guix/scripts/system.scm b/guix/scripts/system.scm
index 4ca4f1fa85..0fd153a278 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -328,25 +328,30 @@ (define-syntax-rule (unless-file-not-found exp)
#f
(apply throw args)))))
-(define (generation->boot-parameters profile number)
- "Return the 'boot-parameters' for the generation of PROFILE specified
+(define (generation->boot-alternative profile number)
+ "Return the 'boot-alternative' for the generation of PROFILE specified
by NUMBER."
(unless-file-not-found
(let* ((system (generation-file-name profile number))
(params (read-boot-parameters-file system))
(epoch (stat:mtime (lstat system)))
(text (boot-parameters-label params)))
- (boot-parameters
- (inherit params)
- (label (decorated-boot-label text number epoch))))))
+ (boot-alternative
+ (generation number)
+ (system-path system)
+ (epoch epoch)
+ (parameters
+ (boot-parameters
+ (inherit params)
+ (label (decorated-boot-label text number epoch))))))))
(define* (profile->boot-alternatives #:optional (profile %system-profile)
(numbers
(reverse (generation-numbers profile))))
- "Return a list of 'boot-parameters' for the generations of PROFILE specified
-by NUMBERS, which is a list of generation numbers. The list is ordered from
-the most recent to the oldest profiles."
- (filter-map (cut generation->boot-parameters profile <>) numbers))
+ "Return a list of 'boot-alternative' for the generations of PROFILE
+specified by NUMBERS, which is a list of generation numbers. The list is
+ordered from the most recent to the oldest profiles."
+ (filter-map (cut generation->boot-alternative profile <>) numbers))
;;;
@@ -394,7 +399,9 @@ (define (reinstall-bootloader store number)
(bootloader bootloader)))
;; Make the specified system generation the default entry.
- (params (generation->boot-parameters %system-profile number))
+ (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
@@ -404,7 +411,7 @@ (define (reinstall-bootloader store number)
(previous-boot-alternatives (profile->boot-alternatives
%system-profile old-generations))
(entries (list (boot-parameters->menu-entry params)))
- (old-entries (map boot-parameters->menu-entry
+ (old-entries (map boot-alternative->menu-entry
previous-boot-alternatives)))
(run-with-store store
(mlet* %store-monad
@@ -822,7 +829,8 @@ (define* (perform-action action image
os
(if (eq? action 'init)
'()
- (map boot-parameters->menu-entry (profile->boot-alternatives))))))
+ (map boot-alternative->menu-entry
+ (profile->boot-alternatives))))))
(when (eq? action 'reconfigure)
(maybe-suggest-running-guix-pull)
--
2.45.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.