From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:50466) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d02Yx-0000c1-Nw for guix-patches@gnu.org; Mon, 17 Apr 2017 05:03:14 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d02Yu-0001Yu-VV for guix-patches@gnu.org; Mon, 17 Apr 2017 05:03:11 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:53312) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d02Yu-0001Yj-Sa for guix-patches@gnu.org; Mon, 17 Apr 2017 05:03:08 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d02Yu-0005Rp-Lt for guix-patches@gnu.org; Mon, 17 Apr 2017 05:03:08 -0400 Subject: bug#26339: [PATCH v2 11/12] scripts: system: Adapt "switch-generation" to new bootloader API. Resent-Message-ID: From: Mathieu Othacehe Date: Mon, 17 Apr 2017 11:01:47 +0200 Message-Id: <20170417090148.13791-12-m.othacehe@gmail.com> In-Reply-To: <20170417090148.13791-1-m.othacehe@gmail.com> References: <20170417090148.13791-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 | 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