diff options
-rw-r--r-- | guix-build-coordinator/coordinator.scm | 39 |
1 files changed, 30 insertions, 9 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index b016744..82f983c 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -82,19 +82,40 @@ (define (allocate-builds datastore) (let ((agents (datastore-list-agents datastore)) - (builds (datastore-list-unprocessed-builds datastore))) + (builds (datastore-list-unprocessed-builds datastore)) + (setup-failures + (datastore-fetch-setup-failures datastore))) + + (define (filter-builds-for-agent agent-id) + (lambda (build) + (let* ((build-id (assq-ref build 'uuid)) + (setup-failures-for-build + (or (assoc-ref setup-failures build-id) + '()))) + (if (any (lambda (setup-failure) + (string=? (assq-ref setup-failure 'agent-id) + agent-id)) + setup-failures-for-build) + ;; Don't allocated builds to agents where the setup has failed + ;; in the past + #f + #t)))) + (datastore-replace-build-allocation-plan datastore (append-map (lambda (agent-id) - (map (lambda (build-id ordering) - (list build-id - agent-id - ordering)) - (map (lambda (build) - (assq-ref build 'uuid)) - builds) - (iota (length builds)))) + (let ((builds-for-agent + (filter (filter-builds-for-agent agent-id) + builds))) + (map (lambda (build-id ordering) + (list build-id + agent-id + ordering)) + (map (lambda (build) + (assq-ref build 'uuid)) + builds-for-agent) + (iota (length builds-for-agent))))) (map (lambda (agent) (assq-ref agent 'uuid)) agents)))) |