From b5816897c6db7984f678963dabe8ae58c6947677 Mon Sep 17 00:00:00 2001 From: Chris Marusich Date: Wed, 3 Aug 2016 00:41:01 -0700 Subject: [PATCH 9/9] Implement switch-generation and roll-back --- guix/scripts/system.scm | 87 ++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 83 insertions(+), 4 deletions(-) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index f450c9a..5c72808 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -408,6 +408,57 @@ NUMBERS, which is a list of generation numbers." ;;; +;;; Roll-back. +;;; +(define (roll-back-system store) + "Roll back the system profile to its previous generation." + (switch-to-system-generation store "-1")) + +;;; +;;; Switch generations. +;;; +(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 +generation as its default entry." + (let ((number (relative-generation-spec->number %system-profile spec))) + (if number + (begin + (reinstall-grub 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." + (unless-file-not-found + (let* + ((generation (generation-file-name %system-profile number)) + (file (string-append generation "/parameters")) + (params (call-with-input-file file read-boot-parameters)) + ;; We assume that the root file system contains the store. If this + ;; assumption is ever false, then problems might occur. + (root-device (boot-parameters-root-device params)) + ;; Generate a new grub configuration which uses default values for + ;; just about everything. If the specified system generation was + ;; built from an operating system configuration file that contained + ;; non-default values in its grub-configuration, then the grub + ;; configuration we generate here will be different. However, even + ;; if that is the case, this default configuration will be good + ;; enough to enable the user to boot into the specified generation. + (grub-config (grub-configuration (device root-device))) + ;; Make the specified system generation the default entry. + (entries (grub-entries %system-profile (list number))) + (old-entries (grub-entries)) + (grub.cfg-derivation (run-with-store store + (grub-configuration-file grub-config + root-device + entries + #:old-entries old-entries)))) + (build-derivations store (list grub.cfg-derivation)) + (install-grub-config (derivation->output-path grub.cfg-derivation) "/")))) + + +;;; ;;; Graphs. ;;; @@ -642,14 +693,19 @@ building anything." ;;; (define (show-help) - (display (_ "Usage: guix system [OPTION] ACTION [FILE] -Build the operating system declared in FILE according to ACTION.\n")) + (display (_ "Usage: guix system [OPTION ...] ACTION [ARG ...] [FILE] +Build the operating system declared in FILE according to ACTION. +Some ACTIONS support additional ARGS.\n")) (newline) (display (_ "The valid values for ACTION are:\n")) (newline) (display (_ "\ reconfigure switch to a new operating system configuration\n")) (display (_ "\ + roll-back switch to the previous operating system configuration\n")) + (display (_ "\ + switch-generation switch to an existing operating system configuration\n")) + (display (_ "\ list-generations list the system generations\n")) (display (_ "\ build build the operating system without installing anything\n")) @@ -809,6 +865,8 @@ resulting from command-line parsing." (define (process-command command args opts) "Process COMMAND, one of the 'guix system' sub-commands. ARGS is its argument list and OPTS is the option alist." + ;; The following commands do not need to use the store, and they do not need + ;; an operating system configuration file. (case command ((list-generations) ;; List generations. No need to connect to the daemon, etc. @@ -818,7 +876,27 @@ argument list and OPTS is the option alist." (x (leave (_ "wrong number of arguments~%")))))) (list-generations pattern))) (else - (process-action command args opts)))) + ;; The following commands need to use the store, but they do not need an + ;; operating system configuration file. + (case command + ((switch-generation) + (with-store store + (set-build-options-from-command-line store opts) + (let ((pattern (match args + ((pattern) pattern) + (x (leave (_ "wrong number of arguments~%")))))) + (switch-to-system-generation store pattern)))) + ((roll-back) + (with-store store + (set-build-options-from-command-line store opts) + (let ((pattern (match args + (() "") + (x (leave (_ "wrong number of arguments~%")))))) + (roll-back-system store)))) + (else + ;; The following commands need to use the store, and they also + ;; need an operating system configuration file. + (process-action command args opts)))))) (define (guix-system . args) (define (parse-sub-command arg result) @@ -828,7 +906,8 @@ argument list and OPTS is the option alist." (let ((action (string->symbol arg))) (case action ((build container vm vm-image disk-image reconfigure init - extension-graph shepherd-graph list-generations) + extension-graph shepherd-graph list-generations roll-back + switch-generation) (alist-cons 'action action result)) (else (leave (_ "~a: unknown action~%") action)))))) -- 2.9.2