diff options
author | Christopher Baines <mail@cbaines.net> | 2023-04-02 20:48:19 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2023-04-02 20:48:19 +0100 |
commit | 9fc74074e6e81aa6c9acd368bc4a6ee5eb9b45d2 (patch) | |
tree | 85e6a7f4cbd5ae28829def3b03d4a4dff2b4fbb3 /guix-build-coordinator/coordinator.scm | |
parent | 7c5e7cc28752a50abdb9ecaa3c60ace76828d8f4 (diff) | |
download | build-coordinator-9fc74074e6e81aa6c9acd368bc4a6ee5eb9b45d2.tar build-coordinator-9fc74074e6e81aa6c9acd368bc4a6ee5eb9b45d2.tar.gz |
Try to improve hook exception handling
This should lead to more concise backtraces at least although it may
reintroduce the problem where backtraces lead to excessive memory usage.
Diffstat (limited to 'guix-build-coordinator/coordinator.scm')
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 97 |
1 files changed, 48 insertions, 49 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 54380f3..b022c76 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -31,6 +31,7 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 format) #:use-module (ice-9 atomic) + #:use-module (ice-9 control) #:use-module (ice-9 threads) #:use-module (ice-9 exceptions) #:use-module (web uri) @@ -1001,55 +1002,53 @@ #:labels '(event))) (define (process-event id event arguments handler) - (with-exception-handler - (lambda (exn) - (log-msg - (build-coordinator-logger build-coordinator) - 'ERROR - "process-event " event " (" id ") exception: " exn) - (metric-increment failure-counter-metric - #:label-values - `((event . ,event))) - (core-guile-sleep 10)) - (lambda () - (log-msg (build-coordinator-logger build-coordinator) - 'DEBUG - "processing " event " event: " arguments) - (with-throw-handler #t - (lambda () - (call-with-duration-metric - (build-coordinator-metrics-registry build-coordinator) - "hook_duration_seconds" - (lambda () - (apply handler build-coordinator arguments)) - #:labels '(event) - #:label-values `((event . ,event)))) - (lambda args - (apply log-msg (build-coordinator-logger build-coordinator) - 'ERROR - "error running " event " (" id ") hook: " - args) - ;; TODO: This seems to be causing the threads to get stuck and use - ;; excessive amounts of memory :( - ;; (backtrace) - )) - (log-msg (build-coordinator-logger build-coordinator) - 'DEBUG - event " handler finished") - (datastore-delete-unprocessed-hook-event datastore id) - - ;; If this is the hook for a successful build, once the hook - ;; completed successfully, delete the nar files for this build. - (when (eq? 'build-success event) - (match arguments - ((build-id) - (let ((data-location (build-data-location build-id))) - (when (file-exists? data-location) - (delete-file-recursively data-location)))))) - (metric-increment success-counter-metric - #:label-values - `((event . ,event)))) - #:unwind? #t)) + (let/ec cancel + (with-exception-handler + (lambda (exn) + (log-msg (build-coordinator-logger build-coordinator) + 'ERROR + "error running " event " (" id ") hook: " + exn) + (let* ((stack (make-stack #t 3)) + (backtrace + (call-with-output-string + (lambda (port) + (display-backtrace stack port) + (newline port))))) + (display + backtrace + (current-output-port))) + (metric-increment failure-counter-metric + #:label-values + `((event . ,event))) + (core-guile-sleep 10) + (cancel #f)) + (lambda () + (call-with-duration-metric + (build-coordinator-metrics-registry build-coordinator) + "hook_duration_seconds" + (lambda () + (start-stack + 'hook + (apply handler build-coordinator arguments))) + #:labels '(event) + #:label-values `((event . ,event))))) + (log-msg (build-coordinator-logger build-coordinator) + 'DEBUG + event " handler finished") + (datastore-delete-unprocessed-hook-event datastore id) + + ;; If this is the hook for a successful build, once the hook + ;; completed successfully, delete the nar files for this build. + (when (eq? 'build-success event) + (match arguments + ((build-id) + (let ((data-location (build-data-location build-id))) + (when (file-exists? data-location) + (delete-file-recursively data-location)))))) + (metric-increment success-counter-metric + #:label-values + `((event . ,event))))) (define (single-thread-process-events event-name handler) (let ((mtx (make-mutex)) |