deploy: Honor '--dry-run'.
* guix/scripts/deploy.scm (%options): Add "dry-run". (show-what-to-deploy): Add #:dry-run? and honor it. (guix-deploy): Honor --dry-run.
This commit is contained in:
parent
c9a37f57cb
commit
ff94f9dfde
@ -76,6 +76,9 @@ Perform the deployment specified by FILE.\n"))
|
|||||||
(lambda args
|
(lambda args
|
||||||
(show-version-and-exit "guix deploy")))
|
(show-version-and-exit "guix deploy")))
|
||||||
|
|
||||||
|
(option '(#\n "dry-run") #f #f
|
||||||
|
(lambda (opt name arg result)
|
||||||
|
(alist-cons 'dry-run? #t result)))
|
||||||
(option '(#\x "execute") #f #f
|
(option '(#\x "execute") #f #f
|
||||||
(lambda (opt name arg result)
|
(lambda (opt name arg result)
|
||||||
(alist-cons 'execute-command? #t result)))
|
(alist-cons 'execute-command? #t result)))
|
||||||
@ -110,14 +113,20 @@ Perform the deployment specified by FILE.\n"))
|
|||||||
environment-modules))))
|
environment-modules))))
|
||||||
(load* file module)))
|
(load* file module)))
|
||||||
|
|
||||||
(define (show-what-to-deploy machines)
|
(define* (show-what-to-deploy machines #:key (dry-run? #f))
|
||||||
"Show the list of machines to deploy, MACHINES."
|
"Show the list of machines to deploy, MACHINES."
|
||||||
(let ((count (length machines)))
|
(let ((count (length machines)))
|
||||||
(format (current-error-port)
|
(if dry-run?
|
||||||
(N_ "The following ~d machine will be deployed:~%"
|
(format (current-error-port)
|
||||||
"The following ~d machines will be deployed:~%"
|
(N_ "The following ~d machine would be deployed:~%"
|
||||||
|
"The following ~d machines would be deployed:~%"
|
||||||
|
count)
|
||||||
count)
|
count)
|
||||||
count)
|
(format (current-error-port)
|
||||||
|
(N_ "The following ~d machine will be deployed:~%"
|
||||||
|
"The following ~d machines will be deployed:~%"
|
||||||
|
count)
|
||||||
|
count))
|
||||||
(display (indented-string
|
(display (indented-string
|
||||||
(fill-paragraph (string-join (map machine-display-name machines)
|
(fill-paragraph (string-join (map machine-display-name machines)
|
||||||
", ")
|
", ")
|
||||||
@ -241,6 +250,7 @@ otherwise."
|
|||||||
#:argument-handler handle-argument))
|
#:argument-handler handle-argument))
|
||||||
(file (assq-ref opts 'file))
|
(file (assq-ref opts 'file))
|
||||||
(machines (and file (load-source-file file)))
|
(machines (and file (load-source-file file)))
|
||||||
|
(dry-run? (assoc-ref opts 'dry-run?))
|
||||||
(execute-command? (assoc-ref opts 'execute-command?)))
|
(execute-command? (assoc-ref opts 'execute-command?)))
|
||||||
(unless file
|
(unless file
|
||||||
(leave (G_ "missing deployment file argument~%")))
|
(leave (G_ "missing deployment file argument~%")))
|
||||||
@ -254,7 +264,8 @@ otherwise."
|
|||||||
(with-build-handler (build-notifier #:use-substitutes?
|
(with-build-handler (build-notifier #:use-substitutes?
|
||||||
(assoc-ref opts 'substitutes?)
|
(assoc-ref opts 'substitutes?)
|
||||||
#:verbosity
|
#:verbosity
|
||||||
(assoc-ref opts 'verbosity))
|
(assoc-ref opts 'verbosity)
|
||||||
|
#:dry-run? dry-run?)
|
||||||
(parameterize ((%graft? (assq-ref opts 'graft?)))
|
(parameterize ((%graft? (assq-ref opts 'graft?)))
|
||||||
(if execute-command?
|
(if execute-command?
|
||||||
(match command
|
(match command
|
||||||
@ -270,7 +281,8 @@ otherwise."
|
|||||||
(_
|
(_
|
||||||
(leave (G_ "'-x' specified but no command given~%"))))
|
(leave (G_ "'-x' specified but no command given~%"))))
|
||||||
(begin
|
(begin
|
||||||
(show-what-to-deploy machines)
|
(show-what-to-deploy machines #:dry-run? dry-run?)
|
||||||
(map/accumulate-builds store
|
(unless dry-run?
|
||||||
(cut deploy-machine* store <>)
|
(map/accumulate-builds store
|
||||||
machines))))))))))
|
(cut deploy-machine* store <>)
|
||||||
|
machines)))))))))))
|
||||||
|
Loading…
Reference in New Issue
Block a user