aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator
diff options
context:
space:
mode:
Diffstat (limited to 'guix-build-coordinator')
-rw-r--r--guix-build-coordinator/coordinator.scm48
1 files changed, 27 insertions, 21 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 8b76457..fd72ac5 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -38,6 +38,7 @@
#:use-module (ice-9 threads)
#:use-module (ice-9 exceptions)
#:use-module (rnrs bytevectors)
+ #:use-module (system repl debug)
#:use-module (web uri)
#:use-module (web http)
#:use-module (oop goops)
@@ -1407,10 +1408,6 @@
(and
(with-exception-handler
(lambda (exn)
- (log-msg (build-coordinator-logger build-coordinator)
- 'ERROR
- "error running " event " (" id ") hook: "
- exn)
(metric-increment failure-counter-metric
#:label-values
`((event . ,event)))
@@ -1421,25 +1418,34 @@
(build-coordinator-metrics-registry build-coordinator)
"hook_duration_seconds"
(lambda ()
- (with-throw-handler #t
+ (with-exception-handler
+ (lambda (exn)
+ (let* ((stack
+ (match (fluid-ref %stacks)
+ ((stack-tag . prompt-tag)
+ (make-stack #t
+ 0 prompt-tag
+ 0 (and prompt-tag 1)))))
+ (backtrace
+ (call-with-output-string
+ (lambda (port)
+ (print-frames (stack->vector stack)
+ port
+ #:count (stack-length stack))
+ (print-exception
+ port
+ (stack-ref stack 4)
+ '%exception
+ (list exn))))))
+ (log-msg (build-coordinator-logger build-coordinator)
+ 'ERROR
+ "error running " event " (" id ") hook\n"
+ backtrace))
+ (raise-exception exn))
(lambda ()
(start-stack
- 'hook
- (apply handler build-coordinator arguments)))
- (lambda (key . args)
- (log-msg (build-coordinator-logger build-coordinator)
- 'ERROR
- "error running " event " (" id ") hook: "
- key " " args)
- (let* ((stack (make-stack #t 3))
- (backtrace
- (call-with-output-string
- (lambda (port)
- (display-backtrace stack port)
- (newline port)))))
- (display
- backtrace
- (current-output-port))))))
+ #t
+ (apply handler build-coordinator arguments)))))
#:labels '(event)
#:label-values `((event . ,event)))
#t)