[PATCH 00/12] Simplify bootloader data structures and procedures

Open

Details

3 participants

Felix Lechner
Herman Rimm
Lilah Tascheter

Owner: unassigned

Submitted by: Felix Lechner

Severity: normal

Felix Lechner wrote on 24 Feb 02:05 +0100

Recipients:(address . guix-patches@gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:cover.1708736440.git.felix.lechner@lease-up.com

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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 03/12] Also move boot-parameters->menu-entry.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:55f27c88ae2a7d9e6d9b73a306c267e5a312ad2a.1708736440.git.felix.lechner@lease-up.com

Change-Id: I794198e074b6d3012526a3056599ee3db1f1cdba
---
 gnu/system.scm      | 28 ----------------------------
 gnu/system/boot.scm | 24 ++++++++++++++++++++++++
 2 files changed, 24 insertions(+), 28 deletions(-)

Toggle diff (88 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 01/12] Fix bug where the extra menu entries for a bootloader were shown twice.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:25f1480b74f37095077b2cbbb8b0a169a272365d.1708736440.git.felix.lechner@lease-up.com

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(-)

Toggle diff (16 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 04/12] Rename seconds->string procedure to epoch->date-string.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:920e58bf7db229d45e078f1a2e02b6d9052e1915.1708736440.git.felix.lechner@lease-up.com

Change-Id: I2b9aaa816b3ca84c32f7d6fa690245b149228310

---

guix/scripts/system.scm | 8 ++++----

1 file changed, 4 insertions(+), 4 deletions(-)

Toggle diff (28 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 06/12] Offer a uniform decorated-boot-label and use it.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:0ec0c6abe0ee8020257c599c03485318bf9fd37f.1708736440.git.felix.lechner@lease-up.com

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(-)

Toggle diff (75 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 08/12] Rename two remote variables confusingly named 'generations'.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:4fc8cce4e11bad8521b4afb93642de7c872d2d63.1708736440.git.felix.lechner@lease-up.com

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(-)

Toggle diff (29 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 05/12] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:c339fdfe0fde00cdd111be66adaafcbd62e8143a.1708736440.git.felix.lechner@lease-up.com

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(-)

Toggle diff (106 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

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

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:f0591fbb312e8e9a0631df969748ed2047b7b587.1708736440.git.felix.lechner@lease-up.com

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(-)

Toggle diff (179 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 09/12] Give a separate name to a commonly used expression.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:d0450ee78c1249ef2cc2138a7f6526c69d9ae977.1708736440.git.felix.lechner@lease-up.com

Change-Id: I8d70684142bea736042d6c9dc8276ea7bdb9c181

---

gnu/machine/ssh.scm | 13 +++++--------

1 file changed, 5 insertions(+), 8 deletions(-)

Toggle diff (26 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 11/12] Split generation->boot-parameters out of profile->boot-alternatives.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:f5ebe1834d5a58691d812ffc57227fb13463b343.1708736440.git.felix.lechner@lease-up.com

Change-Id: I51ef1a4fa8fd18104d28a6a845707d7dedde3782

---

guix/scripts/system.scm | 28 ++++++++++++++++------------

1 file changed, 16 insertions(+), 12 deletions(-)

Toggle diff (54 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 10/12] Simplify profile->boot-alternatives.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:ab0d962a458c1d6d86ac2d87153e83efa4c24801.1708736440.git.felix.lechner@lease-up.com

Change-Id: If31eeb4cef4f5a107a0ee5ad3f117bf38629ac38

---

guix/scripts/system.scm | 14 +++++---------

1 file changed, 5 insertions(+), 9 deletions(-)

Toggle diff (32 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 07/12] Rename boot-parameters to boot-alternatives when appropriate.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:4e6ac07abb8ade8d10ce5a7c41836abebfb4ed4a.1708736440.git.felix.lechner@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.

Change-Id: Iabb04dbb39f42f989692bede7304f20a69bef9fb

---

gnu/machine/ssh.scm | 20 ++++++++++----------

guix/scripts/system.scm | 19 ++++++++++---------

2 files changed, 20 insertions(+), 19 deletions(-)

Toggle diff (110 lines)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

Felix Lechner wrote on 24 Feb 02:51 +0100

[PATCH 02/12] Move <boot-parameters> record to a separate file.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:42a9d53a4de3788e22b953927abb1a9723921e87.1708736440.git.felix.lechner@lease-up.com

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

Toggle diff (59 lines)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 on

This message was truncated. Download the full message here.

Lilah Tascheter wrote on 3 Mar 00:46 +0100

Re: Simplify bootloader data structures and procedures

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:8d254c5e232fbe7fcecaa94638dc714b3b5678c8.camel@lunabee.space

In guix/scripts/system.scm(generation->boot-alternative) system-path

isn't defined. Assuming system is supposed to be that?

Lilah Tascheter wrote on 8 Mar 09:11 +0100

[PATCH v2 00/12] Simplify bootloader data structures and procedures

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:cover.1709885528.git.lilah@lunabee.space

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

Lilah Tascheter wrote on 8 Mar 09:11 +0100

[PATCH v2 01/12] Fix bug where the extra menu entries for a bootloader were shown twice.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:8dc29d9f104ed8b62c7b952b5dcc99de8c216c8a.1709885528.git.lilah@lunabee.space

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(-)

Toggle diff (16 lines)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

Lilah Tascheter wrote on 8 Mar 09:11 +0100

[PATCH v2 02/12] Move <boot-parameters> record to a separate file.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:3dd7292b65fad15b1f808a22a7cc73560ee7d4b4.1709885528.git.lilah@lunabee.space

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

Toggle diff (467 lines)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@gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
+;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <jannek@gnu.org>
+;;; Copyright © 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner@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))
+
+      (ker

This message was truncated. Download the full message here.

Lilah Tascheter wrote on 8 Mar 09:12 +0100

[PATCH v2 04/12] Rename seconds->string procedure to epoch->date-string.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:df3d6fa439d4ccdcf6b379c1bfa27913ee3e8e90.1709885528.git.lilah@lunabee.space

* 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(-)

Toggle diff (28 lines)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

Lilah Tascheter wrote on 8 Mar 09:11 +0100

[PATCH v2 03/12] Also move boot-parameters->menu-entry.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:3ea3ac3e5c436726d19ea4df603f88d0bc861c2e.1709885528.git.lilah@lunabee.space

* 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(-)

Toggle diff (96 lines)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

Lilah Tascheter wrote on 8 Mar 09:12 +0100

[PATCH v2 06/12] Offer a uniform decorated-boot-label and use it.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:1aa5fb52ea0aaf3cffc990737140d7c169cb96c2.1709885528.git.lilah@lunabee.space

From: Felix Lechner <felix.lechner@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(-)

Toggle diff (75 lines)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

Lilah Tascheter wrote on 8 Mar 09:12 +0100

[PATCH v2 08/12] Rename two remote variables confusingly named 'generations'.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:fb0fc5e3cd2ee69221b0e443e9c905e72995cf30.1709885528.git.lilah@lunabee.space

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(-)

Toggle diff (29 lines)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

Lilah Tascheter wrote on 8 Mar 09:12 +0100

[PATCH v2 05/12] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:7adf6f188991d9d7052adb0056c0fb8b618c5059.1709885528.git.lilah@lunabee.space

From: Felix Lechner <felix.lechner@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(-)

Toggle diff (106 lines)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

Lilah Tascheter wrote on 8 Mar 09:12 +0100

[PATCH v2 07/12] Rename boot-parameters to boot-alternatives when appropriate.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:7c47238a38488fdb2f509c2a021c183f645cbc11.1709885528.git.lilah@lunabee.space

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(-)

Toggle diff (110 lines)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

Lilah Tascheter wrote on 8 Mar 09:12 +0100

[PATCH v2 10/12] Simplify profile->boot-alternatives.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:12f5292170b873f491330a10a048af52232405aa.1709885528.git.lilah@lunabee.space

* 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(-)

Toggle diff (32 lines)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

Lilah Tascheter wrote on 8 Mar 09:12 +0100

[PATCH v2 11/12] Split generation->boot-parameters out of profile->boot-alternatives.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:05ea87298e8731b00fa7127e97a6b497ae391695.1709885528.git.lilah@lunabee.space

* 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(-)

Toggle diff (54 lines)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

Lilah Tascheter wrote on 8 Mar 09:12 +0100

[PATCH v2 09/12] Give a separate name to a commonly used expression.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:6b8cc8a8b8b13d0c06ffba22585a485bb96fd562.1709885528.git.lilah@lunabee.space

* 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(-)

Toggle diff (26 lines)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

Lilah Tascheter wrote on 8 Mar 09:12 +0100

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

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:1242fe7e331528023c6d2a4768256d8f48607b34.1709885528.git.lilah@lunabee.space

* 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(-)

Toggle diff (179 lines)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

Felix Lechner wrote on 8 Mar 17:33 +0100

Re: Simplify bootloader data structures and procedures

Recipients:(name . Lilah Tascheter)(address . lilah@lunabee.space)(address . 69343@patchwise.org)

Message-ID:87jzmcwumv.fsf@lease-up.com

Hi Lilah,

On Fri, Mar 08 2024, Lilah Tascheter wrote:

Toggle quote (3 lines)

> 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.

Toggle quote (2 lines)

> * (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.

Toggle quote (4 lines)

> * (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.

Toggle quote (3 lines)

> * 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.

Toggle quote (2 lines)

> * 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.

Toggle quote (3 lines)

> * 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.

Toggle quote (4 lines)

> 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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 00/12] Simplify bootloader data structures and procedures

Recipients:(address . 69343@debbugs.gnu.org)(name . Lilah Tascheter)(address . lilah@lunabee.space)

Message-ID:cover.1722741214.git.lilah@lunabee.space

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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 01/12] Fix bug where the extra menu entries for a bootloader were shown twice.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:048a294013321d432030a71007d7386d2f1308d7.1722741214.git.lilah@lunabee.space

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(-)

Toggle diff (16 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 03/12] Also move boot-parameters->menu-entry.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:9f0909b3323fd6dda448e7c9b36f9c46115dc778.1722741214.git.lilah@lunabee.space

* 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(-)

Toggle diff (96 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 02/12] Move <boot-parameters> record to a separate file.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:84d2bacfdda34a9c8be2ed13b3d348280f9ba2ef.1722741214.git.lilah@lunabee.space

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

Toggle diff (457 lines)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@gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
+;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <jannek@gnu.org>
+;;; Copyright © 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner@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 b

This message was truncated. Download the full message here.

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 04/12] Rename seconds->string procedure to epoch->date-string.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:df1d58f482a90f5e5c67a08aaff1673dc319fdca.1722741214.git.lilah@lunabee.space

* 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(-)

Toggle diff (28 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 05/12] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:d9708ecbc7b3b10ffed7a78d6076e5ffaaef25d5.1722741214.git.lilah@lunabee.space

From: Felix Lechner <felix.lechner@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(-)

Toggle diff (106 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 06/12] Offer a uniform decorated-boot-label and use it.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:1cd48d746543091532044ffa979cacc17f725cc7.1722741214.git.lilah@lunabee.space

From: Felix Lechner <felix.lechner@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(-)

Toggle diff (75 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 07/12] Rename boot-parameters to boot-alternatives when appropriate.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:0bc81e0b885d720e8b094a64f22253248425e787.1722741214.git.lilah@lunabee.space

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(-)

Toggle diff (110 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 08/12] Rename two remote variables confusingly named 'generations'.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:e868e6475ecb703122792bc93b831d4ac5885bc8.1722741214.git.lilah@lunabee.space

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(-)

Toggle diff (29 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 09/12] Give a separate name to a commonly used expression.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:907087c7d2f0161e1c7800430c6017d2b4b92b9a.1722741214.git.lilah@lunabee.space

* 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(-)

Toggle diff (26 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 10/12] Simplify profile->boot-alternatives.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:6b454e5cd048626a4f32bcec0d135f700f705b92.1722741214.git.lilah@lunabee.space

* 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(-)

Toggle diff (32 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

[PATCH v3 11/12] Split generation->boot-parameters out of profile->boot-alternatives.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:009964ba87f3458ce70ce14f3106c46971cb57ef.1722741214.git.lilah@lunabee.space

* 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(-)

Toggle diff (54 lines)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

Lilah Tascheter wrote on 4 Aug 05:13 +0200

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

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:7d781027c78bdea5fdb3f1c9c9ec432b9606d2b5.1722741214.git.lilah@lunabee.space

* 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(-)

Toggle diff (179 lines)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

Herman Rimm wrote on 5 Sep 09:13 +0200

Re: [bug#69343] [PATCH v3 00/12] Simplify bootloader data structures and procedures

Recipients:(address . 69343@debbugs.gnu.org)(name . Lilah Tascheter)(address . lilah@lunabee.space)

Message-ID:hz5fnapfxgltu5k3ib2pp4xcdm4tazkic4ia6dkccxd2go5rhp@w76pordmlmtz

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

Lilah Tascheter wrote on 20 Sep 06:15 +0200

[PATCH v4 00/11] Simplify bootloader data structures and procedures

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:cover.1726805765.git.lilah@lunabee.space

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

Lilah Tascheter wrote on 20 Sep 06:15 +0200

[PATCH v4 01/11] Fix bug where the extra menu entries for a bootloader were shown twice.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:048a294013321d432030a71007d7386d2f1308d7.1726805765.git.lilah@lunabee.space

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(-)

Toggle diff (16 lines)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

Lilah Tascheter wrote on 20 Sep 06:15 +0200

[PATCH v4 03/11] Rename seconds->string procedure to epoch->date-string.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:26815704b0d1122f45aeaca6e30438c713cf76c1.1726805765.git.lilah@lunabee.space

* 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(-)

Toggle diff (28 lines)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

Lilah Tascheter wrote on 20 Sep 06:15 +0200

[PATCH v4 02/11] Move <boot-parameters> record to a separate file.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:1f574c422d47205d1f5e0fc139959d0e93280576.1726805765.git.lilah@lunabee.space

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

Toggle diff (468 lines)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@gnu.org>
+;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2015, 2016 Alex Kost <alezost@gmail.com>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019 Meiyo Peng <meiyo.peng@gmail.com>
+;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020, 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <jannek@gnu.org>
+;;; Copyright © 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
+;;; Copyright © 2023 Felix Lechner <felix.lechner@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

This message was truncated. Download the full message here.

Lilah Tascheter wrote on 20 Sep 06:15 +0200

[PATCH v4 04/11] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:a7f035efc6e491e7e462fa1b5887a3e680ec4ad8.1726805765.git.lilah@lunabee.space

From: Felix Lechner <felix.lechner@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(-)

Toggle diff (106 lines)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

Lilah Tascheter wrote on 20 Sep 06:15 +0200

[PATCH v4 05/11] Offer a uniform decorated-boot-label and use it.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:8715f3e79e6b1dff09eb2c4c04d23af14b1247ba.1726805765.git.lilah@lunabee.space

From: Felix Lechner <felix.lechner@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(-)

Toggle diff (75 lines)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

Lilah Tascheter wrote on 20 Sep 06:16 +0200

[PATCH v4 06/11] Rename boot-parameters to boot-alternatives when appropriate.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:d3644424ddb20346d8a1888287101b7919aee3af.1726805765.git.lilah@lunabee.space

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(-)

Toggle diff (110 lines)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

Lilah Tascheter wrote on 20 Sep 06:16 +0200

[PATCH v4 07/11] Rename two remote variables confusingly named 'generations'.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:849f65d3453b94dcef8c572a8486196695d865bb.1726805765.git.lilah@lunabee.space

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(-)

Toggle diff (30 lines)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

Lilah Tascheter wrote on 20 Sep 06:16 +0200

[PATCH v4 09/11] Simplify profile->boot-alternatives.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:5cfea442dfbae70e44123556783d4df9e69113be.1726805765.git.lilah@lunabee.space

* 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(-)

Toggle diff (32 lines)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

Lilah Tascheter wrote on 20 Sep 06:16 +0200

[PATCH v4 08/11] Give a separate name to a commonly used expression.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:6e4fc53df2ff12590bfa557c38f4ea03446f5749.1726805765.git.lilah@lunabee.space

* 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(-)

Toggle diff (60 lines)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

Lilah Tascheter wrote on 20 Sep 06:16 +0200

[PATCH v4 10/11] Split generation->boot-parameters out of profile->boot-alternatives.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:852043d05b73160c4613e209130a527fb1f7a5ce.1726805765.git.lilah@lunabee.space

* 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(-)

Toggle diff (54 lines)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

Lilah Tascheter wrote on 20 Sep 06:16 +0200

[PATCH v4 11/11] Encapsulate <boot-parameters> to retain generation, system-path and epoch.

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:5440f547c4fd458acdc327afeded9a6067e98124.1726805765.git.lilah@lunabee.space

* 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(-)

Toggle diff (171 lines)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 wrote on 20 Sep 15:42 +0200

Recipients:(address . control@debbugs.gnu.org)

Message-ID:23990aeff364fc233963f4801b269f91c80ed9b7.camel@lunabee.space

block 73202 with 69343

block 72457 with 73202

Herman Rimm wrote on 21 Sep 12:23 +0200

Recipients:(address . 69343@debbugs.gnu.org)

Message-ID:cover.1726913452.git.herman@rimm.ee

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

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 01/10] Fix bug where the extra menu entries for a bootloader were shown twice.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:485412da830c8b9a6d4ad4d98aec168eba9a6a3a.1726913452.git.herman@rimm.ee

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(-)

Toggle diff (16 lines)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

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 02/10] Move <boot-parameters> record to a separate file.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:cee6388d584da07748378256a133492c0be0a70d.1726913452.git.herman@rimm.ee

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

Toggle diff (466 lines)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@gnu.org>
+;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2017 David Craven <david@craven.ch>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
+;;; Copyright © 2019, 2020 Miguel Ángel Arruga Vivas <rosen644835@gmail.com>
+;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org>
+;;; Copyright © 2020 Stefan <stefan-guix@vodafonemail.de>
+;;; Copyright © 2020, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2020 Janneke Nieuwenhuizen <jannek@gnu.org>
+;;; Copyright © 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu system boot)
+  #:use-module (guix gexp)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
+  #:use-module (guix records)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu system file-systems)
+  #:use-module (gnu system uuid)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (rnrs bytevectors)
+  #:export (boot-parameters
+            boot-parameters?
+            boot-parameters-label
+            boot-parameters-root-device
+            boot-parameters-bootloader-name
+            boot-parameters-bootloader-menu-entries
+            boot-parameters-store-crypto-devices
+            boot-parameters-store-device
+            boot-parameters-store-directory-prefix
+            boot-parameters-store-mount-point
+            boot-parameters-locale
+            boot-parameters-kernel
+            boot-parameters-kernel-arguments
+            boot-parameters-initrd
+            boot-parameters-multiboot-modules
+            boot-parameters-version
+            %boot-parameters-version
+
+            read-boot-parameters
+            read-boot-parameters-file
+            bootable-kernel-arguments
+
+            boot-parameters->menu-entry
+
+            ensure-not-/dev
+            system-linux-image-file-name))
+
+;;;
+;;; Boot parameters
+;;;
+
+;;; Version 1 was introduced early 2022 to mark the departure from long option
+;;; names such as '--load' to the more conventional initrd option names like
+;;; 'gnu.load'.
+;;;
+;;; When bumping the boot-parameters version, increment it by one (1).
+(define %boot-parameters-version 1)
+
+(define-record-type* <boot-parameters>
+  boot-parameters make-boot-parameters boot-parameters?
+  (label            boot-parameters-label)
+  ;; Because we will use the 'store-device' to create the GRUB search command,
+  ;; the 'store-device' has slightly different semantics than 'root-device'.
+  ;; The 'store-device' can be a file system uuid, a file system label, or #f,
+  ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
+  ;; not understand that.  The 'root-device', on the other hand, corresponds
+  ;; exactly to the device field of the <file-system> object representing the
+  ;; OS's root file system, so it might be a device file name like
+  ;; "/dev/sda3".  The 'store-directory-prefix' field contains #f or the store
+  ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
+  ;; contain "/storefs" if the s

This message was truncated. Download the full message here.

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 03/10] Rename seconds->string procedure to epoch->date-string.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:d944345dd82dfce11edb8c9a3f518fd73c65a5c2.1726913452.git.herman@rimm.ee

* 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(-)

Toggle diff (28 lines)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

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 04/10] Move epoch->date-string to gnu/system/boot.scm and use it elsewhere.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:c9dace7f7e80907dddcac5d050fc2c7152c23207.1726913452.git.herman@rimm.ee

From: Felix Lechner <felix.lechner@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(-)

Toggle diff (106 lines)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

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 05/10] Offer a uniform decorated-boot-label and use it.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:f734db8e278920da59c704357a6bd0372ef43c6d.1726913452.git.herman@rimm.ee

From: Felix Lechner <felix.lechner@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(-)

Toggle diff (82 lines)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@gnu.org>
 ;;; Copyright © 2020, 2022 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
+;;; Copyright © 2024 Felix Lechner <felix.lechner@lease-up.com>
+;;; Copyright © 2024 Herman Rimm <herman@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

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 06/10] Rename boot-parameters to boot-alternatives when appropriate.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:17be076dc405f409a84bb566d4f5c226e62d6ae8.1726913452.git.herman@rimm.ee

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(-)

Toggle diff (110 lines)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

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 07/10] Rename two remote variables confusingly named 'generations'.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:5a7c148ce2d6c4838d543a4dcca845d69fe059d8.1726913452.git.herman@rimm.ee

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(-)

Toggle diff (30 lines)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

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 08/10] Give a separate name to a commonly used expression.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:0780c8928d26c112af681337065755bc84697487.1726913452.git.herman@rimm.ee

* 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(-)

Toggle diff (61 lines)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

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 09/10] Split system->boot-parameters out of profile->boot-alternatives.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:470795ee2a6bcf10608519c5cf2579ce4f7092c3.1726913452.git.herman@rimm.ee

* 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(-)

Toggle diff (56 lines)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

Herman Rimm wrote on 21 Sep 12:23 +0200

[PATCH v5 10/10] Encapsulate <boot-parameters> to retain generation, system-path and epoch.

Recipients:(address . 69343@debbugs.gnu.org)(name . Felix Lechner)(address . felix.lechner@lease-up.com)

Message-ID:8edc2882011d47a2263f3d8069defb30427f6d96.1726913452.git.herman@rimm.ee

* 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(-)

Toggle diff (213 lines)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@ngraves.fr>
 ;;; Copyright © 2024 Felix Lechner <felix.lechner@lease-up.com>
 ;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
+;;; Copyright © 2024 Lilah Tascheter <lilah@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

Your comment

Commenting via the web interface is currently disabled.

To comment on this conversation send an email to 69343@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it

mumi current 69343

Then, you may apply the latest patchset in this issue (with sign off)

mumi am -- -s

Or, compose a reply to this issue

mumi compose

Or, send patches to this issue

mumi send-email *.patch

is:open	open issues
is:done	closed issues
submitter:<who>	search issue submitter
author:<who>	search by message author
date:yesterday..now	search by issue date
mdate:3m..2d	search by message date