diff options
-rw-r--r-- | guix-build-coordinator/build-allocator.scm | 49 |
1 files changed, 38 insertions, 11 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index 8e7dcd8..e89c719 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -55,6 +55,14 @@ (datastore-list-builds-for-output datastore output))) (let* ((agents (datastore-list-agents datastore)) + (requested-systems-by-agent + (map (lambda (agent-details) + (let ((agent-id (assq-ref agent-details 'uuid))) + (cons agent-id + (datastore-agent-requested-systems + datastore + agent-id)))) + agents)) (builds (datastore-list-unprocessed-builds datastore)) (setup-failures-hash (datastore-fetch-setup-failures datastore)) @@ -74,7 +82,21 @@ (build-ordering-hints-hash (make-hash-table))) + (define systems-for-builds + ;; TODO Should be one query + (map (lambda (build) + (let ((build-id (assq-ref build 'uuid))) + (cons build-id + (datastore-find-build-derivation-system + datastore + build-id)))) + builds)) + (define (filter-builds-for-agent agent-id) + (define requested-systems + (assoc-ref requested-systems-by-agent + agent-id)) + (define (relevant-setup-failure? setup-failure) (log "setup failure:" setup-failure) (let ((failure-reason @@ -99,17 +121,22 @@ (lambda (build) (log "build:" (assq-ref build 'uuid)) - (let* ((build-id (assq-ref build 'uuid)) - (setup-failures-for-build - (or (hash-ref setup-failures-hash build-id) - '())) - (relevant-setup-failures - (filter relevant-setup-failure? - setup-failures-for-build))) - (log "relevant setup failures:" relevant-setup-failures) - (if (null? relevant-setup-failures) - #t - #f)))) + (and + (or (null? requested-systems) + (let ((build-system (assoc-ref systems-for-builds + (assq-ref build 'uuid)))) + (member build-system requested-systems))) + (let* ((build-id (assq-ref build 'uuid)) + (setup-failures-for-build + (or (hash-ref setup-failures-hash build-id) + '())) + (relevant-setup-failures + (filter relevant-setup-failure? + setup-failures-for-build))) + (log "relevant setup failures:" relevant-setup-failures) + (if (null? relevant-setup-failures) + #t + #f))))) (define (build-sorting-function-for-agent agent-id) (lambda (a b) |