[bug#75414] [PATCH 0/2] Add roll-back action to guix deploy

[bug#75414] [PATCH 0/2] Add roll-back action to guix deploy

[Arun Isaac]

Hi,

I implement a roll-back action for guix deploy. This is convenient to roll
back all machines in a `guix deploy' configuration.

By the by, PATCH 1 fixes a bug necessary to make this work.

Regards,
Arun

Arun Isaac (2):
  machine: ssh: Return monadic value from roll-back-managed-host.
  deploy: Add roll-back action.

 doc/guix.texi           |  7 ++++
 gnu/machine/ssh.scm     |  6 ++-
 guix/scripts/deploy.scm | 90 +++++++++++++++++++++++++++++++++--------
 3 files changed, 84 insertions(+), 19 deletions(-)


base-commit: 67a535351f8678969e412e8dba9197a883b524d0
-- 
2.47.1

[bug#75414] [PATCH 1/2] machine: ssh: Return monadic value from roll-back-managed-host.

[Arun Isaac]

Previously, <unspecified> would be returned. That was a bug. Monadic
procedures must always return monadic values.

* gnu/machine/ssh.scm (roll-back-managed-host): Return monadic value.

Change-Id: I3db2879dbfbcab5e9d251fa5ed02c8653adbeafb
---
 gnu/machine/ssh.scm | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index bc4289ef7d..73d5dc513e 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
 ;;; Copyright © 2020-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2024 Ricardo <rekado@elephly.net>
+;;; Copyright © 2025 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -621,8 +622,9 @@ (define (roll-back-managed-host machine)
                                   #:store-directory-prefix store-dir
                                   #:old-entries old-entries)))
                        (remote-result (machine-remote-eval machine remote-exp)))
-    (when (eqv? 'error remote-result)
-      (raise roll-back-failure))))
+    (if (eqv? 'error remote-result)
+        (raise roll-back-failure)
+        (return remote-result))))
 
 \f
 ;;;
-- 
2.47.1

[bug#75414] [PATCH 2/2] deploy: Add roll-back action.

[Arun Isaac]

* 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

[bug#75414] [PATCH 1/2] machine: ssh: Return monadic value from roll-back-managed-host.

[Ludovic Courtès]

Howdy Arun,

Arun Isaac <arunisaac@systemreboot.net> skribis:

> Previously, <unspecified> would be returned. That was a bug. Monadic
> procedures must always return monadic values.
>
> * gnu/machine/ssh.scm (roll-back-managed-host): Return monadic value.
>
> Change-Id: I3db2879dbfbcab5e9d251fa5ed02c8653adbeafb

LGTM!

[bug#75414] [PATCH 2/2] deploy: Add roll-back action.

[Ludovic Courtès]

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’.