diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/profiles.scm | 19 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 8 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 106 |
3 files changed, 116 insertions, 17 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index 6a9e570a3f..b56b8f4c79 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net> +;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -97,6 +98,7 @@ generation-number generation-numbers profile-generations + relative-generation-spec->number relative-generation previous-generation-number generation-time @@ -1048,6 +1050,23 @@ former profiles were found." '() generations))) +(define (relative-generation-spec->number profile spec) + "Return PROFILE's generation specified by SPEC, which is a string. The SPEC +may be a N, -N, or +N, where N is a number. If the spec is N, then the number +returned is N. If it is -N, then the number returned is the profile's current +generation number minus N. If it is +N, then the number returned is the +profile's current generation number plus N. Return #f if there is no such +generation." + (let ((number (string->number spec))) + (and number + (case (string-ref spec 0) + ((#\+ #\-) + (relative-generation profile number)) + (else (if (memv number (profile-generations profile)) + number + #f)))))) + + (define* (relative-generation profile shift #:optional (current (generation-number profile))) "Return PROFILE's generation shifted from the CURRENT generation by SHIFT. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 70ed0a7ea6..96a22f6fab 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com> ;;; Copyright © 2016 Roel Janssen <roel@gnu.org> ;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch> +;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -782,12 +783,7 @@ processed, #f otherwise." #:key dry-run?) "Switch PROFILE to the generation specified by SPEC." (unless dry-run? - (let* ((number (string->number spec)) - (number (and number - (case (string-ref spec 0) - ((#\+ #\-) - (relative-generation profile number)) - (else number))))) + (let ((number (relative-generation-spec->number profile spec))) (if number (switch-to-generation* profile number) (leave (_ "cannot switch to generation '~a'~%") spec))))) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index e548be649d..df9b37d544 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -366,8 +366,10 @@ it atomically, and then run OS's activation script." (date->string (time-utc->date time) "~Y-~m-~d ~H:~M"))) -(define* (previous-grub-entries #:optional (profile %system-profile)) - "Return a list of 'menu-entry' for the generations of PROFILE." +(define* (profile-grub-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->grub-entry system number time) (unless-file-not-found (let* ((file (string-append system "/parameters")) @@ -395,8 +397,7 @@ it atomically, and then run OS's activation script." kernel-arguments)) (initrd initrd))))) - (let* ((numbers (generation-numbers profile)) - (systems (map (cut generation-file-name profile <>) + (let* ((systems (map (cut generation-file-name profile <>) numbers)) (times (map (lambda (system) (unless-file-not-found @@ -406,6 +407,65 @@ it atomically, and then run OS's activation script." ;;; +;;; Roll-back. +;;; +(define (roll-back-system store) + "Roll back the system profile to its previous generation. STORE is an open +connection to the store." + (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. STORE is an open connection to the store." + (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. 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)) + ;; 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))) + ;; Make the specified system generation the default entry. + (entries (profile-grub-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)))) + + +;;; ;;; Graphs. ;;; @@ -563,7 +623,7 @@ building anything." (operating-system-grub.cfg os (if (eq? 'init action) '() - (previous-grub-entries))))) + (profile-grub-entries))))) ;; For 'init' and 'reconfigure', always build GRUB.CFG, even if ;; --no-grub is passed, because GRUB.CFG because we then use it as a GC @@ -640,14 +700,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")) @@ -808,15 +873,33 @@ resulting from command-line parsing." "Process COMMAND, one of the 'guix system' sub-commands. ARGS is its argument list and OPTS is the option alist." (case command + ;; The following commands do not need to use the store, and they do not need + ;; an operating system configuration file. ((list-generations) - ;; List generations. No need to connect to the daemon, etc. (let ((pattern (match args (() "") ((pattern) pattern) (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. + ((switch-generation) + (let ((pattern (match args + ((pattern) pattern) + (x (leave (_ "wrong number of arguments~%")))))) + (with-store store + (set-build-options-from-command-line store opts) + (switch-to-system-generation store pattern)))) + ((roll-back) + (let ((pattern (match args + (() "") + (x (leave (_ "wrong number of arguments~%")))))) + (with-store store + (set-build-options-from-command-line store opts) + (roll-back-system store)))) + ;; The following commands need to use the store, and they also + ;; need an operating system configuration file. + (else (process-action command args opts)))) (define (guix-system . args) (define (parse-sub-command arg result) @@ -826,7 +909,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)))))) |