diff options
| author | Christopher Baines <mail@cbaines.net> | 2025-02-10 14:02:39 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2025-02-10 14:02:39 +0000 |
| commit | e4809ca2bd8b248e10642090e1f83b82715b94f7 (patch) | |
| tree | e38db370eb5691d23d6c1fb49fa851bb6735f38e /guix-build-coordinator | |
| parent | 81775f76958ce96133f88f4569f08eb0bc1e0b92 (diff) | |
| download | build-coordinator-e4809ca2bd8b248e10642090e1f83b82715b94f7.tar build-coordinator-e4809ca2bd8b248e10642090e1f83b82715b94f7.tar.gz | |
Improve hook exception printing
Diffstat (limited to 'guix-build-coordinator')
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 48 |
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) |