diff options
author | Christopher Baines <mail@cbaines.net> | 2024-06-22 13:51:36 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2024-06-22 13:51:36 +0100 |
commit | 0d1e6e64c7a339fed717a0b017b9650a07da87db (patch) | |
tree | a7bcc9392c8f5aa62492f7d0b4113bf8e6f7208a | |
parent | c7b13f2cdd6c2cb24c114e1b5593ef4ce3ef36aa (diff) | |
download | build-coordinator-0d1e6e64c7a339fed717a0b017b9650a07da87db.tar build-coordinator-0d1e6e64c7a339fed717a0b017b9650a07da87db.tar.gz |
Add some logging in to build-coordinator-fetch-build-to-allocate
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 56 |
1 files changed, 38 insertions, 18 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index dc72ca9..b51c791 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -1238,24 +1238,44 @@ (define datastore (build-coordinator-datastore coordinator)) - (let loop ((planned-builds - (build-coordinator-fetch-agent-allocation-plan coordinator - agent-id))) - - (if (null? planned-builds) - #f - (match (datastore-fetch-build-to-allocate datastore (first planned-builds)) - (#f #f) - (#(uuid derivation-id derivation-name derived_priority) - - (if (datastore-check-if-derivation-conflicts? - datastore - agent-id - derivation-id) - (loop (cdr planned-builds)) - `((uuid . ,uuid) - (derivation_name . ,derivation-name) - (derived_priority . ,derived_priority)))))))) + (let ((all-planned-builds + (build-coordinator-fetch-agent-allocation-plan coordinator + agent-id))) + + (log-msg (build-coordinator-logger coordinator) + 'DEBUG + "fetching build to allocate to " agent-id ", " + (length all-planned-builds) " to consider") + + (let loop ((planned-builds all-planned-builds)) + (if (null? planned-builds) + #f + (match (datastore-fetch-build-to-allocate datastore + (first planned-builds)) + (#f + (log-msg (build-coordinator-logger coordinator) + 'DEBUG + agent-id ": ignoring " (first planned-builds)) + #f) + (#(uuid derivation-id derivation-name derived_priority) + + (if (datastore-check-if-derivation-conflicts? + datastore + agent-id + derivation-id) + (begin + (log-msg (build-coordinator-logger coordinator) + 'DEBUG + agent-id ": " uuid " conflicts with allocated build") + (loop (cdr planned-builds))) + (begin + (log-msg (build-coordinator-logger coordinator) + 'DEBUG + agent-id ": " uuid " selected") + + `((uuid . ,uuid) + (derivation_name . ,derivation-name) + (derived_priority . ,derived_priority)))))))))) (define* (build-coordinator-list-allocation-plan-builds coordinator agent-id |