diff options
Diffstat (limited to 'guix-build-coordinator/coordinator.scm')
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 81 |
1 files changed, 44 insertions, 37 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index bb4e645..5bb922a 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -727,43 +727,50 @@ (build-coordinator-metrics-registry build-coordinator) "coordinator_fetch_builds_duration_seconds" (lambda () - (let ((update-made (datastore-update-agent-requested-systems - (build-coordinator-datastore build-coordinator) - agent - systems))) - (when update-made - (trigger-build-allocation build-coordinator))) - - (map (lambda (build) - (define submit-outputs? - (with-exception-handler - (lambda (exn) - (log-msg (build-coordinator-logger build-coordinator) - 'CRITICAL - "build-submit-outputs hook raised exception: " - exn)) - (lambda () - (with-throw-handler #t - (lambda () - (let ((hook-result (build-submit-outputs-hook build-coordinator - (assq-ref build 'uuid)))) - (if (boolean? hook-result) - hook-result - (begin - (log-msg (build-coordinator-logger build-coordinator) - 'CRITICAL - "build-submit-outputs hook returned non boolean: " - hook-result) - #t)))) - (lambda (key . args) - (backtrace)))) - #:unwind? #t)) - - `(,@build - ;; TODO This needs reconsidering when things having been built in - ;; the past doesn't necessarily mean they're still available. - (submit_outputs . ,submit-outputs?))) - (get-builds))))) + (call-with-delay-logging + (lambda () + (let ((update-made (datastore-update-agent-requested-systems + (build-coordinator-datastore build-coordinator) + agent + systems))) + (when update-made + (trigger-build-allocation build-coordinator))) + + (map (lambda (build) + (define submit-outputs? + (with-exception-handler + (lambda (exn) + (log-msg (build-coordinator-logger build-coordinator) + 'CRITICAL + "build-submit-outputs hook raised exception: " + exn)) + (lambda () + (with-throw-handler #t + (lambda () + (let ((hook-result + (call-with-delay-logging + (lambda () + (build-submit-outputs-hook + build-coordinator + (assq-ref build 'uuid)))))) + (if (boolean? hook-result) + hook-result + (begin + (log-msg + (build-coordinator-logger build-coordinator) + 'CRITICAL + "build-submit-outputs hook returned non boolean: " + hook-result) + #t)))) + (lambda (key . args) + (backtrace)))) + #:unwind? #t)) + + `(,@build + ;; TODO This needs reconsidering when things having been built in + ;; the past doesn't necessarily mean they're still available. + (submit_outputs . ,submit-outputs?))) + (get-builds))))))) (define (agent-details datastore agent-id) (let ((agent (datastore-find-agent datastore agent-id)) |