diff options
| author | Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org> | 2019-07-23 14:14:39 -0400 |
|---|---|---|
| committer | Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org> | 2019-07-31 09:54:50 -0400 |
| commit | 8e708b9e6895f0469cd4251567f43a174d372d26 (patch) | |
| tree | e7c691cebb670e9e469341e7c4f8bb0681da0c77 /guix/scripts/deploy.scm | |
| parent | 2caa50c35e6904b6f1118fb2b969740aa32f3210 (diff) | |
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/scripts/deploy.scm')
| -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 52bba3f3b..8eeb9ae7a 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -27,6 +27,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)) @@ -87,8 +89,19 @@ 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 ((%current-system (assq-ref opts 'system)) (%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)))) |