diff options
| author | Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org> | 2019-08-15 04:05:57 -0400 |
|---|---|---|
| committer | Christopher Lemmer Webber <cwebber@dustycloud.org> | 2019-08-15 07:43:09 -0400 |
| commit | 9c70c460a05b2bc60f3f3602f0a2dba0f79ce86c (patch) | |
| tree | 5b55aca91aba654177e117e61020b68236b8dc58 /gnu/machine.scm | |
| parent | 5ea7537b9a650cfa525401c19879080a9cf42e13 (diff) | |
| download | patches-9c70c460a05b2bc60f3f3602f0a2dba0f79ce86c.tar patches-9c70c460a05b2bc60f3f3602f0a2dba0f79ce86c.tar.gz | |
machine: Implement 'roll-back-machine'.
* gnu/machine.scm (roll-back-machine, &deploy-error, deploy-error?)
(deploy-error-should-roll-back)
(deploy-error-captured-args): New variable.
* gnu/machine/ssh.scm (roll-back-managed-host): New variable.
* guix/scripts/deploy.scm (guix-deploy): Roll-back systems when a
deployment fails.
Diffstat (limited to 'gnu/machine.scm')
| -rw-r--r-- | gnu/machine.scm | 27 |
1 files changed, 26 insertions, 1 deletions
diff --git a/gnu/machine.scm b/gnu/machine.scm index 30ae97f6ec..05b03b21d4 100644 --- a/gnu/machine.scm +++ b/gnu/machine.scm @@ -24,6 +24,7 @@ #:use-module (guix records) #:use-module (guix store) #:use-module ((guix utils) #:select (source-properties->location)) + #:use-module (srfi srfi-35) #:export (environment-type environment-type? environment-type-name @@ -40,7 +41,13 @@ machine-display-name deploy-machine - machine-remote-eval)) + roll-back-machine + machine-remote-eval + + &deploy-error + deploy-error? + deploy-error-should-roll-back + deploy-error-captured-args)) ;;; Commentary: ;;; @@ -66,6 +73,7 @@ ;; of the form '(machine-remote-eval machine exp)'. (machine-remote-eval environment-type-machine-remote-eval) ; procedure (deploy-machine environment-type-deploy-machine) ; procedure + (roll-back-machine environment-type-roll-back-machine) ; procedure ;; Metadata. (name environment-type-name) ; symbol @@ -105,3 +113,20 @@ are built and deployed to MACHINE beforehand." MACHINE, activating it on MACHINE and switching MACHINE to the new generation." (let ((environment (machine-environment machine))) ((environment-type-deploy-machine environment) machine))) + +(define (roll-back-machine machine) + "Monadic procedure rolling back to the previous system generation on +MACHINE. Return the number of the generation that was current before switching +and the new generation number." + (let ((environment (machine-environment machine))) + ((environment-type-roll-back-machine environment) machine))) + + +;;; +;;; Error types. +;;; + +(define-condition-type &deploy-error &error + deploy-error? + (should-roll-back deploy-error-should-roll-back) + (captured-args deploy-error-captured-args)) |