diff options
-rw-r--r-- | doc/guix.texi | 8 | ||||
-rw-r--r-- | guix/scripts/deploy.scm | 75 |
2 files changed, 72 insertions, 11 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 9fd92b4891..0ca109a214 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -45249,6 +45249,14 @@ guix deploy @var{file} -x -- herd restart @var{service} The @command{guix deploy -x} command returns zero if and only if the command succeeded on all the machines. +You may also wish to roll back configurations on machines to a previous +generation. You can do that using the @option{--roll-back} or +@option{-r} option like so: + +@example +guix deploy --roll-back @var{file} +@end example + @c FIXME/TODO: Separate the API doc from the CLI doc. Below are the data types you need to know about when writing a diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm index 941ee199f0..e2ef0006e0 100644 --- a/guix/scripts/deploy.scm +++ b/guix/scripts/deploy.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org> ;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com> +;;; Copyright © 2025 Arun Isaac <arunisaac@systemreboot.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -63,6 +64,8 @@ Perform the deployment specified by FILE.\n")) -e, --expression=EXPR deploy the list of machines EXPR evaluates to")) (newline) (display (G_ " + -r, --roll-back switch to the previous operating system configuration")) + (display (G_ " -x, --execute execute the following command on all the machines")) (newline) (display (G_ " @@ -84,6 +87,9 @@ Perform the deployment specified by FILE.\n")) (option '(#\n "dry-run") #f #f (lambda (opt name arg result) (alist-cons 'dry-run? #t result))) + (option '(#\r "roll-back") #f #f + (lambda (opt name arg result) + (alist-cons 'roll-back? #t result))) (option '(#\x "execute") #f #f (lambda (opt name arg result) (alist-cons 'execute-command? #t result))) @@ -118,20 +124,32 @@ Perform the deployment specified by FILE.\n")) environment-modules)))) (load* file module))) -(define* (show-what-to-deploy machines #:key (dry-run? #f)) - "Show the list of machines to deploy, MACHINES." +(define* (show-what-to-deploy machines #:key (dry-run? #f) (roll-back? #f)) + "Show the list of machines in MACHINES to deploy or roll back." (let ((count (length machines))) (if dry-run? - (format (current-error-port) - (N_ "The following ~d machine would be deployed:~%" - "The following ~d machines would be deployed:~%" + (if roll-back? + (format (current-error-port) + (N_ "The following ~d machine would be rolled back:~%" + "The following ~d machines would be rolled back:~%" count) count) - (format (current-error-port) - (N_ "The following ~d machine will be deployed:~%" - "The following ~d machines will be deployed:~%" + (format (current-error-port) + (N_ "The following ~d machine would be deployed:~%" + "The following ~d machines would be deployed:~%" + count) + count)) + (if roll-back? + (format (current-error-port) + (N_ "The following ~d machine will be rolled back:~%" + "The following ~d machines will be rolled back:~%" + 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) ", ") @@ -175,6 +193,35 @@ Perform the deployment specified by FILE.\n")) (info (G_ "successfully deployed ~a~%") (machine-display-name machine)))) +(define (roll-back-machine* store machine) + "Roll back MACHINE, taking care of error handling." + (info (G_ "rolling back ~a...~%") + (machine-display-name 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. + (((exception-predicate &exception-with-kind-and-args) c) + (raise c)) + + ((message-condition? c) + (leave (G_ "failed to roll back ~a: ~a~%") + (machine-display-name machine) + (condition-message c))) + ((formatted-message? c) + (leave (G_ "failed to roll back ~a: ~a~%") + (machine-display-name machine) + (apply format #f + (gettext (formatted-message-string c) + %gettext-domain) + (formatted-message-arguments c))))) + (run-with-store store (roll-back-machine machine))) + + (info (G_ "successfully rolled back ~a~%") + (machine-display-name machine))) + (define (invoke-command store machine command) "Invoke COMMAND, a list of strings, on MACHINE. Display its output (if any) and its error code if it's non-zero. Return true if COMMAND succeeded, false @@ -258,6 +305,7 @@ otherwise." (machines (or (and file (load-source-file file)) (and expression (read/eval expression)))) (dry-run? (assoc-ref opts 'dry-run?)) + (roll-back? (assq-ref opts 'roll-back?)) (execute-command? (assoc-ref opts 'execute-command?))) (when (and file expression) (leave (G_ "both '--expression' and a deployment file were provided~%"))) @@ -292,8 +340,13 @@ otherwise." (_ (leave (G_ "'-x' specified but no command given~%")))) (begin - (show-what-to-deploy machines #:dry-run? dry-run?) + (show-what-to-deploy machines + #:dry-run? dry-run? + #:roll-back? roll-back?) (unless dry-run? (map/accumulate-builds store - (cut deploy-machine* store <>) + (cut (if roll-back? + roll-back-machine* + deploy-machine*) + store <>) machines))))))))))) |