[bug#75414,2/2] deploy: Add roll-back action.
Commit Message
* guix/scripts/deploy.scm (guix-deploy): Add the roll-back action.
(show-what-to-deploy): Optionally support the roll-back action.
(roll-back-machine*): New function.
(show-help): Document the roll-back action.
* doc/guix.texi (Invoking guix deploy): Document the roll-back action.
Change-Id: Ic5084f287aefb2d1d28380ca4ba1c6971cb913e7
---
doc/guix.texi | 7 ++++
guix/scripts/deploy.scm | 90 +++++++++++++++++++++++++++++++++--------
2 files changed, 80 insertions(+), 17 deletions(-)
Comments
Arun Isaac <arunisaac@systemreboot.net> skribis:
> * guix/scripts/deploy.scm (guix-deploy): Add the roll-back action.
> (show-what-to-deploy): Optionally support the roll-back action.
> (roll-back-machine*): New function.
> (show-help): Document the roll-back action.
> * doc/guix.texi (Invoking guix deploy): Document the roll-back action.
>
> Change-Id: Ic5084f287aefb2d1d28380ca4ba1c6971cb913e7
[...]
> +You may also wish to roll back configurations on machines to a previous
> +generation. You can do that using
^
I would add a colon.
> (define (show-help)
> - (display (G_ "Usage: guix deploy [OPTION] FILE...
> -Perform the deployment specified by FILE.\n"))
> + (display (G_ "Usage: guix deploy [OPTION] [ACTION] FILE...
Hmm I would rather have ‘guix deploy --roll-back’, although that’d be
different from ‘guix system’, primarily because I don’t see what other
actions we could have, and in particular how we’d name the default
action (‘guix deploy deploy’? ‘guix deploy really’? ‘guix deploy
please’?).
Tough issue!
But note that if we make it a ‘--roll-back’ option, we can easily change
our mind later and make it an action, whereas the converse would be more
difficult.
Apart from that it looks great to me.
Thank you!
Ludo’.
@@ -44354,6 +44354,13 @@ Invoking guix deploy
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
+
+@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
@@ -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.
;;;
@@ -50,8 +51,13 @@ (define-module (guix scripts deploy)
(define (show-help)
- (display (G_ "Usage: guix deploy [OPTION] FILE...
-Perform the deployment specified by FILE.\n"))
+ (display (G_ "Usage: guix deploy [OPTION] [ACTION] FILE...
+Perform the deployment specified by FILE.
+Optionally, perform ACTION.\n\n"))
+ (display (G_ "The valid values for ACTION are:\n"))
+ (newline)
+ (display (G_ "\
+ roll-back switch to the previous operating system configuration\n"))
(show-build-options-help)
(newline)
(display (G_ "
@@ -118,20 +124,32 @@ (define (load-source-file file)
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 @@ (define (deploy-machine* store machine)
(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
@@ -291,9 +338,18 @@ (define-command (guix-deploy . args)
machines)))
(_
(leave (G_ "'-x' specified but no command given~%"))))
- (begin
- (show-what-to-deploy machines #:dry-run? dry-run?)
- (unless dry-run?
- (map/accumulate-builds store
- (cut deploy-machine* store <>)
- machines)))))))))))
+ (match args
+ (("roll-back" _ ...)
+ (show-what-to-deploy machines
+ #:dry-run? dry-run?
+ #:roll-back? #t)
+ (unless dry-run?
+ (map/accumulate-builds store
+ (cut roll-back-machine* store <>)
+ machines)))
+ (_
+ (show-what-to-deploy machines #:dry-run? dry-run?)
+ (unless dry-run?
+ (map/accumulate-builds store
+ (cut deploy-machine* store <>)
+ machines))))))))))))