diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-05-15 22:35:24 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-05-15 22:35:24 +0100 |
| commit | ed3c806ab83c77c1b8f04bb399c66743f1858178 (patch) | |
| tree | 13ebfa10dbe693568ced24c9767e17e6a240c107 | |
| parent | ea4a1fad3fd5daab07ff9080db9e4d808386539b (diff) | |
| download | build-coordinator-ed3c806ab83c77c1b8f04bb399c66743f1858178.tar build-coordinator-ed3c806ab83c77c1b8f04bb399c66743f1858178.tar.gz | |
Avoid substituting derivations when builds are submitted
When the derivation substitute URLs are known. This avoids having to add the
derivation to the store, which can be blocked by garbage collection.
| -rw-r--r-- | guix-build-coordinator/client-communication.scm | 35 | ||||
| -rw-r--r-- | guix-build-coordinator/coordinator.scm | 9 |
2 files changed, 25 insertions, 19 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm index fec53e3..27f98ff 100644 --- a/guix-build-coordinator/client-communication.scm +++ b/guix-build-coordinator/client-communication.scm @@ -377,33 +377,38 @@ (string->number val))) 1000))))))))) (('POST "builds") - (let ((derivation-file (assoc-ref body "derivation"))) + (let ((derivation-file (assoc-ref body "derivation")) + (substitute-urls + (and=> (assoc-ref body "substitute-urls") + vector->list))) (unless (string? derivation-file) (raise-exception (make-exception-with-message (simple-format #f "derivation must be a string: ~A\n" derivation)))) - (let ((derivation-database-entry - (datastore-find-derivation datastore derivation-file))) - (unless derivation-database-entry - (unless (with-store store - (valid-path? store derivation-file)) - (call-with-worker-thread - substitutes-channel - (lambda () - (let ((raw-substitute-urls - (assoc-ref body "substitute-urls"))) - (substitute-derivation derivation-file - #:substitute-urls - (and=> raw-substitute-urls - vector->list)))))))) + (define (read-drv/substitute derivation-file) + (unless (with-store store + (valid-path? store derivation-file)) + (call-with-worker-thread + substitutes-channel + (lambda () + (substitute-derivation derivation-file + #:substitute-urls substitute-urls))) + (read-derivation-from-file derivation-file))) (let ((submit-build-result (apply submit-build `(,build-coordinator ,derivation-file + #:read-drv + ,(if (null? (or substitute-urls '())) + read-drv/substitute + (lambda (derivation-file) + (read-derivation-through-substitutes + derivation-file + substitute-urls))) ,@(let ((priority (assoc-ref body "priority"))) (if priority `(#:priority ,priority) diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm index 05c5772..62833df 100644 --- a/guix-build-coordinator/coordinator.scm +++ b/guix-build-coordinator/coordinator.scm @@ -292,7 +292,8 @@ (ignore-if-build-for-outputs-exists? #f) (ensure-all-related-derivation-outputs-have-builds? #f) (tags '()) - defer-until) + defer-until + (read-drv read-derivation-from-file)) (define datastore (build-coordinator-datastore build-coordinator)) (define (build-for-derivation-exists?) @@ -308,7 +309,7 @@ (let ((system (or (datastore-find-derivation-system datastore derivation-file) (derivation-system - (read-derivation-from-file derivation-file)))) + (read-drv derivation-file)))) (outputs (or (datastore-find-derivation-outputs datastore derivation-file) (map @@ -317,7 +318,7 @@ `((name . ,name) (output . ,(derivation-output-path output))))) (derivation-outputs - (read-derivation-from-file derivation-file)))))) + (read-drv derivation-file)))))) (any (lambda (output-details) (let ((builds-for-output @@ -408,7 +409,7 @@ (unless (datastore-find-derivation datastore derivation-file) (datastore-store-derivation datastore - (read-derivation-from-file derivation-file))) + (read-drv derivation-file))) (let ((related-derivations-lacking-builds (if ensure-all-related-derivation-outputs-have-builds? |