me
/
guix
Archived
1
0
Fork 0
Code

deploy: Factorize machine deployment. 

* guix/scripts/deploy.scm (deploy-machine*): New procedure.
(guix-deploy): Call it in 'for-each'.
master
Ludovic Courtès 2020-03-29 15:51:08 +02:00
parent 4c60d5325e
commit d089b23335
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
guix/scripts/deploy.scm
View File

@ -30,6 +30,7 @@
#:use-module (guix status)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
@ -114,6 +115,27 @@ Perform the deployment specified by FILE.\n"))
(current-error-port))
(display "\n\n" (current-error-port))))
(define (deploy-machine* store machine)
"Deploy MACHINE, taking care of error handling."
(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))
(info (G_ "successfully deployed ~a~%")
(machine-display-name machine))))
(define (guix-deploy . args)
(define (handle-argument arg result)
(alist-cons 'file arg result))
@ -129,21 +151,5 @@ Perform the deployment specified by FILE.\n"))
(set-build-options-from-command-line store opts)
(with-build-handler (build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?))
(for-each (lambda (machine)
(info (G_ "deploying to ~a...~%")
(machine-display-name machine))
(parameterize ((%graft? (assq-ref opts 'graft?)))
(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))
(info (G_ "successfully deployed ~a~%")
(machine-display-name machine)))))
machines))))))
(for-each (cut deploy-machine* store <>) machines)))))))