diff mbox series

[bug#75010,6/7] gnu: machine: ssh: Roll-back on failure.

Message ID bff43ef960ffdcb7c366767b16f2dbe8da037ee5.1734798943.git.herman@rimm.ee
State New
Headers
Series Roll back when deployment fails. |

Commit Message

Herman Rimm Dec. 21, 2024, 5:04 p.m. UTC 
  This restores the roll-back behaviour which was disabled in 2885c35.

* gnu/machine/ssh.scm (deploy-managed-host): Use roll-back-machine.

Change-Id: I8636347541ee1e4e30da15dd43455329a46c3bdb
---
 gnu/machine/ssh.scm | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)
diff mbox series

Patch

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index b954620b69..9cc9c8f099 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -512,7 +512,8 @@  (define (deploy-managed-host machine)
              (menu-entries (map boot-parameters->menu-entry boot-parameters))
              (bootloader-configuration (operating-system-bootloader os))
              (bootcfg (operating-system-bootcfg os menu-entries)))
-        (define-syntax-rule (eval/error-handling condition handler ...)
+        (define-syntax-rule (eval/error-handling condition store
+                                                 handler ...)
           ;; Return a wrapper around EVAL such that HANDLER is evaluated if an
           ;; exception is raised.
           (lambda (exp)
@@ -524,7 +525,7 @@  (define (deploy-managed-host machine)
                         store)))))
 
         (mbegin %store-monad
-          (switch-to-system (eval/error-handling c
+          (switch-to-system (eval/error-handling c store
                               (raise (formatted-message
                                       (G_ "\
 failed to switch systems while deploying '~a':~%~{~s ~}")
@@ -535,13 +536,19 @@  (define (deploy-managed-host machine)
                          (%current-target-system #f))
             (mbegin %store-monad
               (upgrade-shepherd-services
-                (eval/error-handling c
+                (eval/error-handling c store
+                  (info (G_ "rolling back ~a...~%") host)
+                  (run-with-store store (roll-back-machine machine)
+                                  #:system system)
                   (warning (G_ "\
 an error occurred while upgrading services on '~a':~%~{~s ~}~%")
                            host (inferior-exception-arguments c)))
                 os)
               (install-bootloader
-                (eval/error-handling c
+                (eval/error-handling c store
+                  (info (G_ "rolling back ~a...~%") host)
+                  (run-with-store store (roll-back-machine machine)
+                                  #:system system)
                   (raise (formatted-message
                            (G_ "\
 failed to install bootloader on '~a':~%~{~s ~}~%")