[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
06/07: machine: ssh: Gracefully handle failure of the effectful bits.
From: |
guix-commits |
Subject: |
06/07: machine: ssh: Gracefully handle failure of the effectful bits. |
Date: |
Tue, 1 Jun 2021 17:27:29 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 2885c3568edec35086f8feeae5b60259cbea407c
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Jun 1 22:35:28 2021 +0200
machine: ssh: Gracefully handle failure of the effectful bits.
Previously, '&inferior-exception' raised by 'upgrade-shepherd-services'
and co. would go through as-is, leaving users with an ugly backtrace.
* gnu/machine/ssh.scm (deploy-managed-host): Define
'eval/error-handling' and use it in lieu of EVAL as arguments to
'switch-to-system', 'upgrade-shepherd-services', and
'install-bootloader'.
---
gnu/machine/ssh.scm | 40 +++++++++++++++++++++++++++++++++++++---
1 file changed, 37 insertions(+), 3 deletions(-)
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index fa94216..93b0a00 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -38,6 +38,9 @@
#:use-module (guix store)
#:use-module (guix utils)
#:use-module ((guix self) #:select (make-config.scm))
+ #:use-module ((guix inferior)
+ #:select (inferior-exception?
+ inferior-exception-arguments))
#:use-module (gcrypt pk-crypto)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
@@ -443,17 +446,46 @@ have you run 'guix archive --generate-key?'")
(mlet %store-monad ((_ (check-deployment-sanity machine))
(boot-parameters (machine-boot-parameters machine)))
(let* ((os (machine-operating-system machine))
+ (host (machine-ssh-configuration-host-name
+ (machine-configuration machine)))
(eval (cut machine-remote-eval 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 ...)
+ ;; Return a wrapper around EVAL such that HANDLER is evaluated if an
+ ;; exception is raised.
+ (lambda (exp)
+ (lambda (store)
+ (guard (condition ((inferior-exception? condition)
+ (values (begin handler ...) store)))
+ (run-with-store store (eval exp))))))
+
(mbegin %store-monad
(with-roll-back #f
- (switch-to-system eval os))
+ (switch-to-system (eval/error-handling c
+ (raise (formatted-message
+ (G_ "\
+failed to switch systems while deploying '~a':~%~{~s ~}")
+ host
+ (inferior-exception-arguments c))))
+ os))
(with-roll-back #t
(mbegin %store-monad
- (upgrade-shepherd-services eval os)
- (install-bootloader eval bootloader-configuration bootcfg)))))))
+ (upgrade-shepherd-services (eval/error-handling c
+ (warning (G_ "\
+an error occurred while upgrading services on '~a':~%~{~s ~}~%")
+ host
+ (inferior-exception-arguments
+ c)))
+ os)
+ (install-bootloader (eval/error-handling c
+ (raise (formatted-message
+ (G_ "\
+failed to install bootloader on '~a':~%~{~s ~}~%")
+ host
+ (inferior-exception-arguments c))))
+ bootloader-configuration bootcfg)))))))
;;;
@@ -540,4 +572,6 @@ for environment of type '~a'")
;; Local Variables:
;; eval: (put 'remote-let 'scheme-indent-function 1)
+;; eval: (put 'with-roll-back 'scheme-indent-function 1)
+;; eval: (put 'eval/error-handling 'scheme-indent-function 1)
;; End:
- branch master updated (49b1570 -> 2df1c4f), guix-commits, 2021/06/01
- 01/07: maint: Require Guile 3.0., guix-commits, 2021/06/01
- 02/07: ui, lint: Simplify exception handling in Guile 3 style., guix-commits, 2021/06/01
- 04/07: services: cuirass: Create the profile and GC root directory., guix-commits, 2021/06/01
- 07/07: gnu: rtl8821ce-linux-module: Update to 0.0.0-3.897e7c4., guix-commits, 2021/06/01
- 06/07: machine: ssh: Gracefully handle failure of the effectful bits.,
guix-commits <=
- 03/07: nls: Translate (guix diagnostics)., guix-commits, 2021/06/01
- 05/07: services: cuirass: Do not export record type descriptors., guix-commits, 2021/06/01