[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#56616] [PATCH] deploy: Honor '--dry-run'.
From: |
Ludovic Courtès |
Subject: |
[bug#56616] [PATCH] deploy: Honor '--dry-run'. |
Date: |
Sun, 17 Jul 2022 16:50:21 +0200 |
* guix/scripts/deploy.scm (%options): Add "dry-run".
(show-what-to-deploy): Add #:dry-run? and honor it.
(guix-deploy): Honor --dry-run.
---
guix/scripts/deploy.scm | 32 ++++++++++++++++++++++----------
1 file changed, 22 insertions(+), 10 deletions(-)
Hi!
‘guix deploy --help’ would advertise ‘--dry-run’ but it wasn’t
actually implemented. This patch fixes that.
Note that ‘--dry-run’ doesn’t go beyond loading the deploy file.
In particular, it doesn’t attempt to build anything because that
is left to backends such as (gnu machine ssh).
Thoughts?
Ludo’.
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 27478eabc0..2c76645173 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -76,6 +76,9 @@ (define %options
(lambda args
(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
(lambda (opt name arg result)
(alist-cons 'execute-command? #t result)))
@@ -110,14 +113,20 @@ (module (make-user-module (append '((gnu) (gnu machine))
environment-modules))))
(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."
(let ((count (length machines)))
- (format (current-error-port)
- (N_ "The following ~d machine will be deployed:~%"
- "The following ~d machines will be deployed:~%"
+ (if dry-run?
+ (format (current-error-port)
+ (N_ "The following ~d machine would be deployed:~%"
+ "The following ~d machines would be deployed:~%"
+ 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
(fill-paragraph (string-join (map machine-display-name machines)
", ")
@@ -241,6 +250,7 @@ (define (handle-argument arg result)
#:argument-handler handle-argument))
(file (assq-ref opts 'file))
(machines (and file (load-source-file file)))
+ (dry-run? (assoc-ref opts 'dry-run?))
(execute-command? (assoc-ref opts 'execute-command?)))
(unless file
(leave (G_ "missing deployment file argument~%")))
@@ -254,7 +264,8 @@ (define (handle-argument arg result)
(with-build-handler (build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?)
#:verbosity
- (assoc-ref opts 'verbosity))
+ (assoc-ref opts 'verbosity)
+ #:dry-run? dry-run?)
(parameterize ((%graft? (assq-ref opts 'graft?)))
(if execute-command?
(match command
@@ -270,7 +281,8 @@ (define (handle-argument arg result)
(_
(leave (G_ "'-x' specified but no command given~%"))))
(begin
- (show-what-to-deploy machines)
- (map/accumulate-builds store
- (cut deploy-machine* store <>)
- machines))))))))))
+ (show-what-to-deploy machines #:dry-run? dry-run?)
+ (unless dry-run?
+ (map/accumulate-builds store
+ (cut deploy-machine* store <>)
+ machines)))))))))))
base-commit: 4ce7f1fb24a111f3e92d5b889d1271bebf109d09
--
2.36.1