3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

scripts: system: Adapt "switch-generation" to new bootloader API.

* guix/scripts/system.scm (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.
 (system-bootloader-name): New procedure.
 (switch-to-system-generation): Adapt.
This commit is contained in:
Mathieu Othacehe 2017-04-02 09:56:08 +02:00
parent 1229d328fb
commit 3241f7ff92
No known key found for this signature in database
GPG key ID: 8354763531769CA6

View file

@ -412,49 +412,58 @@ connection to the store."
;;; ;;;
(define (switch-to-system-generation store spec) (define (switch-to-system-generation store spec)
"Switch the system profile to the generation specified by SPEC, and "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." generation as its default entry. STORE is an open connection to the store."
(let ((number (relative-generation-spec->number %system-profile spec))) (let ((number (relative-generation-spec->number %system-profile spec)))
(if number (if number
(begin (begin
(reinstall-grub store number) (reinstall-bootloader store number)
(switch-to-generation* %system-profile number)) (switch-to-generation* %system-profile number))
(leave (G_ "cannot switch to system generation '~a'~%") spec)))) (leave (G_ "cannot switch to system generation '~a'~%") spec))))
(define (reinstall-grub store number) (define* (system-bootloader-name #:optional (system %system-profile))
"Re-install grub for existing system profile generation NUMBER. STORE is an "Return the bootloader name stored in SYSTEM's \"parameters\" file."
open connection to the store." (let ((params (unless-file-not-found
(read-boot-parameters-file system))))
(boot-parameters-boot-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)) (let* ((generation (generation-file-name %system-profile number))
(params (unless-file-not-found (params (unless-file-not-found
(read-boot-parameters-file generation))) (read-boot-parameters-file generation)))
(root-device (boot-parameters-root-device params)) ;; Detect the bootloader used in %system-profile.
;; We don't currently keep track of past menu entries' details. The (bootloader (lookup-bootloader-by-name (system-bootloader-name)))
;; default values will allow the system to boot, even if they differ
;; from the actual past values for this generation's entry. ;; Use the detected bootloader with default configuration.
(grub-config (grub-configuration (device root-device))) ;; It will be enough to allow the system to boot.
(bootloader-config (bootloader-configuration
(bootloader bootloader)))
;; Make the specified system generation the default entry. ;; Make the specified system generation the default entry.
(entries (profile-boot-parameters %system-profile (list number))) (entries (profile-boot-parameters %system-profile (list number)))
(old-generations (delv number (generation-numbers %system-profile))) (old-generations (delv number (generation-numbers %system-profile)))
(old-entries (profile-boot-parameters %system-profile old-generations)) (old-entries (profile-boot-parameters
(grub.cfg (run-with-store store %system-profile old-generations)))
(grub-configuration-file grub-config (run-with-store store
entries (mlet* %store-monad
#:old-entries old-entries)))) ((bootcfg ((bootloader-configuration-file-generator bootloader)
(show-what-to-build store (list grub.cfg)) bootloader-config entries
(build-derivations store (list grub.cfg)) #:old-entries old-entries))
;; This is basically the same as install-grub*, but for now we avoid (bootcfg-file -> (bootloader-configuration-file bootloader))
;; re-installing the GRUB boot loader itself onto a device, mainly because (target -> "/")
;; we don't in general have access to the same version of the GRUB package (drvs -> (list bootcfg)))
;; which was used when installing this other system generation. (mbegin %store-monad
(let* ((grub.cfg-path (derivation->output-path grub.cfg)) (show-what-to-build* drvs)
(gc-root (string-append %gc-roots-directory "/grub.cfg")) (built-derivations drvs)
(temp-gc-root (string-append gc-root ".new"))) ;; Only install bootloader configuration file. Thus, no installer
(switch-symlinks temp-gc-root grub.cfg-path) ;; nor device is provided here.
(unless (false-if-exception (install-grub-config grub.cfg-path "/")) (install-bootloader #f
(delete-file temp-gc-root) #:bootcfg bootcfg
(leave (G_ "failed to re-install GRUB configuration file: '~a'~%") #:bootcfg-file bootcfg-file
grub.cfg-path)) #:device #f
(rename-file temp-gc-root gc-root)))) #:target target))))))
;;; ;;;