[bug#69343] [PATCH 12/12] Encapsulate <boot-parameters> to retain generation, system-path and epoch.

[Felix Lechner via Guix-patches via <guix-patches@gnu.org>]

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))
 
 \f
@@ -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