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

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

[Felix Lechner via Guix-patches via]

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

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

[Felix Lechner via Guix-patches via]

The extra menu entries are already being added in each bootloaders, as
applicable.
---
 guix/scripts/system.scm | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bf3d2f9044..955dfa618d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -407,8 +407,7 @@ (define (reinstall-bootloader store number)
           (delv number (reverse (generation-numbers %system-profile))))
          (old-params (profile-boot-parameters
                        %system-profile old-generations))
-         (entries (cons (boot-parameters->menu-entry params)
-                        (boot-parameters-bootloader-menu-entries params)))
+         (entries (list (boot-parameters->menu-entry params)))
          (old-entries (map boot-parameters->menu-entry old-params)))
     (run-with-store store
       (mlet* %store-monad
-- 
2.41.0

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

[Felix Lechner via Guix-patches via]

Without it, the following commit following this one causes 'guix pull' to fail
with this message:

\r[  0/ 50] loading...	  0.0% of 25 files\r[  1/ 50] loading...	  4.0% of 25 files\r[  2/ 50] loading...	  8.0% of 25 files\r[  3/ 50] loading...	 12.0% of 25 files\r[  4/ 50] loading...	 16.0% of 25 files\r[  5/ 50] loading...	 20.0% of 25 files\r[  6/ 50] loading...	 24.0% of 25 files\r[  7/ 50] loading...	 28.0% of 25 files\r[  8/ 50] loading...	 32.0% of 25 files\r[  9/ 50] loading...	 36.0% of 25 files\r[ 10/ 50] loading...	 40.0% of 25 files\r[ 11/ 50] loading...	 44.0% of 25 files\r[ 12/ 50] loading...	 48.0% of 25 files\r[ 13/ 50] loading...	 52.0% of 25 files\r[ 14/ 50] loading...	 56.0% of 25 files\r[ 15/ 50] loading...	 60.0% of 25 files\r[ 16/ 50] loading...	 64.0% of 25 files\r[ 17/ 50] loading...	 68.0% of 25 files\r[ 18/ 50] loading...	 72.0% of 25 files\r[ 19/ 50] loading...	 76.0% of 25 files\r[ 20/ 50] loading...	 80.0% of 25 files\r[ 21/ 50] loading...	 84.0% of 25 files\r[ 22/ 50] loading...	 88.0% of 25 files\r[ 23/ 50] loading...	 92.0% of 25 files\r[ 24/ 50] loading...	 96.0% of 25 files\r[ 25/ 50] loading...	100.0% of 25 files\r[ 25/ 50] compiling...	  0.0% of 25 files\r[ 26/ 50] compiling...	  4.0% of 25 files\r[ 27/ 50] compiling...	  8.0% of 25 files\r[ 28/ 50] compiling...	 12.0% of 25 files\r[ 29/ 50] compiling...	 16.0% of 25 files\r[ 30/ 50] compiling...	 20.0% of 25 files\r[ 31/ 50] compiling...	 24.0% of 25 files\r[ 32/ 50] compiling...	 28.0% of 25 files\r[ 33/ 50] compiling...	 32.0% of 25 files\r[ 34/ 50] compiling...	 36.0% of 25 files\r[ 35/ 50] compiling...	 40.0% of 25 files\r[ 36/ 50] compiling...	 44.0% of 25 files\r[ 37/ 50] compiling...	 48.0% of 25 files\r[ 38/ 50] compiling...	 52.0% of 25 files\r[ 39/ 50] compiling...	 56.0% of 25 files\r[ 40/ 50] compiling...	 60.0% of 25 files\r[ 41/ 50] compiling...	 64.0% of 25 files\r[ 42/ 50] compiling...	 68.0% of 25 files\r[ 43/ 50] compiling...	 72.0% of 25 files\r[ 44/ 50] compiling...	 76.0% of 25 files\r[ 45/ 50] compiling...	 80.0% of 25 files\r[ 46/ 50] compiling...	 84.0% of 25 files\r[ 47/ 50] compiling...	 88.0% of 25 files\r[ 48/ 50] compiling...	 92.0% of 25 files\r[ 49/ 50] compiling...	 96.0% of 25 files\r[ 50/ 50] compiling...	100.0% of 25 files\r[  0/ 50] loading...	  0.0% of 25 files\r[  1/ 50] loading...	  4.0% of 25 files\r[  2/ 50] loading...	  8.0% of 25 files\r[  3/ 50] loading...	 12.0% of 25 files\r[  4/ 50] loading...	 16.0% of 25 files\r[  5/ 50] loading...	 20.0% of 25 files\r[  6/ 50] loading...	 24.0% of 25 files\r[  7/ 50] loading...	 28.0% of 25 files\r[  8/ 50] loading...	 32.0% of 25 files\r[  9/ 50] loading...	 36.0% of 25 files\r[ 10/ 50] loading...	 40.0% of 25 files\r[ 11/ 50] loading...	 44.0% of 25 files\r[ 12/ 50] loading...	 48.0% of 25 files\r[ 13/ 50] loading...	 52.0% of 25 files\r[ 14/ 50] loading...	 56.0% of 25 files\r[ 15/ 50] loading...	 60.0% of 25 files\r[ 16/ 50] loading...	 64.0% of 25 files\r[ 17/ 50] loading...	 68.0% of 25 files\r[ 18/ 50] loading...	 72.0% of 25 files\r[ 19/ 50] loading...	 76.0% of 25 files\r[ 20/ 50] loading...	 80.0% of 25 files\r[ 21/ 50] loading...	 84.0% of 25 files\r[ 22/ 50] loading...	 88.0% of 25 files\r[ 23/ 50] loading...	 92.0% of 25 files\r[ 24/ 50] loading...	 96.0% of 25 files\r[ 25/ 50] loading...	100.0% of 25 files\r[ 25/ 50] compiling...	  0.0% of 25 files\r[ 26/ 50] compiling...	  4.0% of 25 files\r[ 27/ 50] compiling...	  8.0% of 25 files\r[ 28/ 50] compiling...	 12.0% of 25 files\r[ 29/ 50] compiling...	 16.0% of 25 files\r[ 30/ 50] compiling...	 20.0% of 25 files\r[ 31/ 50] compiling...	 24.0% of 25 files\r[ 32/ 50] compiling...	 28.0% of 25 files\r[ 33/ 50] compiling...	 32.0% of 25 files\r[ 34/ 50] compiling...	 36.0% of 25 files\r[ 35/ 50] compiling...	 40.0% of 25 files\r[ 36/ 50] compiling...	 44.0% of 25 files\r[ 37/ 50] compiling...	 48.0% of 25 files\r[ 38/ 50] compiling...	 52.0% of 25 files\r[ 39/ 50] compiling...	 56.0% of 25 files\r[ 40/ 50] compiling...	 60.0% of 25 files\r[ 41/ 50] compiling...	 64.0% of 25 files\r[ 42/ 50] compiling...	 68.0% of 25 files\r[ 43/ 50] compiling...	 72.0% of 25 files\r[ 44/ 50] compiling...	 76.0% of 25 files\r[ 45/ 50] compiling...	 80.0% of 25 files\r[ 46/ 50] compiling...	 84.0% of 25 files\r[ 47/ 50] compiling...	 88.0% of 25 files\r[ 48/ 50] compiling...	 92.0% of 25 files\r[ 49/ 50] compiling...	 96.0% of 25 files\r[ 50/ 50] compiling...	100.0% of 25 files\r[  0/ 50] loading...	  0.0% of 25 files\r[  1/ 50] loading...	  4.0% of 25 files\r[  2/ 50] loading...	  8.0% of 25 files\r[  3/ 50] loading...	 12.0% of 25 files\r[  4/ 50] loading...	 16.0% of 25 files\r[  5/ 50] loading...	 20.0% of 25 files\r[  6/ 50] loading...	 24.0% of 25 files\r[  7/ 50] loading...	 28.0% of 25 files\r[  8/ 50] loading...	 32.0% of 25 files\r[  9/ 50] loading...	 36.0% of 25 files\r[ 10/ 50] loading...	 40.0% of 25 files\r[ 11/ 50] loading...	 44.0% of 25 files\r[ 12/ 50] loading...	 48.0% of 25 files\r[ 13/ 50] loading...	 52.0% of 25 files\r[ 14/ 50] loading...	 56.0% of 25 files\r[ 15/ 50] loading...	 60.0% of 25 files\r[ 16/ 50] loading...	 64.0% of 25 files\r[ 17/ 50] loading...	 68.0% of 25 files\r[ 18/ 50] loading...	 72.0% of 25 files\r[ 19/ 50] loading...	 76.0% of 25 files\r[ 20/ 50] loading...	 80.0% of 25 files\r[ 21/ 50] loading...	 84.0% of 25 files\r[ 22/ 50] loading...	 88.0% of 25 files\r[ 23/ 50] loading...	 92.0% of 25 files\r[ 24/ 50] loading...	 96.0% of 25 files\r[ 25/ 50] loading...	100.0% of 25 files\r[ 25/ 50] compiling...	  0.0% of 25 files\r[ 26/ 50] compiling...	  4.0% of 25 files\r[ 27/ 50] compiling...	  8.0% of 25 files\r[ 28/ 50] compiling...	 12.0% of 25 files\r[ 29/ 50] compiling...	 16.0% of 25 files\r[ 30/ 50] compiling...	 20.0% of 25 files\r[ 31/ 50] compiling...	 24.0% of 25 files\r[ 32/ 50] compiling...	 28.0% of 25 files\r[ 33/ 50] compiling...	 32.0% of 25 files\r[ 34/ 50] compiling...	 36.0% of 25 files\r[ 35/ 50] compiling...	 40.0% of 25 files\r[ 36/ 50] compiling...	 44.0% of 25 files\r[ 37/ 50] compiling...	 48.0% of 25 files\r[ 38/ 50] compiling...	 52.0% of 25 files\r[ 39/ 50] compiling...	 56.0% of 25 files\r[ 40/ 50] compiling...	 60.0% of 25 files\r[ 41/ 50] compiling...	 64.0% of 25 files\r[ 42/ 50] compiling...	 68.0% of 25 files\r[ 43/ 50] compiling...	 72.0% of 25 files\r[ 44/ 50] compiling...	 76.0% of 25 files\r[ 45/ 50] compiling...	 80.0% of 25 files\r[ 46/ 50] compiling...	 84.0% of 25 files\r[ 47/ 50] compiling...	 88.0% of 25 files\r[ 48/ 50] compiling...	 92.0% of 25 files\r[ 49/ 50] compiling...	 96.0% of 25 files\r[ 50/ 50] compiling...	100.0% of 25 files\r[  0/ 50] loading...	  0.0% of 25 files\r[  1/ 50] loading...	  4.0% of 25 files\r[  2/ 50] loading...	  8.0% of 25 files\r[  3/ 50] loading...	 12.0% of 25 files\r[  4/ 50] loading...	 16.0% of 25 files\r[  5/ 50] loading...	 20.0% of 25 files\r[  6/ 50] loading...	 24.0% of 25 files\r[  7/ 50] loading...	 28.0% of 25 files\r[  8/ 50] loading...	 32.0% of 25 files\r[  9/ 50] loading...	 36.0% of 25 files\r[ 10/ 50] loading...	 40.0% of 25 files\r[ 11/ 50] loading...	 44.0% of 25 files\r[ 12/ 50] loading...	 48.0% of 25 files\r[ 13/ 50] loading...	 52.0% of 25 files\r[ 14/ 50] loading...	 56.0% of 25 files\r[ 15/ 50] loading...	 60.0% of 25 files\r[ 16/ 50] loading...	 64.0% of 25 files\r[ 17/ 50] loading...	 68.0% of 25 files\r[ 18/ 50] loading...	 72.0% of 25 files\r[ 19/ 50] loading...	 76.0% of 25 files\r[ 20/ 50] loading...	 80.0% of 25 files\r[ 21/ 50] loading...	 84.0% of 25 files\r[ 22/ 50] loading...	 88.0% of 25 files\r[ 23/ 50] loading...	 92.0% of 25 files\r[ 24/ 50] loading...	 96.0% of 25 files\r[ 25/ 50] loading...	100.0% of 25 files\r[ 25/ 50] compiling...	  0.0% of 25 files\r[ 26/ 50] compiling...	  4.0% of 25 files\r[ 27/ 50] compiling...	  8.0% of 25 files\r[ 28/ 50] compiling...	 12.0% of 25 files\r[ 29/ 50] compiling...	 16.0% of 25 files\r[ 30/ 50] compiling...	 20.0% of 25 files\r[ 31/ 50] compiling...	 24.0% of 25 files\r[ 32/ 50] compiling...	 28.0% of 25 files\r[ 33/ 50] compiling...	 32.0% of 25 files\r[ 34/ 50] compiling...	 36.0% of 25 files\r[ 35/ 50] compiling...	 40.0% of 25 files\r[ 36/ 50] compiling...	 44.0% of 25 files\r[ 37/ 50] compiling...	 48.0% of 25 files\r[ 38/ 50] compiling...	 52.0% of 25 files\r[ 39/ 50] compiling...	 56.0% of 25 files\r[ 40/ 50] compiling...	 60.0% of 25 files\r[ 41/ 50] compiling...	 64.0% of 25 files\r[ 42/ 50] compiling...	 68.0% of 25 files\r[ 43/ 50] compiling...	 72.0% of 25 files\r[ 44/ 50] compiling...	 76.0% of 25 files\r[ 45/ 50] compiling...	 80.0% of 25 files\r[ 46/ 50] compiling...	 84.0% of 25 files\r[ 47/ 50] compiling...	 88.0% of 25 files\r[ 48/ 50] compiling...	 92.0% of 25 files\r[ 49/ 50] compiling...	 96.0% of 25 files\r[ 50/ 50] compiling...	100.0% of 25 files\r[  0/ 50] loading...	  0.0% of 25 files\r[  1/ 50] loading...	  4.0% of 25 files\r[  2/ 50] loading...	  8.0% of 25 files\r[  3/ 50] loading...	 12.0% of 25 files\r[  4/ 50] loading...	 16.0% of 25 files\r[  5/ 50] loading...	 20.0% of 25 files\r[  6/ 50] loading...	 24.0% of 25 files\r[  7/ 50] loading...	 28.0% of 25 files\r[  8/ 50] loading...	 32.0% of 25 files\r[  9/ 50] loading...	 36.0% of 25 files\r[ 10/ 50] loading...	 40.0% of 25 files\r[ 11/ 50] loading...	 44.0% of 25 files\r[ 12/ 50] loading...	 48.0% of 25 files\r[ 13/ 50] loading...	 52.0% of 25 files\r[ 14/ 50] loading...	 56.0% of 25 files\r[ 15/ 50] loading...	 60.0% of 25 files\r[ 16/ 50] loading...	 64.0% of 25 files\r[ 17/ 50] loading...	 68.0% of 25 files\r[ 18/ 50] loading...	 72.0% of 25 files\r[ 19/ 50] loading...	 76.0% of 25 files\r[ 20/ 50] loading...	 80.0% of 25 files\r[ 21/ 50] loading...	 84.0% of 25 files\r[ 22/ 50] loading...	 88.0% of 25 files\r[ 23/ 50] loading...	 92.0% of 25 files\r[ 24/ 50] loading...	 96.0% of 25 files\r[ 25/ 50] loading...	100.0% of 25 files\r[ 25/ 50] compiling...	  0.0% of 25 files\r[ 26/ 50] compiling...	  4.0% of 25 files\r[ 27/ 50] compiling...	  8.0% of 25 files\r[ 28/ 50] compiling...	 12.0% of 25 files\r[ 29/ 50] compiling...	 16.0% of 25 files\r[ 30/ 50] compiling...	 20.0% of 25 files\r[ 31/ 50] compiling...	 24.0% of 25 files\r[ 32/ 50] compiling...	 28.0% of 25 files\r[ 33/ 50] compiling...	 32.0% of 25 files\r[ 34/ 50] compiling...	 36.0% of 25 files\r[ 35/ 50] compiling...	 40.0% of 25 files\r[ 36/ 50] compiling...	 44.0% of 25 files\r[ 37/ 50] compiling...	 48.0% of 25 files\r[ 38/ 50] compiling...	 52.0% of 25 files\r[ 39/ 50] compiling...	 56.0% of 25 files\r[ 40/ 50] compiling...	 60.0% of 25 files\r[ 41/ 50] compiling...	 64.0% of 25 files\r[ 42/ 50] compiling...	 68.0% of 25 files\r[ 43/ 50] compiling...	 72.0% of 25 files\r[ 44/ 50] compiling...	 76.0% of 25 files\r[ 45/ 50] compiling...	 80.0% of 25 files\r[ 46/ 50] compiling...	 84.0% of 25 files\r[ 47/ 50] compiling...	 88.0% of 25 files\r[ 48/ 50] compiling...	 92.0% of 25 files\r[ 49/ 50] compiling...	 96.0% of 25 files\r[ 50/ 50] compiling...	100.0% of 25 files\r[  0/ 50] loading...	  0.0% of 25 files\r[  1/ 50] loading...	  4.0% of 25 files\r[  2/ 50] loading...	  8.0% of 25 files\r[  3/ 50] loading...	 12.0% of 25 files\r[  4/ 50] loading...	 16.0% of 25 files\r[  5/ 50] loading...	 20.0% of 25 files\r[  6/ 50] loading...	 24.0% of 25 files\r[  7/ 50] loading...	 28.0% of 25 files\r[  8/ 50] loading...	 32.0% of 25 files\r[  9/ 50] loading...	 36.0% of 25 files\r[ 10/ 50] loading...	 40.0% of 25 files\r[ 11/ 50] loading...	 44.0% of 25 files\r[ 12/ 50] loading...	 48.0% of 25 files\r[ 13/ 50] loading...	 52.0% of 25 files\r[ 14/ 50] loading...	 56.0% of 25 files\r[ 15/ 50] loading...	 60.0% of 25 files\r[ 16/ 50] loading...	 64.0% of 25 files\r[ 17/ 50] loading...	 68.0% of 25 files\r[ 18/ 50] loading...	 72.0% of 25 files\r[ 19/ 50] loading...	 76.0% of 25 files\r[ 20/ 50] loading...	 80.0% of 25 files\r[ 21/ 50] loading...	 84.0% of 25 files\r[ 22/ 50] loading...	 88.0% of 25 files\r[ 23/ 50] loading...	 92.0% of 25 files\r[ 24/ 50] loading...	 96.0% of 25 files\r[ 25/ 50] loading...	100.0% of 25 files\r[ 25/ 50] compiling...	  0.0% of 25 files\r[ 26/ 50] compiling...	  4.0% of 25 files\r[ 27/ 50] compiling...	  8.0% of 25 files\r[ 28/ 50] compiling...	 12.0% of 25 files\r[ 29/ 50] compiling...	 16.0% of 25 files\r[ 30/ 50] compiling...	 20.0% of 25 files\r[ 31/ 50] compiling...	 24.0% of 25 files\r[ 32/ 50] compiling...	 28.0% of 25 files\r[ 33/ 50] compiling...	 32.0% of 25 files\r[ 34/ 50] compiling...	 36.0% of 25 files\r[ 35/ 50] compiling...	 40.0% of 25 files\r[ 36/ 50] compiling...	 44.0% of 25 files\r[ 37/ 50] compiling...	 48.0% of 25 files\r[ 38/ 50] compiling...	 52.0% of 25 files\r[ 39/ 50] compiling...	 56.0% of 25 files\r[ 40/ 50] compiling...	 60.0% of 25 files\r[ 41/ 50] compiling...	 64.0% of 25 files\r[ 42/ 50] compiling...	 68.0% of 25 files\r[ 43/ 50] compiling...	 72.0% of 25 files\r[ 44/ 50] compiling...	 76.0% of 25 files\r[ 45/ 50] compiling...	 80.0% of 25 files\r[ 46/ 50] compiling...	 84.0% of 25 files\r[ 47/ 50] compiling...	 88.0% of 25 files\r[ 48/ 50] compiling...	 92.0% of 25 files\r[ 49/ 50] compiling...	 96.0% of 25 files\r[ 50/ 50] compiling...	100.0% of 25 files\r[  0/ 50] loading...	  0.0% of 25 files\r[  1/ 50] loading...	  4.0% of 25 filesBacktrace:
In ice-9/boot-9.scm:
   222:29 19 (map1 (((gnu packages nano)) ((gnu packages nvi)) ((gnu packages package-management)) ((gnu packages pciutils)) ((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu # wget)) ?))
   222:29 18 (map1 (((gnu packages nvi)) ((gnu packages package-management)) ((gnu packages pciutils)) ((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu packages wget)) ((gnu #)) ((?)) ?))
   222:29 17 (map1 (((gnu packages package-management)) ((gnu packages pciutils)) ((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu packages wget)) ((gnu services)) ((gnu services #)) ?))
   222:29 16 (map1 (((gnu packages pciutils)) ((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu packages wget)) ((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((# ?)) ?))
   222:29 15 (map1 (((gnu packages texinfo)) ((gnu packages text-editors)) ((gnu packages wget)) ((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((gnu bootloader)) ((gnu # #)) # ?))
   222:29 14 (map1 (((gnu packages text-editors)) ((gnu packages wget)) ((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((gnu bootloader)) ((gnu system shadow)) ((gnu system #)) ?))
   222:29 13 (map1 (((gnu packages wget)) ((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((gnu bootloader)) ((gnu system shadow)) ((gnu system nss)) ((gnu system locale)) ((?)) ?))
   222:17 12 (map1 (((gnu services)) ((gnu services shepherd)) ((gnu services base)) ((gnu bootloader)) ((gnu system shadow)) ((gnu system nss)) ((gnu system locale)) ((gnu system pam)) ((gnu ?)) ?))
  3327:17 11 (resolve-interface (gnu services) #:select _ #:hide _ #:prefix _ #:renamer _ #:version _)
In ice-9/threads.scm:
    390:8 10 (_ _)
In ice-9/boot-9.scm:
  3253:13  9 (_)
In ice-9/threads.scm:
    390:8  8 (_ _)
In ice-9/boot-9.scm:
  3544:20  7 (_)
   2836:4  6 (save-module-excursion #<procedure 7fffdd1c7660 at ice-9/boot-9.scm:3545:21 ()>)
  3564:26  5 (_)
In unknown file:
           4 (primitive-load-path "gnu/services" #<procedure 7fffde800600 at ice-9/boot-9.scm:3551:37 ()>)
In ice-9/eval.scm:
   626:19  3 (_ #<directory (gnu services) 7fffe2b5daa0>)
    159:9  2 (_ #<directory (gnu services) 7fffe2b5daa0>)
   213:37  1 (_ #<directory (gnu services) 7fffe2b5daa0>)
In guix/modules.scm:
   157:28  0 (loop ((gnu build hurd-boot) (guix build syscalls)) ((guix build utils)) #<<set> vhash: #<vhash 7fffdcb533e0 1 pairs> insert: #<procedure %insert (t-5ce36f5c768e728-57f t-5ce36f5c768e?>)

guix/modules.scm:157:28: In procedure loop:
ERROR:
  1. &missing-dependency-error:
      module: (gnu build hurd-boot)
      search-path: ("." "/gnu/store/11i4vribdynrxkp4ppilkjp9y9jshaxq-guix-core-source" "/gnu/store/avd0dsg9rixk3djls8ikzphfjbl227za-guix-extra-source" "/gnu/store/vdi10jyhr1igrkdgnsjj09krjx1jkzkm-guix-packages-base-source" "/gnu/store/l8sdgq6cpnxyk732w23p7mhq6sial0vm-guile-gcrypt-0.4.0/share/guile/site/3.0" "/gnu/store/0i81lpfnn05pmjc5f43q4nfvd27r08f7-guile-gnutls-3.7.12/share/guile/site/3.0" "/gnu/store/rm803mxjvr9zamg1226dl9zf2275yjzg-guile-git-0.5.2/share/guile/site/3.0" "/gnu/store/bxvl7w7q66gbk7qkkhsiq30vl69jj4x7-guile-bytestructures-1.0.10/share/guile/site/3.0" "/gnu/store/q91hbi8yc2jnx0hlk6zb6vlkrw3xm0yx-guile-avahi-0.4.1/share/guile/site/3.0" "/gnu/store/p5f006jcr83jc7m731vhvjdkr2j0hnp3-guile-json-4.7.3/share/guile/site/3.0" "/gnu/store/d75xpk3qxw7na6zgbf2dw3asqhwifd6a-guile-semver-0.1.1/share/guile/site/3.0" "/gnu/store/19m9xm33jq34nb64z11q5bph85ff6gyd-guile-ssh-0.16.3/share/guile/site/3.0" "/gnu/store/r8izi6mi1mjl7s1kn20q1hxmy3jg2bxc-guile-sqlite3-0.1.3/share/guile/site/3.0" "/gnu/store/bc3zzjych6jyp4ph2af9k3w8qcs3nsn2-guile-lib-0.2.7/share/guile/site/3.0" "/gnu/store/w6gpivr3421wbzkjg6qlc95sv1srz15a-guile-zlib-0.1.0/share/guile/site/3.0" "/gnu/store/1zlqd5240mq0dwwig9bv1cg4zjf092h9-guile-lzlib-0.0.2/share/guile/site/3.0" "/gnu/store/rqd5wpa09fizcb211p78g6f2f5jb2lwg-guile-zstd-0.1.1/share/guile/site/3.0" "/gnu/store/xfd68fq6vmali9wqivg84baqp4n4maqx-guix-packages-source" "/gnu/store/a7sykpl77z61sr0dv034rpwby9bz8zwm-module-import" "/gnu/store/4gvgcfdiz67wv04ihqfa8pqwzsb0qpv5-guile-3.0.9/share/guile/3.0" "/gnu/store/4gvgcfdiz67wv04ihqfa8pqwzsb0qpv5-guile-3.0.9/share/guile/site/3.0" "/gnu/store/4gvgcfdiz67wv04ihqfa8pqwzsb0qpv5-guile-3.0.9/share/guile/site" "/gnu/store/4gvgcfdiz67wv04ihqfa8pqwzsb0qpv5-guile-3.0.9/share/guile")

Change-Id: I6944ffd4c323c776005b0cef23218bffae59be23
---
 gnu/machine/ssh.scm       |   1 +
 gnu/system.scm            | 224 +-----------------------------
 gnu/system/boot.scm       | 277 ++++++++++++++++++++++++++++++++++++++
 guix/scripts/system.scm   |   1 +
 tests/boot-parameters.scm |   1 +
 5 files changed, 281 insertions(+), 223 deletions(-)
 create mode 100644 gnu/system/boot.scm

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index b47ce7c225..0ffe71367c 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -23,6 +23,7 @@ (define-module (gnu machine ssh)
   #:use-module (gnu machine)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
   #:use-module (gnu system)
+  #:use-module (gnu system boot)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system uuid)
   #:use-module ((gnu services) #:select (sexp->system-provenance))
diff --git a/gnu/system.scm b/gnu/system.scm
index aede35775e..a438137731 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -70,6 +70,7 @@ (define-module (gnu system)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services base)
   #:use-module (gnu bootloader)
+  #:use-module (gnu system boot)
   #:use-module (gnu system shadow)
   #:use-module (gnu system nss)
   #:use-module (gnu system locale)
@@ -149,25 +150,6 @@ (define-module (gnu system)
 
             hurd-default-essential-services
 
-            boot-parameters
-            boot-parameters?
-            boot-parameters-label
-            boot-parameters-root-device
-            boot-parameters-bootloader-name
-            boot-parameters-bootloader-menu-entries
-            boot-parameters-store-crypto-devices
-            boot-parameters-store-device
-            boot-parameters-store-directory-prefix
-            boot-parameters-store-mount-point
-            boot-parameters-locale
-            boot-parameters-kernel
-            boot-parameters-kernel-arguments
-            boot-parameters-initrd
-            boot-parameters-multiboot-modules
-            boot-parameters-version
-            %boot-parameters-version
-            read-boot-parameters
-            read-boot-parameters-file
             boot-parameters->menu-entry
 
             local-host-aliases                    ;deprecated
@@ -327,210 +309,6 @@ (define* (operating-system-kernel-arguments
 ;;; Boot parameters
 ;;;
 
-;;; Version 1 was introduced early 2022 to mark the departure from long option
-;;; names such as '--load' to the more conventional initrd option names like
-;;; 'gnu.load'.
-;;;
-;;; When bumping the boot-parameters version, increment it by one (1).
-(define %boot-parameters-version 1)
-
-(define-record-type* <boot-parameters>
-  boot-parameters make-boot-parameters boot-parameters?
-  (label            boot-parameters-label)
-  ;; Because we will use the 'store-device' to create the GRUB search command,
-  ;; the 'store-device' has slightly different semantics than 'root-device'.
-  ;; The 'store-device' can be a file system uuid, a file system label, or #f,
-  ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
-  ;; not understand that.  The 'root-device', on the other hand, corresponds
-  ;; exactly to the device field of the <file-system> object representing the
-  ;; OS's root file system, so it might be a device file name like
-  ;; "/dev/sda3".  The 'store-directory-prefix' field contains #f or the store
-  ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
-  ;; contain "/storefs" if the store is located in that subvolume of a btrfs
-  ;; partition.
-  (root-device      boot-parameters-root-device)
-  (bootloader-name  boot-parameters-bootloader-name)
-  (bootloader-menu-entries                        ;list of <menu-entry>
-   boot-parameters-bootloader-menu-entries)
-  (store-device     boot-parameters-store-device)
-  (store-mount-point boot-parameters-store-mount-point)
-  (store-directory-prefix boot-parameters-store-directory-prefix)
-  (store-crypto-devices boot-parameters-store-crypto-devices
-                        (default '()))
-  (locale           boot-parameters-locale)
-  (kernel           boot-parameters-kernel)
-  (kernel-arguments boot-parameters-kernel-arguments)
-  (initrd           boot-parameters-initrd)
-  (multiboot-modules boot-parameters-multiboot-modules)
-  (version          boot-parameters-version  ;positive integer
-                    (default %boot-parameters-version)))
-
-(define (ensure-not-/dev device)
-  "If DEVICE starts with a slash, return #f.  This is meant to filter out
-Linux device names such as /dev/sda, and to preserve GRUB device names and
-file system labels."
-  (if (and (string? device) (string-prefix? "/" device))
-      #f
-      device))
-
-(define (read-boot-parameters port)
-  "Read boot parameters from PORT and return the corresponding
-<boot-parameters> object.  Raise an error if the format is unrecognized."
-  (define device-sexp->device
-    (match-lambda
-      (('uuid (? symbol? type) (? bytevector? bv))
-       (bytevector->uuid bv type))
-      (('file-system-label (? string? label))
-       (file-system-label label))
-      ((? bytevector? bv)                         ;old format
-       (bytevector->uuid bv 'dce))
-      ((? string? device)
-       (if (string-contains device ":/")
-           device ; nfs-root
-           ;; It used to be that we would not distinguish between labels and
-           ;; device names.  Try to infer the right thing here.
-           (if (string-prefix? "/" device)
-               device
-               (file-system-label device))))))
-  (define uuid-sexp->uuid
-    (match-lambda
-      (('uuid (? symbol? type) (? bytevector? bv))
-       (bytevector->uuid bv type))
-      (x
-       (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
-       #f)))
-
-  ;; New versions are not backward-compatible, so only accept past and current
-  ;; versions, not future ones.
-  (define (version? n)
-    (member n (iota (1+ %boot-parameters-version))))
-
-  (match (read port)
-    (('boot-parameters ('version (? version? version))
-                       ('label label) ('root-device root)
-                       ('kernel kernel)
-                       rest ...)
-     (boot-parameters
-      (version version)
-      (label label)
-      (root-device (device-sexp->device root))
-
-      (bootloader-name
-       (match (assq 'bootloader-name rest)
-         ((_ args) args)
-         (#f       'grub))) ; for compatibility reasons.
-
-      (bootloader-menu-entries
-       (match (assq 'bootloader-menu-entries rest)
-         ((_ entries) (map sexp->menu-entry entries))
-         (#f          '())))
-
-      ;; In the past, we would store the directory name of linux instead of
-      ;; the absolute file name of its image.  Detect that and correct it.
-      (kernel (if (string=? kernel (direct-store-path kernel))
-                  (string-append kernel "/"
-                                 (system-linux-image-file-name))
-                  kernel))
-
-      (kernel-arguments
-       (match (assq 'kernel-arguments rest)
-         ((_ args) args)
-         (#f       '())))                         ;the old format
-
-      (initrd
-       (match (assq 'initrd rest)
-         (('initrd ('string-append directory file)) ;the old format
-          (string-append directory file))
-         (('initrd (? string? file))
-          file)
-         (#f #f)))
-
-      (multiboot-modules
-       (match (assq 'multiboot-modules rest)
-         ((_ args) args)
-         (#f       '())))
-
-      (locale
-       (match (assq 'locale rest)
-         ((_ locale) locale)
-         (#f         #f)))
-
-      (store-device
-       ;; Linux device names like "/dev/sda1" are not suitable GRUB device
-       ;; identifiers, so we just filter them out.
-       (ensure-not-/dev
-        (match (assq 'store rest)
-          (('store ('device #f) _ ...)
-           root-device)
-          (('store ('device device) _ ...)
-           (device-sexp->device device))
-          (_                                      ;the old format
-           root-device))))
-
-      (store-directory-prefix
-       (match (assq 'store rest)
-         (('store . store-data)
-          (match (assq 'directory-prefix store-data)
-            (('directory-prefix prefix) prefix)
-            ;; No directory-prefix found.
-            (_ #f)))
-         (_
-          ;; No store found, old format.
-          #f)))
-
-      (store-crypto-devices
-       (match (assq 'store rest)
-         (('store . store-data)
-          (match (assq 'crypto-devices store-data)
-            (('crypto-devices (devices ...))
-             (map uuid-sexp->uuid devices))
-            (('crypto-devices dev)
-             (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
-                      dev (port-filename port))
-             '())
-            (_
-             ;; No crypto-devices found.
-             '())))
-         (_
-          ;; No store found, old format.
-          '())))
-
-      (store-mount-point
-       (match (assq 'store rest)
-         (('store ('device _) ('mount-point mount-point) _ ...)
-          mount-point)
-         (_                                       ;the old format
-          "/")))))
-    (x                                            ;unsupported format
-     (raise
-      (make-compound-condition
-       (formatted-message
-        (G_ "unrecognized boot parameters at '~a'~%")
-        (port-filename port))
-       (condition
-        (&fix-hint (hint (format #f (G_ "This probably means that this version
-of Guix is older than the one that created @file{~a}.  To address this, you
-need to update Guix:
-
-@example
-guix pull
-@end example")
-                                 (port-filename port))))))))))
-
-(define (read-boot-parameters-file system)
-  "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
-file and returns the corresponding <boot-parameters> object or #f if the
-format is unrecognized.
-The object has its kernel-arguments extended in order to make it bootable."
-  (let* ((file (string-append system "/parameters"))
-         (params (call-with-input-file file read-boot-parameters))
-         (root (boot-parameters-root-device params))
-         (version (boot-parameters-version params)))
-    (boot-parameters
-     (inherit params)
-     (kernel-arguments (append (bootable-kernel-arguments system root version)
-                               (boot-parameters-kernel-arguments params))))))
-
 (define (boot-parameters->menu-entry conf)
   "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
   (let* ((kernel (boot-parameters-kernel conf))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
new file mode 100644
index 0000000000..87b0184f98
--- /dev/null
+++ b/gnu/system/boot.scm
@@ -0,0 +1,277 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo@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 store)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (gnu bootloader)
+  #:use-module (gnu system file-systems)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-35)
+  #:use-module (rnrs bytevectors)
+  #:export (boot-parameters
+            boot-parameters?
+            boot-parameters-label
+            boot-parameters-root-device
+            boot-parameters-bootloader-name
+            boot-parameters-bootloader-menu-entries
+            boot-parameters-store-crypto-devices
+            boot-parameters-store-device
+            boot-parameters-store-directory-prefix
+            boot-parameters-store-mount-point
+            boot-parameters-locale
+            boot-parameters-kernel
+            boot-parameters-kernel-arguments
+            boot-parameters-initrd
+            boot-parameters-multiboot-modules
+            boot-parameters-version
+            %boot-parameters-version
+
+            read-boot-parameters
+            read-boot-parameters-file
+
+            ensure-not-/dev))
+
+;;;
+;;; Boot parameters
+;;;
+
+;;; Version 1 was introduced early 2022 to mark the departure from long option
+;;; names such as '--load' to the more conventional initrd option names like
+;;; 'gnu.load'.
+;;;
+;;; When bumping the boot-parameters version, increment it by one (1).
+(define %boot-parameters-version 1)
+
+(define-record-type* <boot-parameters>
+  boot-parameters make-boot-parameters boot-parameters?
+  (label            boot-parameters-label)
+  ;; Because we will use the 'store-device' to create the GRUB search command,
+  ;; the 'store-device' has slightly different semantics than 'root-device'.
+  ;; The 'store-device' can be a file system uuid, a file system label, or #f,
+  ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
+  ;; not understand that.  The 'root-device', on the other hand, corresponds
+  ;; exactly to the device field of the <file-system> object representing the
+  ;; OS's root file system, so it might be a device file name like
+  ;; "/dev/sda3".  The 'store-directory-prefix' field contains #f or the store
+  ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
+  ;; contain "/storefs" if the store is located in that subvolume of a btrfs
+  ;; partition.
+  (root-device      boot-parameters-root-device)
+  (bootloader-name  boot-parameters-bootloader-name)
+  (bootloader-menu-entries                        ;list of <menu-entry>
+   boot-parameters-bootloader-menu-entries)
+  (store-device     boot-parameters-store-device)
+  (store-mount-point boot-parameters-store-mount-point)
+  (store-directory-prefix boot-parameters-store-directory-prefix)
+  (store-crypto-devices boot-parameters-store-crypto-devices
+                        (default '()))
+  (locale           boot-parameters-locale)
+  (kernel           boot-parameters-kernel)
+  (kernel-arguments boot-parameters-kernel-arguments)
+  (initrd           boot-parameters-initrd)
+  (multiboot-modules boot-parameters-multiboot-modules)
+  (version          boot-parameters-version  ;positive integer
+                    (default %boot-parameters-version)))
+
+(define (read-boot-parameters port)
+  "Read boot parameters from PORT and return the corresponding
+<boot-parameters> object.  Raise an error if the format is unrecognized."
+  (define device-sexp->device
+    (match-lambda
+      (('uuid (? symbol? type) (? bytevector? bv))
+       (bytevector->uuid bv type))
+      (('file-system-label (? string? label))
+       (file-system-label label))
+      ((? bytevector? bv)                         ;old format
+       (bytevector->uuid bv 'dce))
+      ((? string? device)
+       (if (string-contains device ":/")
+           device ; nfs-root
+           ;; It used to be that we would not distinguish between labels and
+           ;; device names.  Try to infer the right thing here.
+           (if (string-prefix? "/" device)
+               device
+               (file-system-label device))))))
+  (define uuid-sexp->uuid
+    (match-lambda
+      (('uuid (? symbol? type) (? bytevector? bv))
+       (bytevector->uuid bv type))
+      (x
+       (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
+       #f)))
+
+  ;; New versions are not backward-compatible, so only accept past and current
+  ;; versions, not future ones.
+  (define (version? n)
+    (member n (iota (1+ %boot-parameters-version))))
+
+  (match (read port)
+    (('boot-parameters ('version (? version? version))
+                       ('label label) ('root-device root)
+                       ('kernel kernel)
+                       rest ...)
+     (boot-parameters
+      (version version)
+      (label label)
+      (root-device (device-sexp->device root))
+
+      (bootloader-name
+       (match (assq 'bootloader-name rest)
+         ((_ args) args)
+         (#f       'grub))) ; for compatibility reasons.
+
+      (bootloader-menu-entries
+       (match (assq 'bootloader-menu-entries rest)
+         ((_ entries) (map sexp->menu-entry entries))
+         (#f          '())))
+
+      ;; In the past, we would store the directory name of linux instead of
+      ;; the absolute file name of its image.  Detect that and correct it.
+      (kernel (if (string=? kernel (direct-store-path kernel))
+                  (string-append kernel "/"
+                                 (system-linux-image-file-name))
+                  kernel))
+
+      (kernel-arguments
+       (match (assq 'kernel-arguments rest)
+         ((_ args) args)
+         (#f       '())))                         ;the old format
+
+      (initrd
+       (match (assq 'initrd rest)
+         (('initrd ('string-append directory file)) ;the old format
+          (string-append directory file))
+         (('initrd (? string? file))
+          file)
+         (#f #f)))
+
+      (multiboot-modules
+       (match (assq 'multiboot-modules rest)
+         ((_ args) args)
+         (#f       '())))
+
+      (locale
+       (match (assq 'locale rest)
+         ((_ locale) locale)
+         (#f         #f)))
+
+      (store-device
+       ;; Linux device names like "/dev/sda1" are not suitable GRUB device
+       ;; identifiers, so we just filter them out.
+       (ensure-not-/dev
+        (match (assq 'store rest)
+          (('store ('device #f) _ ...)
+           root-device)
+          (('store ('device device) _ ...)
+           (device-sexp->device device))
+          (_                                      ;the old format
+           root-device))))
+
+      (store-directory-prefix
+       (match (assq 'store rest)
+         (('store . store-data)
+          (match (assq 'directory-prefix store-data)
+            (('directory-prefix prefix) prefix)
+            ;; No directory-prefix found.
+            (_ #f)))
+         (_
+          ;; No store found, old format.
+          #f)))
+
+      (store-crypto-devices
+       (match (assq 'store rest)
+         (('store . store-data)
+          (match (assq 'crypto-devices store-data)
+            (('crypto-devices (devices ...))
+             (map uuid-sexp->uuid devices))
+            (('crypto-devices dev)
+             (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
+                      dev (port-filename port))
+             '())
+            (_
+             ;; No crypto-devices found.
+             '())))
+         (_
+          ;; No store found, old format.
+          '())))
+
+      (store-mount-point
+       (match (assq 'store rest)
+         (('store ('device _) ('mount-point mount-point) _ ...)
+          mount-point)
+         (_                                       ;the old format
+          "/")))))
+    (x                                            ;unsupported format
+     (raise
+      (make-compound-condition
+       (formatted-message
+        (G_ "unrecognized boot parameters at '~a'~%")
+        (port-filename port))
+       (condition
+        (&fix-hint (hint (format #f (G_ "This probably means that this version
+of Guix is older than the one that created @file{~a}.  To address this, you
+need to update Guix:
+
+@example
+guix pull
+@end example")
+                                 (port-filename port))))))))))
+
+(define (read-boot-parameters-file system)
+  "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
+file and returns the corresponding <boot-parameters> object or #f if the
+format is unrecognized.
+The object has its kernel-arguments extended in order to make it bootable."
+  (let* ((file (string-append system "/parameters"))
+         (params (call-with-input-file file read-boot-parameters))
+         (root (boot-parameters-root-device params))
+         (version (boot-parameters-version params)))
+    (boot-parameters
+     (inherit params)
+     (kernel-arguments (append (bootable-kernel-arguments system root version)
+                               (boot-parameters-kernel-arguments params))))))
+
+(define (ensure-not-/dev device)
+  "If DEVICE starts with a slash, return #f.  This is meant to filter out
+Linux device names such as /dev/sda, and to preserve GRUB device names and
+file system labels."
+  (if (and (string? device) (string-prefix? "/" device))
+      #f
+      device))
+
+;;; boot.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 955dfa618d..40df166fd7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -66,6 +66,7 @@ (define-module (guix scripts system)
   #:use-module (gnu image)
   #:use-module (gnu system)
   #:use-module (gnu bootloader)
+  #:use-module (gnu system boot)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system image)
   #:use-module (gnu system mapped-devices)
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 03a1d01aff..2e7976aa6c 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -27,6 +27,7 @@ (define-module (test-boot-parameters)
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader grub)
   #:use-module (gnu system)
+  #:use-module (gnu system boot)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system uuid)
   #:use-module ((guix diagnostics) #:select (formatted-message?))
-- 
2.41.0

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

[Felix Lechner via Guix-patches via]

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

diff --git a/gnu/system.scm b/gnu/system.scm
index a438137731..e748066e16 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -150,8 +150,6 @@ (define-module (gnu system)
 
             hurd-default-essential-services
 
-            boot-parameters->menu-entry
-
             local-host-aliases                    ;deprecated
             %root-account
             %setuid-programs
@@ -304,32 +302,6 @@ (define* (operating-system-kernel-arguments
   (append (bootable-kernel-arguments os root-device version)
           (operating-system-user-kernel-arguments os)))
 
-\f
-;;;
-;;; 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)
-                            '())))))
 
 \f
 ;;;
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

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

[Felix Lechner via Guix-patches via]

Change-Id: I2b9aaa816b3ca84c32f7d6fa690245b149228310
---
 guix/scripts/system.scm | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 40df166fd7..86ee2ddc76 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,9 +323,9 @@ (define-syntax-rule (unless-file-not-found exp)
           #f
           (apply throw args)))))
 
-(define (seconds->string seconds)
-  "Return a string representing the date for SECONDS."
-  (let ((time (make-time time-utc 0 seconds)))
+(define (epoch->date-string epoch)
+  "Return a string representing the date for EPOCH seconds."
+  (let ((time (make-time time-utc 0 epoch)))
     (date->string (time-utc->date time)
                   "~Y-~m-~d ~H:~M")))
 
@@ -343,7 +343,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
          (inherit params)
          (label (string-append label " (#"
                                (number->string number) ", "
-                               (seconds->string time) ")"))))))
+                               (epoch->date-string time) ")"))))))
   (let* ((systems (map (cut generation-file-name profile <>)
                        numbers))
          (times   (map (lambda (system)
-- 
2.41.0

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

[Felix Lechner via Guix-patches via]

Change-Id: I6a5f793567221f81edd7b2d8d9f0f3e801d1b113
---
 gnu/machine/ssh.scm     | 10 ++++------
 gnu/system/boot.scm     |  8 ++++++++
 guix/scripts/system.scm | 10 ++--------
 3 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 0ffe71367c..449b65dbfb 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -444,10 +444,10 @@ (define (machine-boot-parameters machine)
                                                              generation))
                           (boot-parameters-path (string-append system-path
                                                                "/parameters"))
-                          (time (stat:mtime (lstat system-path))))
+                          (epoch (stat:mtime (lstat system-path))))
                      (list generation
                            system-path
-                           time
+                           epoch
                            (read-file boot-parameters-path))))
                  (reverse (generation-numbers %system-profile)))))))
 
@@ -455,7 +455,7 @@ (define (machine-boot-parameters machine)
     (return
      (map (lambda (generation)
             (match generation
-              ((generation system-path time serialized-params)
+              ((generation system-path epoch serialized-params)
                (let* ((params (call-with-input-string serialized-params
                                 read-boot-parameters))
                       (root (boot-parameters-root-device params))
@@ -466,9 +466,7 @@ (define (machine-boot-parameters machine)
                   (label
                    (string-append label " (#"
                                   (number->string generation) ", "
-                                  (let ((time (make-time time-utc 0 time)))
-                                    (date->string (time-utc->date time)
-                                                  "~Y-~m-~d ~H:~M"))
+                                  (epoch->date-string epoch)
                                   ")"))
                   (kernel-arguments
                    (append (bootable-kernel-arguments system-path root version)
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index d3f58e1ade..df04ef92da 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -41,6 +41,7 @@ (define-module (gnu system boot)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-35)
   #:use-module (rnrs bytevectors)
   #:export (boot-parameters
@@ -64,6 +65,7 @@ (define-module (gnu system boot)
             read-boot-parameters
             read-boot-parameters-file
 
+            epoch->date-string
             boot-parameters->menu-entry
 
             ensure-not-/dev))
@@ -276,6 +278,12 @@ (define (ensure-not-/dev device)
       #f
       device))
 
+(define (epoch->date-string epoch)
+  "Return a string representing the date for EPOCH seconds."
+  (let ((time (make-time time-utc 0 epoch)))
+    (date->string (time-utc->date time)
+                  "~Y-~m-~d ~H:~M")))
+
 (define (boot-parameters->menu-entry conf)
   "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
   (let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 86ee2ddc76..47c072ba5c 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,19 +323,13 @@ (define-syntax-rule (unless-file-not-found exp)
           #f
           (apply throw args)))))
 
-(define (epoch->date-string epoch)
-  "Return a string representing the date for EPOCH seconds."
-  (let ((time (make-time time-utc 0 epoch)))
-    (date->string (time-utc->date time)
-                  "~Y-~m-~d ~H:~M")))
-
 (define* (profile-boot-parameters #:optional (profile %system-profile)
                                   (numbers
                                    (reverse (generation-numbers profile))))
   "Return a list of 'boot-parameters' for the generations of PROFILE specified
 by NUMBERS, which is a list of generation numbers. The list is ordered from
 the most recent to the oldest profiles."
-  (define (system->boot-parameters system number time)
+  (define (system->boot-parameters system number epoch)
     (unless-file-not-found
      (let* ((params           (read-boot-parameters-file system))
             (label            (boot-parameters-label params)))
@@ -343,7 +337,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
          (inherit params)
          (label (string-append label " (#"
                                (number->string number) ", "
-                               (epoch->date-string time) ")"))))))
+                               (epoch->date-string epoch) ")"))))))
   (let* ((systems (map (cut generation-file-name profile <>)
                        numbers))
          (times   (map (lambda (system)
-- 
2.41.0

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

[Felix Lechner via Guix-patches via]

Change-Id: Id348c3047df2353f76b1bad0eb2a3e0fa17e474c
---
 gnu/machine/ssh.scm     |  8 ++------
 gnu/system/boot.scm     | 13 +++++++++++++
 guix/scripts/system.scm |  8 +++-----
 3 files changed, 18 insertions(+), 11 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 449b65dbfb..fe47474470 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -459,15 +459,11 @@ (define (machine-boot-parameters machine)
                (let* ((params (call-with-input-string serialized-params
                                 read-boot-parameters))
                       (root (boot-parameters-root-device params))
-                      (label (boot-parameters-label params))
+                      (text (boot-parameters-label params))
                       (version (boot-parameters-version params)))
                  (boot-parameters
                   (inherit params)
-                  (label
-                   (string-append label " (#"
-                                  (number->string generation) ", "
-                                  (epoch->date-string epoch)
-                                  ")"))
+                  (label (decorated-boot-label text generation epoch))
                   (kernel-arguments
                    (append (bootable-kernel-arguments system-path root version)
                            (boot-parameters-kernel-arguments params))))))))
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index df04ef92da..f5342e06ca 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -66,6 +66,7 @@ (define-module (gnu system boot)
             read-boot-parameters-file
 
             epoch->date-string
+            decorated-boot-label
             boot-parameters->menu-entry
 
             ensure-not-/dev))
@@ -284,6 +285,18 @@ (define (epoch->date-string epoch)
     (date->string (time-utc->date time)
                   "~Y-~m-~d ~H:~M")))
 
+(define (decorated-boot-label text generation epoch)
+  "Return a string for a nice boot label that includes TEXT, a numbered GENERATION,
+and a timestamp derived from EPOCH seconds."
+  (let* ((numbered (lambda (number) (string-append "#" (number->string number))))
+         (count (and=> generation numbered))
+         (timestamp (and=> epoch epoch->date-string))
+         (extras (filter identity (list count timestamp)))
+         (helpful (if (null? extras)
+                      ""
+                      (string-append "(" (string-join extras ", ") ")"))))
+    (string-join (list text helpful))))
+
 (define (boot-parameters->menu-entry conf)
   "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
   (let* ((kernel (boot-parameters-kernel conf))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 47c072ba5c..09d29dbbb1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -332,12 +332,10 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
   (define (system->boot-parameters system number epoch)
     (unless-file-not-found
      (let* ((params           (read-boot-parameters-file system))
-            (label            (boot-parameters-label params)))
+            (text             (boot-parameters-label params)))
        (boot-parameters
-         (inherit params)
-         (label (string-append label " (#"
-                               (number->string number) ", "
-                               (epoch->date-string epoch) ")"))))))
+        (inherit params)
+        (label (decorated-boot-label text number epoch))))))
   (let* ((systems (map (cut generation-file-name profile <>)
                        numbers))
          (times   (map (lambda (system)
-- 
2.41.0

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

[Felix Lechner via Guix-patches via]

Throughout the code base, the token 'boot-parameters' refers to collection of
data that is stored on disk for each system generation. It was confusing to
use it for a list of such records. This comment imposes an alternative name.

Change-Id: Iabb04dbb39f42f989692bede7304f20a69bef9fb
---
 gnu/machine/ssh.scm     | 20 ++++++++++----------
 guix/scripts/system.scm | 19 ++++++++++---------
 2 files changed, 20 insertions(+), 19 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index fe47474470..11534c6740 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -414,7 +414,7 @@ (define not-config?
     (('gnu _ ...) #t)
     (_ #f)))
 
-(define (machine-boot-parameters machine)
+(define (machine->boot-alternatives machine)
   "Monadic procedure returning a list of 'boot-parameters' for the generations
 of MACHINE's system profile, ordered from most recent to oldest."
   (define bootable-kernel-arguments
@@ -503,14 +503,14 @@ (define (deploy-managed-host machine)
                                   (machine-become-command machine)))
 
   (mlet %store-monad ((_ (check-deployment-sanity machine))
-                      (boot-parameters (machine-boot-parameters machine)))
+                      (boot-alternatives (machine->boot-alternatives machine)))
     ;; Make sure code that check %CURRENT-SYSTEM, such as
     ;; %BASE-INITRD-MODULES, gets to see the right value.
     (parameterize ((%current-system system)
                    (%current-target-system #f))
       (let* ((os (machine-operating-system machine))
              (eval (cut machine-remote-eval machine <>))
-             (menu-entries (map boot-parameters->menu-entry boot-parameters))
+             (menu-entries (map boot-parameters->menu-entry boot-alternatives))
              (bootloader-configuration (operating-system-bootloader os))
              (bootcfg (operating-system-bootcfg os menu-entries)))
         (define-syntax-rule (eval/error-handling condition handler ...)
@@ -581,19 +581,19 @@ (define (roll-back-managed-host machine)
   (define roll-back-failure
     (condition (&message (message (G_ "could not roll-back machine")))))
 
-  (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))
-                       (_ -> (if (< (length boot-parameters) 2)
+  (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
+                       (_ -> (if (< (length boot-alternatives) 2)
                                  (raise roll-back-failure)))
                        (entries -> (map boot-parameters->menu-entry
-                                        (list (second boot-parameters))))
+                                        (list (second boot-alternatives))))
                        (locale -> (boot-parameters-locale
-                                   (second boot-parameters)))
+                                   (second boot-alternatives)))
                        (crypto-dev -> (boot-parameters-store-crypto-devices
-                                       (second boot-parameters)))
+                                       (second boot-alternatives)))
                        (store-dir -> (boot-parameters-store-directory-prefix
-                                      (second boot-parameters)))
+                                      (second boot-alternatives)))
                        (old-entries -> (map boot-parameters->menu-entry
-                                            (drop boot-parameters 2)))
+                                            (drop boot-alternatives 2)))
                        (bootloader -> (operating-system-bootloader
                                        (machine-operating-system machine)))
                        (bootcfg (lower-object
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 09d29dbbb1..fd9f0727ee 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,9 +323,9 @@ (define-syntax-rule (unless-file-not-found exp)
           #f
           (apply throw args)))))
 
-(define* (profile-boot-parameters #:optional (profile %system-profile)
-                                  (numbers
-                                   (reverse (generation-numbers profile))))
+(define* (profile->boot-alternatives #:optional (profile %system-profile)
+                                     (numbers
+                                      (reverse (generation-numbers profile))))
   "Return a list of 'boot-parameters' for the generations of PROFILE specified
 by NUMBERS, which is a list of generation numbers. The list is ordered from
 the most recent to the oldest profiles."
@@ -390,18 +390,19 @@ (define (reinstall-bootloader store number)
                              (bootloader bootloader)))
 
          ;; Make the specified system generation the default entry.
-         (params (first (profile-boot-parameters %system-profile
-                                                 (list number))))
+         (params (first (profile->boot-alternatives %system-profile
+                                                    (list number))))
          (locale (boot-parameters-locale params))
          (store-crypto-devices (boot-parameters-store-crypto-devices params))
          (store-directory-prefix
           (boot-parameters-store-directory-prefix params))
          (old-generations
           (delv number (reverse (generation-numbers %system-profile))))
-         (old-params (profile-boot-parameters
-                       %system-profile old-generations))
+         (previous-boot-alternatives (profile->boot-alternatives
+                                      %system-profile old-generations))
          (entries (list (boot-parameters->menu-entry params)))
-         (old-entries (map boot-parameters->menu-entry old-params)))
+         (old-entries (map boot-parameters->menu-entry
+                           previous-boot-alternatives)))
     (run-with-store store
       (mlet* %store-monad
           ((bootcfg (lower-object
@@ -817,7 +818,7 @@ (define* (perform-action action image
           os
           (if (eq? action 'init)
               '()
-              (map boot-parameters->menu-entry (profile-boot-parameters))))))
+              (map boot-parameters->menu-entry (profile->boot-alternatives))))))
 
   (when (eq? action 'reconfigure)
     (maybe-suggest-running-guix-pull)
-- 
2.41.0

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

[Felix Lechner via Guix-patches via]

Both refer to data sets returned from the remote expression, and one of them
shadowed an element of itself.

Change-Id: Ibd8a3036126d9da1215cfc191884c0f54df637df
---
 gnu/machine/ssh.scm | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 11534c6740..9adb5e79b9 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -451,10 +451,10 @@ (define (machine->boot-alternatives machine)
                            (read-file boot-parameters-path))))
                  (reverse (generation-numbers %system-profile)))))))
 
-  (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp)))
+  (mlet* %store-monad ((remote-results (machine-remote-eval machine remote-exp)))
     (return
-     (map (lambda (generation)
-            (match generation
+     (map (lambda (remote-result)
+            (match remote-result
               ((generation system-path epoch serialized-params)
                (let* ((params (call-with-input-string serialized-params
                                 read-boot-parameters))
@@ -467,7 +467,7 @@ (define (machine->boot-alternatives machine)
                   (kernel-arguments
                    (append (bootable-kernel-arguments system-path root version)
                            (boot-parameters-kernel-arguments params))))))))
-          generations))))
+          remote-results))))
 
 (define-syntax-rule (with-roll-back should-roll-back? mbody ...)
   "Catch exceptions that arise when binding MBODY, a monadic expression in
-- 
2.41.0

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

[Felix Lechner via Guix-patches via]

Change-Id: I8d70684142bea736042d6c9dc8276ea7bdb9c181
---
 gnu/machine/ssh.scm | 13 +++++--------
 1 file changed, 5 insertions(+), 8 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 9adb5e79b9..45ab8b9868 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -584,14 +584,11 @@ (define (roll-back-managed-host machine)
   (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
                        (_ -> (if (< (length boot-alternatives) 2)
                                  (raise roll-back-failure)))
-                       (entries -> (map boot-parameters->menu-entry
-                                        (list (second boot-alternatives))))
-                       (locale -> (boot-parameters-locale
-                                   (second boot-alternatives)))
-                       (crypto-dev -> (boot-parameters-store-crypto-devices
-                                       (second boot-alternatives)))
-                       (store-dir -> (boot-parameters-store-directory-prefix
-                                      (second boot-alternatives)))
+                       (parameters (second boot-alternatives))
+                       (entries -> (list (boot-parameters->menu-entry parameters)))
+                       (locale -> (boot-parameters-locale parameters))
+                       (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
+                       (store-dir -> (boot-parameters-store-directory-prefix parameters))
                        (old-entries -> (map boot-parameters->menu-entry
                                             (drop boot-alternatives 2)))
                        (bootloader -> (operating-system-bootloader
-- 
2.41.0

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

[Felix Lechner via Guix-patches via]

Change-Id: If31eeb4cef4f5a107a0ee5ad3f117bf38629ac38
---
 guix/scripts/system.scm | 14 +++++---------
 1 file changed, 5 insertions(+), 9 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index fd9f0727ee..3df37e5510 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -329,20 +329,16 @@ (define* (profile->boot-alternatives #:optional (profile %system-profile)
   "Return a list of 'boot-parameters' for the generations of PROFILE specified
 by NUMBERS, which is a list of generation numbers. The list is ordered from
 the most recent to the oldest profiles."
-  (define (system->boot-parameters system number epoch)
+  (define (generation->boot-parameters number)
     (unless-file-not-found
-     (let* ((params           (read-boot-parameters-file system))
+     (let* ((system           (generation-file-name profile number))
+            (params           (read-boot-parameters-file system))
+            (epoch            (stat:mtime (lstat system)))
             (text             (boot-parameters-label params)))
        (boot-parameters
         (inherit params)
         (label (decorated-boot-label text number epoch))))))
-  (let* ((systems (map (cut generation-file-name profile <>)
-                       numbers))
-         (times   (map (lambda (system)
-                         (unless-file-not-found
-                          (stat:mtime (lstat system))))
-                       systems)))
-    (filter-map system->boot-parameters systems numbers times)))
+  (filter-map generation->boot-parameters numbers))
 
 \f
 ;;;
-- 
2.41.0

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

[Felix Lechner via Guix-patches via]

Change-Id: I51ef1a4fa8fd18104d28a6a845707d7dedde3782
---
 guix/scripts/system.scm | 28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3df37e5510..7f6ba20ef9 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,22 +323,27 @@ (define-syntax-rule (unless-file-not-found exp)
           #f
           (apply throw args)))))
 
+(define (generation->boot-parameters profile number)
+  "Return the 'boot-parameters' for the generation of PROFILE specified
+by NUMBER."
+  (unless-file-not-found
+   (let* ((system (generation-file-name profile number))
+          (params (read-boot-parameters-file system))
+          (epoch (stat:mtime (lstat system)))
+          (text (boot-parameters-label params)))
+     (boot-parameters
+      (inherit params)
+      (label (decorated-boot-label text number epoch))))))
+
 (define* (profile->boot-alternatives #:optional (profile %system-profile)
                                      (numbers
                                       (reverse (generation-numbers profile))))
   "Return a list of 'boot-parameters' for the generations of PROFILE specified
 by NUMBERS, which is a list of generation numbers. The list is ordered from
 the most recent to the oldest profiles."
-  (define (generation->boot-parameters number)
-    (unless-file-not-found
-     (let* ((system           (generation-file-name profile number))
-            (params           (read-boot-parameters-file system))
-            (epoch            (stat:mtime (lstat system)))
-            (text             (boot-parameters-label params)))
-       (boot-parameters
-        (inherit params)
-        (label (decorated-boot-label text number epoch))))))
-  (filter-map generation->boot-parameters numbers))
+  (filter-map (lambda (number)
+                (generation->boot-parameters profile number))
+              numbers))
 
 \f
 ;;;
@@ -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

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

[Felix Lechner via Guix-patches via]

Change-Id: Iaef0b0a3fa9240ca8315a9699bcf4a7bfe908e33
---
 gnu/machine/ssh.scm     | 32 ++++++++++++++++++++------------
 gnu/system/boot.scm     | 14 ++++++++++++++
 guix/scripts/system.scm | 32 +++++++++++++++++++++-----------
 3 files changed, 55 insertions(+), 23 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 45ab8b9868..61125dddce 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -415,8 +415,8 @@ (define not-config?
     (_ #f)))
 
 (define (machine->boot-alternatives machine)
-  "Monadic procedure returning a list of 'boot-parameters' for the generations
-of MACHINE's system profile, ordered from most recent to oldest."
+  "Monadic procedure returning a list of <boot-alternative> records for the
+generations of MACHINE's system profile, ordered from most recent to oldest."
   (define bootable-kernel-arguments
     (@@ (gnu system) bootable-kernel-arguments))
 
@@ -460,13 +460,18 @@ (define (machine->boot-alternatives machine)
                                 read-boot-parameters))
                       (root (boot-parameters-root-device params))
                       (text (boot-parameters-label params))
-                      (version (boot-parameters-version params)))
-                 (boot-parameters
-                  (inherit params)
-                  (label (decorated-boot-label text generation epoch))
-                  (kernel-arguments
-                   (append (bootable-kernel-arguments system-path root version)
-                           (boot-parameters-kernel-arguments params))))))))
+                      (version (boot-parameters-version params))
+                      (parameters (boot-parameters
+                                   (inherit params)
+                                   (label (decorated-boot-label text generation epoch))
+                                   (kernel-arguments
+                                    (append (bootable-kernel-arguments system-path root version)
+                                            (boot-parameters-kernel-arguments params))))))
+                 (boot-alternative
+                  (generation generation)
+                  (system-path system-path)
+                  (epoch epoch)
+                  (parameters parameters))))))
           remote-results))))
 
 (define-syntax-rule (with-roll-back should-roll-back? mbody ...)
@@ -510,7 +515,8 @@ (define (deploy-managed-host machine)
                    (%current-target-system #f))
       (let* ((os (machine-operating-system machine))
              (eval (cut machine-remote-eval machine <>))
-             (menu-entries (map boot-parameters->menu-entry boot-alternatives))
+             (menu-entries (map boot-parameters->menu-entry
+                                (map boot-alternative-parameters boot-alternatives)))
              (bootloader-configuration (operating-system-bootloader os))
              (bootcfg (operating-system-bootcfg os menu-entries)))
         (define-syntax-rule (eval/error-handling condition handler ...)
@@ -584,13 +590,15 @@ (define (roll-back-managed-host machine)
   (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
                        (_ -> (if (< (length boot-alternatives) 2)
                                  (raise roll-back-failure)))
-                       (parameters (second boot-alternatives))
+                       (chosen-alternative (second boot-alternatives))
+                       (parameters (boot-alternative-parameters chosen-alternative))
                        (entries -> (list (boot-parameters->menu-entry parameters)))
                        (locale -> (boot-parameters-locale parameters))
                        (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
                        (store-dir -> (boot-parameters-store-directory-prefix parameters))
                        (old-entries -> (map boot-parameters->menu-entry
-                                            (drop boot-alternatives 2)))
+                                            (map boot-alternative-parameters
+                                                 (drop boot-alternatives 2))))
                        (bootloader -> (operating-system-bootloader
                                        (machine-operating-system machine)))
                        (bootcfg (lower-object
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index f5342e06ca..46aad7eeaa 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -65,6 +65,13 @@ (define-module (gnu system boot)
             read-boot-parameters
             read-boot-parameters-file
 
+            boot-alternative
+            boot-alternative?
+            boot-alternative-generation
+            boot-alternative-system-path
+            boot-alternative-epoch
+            boot-alternative-parameters
+
             epoch->date-string
             decorated-boot-label
             boot-parameters->menu-entry
@@ -271,6 +278,13 @@ (define (read-boot-parameters-file system)
      (kernel-arguments (append (bootable-kernel-arguments system root version)
                                (boot-parameters-kernel-arguments params))))))
 
+(define-record-type* <boot-alternative>
+  boot-alternative make-boot-alternative boot-alternative?
+  (generation boot-alternative-generation)
+  (system-path boot-alternative-system-path)
+  (epoch boot-alternative-epoch)
+  (parameters boot-alternative-parameters))
+
 (define (ensure-not-/dev device)
   "If DEVICE starts with a slash, return #f.  This is meant to filter out
 Linux device names such as /dev/sda, and to preserve GRUB device names and
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 7f6ba20ef9..8e1f6e8f06 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,26 +323,31 @@ (define-syntax-rule (unless-file-not-found exp)
           #f
           (apply throw args)))))
 
-(define (generation->boot-parameters profile number)
-  "Return the 'boot-parameters' for the generation of PROFILE specified
+(define (generation->boot-alternative profile number)
+  "Return the 'boot-alternative' for the generation of PROFILE specified
 by NUMBER."
   (unless-file-not-found
    (let* ((system (generation-file-name profile number))
           (params (read-boot-parameters-file system))
           (epoch (stat:mtime (lstat system)))
-          (text (boot-parameters-label params)))
-     (boot-parameters
-      (inherit params)
-      (label (decorated-boot-label text number epoch))))))
+          (text (boot-parameters-label params))
+          (parameters (boot-parameters
+                       (inherit params)
+                       (label (decorated-boot-label text number epoch)))))
+     (boot-alternative
+      (generation generation)
+      (system-path system-path)
+      (epoch epoch)
+      (parameters parameters)))))
 
 (define* (profile->boot-alternatives #:optional (profile %system-profile)
                                      (numbers
                                       (reverse (generation-numbers profile))))
-  "Return a list of 'boot-parameters' for the generations of PROFILE specified
+  "Return a list of 'boot-alternative' for the generations of PROFILE specified
 by NUMBERS, which is a list of generation numbers. The list is ordered from
 the most recent to the oldest profiles."
   (filter-map (lambda (number)
-                (generation->boot-parameters profile number))
+                (generation->boot-alternative profile number))
               numbers))
 
 \f
@@ -391,7 +396,9 @@ (define (reinstall-bootloader store number)
                              (bootloader bootloader)))
 
          ;; Make the specified system generation the default entry.
-         (params (generation->boot-parameters %system-profile number))
+         (chosen-alternative (generation->boot-alternative
+                              %system-profile number))
+         (params (boot-alternative-parameters chosen-alternative))
          (locale (boot-parameters-locale params))
          (store-crypto-devices (boot-parameters-store-crypto-devices params))
          (store-directory-prefix
@@ -402,7 +409,8 @@ (define (reinstall-bootloader store number)
                                       %system-profile old-generations))
          (entries (list (boot-parameters->menu-entry params)))
          (old-entries (map boot-parameters->menu-entry
-                           previous-boot-alternatives)))
+                           (map boot-alternative-parameters
+                                previous-boot-alternatives))))
     (run-with-store store
       (mlet* %store-monad
           ((bootcfg (lower-object
@@ -818,7 +826,9 @@ (define* (perform-action action image
           os
           (if (eq? action 'init)
               '()
-              (map boot-parameters->menu-entry (profile->boot-alternatives))))))
+              (map boot-parameters->menu-entry
+                   (map boot-alternative-parameters
+                        (profile->boot-alternatives)))))))
 
   (when (eq? action 'reconfigure)
     (maybe-suggest-running-guix-pull)
-- 
2.41.0

[bug#69343] Simplify bootloader data structures and procedures

[Lilah Tascheter via Guix-patches]

In guix/scripts/system.scm(generation->boot-alternative) system-path
isn't defined. Assuming system is supposed to be that?

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

[Lilah Tascheter via Guix-patches]

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

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <felix.lechner@lease-up.com>

The extra menu entries are already being added in each bootloaders, as
applicable.

* guix/scripts/system.scm (reinstall-bootloader)[entries]: Don't
  extraneously include bootloader-configuration-menu-entries here.

Change-Id: I8a600f2a5836ab4f7db5e27e25b0b8f432c3e1e0
---
 guix/scripts/system.scm | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bf3d2f9044..955dfa618d 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -407,8 +407,7 @@ (define (reinstall-bootloader store number)
           (delv number (reverse (generation-numbers %system-profile))))
          (old-params (profile-boot-parameters
                        %system-profile old-generations))
-         (entries (cons (boot-parameters->menu-entry params)
-                        (boot-parameters-bootloader-menu-entries params)))
+         (entries (list (boot-parameters->menu-entry params)))
          (old-entries (map boot-parameters->menu-entry old-params)))
     (run-with-store store
       (mlet* %store-monad
-- 
2.41.0

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <felix.lechner@lease-up.com>

Required to avoid a missing dependency error on build-side.

* gnu/system.scm (<boot-parameters>): Move this record, and...
  (system-linux-image-file-name, %boot-parameters-version,
  ensure-not-/dev, read-boot-parameters,
  read-boot-parameters-file): ...these procedures, to...

* gnu/system/boot.scm: ...this new file.

* gnu/machine/ssh.scm, gnu/system.scm, guix/scripts/system.scm,
  tests/boot-parameters.scm: Use new module above.

Change-Id: I6944ffd4c323c776005b0cef23218bffae59be23
---
 gnu/machine/ssh.scm       |   1 +
 gnu/system.scm            | 236 +-----------------------------
 gnu/system/boot.scm       | 296 ++++++++++++++++++++++++++++++++++++++
 guix/scripts/system.scm   |   1 +
 tests/boot-parameters.scm |   1 +
 5 files changed, 300 insertions(+), 235 deletions(-)
 create mode 100644 gnu/system/boot.scm

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index b47ce7c225..0ffe71367c 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -23,6 +23,7 @@ (define-module (gnu machine ssh)
   #:use-module (gnu machine)
   #:autoload   (gnu packages gnupg) (guile-gcrypt)
   #:use-module (gnu system)
+  #:use-module (gnu system boot)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system uuid)
   #:use-module ((gnu services) #:select (sexp->system-provenance))
diff --git a/gnu/system.scm b/gnu/system.scm
index aede35775e..048f9090e0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -70,6 +70,7 @@ (define-module (gnu system)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services base)
   #:use-module (gnu bootloader)
+  #:use-module (gnu system boot)
   #:use-module (gnu system shadow)
   #:use-module (gnu system nss)
   #:use-module (gnu system locale)
@@ -143,31 +144,11 @@ (define-module (gnu system)
             operating-system-boot-script
             operating-system-uuid
 
-            system-linux-image-file-name
             operating-system-with-gc-roots
             operating-system-with-provenance
 
             hurd-default-essential-services
 
-            boot-parameters
-            boot-parameters?
-            boot-parameters-label
-            boot-parameters-root-device
-            boot-parameters-bootloader-name
-            boot-parameters-bootloader-menu-entries
-            boot-parameters-store-crypto-devices
-            boot-parameters-store-device
-            boot-parameters-store-directory-prefix
-            boot-parameters-store-mount-point
-            boot-parameters-locale
-            boot-parameters-kernel
-            boot-parameters-kernel-arguments
-            boot-parameters-initrd
-            boot-parameters-multiboot-modules
-            boot-parameters-version
-            %boot-parameters-version
-            read-boot-parameters
-            read-boot-parameters-file
             boot-parameters->menu-entry
 
             local-host-aliases                    ;deprecated
@@ -327,210 +308,6 @@ (define* (operating-system-kernel-arguments
 ;;; Boot parameters
 ;;;
 
-;;; Version 1 was introduced early 2022 to mark the departure from long option
-;;; names such as '--load' to the more conventional initrd option names like
-;;; 'gnu.load'.
-;;;
-;;; When bumping the boot-parameters version, increment it by one (1).
-(define %boot-parameters-version 1)
-
-(define-record-type* <boot-parameters>
-  boot-parameters make-boot-parameters boot-parameters?
-  (label            boot-parameters-label)
-  ;; Because we will use the 'store-device' to create the GRUB search command,
-  ;; the 'store-device' has slightly different semantics than 'root-device'.
-  ;; The 'store-device' can be a file system uuid, a file system label, or #f,
-  ;; but it cannot be a device file name such as "/dev/sda3", since GRUB would
-  ;; not understand that.  The 'root-device', on the other hand, corresponds
-  ;; exactly to the device field of the <file-system> object representing the
-  ;; OS's root file system, so it might be a device file name like
-  ;; "/dev/sda3".  The 'store-directory-prefix' field contains #f or the store
-  ;; file name inside the 'store-device' as it is seen by GRUB, e.g. it would
-  ;; contain "/storefs" if the store is located in that subvolume of a btrfs
-  ;; partition.
-  (root-device      boot-parameters-root-device)
-  (bootloader-name  boot-parameters-bootloader-name)
-  (bootloader-menu-entries                        ;list of <menu-entry>
-   boot-parameters-bootloader-menu-entries)
-  (store-device     boot-parameters-store-device)
-  (store-mount-point boot-parameters-store-mount-point)
-  (store-directory-prefix boot-parameters-store-directory-prefix)
-  (store-crypto-devices boot-parameters-store-crypto-devices
-                        (default '()))
-  (locale           boot-parameters-locale)
-  (kernel           boot-parameters-kernel)
-  (kernel-arguments boot-parameters-kernel-arguments)
-  (initrd           boot-parameters-initrd)
-  (multiboot-modules boot-parameters-multiboot-modules)
-  (version          boot-parameters-version  ;positive integer
-                    (default %boot-parameters-version)))
-
-(define (ensure-not-/dev device)
-  "If DEVICE starts with a slash, return #f.  This is meant to filter out
-Linux device names such as /dev/sda, and to preserve GRUB device names and
-file system labels."
-  (if (and (string? device) (string-prefix? "/" device))
-      #f
-      device))
-
-(define (read-boot-parameters port)
-  "Read boot parameters from PORT and return the corresponding
-<boot-parameters> object.  Raise an error if the format is unrecognized."
-  (define device-sexp->device
-    (match-lambda
-      (('uuid (? symbol? type) (? bytevector? bv))
-       (bytevector->uuid bv type))
-      (('file-system-label (? string? label))
-       (file-system-label label))
-      ((? bytevector? bv)                         ;old format
-       (bytevector->uuid bv 'dce))
-      ((? string? device)
-       (if (string-contains device ":/")
-           device ; nfs-root
-           ;; It used to be that we would not distinguish between labels and
-           ;; device names.  Try to infer the right thing here.
-           (if (string-prefix? "/" device)
-               device
-               (file-system-label device))))))
-  (define uuid-sexp->uuid
-    (match-lambda
-      (('uuid (? symbol? type) (? bytevector? bv))
-       (bytevector->uuid bv type))
-      (x
-       (warning (G_ "unrecognized uuid ~a at '~a'~%") x (port-filename port))
-       #f)))
-
-  ;; New versions are not backward-compatible, so only accept past and current
-  ;; versions, not future ones.
-  (define (version? n)
-    (member n (iota (1+ %boot-parameters-version))))
-
-  (match (read port)
-    (('boot-parameters ('version (? version? version))
-                       ('label label) ('root-device root)
-                       ('kernel kernel)
-                       rest ...)
-     (boot-parameters
-      (version version)
-      (label label)
-      (root-device (device-sexp->device root))
-
-      (bootloader-name
-       (match (assq 'bootloader-name rest)
-         ((_ args) args)
-         (#f       'grub))) ; for compatibility reasons.
-
-      (bootloader-menu-entries
-       (match (assq 'bootloader-menu-entries rest)
-         ((_ entries) (map sexp->menu-entry entries))
-         (#f          '())))
-
-      ;; In the past, we would store the directory name of linux instead of
-      ;; the absolute file name of its image.  Detect that and correct it.
-      (kernel (if (string=? kernel (direct-store-path kernel))
-                  (string-append kernel "/"
-                                 (system-linux-image-file-name))
-                  kernel))
-
-      (kernel-arguments
-       (match (assq 'kernel-arguments rest)
-         ((_ args) args)
-         (#f       '())))                         ;the old format
-
-      (initrd
-       (match (assq 'initrd rest)
-         (('initrd ('string-append directory file)) ;the old format
-          (string-append directory file))
-         (('initrd (? string? file))
-          file)
-         (#f #f)))
-
-      (multiboot-modules
-       (match (assq 'multiboot-modules rest)
-         ((_ args) args)
-         (#f       '())))
-
-      (locale
-       (match (assq 'locale rest)
-         ((_ locale) locale)
-         (#f         #f)))
-
-      (store-device
-       ;; Linux device names like "/dev/sda1" are not suitable GRUB device
-       ;; identifiers, so we just filter them out.
-       (ensure-not-/dev
-        (match (assq 'store rest)
-          (('store ('device #f) _ ...)
-           root-device)
-          (('store ('device device) _ ...)
-           (device-sexp->device device))
-          (_                                      ;the old format
-           root-device))))
-
-      (store-directory-prefix
-       (match (assq 'store rest)
-         (('store . store-data)
-          (match (assq 'directory-prefix store-data)
-            (('directory-prefix prefix) prefix)
-            ;; No directory-prefix found.
-            (_ #f)))
-         (_
-          ;; No store found, old format.
-          #f)))
-
-      (store-crypto-devices
-       (match (assq 'store rest)
-         (('store . store-data)
-          (match (assq 'crypto-devices store-data)
-            (('crypto-devices (devices ...))
-             (map uuid-sexp->uuid devices))
-            (('crypto-devices dev)
-             (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
-                      dev (port-filename port))
-             '())
-            (_
-             ;; No crypto-devices found.
-             '())))
-         (_
-          ;; No store found, old format.
-          '())))
-
-      (store-mount-point
-       (match (assq 'store rest)
-         (('store ('device _) ('mount-point mount-point) _ ...)
-          mount-point)
-         (_                                       ;the old format
-          "/")))))
-    (x                                            ;unsupported format
-     (raise
-      (make-compound-condition
-       (formatted-message
-        (G_ "unrecognized boot parameters at '~a'~%")
-        (port-filename port))
-       (condition
-        (&fix-hint (hint (format #f (G_ "This probably means that this version
-of Guix is older than the one that created @file{~a}.  To address this, you
-need to update Guix:
-
-@example
-guix pull
-@end example")
-                                 (port-filename port))))))))))
-
-(define (read-boot-parameters-file system)
-  "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
-file and returns the corresponding <boot-parameters> object or #f if the
-format is unrecognized.
-The object has its kernel-arguments extended in order to make it bootable."
-  (let* ((file (string-append system "/parameters"))
-         (params (call-with-input-file file read-boot-parameters))
-         (root (boot-parameters-root-device params))
-         (version (boot-parameters-version params)))
-    (boot-parameters
-     (inherit params)
-     (kernel-arguments (append (bootable-kernel-arguments system root version)
-                               (boot-parameters-kernel-arguments params))))))
-
 (define (boot-parameters->menu-entry conf)
   "Return a <menu-entry> instance given CONF, a <boot-parameters> instance."
   (let* ((kernel (boot-parameters-kernel conf))
@@ -692,17 +469,6 @@ (define (swap-services os)
   (map (compose swap-service filter-deps)
        (operating-system-swap-devices os)))
 
-(define* (system-linux-image-file-name #:optional
-                                       (target (or (%current-target-system)
-                                                   (%current-system))))
-  "Return the basename of the kernel image file for TARGET."
-  (cond
-   ((string-prefix? "arm" target) "zImage")
-   ((string-prefix? "mips" target) "vmlinuz")
-   ((string-prefix? "aarch64" target) "Image")
-   ((string-prefix? "riscv64" target) "Image")
-   (else "bzImage")))
-
 (define (operating-system-kernel-file os)
   "Return an object representing the absolute file name of the kernel image of
 OS."
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
new file mode 100644
index 0000000000..3f227ab801
--- /dev/null
+++ b/gnu/system/boot.scm
@@ -0,0 +1,296 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2013-2022 Ludovic Courtès <ludo@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))
+
+      (kernel-arguments
+       (match (assq 'kernel-arguments rest)
+         ((_ args) args)
+         (#f       '())))                         ;the old format
+
+      (initrd
+       (match (assq 'initrd rest)
+         (('initrd ('string-append directory file)) ;the old format
+          (string-append directory file))
+         (('initrd (? string? file))
+          file)
+         (#f #f)))
+
+      (multiboot-modules
+       (match (assq 'multiboot-modules rest)
+         ((_ args) args)
+         (#f       '())))
+
+      (locale
+       (match (assq 'locale rest)
+         ((_ locale) locale)
+         (#f         #f)))
+
+      (store-device
+       ;; Linux device names like "/dev/sda1" are not suitable GRUB device
+       ;; identifiers, so we just filter them out.
+       (ensure-not-/dev
+        (match (assq 'store rest)
+          (('store ('device #f) _ ...)
+           root-device)
+          (('store ('device device) _ ...)
+           (device-sexp->device device))
+          (_                                      ;the old format
+           root-device))))
+
+      (store-directory-prefix
+       (match (assq 'store rest)
+         (('store . store-data)
+          (match (assq 'directory-prefix store-data)
+            (('directory-prefix prefix) prefix)
+            ;; No directory-prefix found.
+            (_ #f)))
+         (_
+          ;; No store found, old format.
+          #f)))
+
+      (store-crypto-devices
+       (match (assq 'store rest)
+         (('store . store-data)
+          (match (assq 'crypto-devices store-data)
+            (('crypto-devices (devices ...))
+             (map uuid-sexp->uuid devices))
+            (('crypto-devices dev)
+             (warning (G_ "unrecognized crypto-devices ~S at '~a'~%")
+                      dev (port-filename port))
+             '())
+            (_
+             ;; No crypto-devices found.
+             '())))
+         (_
+          ;; No store found, old format.
+          '())))
+
+      (store-mount-point
+       (match (assq 'store rest)
+         (('store ('device _) ('mount-point mount-point) _ ...)
+          mount-point)
+         (_                                       ;the old format
+          "/")))))
+    (x                                            ;unsupported format
+     (raise
+      (make-compound-condition
+       (formatted-message
+        (G_ "unrecognized boot parameters at '~a'~%")
+        (port-filename port))
+       (condition
+        (&fix-hint (hint (format #f (G_ "This probably means that this version
+of Guix is older than the one that created @file{~a}.  To address this, you
+need to update Guix:
+
+@example
+guix pull
+@end example")
+                                 (port-filename port))))))))))
+
+(define (read-boot-parameters-file system)
+  "Read boot parameters from SYSTEM's (system or generation) \"parameters\"
+file and returns the corresponding <boot-parameters> object or #f if the
+format is unrecognized.
+The object has its kernel-arguments extended in order to make it bootable."
+  (let* ((file (string-append system "/parameters"))
+         (params (call-with-input-file file read-boot-parameters))
+         (root (boot-parameters-root-device params))
+         (version (boot-parameters-version params)))
+    (boot-parameters
+     (inherit params)
+     (kernel-arguments (append (bootable-kernel-arguments system root version)
+                               (boot-parameters-kernel-arguments params))))))
+
+(define (ensure-not-/dev device)
+  "If DEVICE starts with a slash, return #f.  This is meant to filter out
+Linux device names such as /dev/sda, and to preserve GRUB device names and
+file system labels."
+  (if (and (string? device) (string-prefix? "/" device))
+      #f
+      device))
+
+;; XXX: defined here instead of (gnu system) to prevent dependency loop
+(define* (system-linux-image-file-name #:optional
+                                       (target (or (%current-target-system)
+                                                   (%current-system))))
+  "Return the basename of the kernel image file for TARGET."
+  (cond
+   ((string-prefix? "arm" target) "zImage")
+   ((string-prefix? "mips" target) "vmlinuz")
+   ((string-prefix? "aarch64" target) "Image")
+   ((string-prefix? "riscv64" target) "Image")
+   (else "bzImage")))
+
+
+;;; boot.scm ends here
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 955dfa618d..40df166fd7 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -66,6 +66,7 @@ (define-module (guix scripts system)
   #:use-module (gnu image)
   #:use-module (gnu system)
   #:use-module (gnu bootloader)
+  #:use-module (gnu system boot)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system image)
   #:use-module (gnu system mapped-devices)
diff --git a/tests/boot-parameters.scm b/tests/boot-parameters.scm
index 03a1d01aff..2e7976aa6c 100644
--- a/tests/boot-parameters.scm
+++ b/tests/boot-parameters.scm
@@ -27,6 +27,7 @@ (define-module (test-boot-parameters)
   #:use-module (gnu bootloader)
   #:use-module (gnu bootloader grub)
   #:use-module (gnu system)
+  #:use-module (gnu system boot)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system uuid)
   #:use-module ((guix diagnostics) #:select (formatted-message?))
-- 
2.41.0

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <felix.lechner@lease-up.com>

* gnu/system.scm (boot-parameters->menu-entry): Move to...
* gnu/system/boot.scm (boot-parameters->menu-entry): ...here.

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

diff --git a/gnu/system.scm b/gnu/system.scm
index 048f9090e0..11f8e06cc0 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -149,8 +149,6 @@ (define-module (gnu system)
 
             hurd-default-essential-services
 
-            boot-parameters->menu-entry
-
             local-host-aliases                    ;deprecated
             %root-account
             %setuid-programs
@@ -303,32 +301,6 @@ (define* (operating-system-kernel-arguments
   (append (bootable-kernel-arguments os root-device version)
           (operating-system-user-kernel-arguments os)))
 
-\f
-;;;
-;;; 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)
-                            '())))))
 
 \f
 ;;;
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

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <felix.lechner@lease-up.com>

* guix/scripts/system.scm (seconds->string): Rename to
  epoch->date-string.
  (profile-boot-parameters)[boot-parameters]: Update as above.

Change-Id: I2b9aaa816b3ca84c32f7d6fa690245b149228310
---
 guix/scripts/system.scm | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 40df166fd7..86ee2ddc76 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,9 +323,9 @@ (define-syntax-rule (unless-file-not-found exp)
           #f
           (apply throw args)))))
 
-(define (seconds->string seconds)
-  "Return a string representing the date for SECONDS."
-  (let ((time (make-time time-utc 0 seconds)))
+(define (epoch->date-string epoch)
+  "Return a string representing the date for EPOCH seconds."
+  (let ((time (make-time time-utc 0 epoch)))
     (date->string (time-utc->date time)
                   "~Y-~m-~d ~H:~M")))
 
@@ -343,7 +343,7 @@ (define* (profile-boot-parameters #:optional (profile %system-profile)
          (inherit params)
          (label (string-append label " (#"
                                (number->string number) ", "
-                               (seconds->string time) ")"))))))
+                               (epoch->date-string time) ")"))))))
   (let* ((systems (map (cut generation-file-name profile <>)
                        numbers))
          (times   (map (lambda (system)
-- 
2.41.0

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

[Lilah Tascheter via Guix-patches]

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

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

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

[Lilah Tascheter via Guix-patches]

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

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

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <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.

* gnu/machine/ssh.scm (machine-boot-parameters): Rename to
  machine->boot-alternatives.
  (machine->boot-alternatives, roll-back-managed-host): Use
  boot-alternatives instead of boot-parameters as appropriate.
* guix/scripts/system.scm (profile-boot-parameters): Rename to
  profile->boot-alternatives.
  (reinstall-bootloader, perform-action): Use boot-alternatives instead
  of boot-parameters as appropriate.

Change-Id: Iabb04dbb39f42f989692bede7304f20a69bef9fb
---
 gnu/machine/ssh.scm     | 20 ++++++++++----------
 guix/scripts/system.scm | 19 ++++++++++---------
 2 files changed, 20 insertions(+), 19 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index fe47474470..11534c6740 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -414,7 +414,7 @@ (define not-config?
     (('gnu _ ...) #t)
     (_ #f)))
 
-(define (machine-boot-parameters machine)
+(define (machine->boot-alternatives machine)
   "Monadic procedure returning a list of 'boot-parameters' for the generations
 of MACHINE's system profile, ordered from most recent to oldest."
   (define bootable-kernel-arguments
@@ -503,14 +503,14 @@ (define (deploy-managed-host machine)
                                   (machine-become-command machine)))
 
   (mlet %store-monad ((_ (check-deployment-sanity machine))
-                      (boot-parameters (machine-boot-parameters machine)))
+                      (boot-alternatives (machine->boot-alternatives machine)))
     ;; Make sure code that check %CURRENT-SYSTEM, such as
     ;; %BASE-INITRD-MODULES, gets to see the right value.
     (parameterize ((%current-system system)
                    (%current-target-system #f))
       (let* ((os (machine-operating-system machine))
              (eval (cut machine-remote-eval machine <>))
-             (menu-entries (map boot-parameters->menu-entry boot-parameters))
+             (menu-entries (map boot-parameters->menu-entry boot-alternatives))
              (bootloader-configuration (operating-system-bootloader os))
              (bootcfg (operating-system-bootcfg os menu-entries)))
         (define-syntax-rule (eval/error-handling condition handler ...)
@@ -581,19 +581,19 @@ (define (roll-back-managed-host machine)
   (define roll-back-failure
     (condition (&message (message (G_ "could not roll-back machine")))))
 
-  (mlet* %store-monad ((boot-parameters (machine-boot-parameters machine))
-                       (_ -> (if (< (length boot-parameters) 2)
+  (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
+                       (_ -> (if (< (length boot-alternatives) 2)
                                  (raise roll-back-failure)))
                        (entries -> (map boot-parameters->menu-entry
-                                        (list (second boot-parameters))))
+                                        (list (second boot-alternatives))))
                        (locale -> (boot-parameters-locale
-                                   (second boot-parameters)))
+                                   (second boot-alternatives)))
                        (crypto-dev -> (boot-parameters-store-crypto-devices
-                                       (second boot-parameters)))
+                                       (second boot-alternatives)))
                        (store-dir -> (boot-parameters-store-directory-prefix
-                                      (second boot-parameters)))
+                                      (second boot-alternatives)))
                        (old-entries -> (map boot-parameters->menu-entry
-                                            (drop boot-parameters 2)))
+                                            (drop boot-alternatives 2)))
                        (bootloader -> (operating-system-bootloader
                                        (machine-operating-system machine)))
                        (bootcfg (lower-object
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 09d29dbbb1..fd9f0727ee 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,9 +323,9 @@ (define-syntax-rule (unless-file-not-found exp)
           #f
           (apply throw args)))))
 
-(define* (profile-boot-parameters #:optional (profile %system-profile)
-                                  (numbers
-                                   (reverse (generation-numbers profile))))
+(define* (profile->boot-alternatives #:optional (profile %system-profile)
+                                     (numbers
+                                      (reverse (generation-numbers profile))))
   "Return a list of 'boot-parameters' for the generations of PROFILE specified
 by NUMBERS, which is a list of generation numbers. The list is ordered from
 the most recent to the oldest profiles."
@@ -390,18 +390,19 @@ (define (reinstall-bootloader store number)
                              (bootloader bootloader)))
 
          ;; Make the specified system generation the default entry.
-         (params (first (profile-boot-parameters %system-profile
-                                                 (list number))))
+         (params (first (profile->boot-alternatives %system-profile
+                                                    (list number))))
          (locale (boot-parameters-locale params))
          (store-crypto-devices (boot-parameters-store-crypto-devices params))
          (store-directory-prefix
           (boot-parameters-store-directory-prefix params))
          (old-generations
           (delv number (reverse (generation-numbers %system-profile))))
-         (old-params (profile-boot-parameters
-                       %system-profile old-generations))
+         (previous-boot-alternatives (profile->boot-alternatives
+                                      %system-profile old-generations))
          (entries (list (boot-parameters->menu-entry params)))
-         (old-entries (map boot-parameters->menu-entry old-params)))
+         (old-entries (map boot-parameters->menu-entry
+                           previous-boot-alternatives)))
     (run-with-store store
       (mlet* %store-monad
           ((bootcfg (lower-object
@@ -817,7 +818,7 @@ (define* (perform-action action image
           os
           (if (eq? action 'init)
               '()
-              (map boot-parameters->menu-entry (profile-boot-parameters))))))
+              (map boot-parameters->menu-entry (profile->boot-alternatives))))))
 
   (when (eq? action 'reconfigure)
     (maybe-suggest-running-guix-pull)
-- 
2.41.0

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <felix.lechner@lease-up.com>

Both refer to data sets returned from the remote expression, and one of them
shadowed an element of itself.

* gnu/machine/ssh.scm (machine->boot-alternatives): Rename generations
  to remote-results.

Change-Id: Ibd8a3036126d9da1215cfc191884c0f54df637df
---
 gnu/machine/ssh.scm | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 11534c6740..9adb5e79b9 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -451,10 +451,10 @@ (define (machine->boot-alternatives machine)
                            (read-file boot-parameters-path))))
                  (reverse (generation-numbers %system-profile)))))))
 
-  (mlet* %store-monad ((generations (machine-remote-eval machine remote-exp)))
+  (mlet* %store-monad ((remote-results (machine-remote-eval machine remote-exp)))
     (return
-     (map (lambda (generation)
-            (match generation
+     (map (lambda (remote-result)
+            (match remote-result
               ((generation system-path epoch serialized-params)
                (let* ((params (call-with-input-string serialized-params
                                 read-boot-parameters))
@@ -467,7 +467,7 @@ (define (machine->boot-alternatives machine)
                   (kernel-arguments
                    (append (bootable-kernel-arguments system-path root version)
                            (boot-parameters-kernel-arguments params))))))))
-          generations))))
+          remote-results))))
 
 (define-syntax-rule (with-roll-back should-roll-back? mbody ...)
   "Catch exceptions that arise when binding MBODY, a monadic expression in
-- 
2.41.0

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <felix.lechner@lease-up.com>

* gnu/machine/ssh.scm (roll-back-managed-host): Factor out a
  subexpression into new variable parameters.

Change-Id: I8d70684142bea736042d6c9dc8276ea7bdb9c181
---
 gnu/machine/ssh.scm | 13 +++++--------
 1 file changed, 5 insertions(+), 8 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 9adb5e79b9..45ab8b9868 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -584,14 +584,11 @@ (define (roll-back-managed-host machine)
   (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
                        (_ -> (if (< (length boot-alternatives) 2)
                                  (raise roll-back-failure)))
-                       (entries -> (map boot-parameters->menu-entry
-                                        (list (second boot-alternatives))))
-                       (locale -> (boot-parameters-locale
-                                   (second boot-alternatives)))
-                       (crypto-dev -> (boot-parameters-store-crypto-devices
-                                       (second boot-alternatives)))
-                       (store-dir -> (boot-parameters-store-directory-prefix
-                                      (second boot-alternatives)))
+                       (parameters (second boot-alternatives))
+                       (entries -> (list (boot-parameters->menu-entry parameters)))
+                       (locale -> (boot-parameters-locale parameters))
+                       (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
+                       (store-dir -> (boot-parameters-store-directory-prefix parameters))
                        (old-entries -> (map boot-parameters->menu-entry
                                             (drop boot-alternatives 2)))
                        (bootloader -> (operating-system-bootloader
-- 
2.41.0

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <felix.lechner@lease-up.com>

* guix/scripts/system.scm
  (profile->boot-alternatives)[system->boot-parameters]: Rename to
  generation->boot-parameters and factor out processing from...
  (profile->boot-alternatives): ...here.

Change-Id: If31eeb4cef4f5a107a0ee5ad3f117bf38629ac38
---
 guix/scripts/system.scm | 14 +++++---------
 1 file changed, 5 insertions(+), 9 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index fd9f0727ee..3df37e5510 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -329,20 +329,16 @@ (define* (profile->boot-alternatives #:optional (profile %system-profile)
   "Return a list of 'boot-parameters' for the generations of PROFILE specified
 by NUMBERS, which is a list of generation numbers. The list is ordered from
 the most recent to the oldest profiles."
-  (define (system->boot-parameters system number epoch)
+  (define (generation->boot-parameters number)
     (unless-file-not-found
-     (let* ((params           (read-boot-parameters-file system))
+     (let* ((system           (generation-file-name profile number))
+            (params           (read-boot-parameters-file system))
+            (epoch            (stat:mtime (lstat system)))
             (text             (boot-parameters-label params)))
        (boot-parameters
         (inherit params)
         (label (decorated-boot-label text number epoch))))))
-  (let* ((systems (map (cut generation-file-name profile <>)
-                       numbers))
-         (times   (map (lambda (system)
-                         (unless-file-not-found
-                          (stat:mtime (lstat system))))
-                       systems)))
-    (filter-map system->boot-parameters systems numbers times)))
+  (filter-map generation->boot-parameters numbers))
 
 \f
 ;;;
-- 
2.41.0

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <felix.lechner@lease-up.com>

* guix/scripts/system.scm
  (profile->boot-alternatives)[generation->boot-parameters]: Move to...
  (generation->boot-parameters): ...here.
  (reinstall-bootloader): Use procedure above.

Change-Id: I51ef1a4fa8fd18104d28a6a845707d7dedde3782
---
 guix/scripts/system.scm | 28 ++++++++++++++++------------
 1 file changed, 16 insertions(+), 12 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 3df37e5510..7f6ba20ef9 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,22 +323,27 @@ (define-syntax-rule (unless-file-not-found exp)
           #f
           (apply throw args)))))
 
+(define (generation->boot-parameters profile number)
+  "Return the 'boot-parameters' for the generation of PROFILE specified
+by NUMBER."
+  (unless-file-not-found
+   (let* ((system (generation-file-name profile number))
+          (params (read-boot-parameters-file system))
+          (epoch (stat:mtime (lstat system)))
+          (text (boot-parameters-label params)))
+     (boot-parameters
+      (inherit params)
+      (label (decorated-boot-label text number epoch))))))
+
 (define* (profile->boot-alternatives #:optional (profile %system-profile)
                                      (numbers
                                       (reverse (generation-numbers profile))))
   "Return a list of 'boot-parameters' for the generations of PROFILE specified
 by NUMBERS, which is a list of generation numbers. The list is ordered from
 the most recent to the oldest profiles."
-  (define (generation->boot-parameters number)
-    (unless-file-not-found
-     (let* ((system           (generation-file-name profile number))
-            (params           (read-boot-parameters-file system))
-            (epoch            (stat:mtime (lstat system)))
-            (text             (boot-parameters-label params)))
-       (boot-parameters
-        (inherit params)
-        (label (decorated-boot-label text number epoch))))))
-  (filter-map generation->boot-parameters numbers))
+  (filter-map (lambda (number)
+                (generation->boot-parameters profile number))
+              numbers))
 
 \f
 ;;;
@@ -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

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

[Lilah Tascheter via Guix-patches]

From: Felix Lechner <felix.lechner@lease-up.com>

* gnu/system/boot.scm (<boot-alternative>): New record.

* gnu/machine/ssh.scm (machine->boot-alternatives): Return a
  boot-alternative encapsulating previous return value.
  (with-roll-back, roll-back-managed-host): Get parameters from
  boot-alternatives.

* guix/scripts/system.scm (generation->boot-parameters): Rename to...
  (generation->boot-alternative): ...this. Return a boot-alternative
  encapsulating previous return value.
  (profile->boot-alternatives): Rename uses as above.
  (reinstall-bootloader, perform-action): Get parameters from
  boot-alternatives.

Change-Id: Iaef0b0a3fa9240ca8315a9699bcf4a7bfe908e33
---
 gnu/machine/ssh.scm     | 32 ++++++++++++++++++++------------
 gnu/system/boot.scm     | 14 ++++++++++++++
 guix/scripts/system.scm | 32 +++++++++++++++++++++-----------
 3 files changed, 55 insertions(+), 23 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 45ab8b9868..61125dddce 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -415,8 +415,8 @@ (define not-config?
     (_ #f)))
 
 (define (machine->boot-alternatives machine)
-  "Monadic procedure returning a list of 'boot-parameters' for the generations
-of MACHINE's system profile, ordered from most recent to oldest."
+  "Monadic procedure returning a list of <boot-alternative> records for the
+generations of MACHINE's system profile, ordered from most recent to oldest."
   (define bootable-kernel-arguments
     (@@ (gnu system) bootable-kernel-arguments))
 
@@ -460,13 +460,18 @@ (define (machine->boot-alternatives machine)
                                 read-boot-parameters))
                       (root (boot-parameters-root-device params))
                       (text (boot-parameters-label params))
-                      (version (boot-parameters-version params)))
-                 (boot-parameters
-                  (inherit params)
-                  (label (decorated-boot-label text generation epoch))
-                  (kernel-arguments
-                   (append (bootable-kernel-arguments system-path root version)
-                           (boot-parameters-kernel-arguments params))))))))
+                      (version (boot-parameters-version params))
+                      (parameters (boot-parameters
+                                   (inherit params)
+                                   (label (decorated-boot-label text generation epoch))
+                                   (kernel-arguments
+                                    (append (bootable-kernel-arguments system-path root version)
+                                            (boot-parameters-kernel-arguments params))))))
+                 (boot-alternative
+                  (generation generation)
+                  (system-path system-path)
+                  (epoch epoch)
+                  (parameters parameters))))))
           remote-results))))
 
 (define-syntax-rule (with-roll-back should-roll-back? mbody ...)
@@ -510,7 +515,8 @@ (define (deploy-managed-host machine)
                    (%current-target-system #f))
       (let* ((os (machine-operating-system machine))
              (eval (cut machine-remote-eval machine <>))
-             (menu-entries (map boot-parameters->menu-entry boot-alternatives))
+             (menu-entries (map boot-parameters->menu-entry
+                                (map boot-alternative-parameters boot-alternatives)))
              (bootloader-configuration (operating-system-bootloader os))
              (bootcfg (operating-system-bootcfg os menu-entries)))
         (define-syntax-rule (eval/error-handling condition handler ...)
@@ -584,13 +590,15 @@ (define (roll-back-managed-host machine)
   (mlet* %store-monad ((boot-alternatives (machine->boot-alternatives machine))
                        (_ -> (if (< (length boot-alternatives) 2)
                                  (raise roll-back-failure)))
-                       (parameters (second boot-alternatives))
+                       (chosen-alternative (second boot-alternatives))
+                       (parameters (boot-alternative-parameters chosen-alternative))
                        (entries -> (list (boot-parameters->menu-entry parameters)))
                        (locale -> (boot-parameters-locale parameters))
                        (crypto-dev -> (boot-parameters-store-crypto-devices parameters))
                        (store-dir -> (boot-parameters-store-directory-prefix parameters))
                        (old-entries -> (map boot-parameters->menu-entry
-                                            (drop boot-alternatives 2)))
+                                            (map boot-alternative-parameters
+                                                 (drop boot-alternatives 2))))
                        (bootloader -> (operating-system-bootloader
                                        (machine-operating-system machine)))
                        (bootcfg (lower-object
diff --git a/gnu/system/boot.scm b/gnu/system/boot.scm
index b39e7d8610..edb4d213b9 100644
--- a/gnu/system/boot.scm
+++ b/gnu/system/boot.scm
@@ -70,6 +70,13 @@ (define-module (gnu system boot)
             read-boot-parameters
             read-boot-parameters-file
 
+            boot-alternative
+            boot-alternative?
+            boot-alternative-generation
+            boot-alternative-system-path
+            boot-alternative-epoch
+            boot-alternative-parameters
+
             epoch->date-string
             decorated-boot-label
             boot-parameters->menu-entry
@@ -277,6 +284,13 @@ (define (read-boot-parameters-file system)
      (kernel-arguments (append (bootable-kernel-arguments system root version)
                                (boot-parameters-kernel-arguments params))))))
 
+(define-record-type* <boot-alternative>
+  boot-alternative make-boot-alternative boot-alternative?
+  (generation boot-alternative-generation)
+  (system-path boot-alternative-system-path)
+  (epoch boot-alternative-epoch)
+  (parameters boot-alternative-parameters))
+
 (define (epoch->date-string epoch)
   "Return a string representing the date for EPOCH seconds."
   (let ((time (make-time time-utc 0 epoch)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 7f6ba20ef9..97804ad736 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -323,26 +323,31 @@ (define-syntax-rule (unless-file-not-found exp)
           #f
           (apply throw args)))))
 
-(define (generation->boot-parameters profile number)
-  "Return the 'boot-parameters' for the generation of PROFILE specified
+(define (generation->boot-alternative profile number)
+  "Return the 'boot-alternative' for the generation of PROFILE specified
 by NUMBER."
   (unless-file-not-found
    (let* ((system (generation-file-name profile number))
           (params (read-boot-parameters-file system))
           (epoch (stat:mtime (lstat system)))
-          (text (boot-parameters-label params)))
-     (boot-parameters
-      (inherit params)
-      (label (decorated-boot-label text number epoch))))))
+          (text (boot-parameters-label params))
+          (parameters (boot-parameters
+                       (inherit params)
+                       (label (decorated-boot-label text number epoch)))))
+     (boot-alternative
+      (generation number)
+      (system-path system)
+      (epoch epoch)
+      (parameters parameters)))))
 
 (define* (profile->boot-alternatives #:optional (profile %system-profile)
                                      (numbers
                                       (reverse (generation-numbers profile))))
-  "Return a list of 'boot-parameters' for the generations of PROFILE specified
+  "Return a list of 'boot-alternative' for the generations of PROFILE specified
 by NUMBERS, which is a list of generation numbers. The list is ordered from
 the most recent to the oldest profiles."
   (filter-map (lambda (number)
-                (generation->boot-parameters profile number))
+                (generation->boot-alternative profile number))
               numbers))
 
 \f
@@ -391,7 +396,9 @@ (define (reinstall-bootloader store number)
                              (bootloader bootloader)))
 
          ;; Make the specified system generation the default entry.
-         (params (generation->boot-parameters %system-profile number))
+         (chosen-alternative (generation->boot-alternative
+                              %system-profile number))
+         (params (boot-alternative-parameters chosen-alternative))
          (locale (boot-parameters-locale params))
          (store-crypto-devices (boot-parameters-store-crypto-devices params))
          (store-directory-prefix
@@ -402,7 +409,8 @@ (define (reinstall-bootloader store number)
                                       %system-profile old-generations))
          (entries (list (boot-parameters->menu-entry params)))
          (old-entries (map boot-parameters->menu-entry
-                           previous-boot-alternatives)))
+                           (map boot-alternative-parameters
+                                previous-boot-alternatives))))
     (run-with-store store
       (mlet* %store-monad
           ((bootcfg (lower-object
@@ -818,7 +826,9 @@ (define* (perform-action action image
           os
           (if (eq? action 'init)
               '()
-              (map boot-parameters->menu-entry (profile->boot-alternatives))))))
+              (map boot-parameters->menu-entry
+                   (map boot-alternative-parameters
+                        (profile->boot-alternatives)))))))
 
   (when (eq? action 'reconfigure)
     (maybe-suggest-running-guix-pull)
-- 
2.41.0

[bug#69343] Simplify bootloader data structures and procedures

[Felix Lechner via Guix-patches via]

Hi Lilah,

On Fri, Mar 08 2024, Lilah Tascheter wrote:

> this is really useful!! love having access to generation numbers
> alongside boot params, and the terminology fixing's great too :)

Thank you for taking a closer look! Sorry I did not get back to you on
the system-path question before. Of course, you were right.

If you will please accept an excuse for my tardiness: My family has a
new sister. Time passes when a baby cries.

> * (gnu system boot) was missing a few imports that it needs to work.

I regularly notice missing imports, too, but haven't figured out when
they present an obstacle to running a Guile program.

> * (gnu system boot) requires the procedure
> system-linux-image-file-name, which is defined in (gnu system). I
> moved it over to (gnu system boot).

Thanks for doing that! Now you and I are co-conspirators in re-arranging
the procedures.

> * generation->boot-alternative in (guix scripts system) had typos in
> variables resulting in them not being used.

Thank you for finding those. I have poor vision and am not good with
details, including speling.

> * commit messages didn't have relevant gnu changelog info.

Yes, I will read the GNU ChangeLog spec one more time, but all hope may
be lost.

> * one of those commit messages had a wholeass log that's Way too much
> extraneous information and just got in the way

My commit messages are widely regarded as wordy, roundabout and overly
documentative.

> this v2 passes all relevant unit tests, but could still definately use some
> verification that the modified paths function properly before I'd say this is
> ready to be merged.

I use 'guix deploy' and will test your patch series shortly. (Despite
the previous shortcomings, I have been using it in production.) My
branch rebase is overdue.

Unfortunately, I have many custom patches, including some affecting core
packages. A branch rebase locally causes a full bootstrap and takes
about two days.

Given your attention here, I am sure your changes are fine. Folks should
feel free to merge your work before I return with confirmation. Thanks!

Kind regards
Felix