GNU bug report logs - #75010
[PATCH 0/7] Roll back when deployment fails.

Previous Next

Full log

View this message in rfc822 format

From: Herman Rimm <herman <at> rimm.ee>
To: 75010 <at> debbugs.gnu.org
Subject: [bug#75010] [PATCH 6/7] gnu: machine: ssh: Roll-back on failure.
Date: Sat, 21 Dec 2024 18:04:10 +0100

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 --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 ~}~%")
-- 
2.45.2

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.