From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:44254) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cufxL-0002VP-ML for guix-patches@gnu.org; Sun, 02 Apr 2017 09:54:14 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cufxK-0000c6-F7 for guix-patches@gnu.org; Sun, 02 Apr 2017 09:54:11 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:58380) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cufxK-0000bh-BK for guix-patches@gnu.org; Sun, 02 Apr 2017 09:54:10 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1cufxI-0000cx-Tm for guix-patches@gnu.org; Sun, 02 Apr 2017 09:54:10 -0400 Subject: bug#26339: [PATCH 17/18] scripts: system: Adapt "switch-generation" to new bootloader API. Resent-Message-ID: From: Mathieu Othacehe Date: Sun, 2 Apr 2017 15:52:41 +0200 Message-Id: <20170402135242.2958-17-m.othacehe@gmail.com> In-Reply-To: <20170402135242.2958-1-m.othacehe@gmail.com> References: <20170402135242.2958-1-m.othacehe@gmail.com> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 26339@debbugs.gnu.org * 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 | 73 +++++++++++++++++++++++++++++-------------------- 1 file changed, 43 insertions(+), 30 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 560115ec3..400152d6d 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -377,8 +377,8 @@ it atomically, and then run OS's activation script." (date->string (time-utc->date time) "~Y-~m-~d ~H:~M"))) -(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) @@ -419,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-procedure boot-config) + boot-config entries + #:old-entries old-entries)) + (bootcfg-location -> (bootloader-configuration-file-location + boot-config)) + (bootloader (package->derivation + (bootloader-configuration-bootloader boot-config))) + (target -> "/") + (install-proc + (let ((procedure (bootloader-configuration-install-procedure + 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