summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/profiles.scm19
-rw-r--r--guix/scripts/package.scm8
-rw-r--r--guix/scripts/system.scm106
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))))))