diff options
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 66 |
1 files changed, 38 insertions, 28 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 7c3201c..b2310e6 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -263,40 +263,50 @@ "guixbuildcoordinator_hook_failure_total" #:labels '(event))) + (define (process-events event-name handler) + (while #t + (match (datastore-list-unprocessed-hook-events datastore event-name 1) + (() (sleep 1)) + (((id event arguments)) + (catch + #t + (lambda () + (apply handler build-coordinator arguments) + (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)))) + (lambda (key . args) + (simple-format #t "error: running ~A hook: ~A ~A\n" + event key args) + (metric-increment failure-counter-metric + #:label-values + `((event . ,event))) + #f)))))) + (for-each (match-lambda ((event-name . handler) (parameterize (((@@ (fibers internal) current-fiber) #f)) (call-with-new-thread (lambda () - (while #t - (match (datastore-list-unprocessed-hook-events datastore event-name 1) - (() (sleep 1)) - (((id event arguments)) - (catch - #t - (lambda () - (apply handler build-coordinator arguments) - (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)))) - (lambda (key . args) - (simple-format #t "error: running ~A hook: ~A ~A\n" - event key args) - (metric-increment failure-counter-metric - #:label-values - `((event . ,event))) - #f)))))))))) + (with-exception-handler + (lambda (exn) + (simple-format (current-error-port) + "error: ~A thread: ~A\n" + event-name exn) + (exit 1)) + (lambda () + (process-events event-name handler)))))))) (build-coordinator-hooks build-coordinator)) #t) |