diff options
author | Christopher Baines <mail@cbaines.net> | 2021-11-15 22:36:50 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2021-11-16 12:50:09 +0000 |
commit | 1288d9c1185bd1111e2fee9459714178a2cb8f13 (patch) | |
tree | 91f5850dff5c34b563114712628b6b7a9a900895 /guix-build-coordinator/coordinator.scm | |
parent | 200ffe795bd36052b64f7868c71a92925ee7beca (diff) | |
download | build-coordinator-1288d9c1185bd1111e2fee9459714178a2cb8f13.tar build-coordinator-1288d9c1185bd1111e2fee9459714178a2cb8f13.tar.gz |
Move the timing of fetch-builds around more of the code
As it was just covering part of the action.
Diffstat (limited to 'guix-build-coordinator/coordinator.scm')
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 170 |
1 files changed, 85 insertions, 85 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 9e646a9..bb4e645 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -678,92 +678,92 @@ (assq-ref (build-coordinator-hooks build-coordinator) 'build-submit-outputs)) - (define builds - (call-with-duration-metric - (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))) - - (datastore-call-with-transaction - datastore - (lambda _ - (let* ((initially-allocated-builds - (datastore-select-allocated-builds datastore agent)) - (start-count - (length initially-allocated-builds)) - (target-count (or max-builds - (+ start-count - deprecated-requested-count)))) - (if (< start-count target-count) - (let ((new-builds - (allocate-several-builds agent - (- target-count start-count)))) - (unless (null? new-builds) - (let ((allocation-plan-metric - (metrics-registry-fetch-metric - (slot-ref datastore 'metrics-registry) - "build_allocation_plan_total"))) - (for-each - (match-lambda - ((agent-id . count) - (metric-set allocation-plan-metric - count - #:label-values - `((agent_id . ,agent-id))))) - (datastore-count-build-allocation-plan-entries datastore)))) - - ;; Previously allocate builds just returned newly allocated - ;; builds, but if max-builds is provided, return all the - ;; builds. This means the agent can handle this in a idempotent - ;; manor. - (if max-builds - (append initially-allocated-builds - new-builds) - new-builds)) - ;; Previously allocate builds just returned newly allocated builds, - ;; but if max-builds is provided, return all the builds. This means - ;; the agent can handle this in a idempotent manor. - (if max-builds - initially-allocated-builds - '())))) - #:duration-metric-name "allocate_builds_to_agent")))) - - (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)) + (define (get-builds) + (datastore-call-with-transaction + datastore + (lambda _ + (let* ((initially-allocated-builds + (datastore-select-allocated-builds datastore agent)) + (start-count + (length initially-allocated-builds)) + (target-count (or max-builds + (+ start-count + deprecated-requested-count)))) + (if (< start-count target-count) + (let ((new-builds + (allocate-several-builds agent + (- target-count start-count)))) + (unless (null? new-builds) + (let ((allocation-plan-metric + (metrics-registry-fetch-metric + (slot-ref datastore 'metrics-registry) + "build_allocation_plan_total"))) + (for-each + (match-lambda + ((agent-id . count) + (metric-set allocation-plan-metric + count + #:label-values + `((agent_id . ,agent-id))))) + (datastore-count-build-allocation-plan-entries datastore)))) + + ;; Previously allocate builds just returned newly allocated + ;; builds, but if max-builds is provided, return all the + ;; builds. This means the agent can handle this in a idempotent + ;; manor. + (if max-builds + (append initially-allocated-builds + new-builds) + new-builds)) + ;; Previously allocate builds just returned newly allocated builds, + ;; but if max-builds is provided, return all the builds. This means + ;; the agent can handle this in a idempotent manor. + (if max-builds + initially-allocated-builds + '())))) + #:duration-metric-name "allocate_builds_to_agent")) - `(,@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)) + (call-with-duration-metric + (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))))) (define (agent-details datastore agent-id) (let ((agent (datastore-find-agent datastore agent-id)) |