diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-11-29 14:19:55 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-11-29 17:34:18 +0000 |
| commit | ff01206345e2306cc633db48e0b29eab9077091a (patch) | |
| tree | 25c7ee17005dadc9bf4fae3f0873e03a4704f782 /guix/scripts/deploy.scm | |
| parent | ed2545f0fa0e2ad99d5a0c45f532c539b299b9fb (diff) | |
| parent | 7c2e67400ffaef8eb6f30ef7126c976ee3d7e36c (diff) | |
Merge remote-tracking branch 'origin/master' into core-updates
Diffstat (limited to 'guix/scripts/deploy.scm')
| -rw-r--r-- | guix/scripts/deploy.scm | 33 |
1 files changed, 22 insertions, 11 deletions
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index 1b5be307be..0725fba54b 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -120,17 +120,28 @@ Perform the deployment specified by FILE.\n")) (info (G_ "deploying to ~a...~%") (machine-display-name 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)) + (guard* (c + ;; On Guile 3.0, exceptions such as 'unbound-variable' are compound + ;; and include a '&message'. However, that message only contains + ;; the format string. Thus, special-case it here to avoid + ;; displaying a bare format string. + ((cond-expand + (guile-3 + ((exception-predicate &exception-with-kind-and-args) c)) + (else #f)) + (raise 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)) (info (G_ "successfully deployed ~a~%") (machine-display-name machine)))) |