[bug#73202] [PATCH] guix: scripts: Rewrite reinstall-bootloader to use provenance data.

[Herman Rimm]

From: Lilah Tascheter <lilah@lunabee.space>

Looking up bootloaders by name is broken because (extlinux) bootloaders
share a name.  Also, bootloader-configuration data is significant to
bootloader installation, so it shouldn't just use the default values.
Installation can rely on the provenance service instead, which should be
present for the vast majority of systems.

* guix/scripts/system.scm (install-bootloader-from-os,
install-bootloader-from-provenance): Add procedures.
(reinstall-bootloader): Remove procedure.
(switch-to-system-generation, process-command): Use
install-bootloader-from-provenance.

Change-Id: I5713a43ad4f9f32a129d980db06d70de16b03f27
---
Hello,

This requires patches from #69343.  #72457 is big and I thought it would
be nice to separately review whatever possible, hence the new issue.  

This is [PATCH v5 01/15] from issue #72457, but with a modified commit
description and the addition of an install-bootloader-from-os procedure,
to reduce nesting and only define local variables when relevant.

The (gnu tests reconfigure) tests all pass, though I myself cannot
roll-back or switch-generations for unrelated reasons.  So please let me
know if this patch creates any trouble with the aformentioned and if you
have ideas for additional (gnu tests reconfigure) tests.

Thanks,
Herman

 gnu/bootloader.scm      |  2 ++
 guix/scripts/system.scm | 72 +++++++++++++++--------------------------
 2 files changed, 28 insertions(+), 46 deletions(-)

diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm
index f32e90e79d..61311b32cb 100644
--- a/gnu/bootloader.scm
+++ b/gnu/bootloader.scm
@@ -7,6 +7,8 @@
 ;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 ;;; Copyright © 2022 Reza Alizadeh Majd <r.majd@pantherx.org>
 ;;; Copyright © 2024 Tomas Volf <~@wolfsden.cz>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 0f7d864e06..d14dfd8d81 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -88,6 +88,7 @@ (define-module (guix scripts system)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 receive)
   #:use-module (rnrs bytevectors)
   #:export (guix-system
             read-operating-system
@@ -377,61 +378,39 @@ (define (switch-to-system-generation store spec)
          (activate (string-append generation "/activate")))
     (if number
         (begin
-          (reinstall-bootloader store number)
+          (install-bootloader-from-provenance store number)
           (switch-to-generation* %system-profile number)
           (unless-file-not-found (primitive-load activate)))
         (leave (G_ "cannot switch to system generation '~a'~%") spec))))
 
-(define* (system-bootloader-name #:optional (system %system-profile))
-  "Return the bootloader name stored in SYSTEM's \"parameters\" file."
-  (let ((params (unless-file-not-found
-                 (read-boot-parameters-file system))))
-    (boot-parameters-bootloader-name params)))
-
-(define (reinstall-bootloader store number)
-  "Re-install bootloader for existing system profile generation NUMBER.
-STORE is an open connection to the store."
-  (let* ((generation (generation-file-name %system-profile number))
-         ;; Detect the bootloader used in %system-profile.
-         (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
-
-         ;; Use the detected bootloader with default configuration.
-         ;; It will be enough to allow the system to boot.
-         (bootloader-config (bootloader-configuration
-                             (bootloader bootloader)))
-
-         ;; Make the specified system generation the default entry.
-         (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
-          (boot-parameters-store-directory-prefix params))
-         (old-generations
-          (delv number (reverse (generation-numbers %system-profile))))
-         (previous-boot-alternatives (profile->boot-alternatives
-                                      %system-profile old-generations))
-         (entries (list (boot-parameters->menu-entry params)))
-         (old-entries (map boot-parameters->menu-entry
-                           (map boot-alternative-parameters
-                                previous-boot-alternatives))))
+(define (install-bootloader-from-os store number os)
+  "Re-install an old bootloader defined in <operating-system> record OS,
+for system profile generation NUMBER, with store STORE."
+  (let* ((os (read-operating-system os))
+         (bootloader-config (operating-system-bootloader os))
+         (numbers (generation-numbers %system-profile))
+         (numbers (delv number (reverse numbers)))
+         (old (profile->boot-alternatives %system-profile numbers))
+         (bootcfg (operating-system-bootcfg os old)))
     (run-with-store store
-      (mlet* %store-monad
-          ((bootcfg (lower-object
-                     ((bootloader-configuration-file-generator bootloader)
-                      bootloader-config entries
-                      #:locale locale
-                      #:store-crypto-devices store-crypto-devices
-                      #:store-directory-prefix store-directory-prefix
-                      #:old-entries old-entries)))
-           (drvs -> (list bootcfg)))
+      (mlet* %store-monad ((bootcfg (lower-object bootcfg))
+                           (drvs -> (list bootcfg)))
         (mbegin %store-monad
           (built-derivations drvs)
           ;; Only install bootloader configuration file.
           (install-bootloader local-eval bootloader-config bootcfg
                               #:run-installer? #f))))))
 
+(define (install-bootloader-from-provenance store number)
+  "Re-install an old bootloader using provenance data for system profile
+generation NUMBER with store STORE."
+  (receive (_ os)
+      (system-provenance (generation-file-name %system-profile number))
+    (if os
+        (install-bootloader-from-os store number os)
+        (leave (G_ "cannot rollback to generation '~a': no provenance~%")
+               number))))
+
 
 ;;;
 ;;; Graphs.
@@ -1413,10 +1392,11 @@ (define-syntax-rule (with-store* store exp ...)
      (let ((pattern (match args
                       (() #f)
                       ((pattern) pattern)
-                      (x (leave (G_ "wrong number of arguments~%"))))))
+                      (_ (leave (G_ "wrong number of arguments~%")))))
+           (number (generation-number %system-profile)))
        (with-store* store
          (delete-matching-generations store %system-profile pattern)
-         (reinstall-bootloader store (generation-number %system-profile)))))
+         (install-bootloader-from-provenance store number))))
     ((switch-generation)
      (let ((pattern (match args
                       ((pattern) pattern)
-- 
2.45.2