guix: scripts: Rewrite reinstall-bootloader to use provenance data.

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.

* gnu/bootloader.scm (%bootloaders): Delete variable.
(lookup-bootloader-by-name, bootloader-modules): Delete procedures.
* 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

gnu/bootloader.scm

@@ -26,7 +26,6 @@
 (define-module (gnu bootloader)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system uuid)
-  #:use-module (guix discovery)
   #:use-module (guix gexp)
   #:use-module (guix profiles)
   #:use-module (guix records)
@@ -79,8 +78,6 @@ (define-module (gnu bootloader)
             bootloader-configuration-device-tree-support?
             bootloader-configuration-extra-initrd
 
-            %bootloaders
-            lookup-bootloader-by-name
 
             efi-bootloader-chain))
 
@@ -287,29 +284,6 @@ (define (bootloader-configuration-targets config)
 ;;; Bootloaders.
 ;;;
 
-(define (bootloader-modules)
-  "Return the list of bootloader modules."
-  (all-modules (map (lambda (entry)
-                      `(,entry . "gnu/bootloader"))
-                    %load-path)
-               #:warn warn-about-load-error))
-
-(define %bootloaders
-  ;; The list of publically-known bootloaders.
-  (delay (fold-module-public-variables (lambda (obj result)
-                                         (if (bootloader? obj)
-                                             (cons obj result)
-                                             result))
-                                       '()
-                                       (bootloader-modules))))
-
-(define (lookup-bootloader-by-name name)
-  "Return the bootloader called NAME."
-  (or (find (lambda (bootloader)
-              (eq? name (bootloader-name bootloader)))
-            (force %bootloaders))
-      (leave (G_ "~a: no such bootloader~%") name)))
-
 (define (efi-bootloader-profile packages files hooks)
   "Creates a profile from the lists of PACKAGES and FILES from the store.
 This profile is meant to be used by the bootloader-installer.

guix/scripts/system.scm

@@ -11,6 +11,8 @@
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -88,6 +90,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
@@ -375,60 +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))
+(define (install-bootloader-from-os store number os)
-  "Return the bootloader name stored in SYSTEM's \"parameters\" file."
+  "Re-install an old bootloader defined in <operating-system> record OS,
-  (let ((params (unless-file-not-found
+for system profile generation NUMBER, with store STORE."
-                 (read-boot-parameters-file system))))
+  (let* ((os (read-operating-system os))
-    (boot-parameters-bootloader-name params)))
+         (bootloader-config (operating-system-bootloader os))
-
+         (numbers (generation-numbers %system-profile))
-(define (reinstall-bootloader store number)
+         (numbers (delv number (reverse numbers)))
-  "Re-install bootloader for existing system profile generation NUMBER.
+         (old (profile->boot-alternatives %system-profile numbers))
-STORE is an open connection to the store."
+         (bootcfg (operating-system-bootcfg os old)))
-  (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-alternative->menu-entry
-                           previous-boot-alternatives)))
     (run-with-store store
-      (mlet* %store-monad
+      (mlet* %store-monad ((bootcfg (lower-object bootcfg))
-          ((bootcfg (lower-object
+                           (drvs -> (list bootcfg)))
-                     ((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)))
         (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.
@@ -1387,10 +1369,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)