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
View this message in rfc822 format
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>, Christopher Baines <guix <at> cbaines.net>, Josselin Poiret <dev <at> jpoiret.xyz>, Ludovic Court??s <ludo <at> gnu.org>, Mathieu Othacehe <othacehe <at> gnu.org>, Simon Tournier <zimon.toutoune <at> gmail.com>, Tobias Geerinckx-Rice <me <at> tobias.gr> Subject: [bug#69343] [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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.