diff options
Diffstat (limited to 'guix-build-coordinator/build-allocator.scm')
| -rw-r--r-- | guix-build-coordinator/build-allocator.scm | 166 |
1 files changed, 70 insertions, 96 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index f73c457..8c08144 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -352,20 +352,13 @@ #:label-values `((system . ,system))))) counts))) - ;; Go through the setup failures and look specifically at the - ;; missing_inputs ones. Eliminate any missing_inputs failures if all the - ;; missing inputs appear to have been built successfully, and update the + ;; Go through the setup failures and update the ;; derived-build-priorities-hash to reflect the priorities of builds based ;; on the builds that would be "unblocked" if they were completed. (for-each (lambda (setup-failure-build-id) (let ((setup-failures - (filter - (lambda (setup-failure) - (string=? "missing_inputs" - (assq-ref setup-failure 'failure-reason))) - (hash-ref setup-failures-hash - setup-failure-build-id))) + (hash-ref setup-failures-hash setup-failure-build-id)) (setup-failure-build-derived-priority (hash-ref derived-build-priorities-hash setup-failure-build-id))) @@ -425,31 +418,28 @@ setup-failures-hash)) (let ((result - (append-map + (map (lambda (agent-id) (log "considering builds for" agent-id) (let ((builds-sorted-by-derived-priority (sort-list (filter (filter-builds-for-agent agent-id) builds) (build-sorting-function-for-agent agent-id)))) - (if (null? builds-sorted-by-derived-priority) - '() - (let ((final-ordered-builds - (concatenate - (map sort-priority-sublist - (limit-processed-sublists - (break-builds-in-to-priority-sublists - builds-sorted-by-derived-priority)))))) - (let ((builds-for-agent - (limit-planned-builds final-ordered-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)))))))) + (cons + agent-id + (if (null? builds-sorted-by-derived-priority) + '() + (let ((final-ordered-builds + (concatenate + (map sort-priority-sublist + (limit-processed-sublists + (break-builds-in-to-priority-sublists + builds-sorted-by-derived-priority)))))) + (let ((builds-for-agent + (limit-planned-builds final-ordered-builds))) + (map (lambda (build) + (assq-ref build 'uuid)) + builds-for-agent))))))) (map (lambda (agent) (assq-ref agent 'uuid)) agents)))) @@ -502,18 +492,6 @@ (let ((prioritised-builds (datastore-fetch-prioritised-unprocessed-builds datastore))) - (define systems-for-builds - ;; TODO Should be one query - (let ((table (make-hash-table))) - (for-each (lambda (build-id) - (hash-set! table - build-id - (datastore-find-build-derivation-system - datastore - build-id))) - prioritised-builds) - table)) - (define tags-for-build (let ((build-tags (make-hash-table))) (lambda (build-id) @@ -538,7 +516,10 @@ (assq-ref setup-failure 'failure-reason))) (cond ((string=? failure-reason "missing_inputs") - #f) + ;; This problem might go away, but just don't try the same agent + ;; again for now. + (string=? (assq-ref setup-failure 'agent-id) + agent-id)) ((string=? failure-reason "could_not_delete_outputs") ;; This problem might go away, but just don't try the same agent ;; again for now. @@ -552,43 +533,44 @@ (else (error "Unknown setup failure " failure-reason))))) - (lambda (build-id) - (log "build:" build-id) - (and - (or (null? requested-systems) - (let ((build-system (hash-ref systems-for-builds build-id))) - (member build-system requested-systems))) - (agent-tags-match-build-tags agent-tags tags-for-build - agent-id build-id) - (let* ((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))))) - - (when metrics-registry - (let ((counts - (hash-fold - (lambda (_ system result) - `(,@(alist-delete system result) - (,system . ,(+ 1 (or (assoc-ref result system) 0))))) - '() - systems-for-builds))) - (for-each - (match-lambda - ((system . count) - (metric-set allocator-considered-builds-metric - count - #:label-values `((system . ,system))))) - counts))) + (match-lambda + (#(build-id build-system) + (log "build:" build-id) + (and + (or (null? requested-systems) + (member build-system requested-systems)) + (agent-tags-match-build-tags agent-tags tags-for-build + agent-id build-id) + (let* ((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)))))) + + ;; TODO Restore this in a more performant way + ;; (when metrics-registry + ;; (let ((counts + ;; (hash-fold + ;; (lambda (_ system result) + ;; `(,@(alist-delete system result) + ;; (,system . ,(+ 1 (or (assoc-ref result system) 0))))) + ;; '() + ;; systems-for-builds))) + ;; (for-each + ;; (match-lambda + ;; ((system . count) + ;; (metric-set allocator-considered-builds-metric + ;; count + ;; #:label-values `((system . ,system))))) + ;; counts))) (let ((result - (append-map + (map (lambda (agent-id) (log "considering builds for" agent-id) (let* ((filter-proc @@ -596,32 +578,24 @@ (build-ids (let loop ((count 0) (build-ids '()) - (potential-build-ids prioritised-builds)) + (potential-builds prioritised-builds)) (if (or (and planned-builds-for-agent-limit (>= count planned-builds-for-agent-limit)) - (null? potential-build-ids)) - build-ids ;; highest priority last - (let ((potential-build (first potential-build-ids))) - (if (filter-proc potential-build) + (null? potential-builds)) + (reverse build-ids) ;; highest priority last, so + ;; reverse + (let ((potential-build-details (first potential-builds))) + (if (filter-proc potential-build-details) (loop (+ 1 count) - (cons potential-build + (cons (vector-ref + potential-build-details + 0) build-ids) - (cdr potential-build-ids)) + (cdr potential-builds)) (loop count build-ids - (cdr potential-build-ids)))))))) - (if (null? build-ids) - '() - (let ((build-ids-count - (length build-ids))) - (map (lambda (build-id ordering) - (list build-id - agent-id - ordering)) - build-ids - (iota build-ids-count - build-ids-count - -1)))))) + (cdr potential-builds)))))))) + (cons agent-id build-ids))) (map (lambda (agent) (assq-ref agent 'uuid)) agents)))) |