diff options
Diffstat (limited to 'guix-build-coordinator/build-allocator.scm')
| -rw-r--r-- | guix-build-coordinator/build-allocator.scm | 103 |
1 files changed, 77 insertions, 26 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index bba3143..02af0b4 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -36,24 +36,24 @@ args) " ")))) - (define output-has-successful-build? + (define cached/list-builds-for-output (mlambda (output) - (log "considering missing input:" output) - (any (lambda (output-build) - (let ((build-successful? - (string=? (or (assq-ref output-build 'result) - "unknown") - "success"))) - (when build-successful? - (log "found successful build:" (assq-ref output-build 'uuid))) + (datastore-list-builds-for-output datastore output))) - build-successful?)) - (datastore-list-builds-for-output datastore output)))) - - (let ((agents (datastore-list-agents datastore)) - (builds (datastore-list-unprocessed-builds datastore)) - (setup-failures-hash - (datastore-fetch-setup-failures datastore))) + (let* ((agents (datastore-list-agents datastore)) + (builds (datastore-list-unprocessed-builds datastore)) + (setup-failures-hash + (datastore-fetch-setup-failures datastore)) + (derived-build-priorities-hash + ;; Mapping from build_id to priority, initialised at the individual + ;; priorities for the builds + (let ((table (make-hash-table (length builds)))) + (for-each (lambda (build) + (hash-set! table + (assq-ref build 'uuid) + (assq-ref build 'priority))) + builds) + table))) (define (filter-builds-for-agent agent-id) (define (relevant-setup-failure? setup-failure) @@ -62,14 +62,9 @@ (assq-ref setup-failure 'failure-reason))) (cond ((string=? failure-reason "missing_inputs") - ;; If all outputs have had at least one successful build, then the - ;; inputs should be available. Otherwise, treat the setup failure - ;; as still relevant (return #t) - (not - (every output-has-successful-build? - (datastore-list-setup-failure-missing-inputs - datastore - (assq-ref setup-failure 'id))))) + ;; missing_inputs setup failures that should be resolved have been + ;; filtered out by this point, so this is a relevant setup failure + #t) ((string=? failure-reason "could_not_delete_outputs") ;; This problem might go away, but just don't try the same agent ;; again for now. @@ -94,8 +89,10 @@ (define (build-sorting-function-for-agent agent-id) (lambda (a b) - (let ((a-priority (assq-ref a 'priority)) - (b-priority (assq-ref b 'priority))) + (let ((a-priority (hash-ref derived-build-priorities-hash + (assq-ref a 'uuid))) + (b-priority (hash-ref derived-build-priorities-hash + (assq-ref b 'uuid)))) (< b-priority a-priority)))) (define (limit-planned-builds builds) @@ -105,6 +102,60 @@ builds) builds)) + ;; 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 + ;; 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 (hash-ref setup-failures-hash + setup-failure-build-id)) + (setup-failure-build-derived-priority + (hash-ref derived-build-priorities-hash + setup-failure-build-id))) + (for-each + (lambda (setup-failure) + (when (string=? "missing_inputs" + (assq-ref setup-failure 'failure-reason)) + (for-each + (lambda (output) + (let ((builds (cached/list-builds-for-output output))) + (if (any (lambda (output-build) + (string=? (or (assq-ref output-build 'result) + "unknown") + "success")) + builds) + ;; At least one build for this output has been successful, + ;; so delete the setup failure + (hash-remove! setup-failures-hash + setup-failure-build-id) + ;; The missing input isn't available, so set the derived + ;; priority to be as least as high as this build + (for-each + (lambda (build) + (when (eq? 0 (assq-ref build 'processed)) + (let* ((missing-input-build-id + (assq-ref build 'uuid)) + (missing-input-build-derived-priority + (hash-ref derived-build-priorities-hash + missing-input-build-id))) + (when (> setup-failure-build-derived-priority + missing-input-build-derived-priority) + ;; Bump the priority of the build + (hash-set! + derived-build-priorities-hash + missing-input-build-id + setup-failure-build-derived-priority))))) + builds)))) + (datastore-list-setup-failure-missing-inputs + datastore + (assq-ref setup-failure 'id))))) + setup-failures))) + (hash-map->list + (lambda (key value) key) + setup-failures-hash)) + (let ((result (append-map (lambda (agent-id) |