From 61bb32ab2115d91e0d710d42d093926442afac30 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Sun, 22 May 2022 16:07:15 +0100 Subject: Double check when to actually store builds as asked This should ensure that the ignore-if-build-for-derivation-exists? and ignore-if-build-for-output-exists? options work even if two builds are submitted for the same derivation at the same time. Since one transaction should commit first, then the other transaction will notice this, even if the checks prior to the transaction have not shown another build. --- guix-build-coordinator/coordinator.scm | 181 ++++++++++++++++++--------------- 1 file 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)) -- cgit v1.2.3