diff options
Diffstat (limited to 'guix-build-coordinator/coordinator.scm')
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 98 |
1 files changed, 48 insertions, 50 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 52dd50c..08eecf3 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -692,51 +692,47 @@ "hook_failure_total" #:labels '(event))) - (define (process-event event-name handler) - (match (datastore-list-unprocessed-hook-events datastore event-name 1) - (() #f) - (((id event arguments)) - (catch - #t - (lambda () - (log-msg (build-coordinator-logger build-coordinator) - 'DEBUG - "processing " event " event: " arguments) - (with-throw-handler #t + (define (process-event id event arguments handler) + (catch + #t + (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 () - (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 _ - (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)))) - (lambda (key . args) - (log-msg (build-coordinator-logger build-coordinator) - 'ERROR - "error running " event " hook: " key " " args) - (metric-increment failure-counter-metric - #:label-values - `((event . ,event))))) - #t))) + (apply handler build-coordinator arguments)) + #:labels '(event) + #:label-values `((event . ,event)))) + (lambda _ + (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)))) + (lambda (key . args) + (log-msg (build-coordinator-logger build-coordinator) + 'ERROR + "error running " event " hook: " key " " args) + (metric-increment failure-counter-metric + #:label-values + `((event . ,event)))))) (map (match-lambda @@ -764,12 +760,14 @@ #:unwind? #t)) (lambda () (while #t - (unless (process-event event-name handler) - (wait-condition-variable condvar - mtx - (+ (time-second (current-time)) - wait-timeout-seconds - (random 30)))))) + (match (datastore-list-unprocessed-hook-events datastore event-name 1) + (() + (wait-condition-variable condvar + mtx + (+ (time-second (current-time)) + wait-timeout-seconds))) + (((id event arguments)) + (process-event id event arguments handler))))) #:unwind? #t) (sleep 10)))) (cons event-name condvar)))) |