bug#26339: [PATCH v2 11/12] scripts: system: Adapt "switch-generation" to new bootloader API.

[Mathieu Othacehe]

* guix/scripts/system.scm (profile-grub-entries): Rename to
  profile-bootloader-entries.
  (reinstall-grub): Rename to reinstall-bootloader. Read boot-device and
  boot-type from parameters file to be able to restore the correct bootloader
  on specified device.
  Factorize bootloader installation code by calling install-bootloader.
 (switch-to-system-generation): Adapt.
---
 guix/scripts/system.scm | 91 +++++++++++++++++++++++--------------------------
 1 file changed, 43 insertions(+), 48 deletions(-)

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 880bd8b56..a637f91aa 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -377,26 +377,8 @@ it atomically, and then run OS's activation script."
     (date->string (time-utc->date time)
                   "~Y-~m-~d ~H:~M")))
 
-(define* (profile-boot-parameters #:optional (profile %system-profile)
-                                  (numbers (generation-numbers profile)))
-  "Return a list of 'menu-entry' for the generations of PROFILE specified by
-NUMBERS, which is a list of generation numbers."
-  (define (system->boot-parameters system number time)
-    (unless-file-not-found
-     (let* ((file             (string-append system "/parameters"))
-            (params           (call-with-input-file file
-                                read-boot-parameters)))
-       params)))
-  (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)))
-
-(define* (profile-grub-entries #:optional (profile %system-profile)
-                                  (numbers (generation-numbers profile)))
+(define* (profile-bootloader-entries #:optional (profile %system-profile)
+                                     (numbers (generation-numbers profile)))
   "Return a list of 'menu-entry' for the generations of PROFILE specified by
 NUMBERS, which is a list of generation numbers."
   (define (system->boot-parameters system number time)
@@ -437,50 +419,63 @@ connection to the store."
 ;;;
 (define (switch-to-system-generation store spec)
   "Switch the system profile to the generation specified by SPEC, and
-re-install grub with a grub configuration file that uses the specified system
+re-install bootloader with a configuration file that uses the specified system
 generation as its default entry.  STORE is an open connection to the store."
   (let ((number (relative-generation-spec->number %system-profile spec)))
     (if number
         (begin
-          (reinstall-grub store number)
+          (reinstall-bootloader store number)
           (switch-to-generation* %system-profile number))
         (leave (_ "cannot switch to system generation '~a'~%") spec))))
 
-(define (reinstall-grub store number)
-  "Re-install grub for existing system profile generation NUMBER.  STORE is an
-open connection to the store."
+(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))
          (file (string-append generation "/parameters"))
          (params (unless-file-not-found
                   (call-with-input-file file read-boot-parameters)))
-         (root-device (boot-parameters-root-device params))
+         (boot-device (boot-parameters-boot-device params))
          ;; We don't currently keep track of past menu entries' details.  The
          ;; default values will allow the system to boot, even if they differ
          ;; from the actual past values for this generation's entry.
-         (grub-config (grub-configuration (device root-device)))
+         (boot-config (bootloader-configuration
+                       (inherit (lookup-bootloader-configuration
+                                 (boot-parameters-boot-type params)))
+                       (device boot-device)))
          ;; Make the specified system generation the default entry.
-         (entries (profile-grub-entries %system-profile (list number)))
+         (entries (profile-bootloader-entries %system-profile (list number)))
          (old-generations (delv number (generation-numbers %system-profile)))
-         (old-entries (profile-grub-entries %system-profile old-generations))
-         (grub.cfg (run-with-store store
-                     (grub-configuration-file grub-config
-                                              entries
-                                              #:old-entries old-entries))))
-    (show-what-to-build store (list grub.cfg))
-    (build-derivations store (list grub.cfg))
-    ;; This is basically the same as install-grub*, but for now we avoid
-    ;; re-installing the GRUB boot loader itself onto a device, mainly because
-    ;; we don't in general have access to the same version of the GRUB package
-    ;; which was used when installing this other system generation.
-    (let* ((grub.cfg-path (derivation->output-path grub.cfg))
-           (gc-root (string-append %gc-roots-directory "/grub.cfg"))
-           (temp-gc-root (string-append gc-root ".new")))
-      (switch-symlinks temp-gc-root grub.cfg-path)
-      (unless (false-if-exception (install-grub-config grub.cfg-path "/"))
-        (delete-file temp-gc-root)
-        (leave (_ "failed to re-install GRUB configuration file: '~a'~%")
-               grub.cfg-path))
-      (rename-file temp-gc-root gc-root))))
+         (old-entries (profile-bootloader-entries
+                       %system-profile old-generations)))
+    (run-with-store store
+      (mlet* %store-monad
+          ((bootcfg ((bootloader-configuration-file-generator boot-config)
+                     boot-config entries
+                     #:old-entries old-entries))
+           (bootcfg-location -> (bootloader-configuration-file-name
+                                 boot-config))
+           (bootloader (package->derivation
+                        (bootloader-configuration-bootloader boot-config)))
+           (target -> "/")
+           (install-proc
+            (let ((procedure (bootloader-configuration-installer
+                              boot-config)))
+              (install-bootloader-derivation
+               procedure bootloader boot-device target)))
+           (drvs -> (list bootcfg bootloader install-proc)))
+        (mbegin %store-monad
+          (show-what-to-build* drvs)
+          (built-derivations drvs)
+          ;; PARAMS file may not contain a suitable BOOT-DEVICE. If BOOT-DEVICE
+          ;; is #f do not run INSTALL-PROC during bootloader installation.
+          (install-bootloader (if boot-device
+                                  install-proc
+                                  #f)
+                              #:bootcfg bootcfg
+                              #:bootcfg-location bootcfg-location
+                              #:device boot-device
+                              #:target target))))))
 
 
 ;;;
-- 
2.12.2