diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-03-25 21:53:51 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-03-25 21:53:51 +0000 |
| commit | 93ffdacac240fea84985c71c601f7faf2dc2a9d3 (patch) | |
| tree | 3f491e5879015605e4e1ac26015360bf21aeecb4 | |
| parent | 1590a088f9c8a05676cbb55a7a8df94fa88bac1f (diff) | |
| download | build-coordinator-93ffdacac240fea84985c71c601f7faf2dc2a9d3.tar build-coordinator-93ffdacac240fea84985c71c601f7faf2dc2a9d3.tar.gz | |
Send an event when builds are allocated to an agent
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 77 |
1 files changed, 43 insertions, 34 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 749c931..3c9fb88 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -1213,41 +1213,50 @@ (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) + (let ((builds + (get-builds))) + + (build-coordinator-send-event + build-coordinator + "agent-builds-allocated" + `((agent_id . ,agent) + (builds . ,(list->vector builds)))) + + (map (lambda (build) + (define submit-outputs? + (with-exception-handler + (lambda (exn) + (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))))))) + "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?))) + builds))))))) (define (agent-details datastore agent-id) (let ((agent (datastore-find-agent datastore agent-id)) |