* [bug#75414] [PATCH 2/2] deploy: Add roll-back action.
2025-01-07 0:18 [bug#75414] [PATCH 0/2] Add roll-back action to guix deploy Arun Isaac
2025-01-07 0:28 ` [bug#75414] [PATCH 1/2] machine: ssh: Return monadic value from roll-back-managed-host Arun Isaac
@ 2025-01-07 0:28 ` Arun Isaac
1 sibling, 0 replies; 3+ messages in thread
From: Arun Isaac @ 2025-01-07 0:28 UTC (permalink / raw)
To: 75414
Cc: Arun Isaac, Arun Isaac, Christopher Baines, Josselin Poiret,
Ludovic Courtès, Mathieu Othacehe, Maxim Cournoyer,
Simon Tournier, Tobias Geerinckx-Rice
* 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(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index b2bcab8791..c08c2c70ef 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 941ee199f0..3f1b8b27a7 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.
;;;
@@ -50,8 +51,13 @@ (define-module (guix scripts deploy)
\f
(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))))))))))))
--
2.47.1
^ permalink raw reply related [flat|nested] 3+ messages in thread