aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/coordinator.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix-build-coordinator/coordinator.scm')
-rw-r--r--guix-build-coordinator/coordinator.scm81
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))