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 /guix | |
| 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 'guix')
| -rw-r--r-- | guix/scripts/deploy.scm | 17 |
1 files changed, 15 insertions, 2 deletions
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index 81f2b33260..6a67985c8b 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -28,6 +28,8 @@ #:use-module (guix grafts) #:use-module (ice-9 format) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (srfi srfi-37) #:export (guix-deploy)) @@ -88,7 +90,18 @@ Perform the deployment specified by FILE.\n")) (with-store store (set-build-options-from-command-line store opts) (for-each (lambda (machine) - (info (G_ "deploying to ~a...") (machine-display-name machine)) + (info (G_ "deploying to ~a...~%") + (machine-display-name machine)) (parameterize ((%graft? (assq-ref opts 'graft?))) - (run-with-store store (deploy-machine machine)))) + (guard (c ((message-condition? c) + (report-error (G_ "failed to deploy ~a: '~a'~%") + (machine-display-name machine) + (condition-message c))) + ((deploy-error? c) + (when (deploy-error-should-roll-back c) + (info (G_ "rolling back ~a...~%") + (machine-display-name machine)) + (run-with-store store (roll-back-machine machine))) + (apply throw (deploy-error-captured-args c)))) + (run-with-store store (deploy-machine machine))))) machines)))) |