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:
Ludovic Courtès 2022-07-17 16:34:01 +02:00
parent c9a37f57cb
commit ff94f9dfde
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

@ -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)))))))))))