diff options
Diffstat (limited to 'guix-build-coordinator/coordinator.scm')
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 181 |
1 files changed, 99 insertions, 82 deletions
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 24c4877..52dd50c 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -344,6 +344,17 @@ (not (null? builds-for-output)))) outputs))) + (define (check-whether-to-store-build) + (cond + ((and ignore-if-build-for-derivation-exists? + (build-for-derivation-exists?)) + '((no-build-submitted . build-already-exists-for-this-derivation))) + ((and ignore-if-build-for-outputs-exists? + (call-with-delay-logging build-for-output-already-exists?)) + '((no-build-submitted . build-already-exists-for-a-output))) + (else + 'continue))) + (define* (store-build derivation-name uuid priority @@ -371,69 +382,71 @@ (define (build-perform-datastore-changes derivations-lacking-builds) (lambda (_) - ;; Actually create a build, do this first so the derived priorities for - ;; the builds inserted below are informed by this build. - (store-build derivation-file - build-id - priority - tags) - - (for-each - (match-lambda - ((related-derivation . related-uuid) - ;; Double check at this point, within the transaction that no build - ;; exists for this related derivation. - ;; - ;; This stops duplicate related builds from being submitted when - ;; simultaneous submit build requests are being processed. - (unless (datastore-build-exists-for-derivation-outputs? - datastore - related-derivation) - - (simple-format #t "submtiting ~A for related ~A\n" - related-uuid - related-derivation) - (call-with-delay-logging - store-build - #:args (list related-derivation - related-uuid - ;; Let the scheduler take care of - ;; the prioritisation - 0 - tags - ;; Since this build's priority isn't important, this - ;; expensive part of inserting builds can be skipped - #:skip-updating-other-build-derived-priorities #t))))) - derivations-lacking-builds) - #t)) + ;; Check again now, since new builds could have been added since the + ;; checks were made before the start of the transaction. + (match (check-whether-to-store-build) + ('continue + ;; Actually create a build, do this first so the derived priorities + ;; for the builds inserted below are informed by this build. + (store-build derivation-file + build-id + priority + tags) + + (for-each + (match-lambda + ((related-derivation . related-uuid) + ;; Double check at this point, within the transaction that no build + ;; exists for this related derivation. + ;; + ;; This stops duplicate related builds from being submitted when + ;; simultaneous submit build requests are being processed. + (unless (datastore-build-exists-for-derivation-outputs? + datastore + related-derivation) + + (simple-format #t "submtiting ~A for related ~A\n" + related-uuid + related-derivation) + (call-with-delay-logging + store-build + #:args (list related-derivation + related-uuid + ;; Let the scheduler take care of + ;; the prioritisation + 0 + tags + ;; Since this build's priority isn't important, this + ;; expensive part of inserting builds can be skipped + #:skip-updating-other-build-derived-priorities #t))))) + derivations-lacking-builds) + + #t) + (stop-reason + stop-reason)))) (call-with-duration-metric (build-coordinator-metrics-registry build-coordinator) "coordinator_submit_build_duration_seconds" (lambda () - (if (and ignore-if-build-for-derivation-exists? - (build-for-derivation-exists?)) - '((no-build-submitted . build-already-exists-for-this-derivation)) - (if (and ignore-if-build-for-outputs-exists? - (call-with-delay-logging build-for-output-already-exists?)) - '((no-build-submitted . build-already-exists-for-a-output)) - (begin - ;; Store the derivation first, so that listing related - ;; derivations with no builds works - (unless (datastore-find-derivation datastore derivation-file) - (datastore-store-derivation - datastore - (call-with-delay-logging read-drv - #:threshold 10 - #:args (list derivation-file)))) - - (let ((related-derivations-lacking-builds - (if ensure-all-related-derivation-outputs-have-builds? - (datastore-list-related-derivations-with-no-build-for-outputs - datastore - derivation-file) - '()))) - (datastore-call-with-transaction + (match (check-whether-to-store-build) + ('continue + ;; Store the derivation first, so that listing related derivations + ;; with no builds works + (unless (datastore-find-derivation datastore derivation-file) + (datastore-store-derivation + datastore + (call-with-delay-logging read-drv + #:threshold 10 + #:args (list derivation-file)))) + + (let ((related-derivations-lacking-builds + (if ensure-all-related-derivation-outputs-have-builds? + (datastore-list-related-derivations-with-no-build-for-outputs + datastore + derivation-file) + '()))) + (match (datastore-call-with-transaction datastore (build-perform-datastore-changes ;; Do this here so it doesn't take time in the writer thread @@ -445,31 +458,35 @@ related-derivations-lacking-builds)) #:duration-metric-name "store_build") - - (let ((builds-total-metric - (metrics-registry-fetch-metric (slot-ref datastore - 'metrics-registry) - "builds_total"))) - (metric-increment - builds-total-metric - #:label-values `((system . ,(datastore-find-derivation-system - datastore - derivation-file)))) - (for-each (lambda (drv-name) - (metric-increment - builds-total-metric - #:label-values - `((system . ,(datastore-find-derivation-system + (#t ; build submitted + (let ((builds-total-metric + (metrics-registry-fetch-metric (slot-ref datastore + 'metrics-registry) + "builds_total"))) + (metric-increment + builds-total-metric + #:label-values `((system . ,(datastore-find-derivation-system datastore - drv-name))))) - related-derivations-lacking-builds))) - - (build-coordinator-prompt-hook-processing-for-event - build-coordinator - 'build-submitted) - (trigger-build-allocation build-coordinator) - - `((build-submitted . ,build-id)))))))) + derivation-file)))) + (for-each (lambda (drv-name) + (metric-increment + builds-total-metric + #:label-values + `((system . ,(datastore-find-derivation-system + datastore + drv-name))))) + related-derivations-lacking-builds)) + + (build-coordinator-prompt-hook-processing-for-event + build-coordinator + 'build-submitted) + (trigger-build-allocation build-coordinator) + + `((build-submitted . ,build-id))) + (stop-condition + stop-condition)))) + (stop-condition + stop-condition))))) (define (cancel-build build-coordinator uuid) (define datastore (build-coordinator-datastore build-coordinator)) |