ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

deploy: Let key-and-args exceptions through.

Browse source 
Fixes <https://bugs.gnu.org/44825>.
Reported by Christopher Lemmer Webber <cwebber@dustycloud.org>.

* guix/ui.scm (guard*): Export.
* guix/scripts/deploy.scm (deploy-machine*): Use 'guard*' instead of
'guard'.  Add '&exception-with-kind-and-args' case.
This commit is contained in:
Ludovic Courtès 2020-11-26 22:53:08 +01:00
parent 3c881facce
commit 5842239a66
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 23 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
guix/scripts/deploy.scm
View file

@ -120,17 +120,28 @@ (define (deploy-machine* store machine)
(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))))

1
guix/ui.scm
View file

@ -101,6 +101,7 @@ (define-module (guix ui)
show-what-to-build
show-what-to-build*
show-manifest-transaction
guard*
call-with-error-handling
with-error-handling
with-unbound-variable-handling