diff mbox series

[bug#75010,v4,4/5] gnu: machine: ssh: Roll-back on failure.

Message ID 4d35b3b044f8a61a4683d12dd71c835fb3d57864.1746769714.git.herman@rimm.ee
State New
Headers
Series Roll back when deployment fails. |

Commit Message

Herman Rimm May 9, 2025, 6:02 a.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 | 20 +++++++++++++++-----
 1 file changed, 15 insertions(+), 5 deletions(-)
diff mbox series

Patch

diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index aea390fe0b3..357b4376d4b 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -513,7 +513,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)
@@ -525,7 +526,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 ~}")
@@ -536,19 +537,28 @@  (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)
               (load-system-for-kexec
-                (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_ "\
 failed to load system of '~a' for kexec reboot:~%~{~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 ~}~%")