diff options
| -rw-r--r-- | guix-build-coordinator/datastore.scm | 1 | ||||
| -rw-r--r-- | guix-build-coordinator/datastore/sqlite.scm | 42 | ||||
| -rw-r--r-- | guix-build-coordinator/hooks.scm | 61 |
3 files changed, 71 insertions, 33 deletions
diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm index 607a412..af55583 100644 --- a/guix-build-coordinator/datastore.scm +++ b/guix-build-coordinator/datastore.scm @@ -49,6 +49,7 @@ (re-export datastore-find-derivation-outputs) (re-export datastore-find-derivation-system) (re-export datastore-find-derivation-inputs) +(re-export datastore-find-derivation-for-output) (re-export datastore-list-builds-for-output) (re-export datastore-list-builds-for-output-and-system) (re-export datastore-agent-for-build) diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm index 7783f76..dd7b592 100644 --- a/guix-build-coordinator/datastore/sqlite.scm +++ b/guix-build-coordinator/datastore/sqlite.scm @@ -41,6 +41,7 @@ datastore-find-derivation datastore-find-derivation-system datastore-find-derivation-inputs + datastore-find-derivation-for-output datastore-find-derivation-outputs datastore-list-builds-for-output datastore-list-builds-for-output-and-system @@ -1963,6 +1964,47 @@ WHERE derivation_inputs.derivation_name = :derivation_name" result))))) +(define-method (datastore-find-derivation-for-output + (datastore <sqlite-datastore>) + start-derivation-name + output) + (call-with-worker-thread + (slot-ref datastore 'worker-reader-thread-channel) + (lambda (db) + (let ((statement + (sqlite-prepare + db + " +WITH RECURSIVE related_derivations(name) AS ( + VALUES(:derivation) +UNION + SELECT derivation_outputs.derivation_name + FROM derivation_outputs + INNER JOIN derivation_inputs + ON derivation_outputs.id = derivation_inputs.derivation_output_id + INNER JOIN related_derivations + ON related_derivations.name = derivation_inputs.derivation_name +) +SELECT related_derivations.name +FROM related_derivations +INNER JOIN derivation_outputs + ON related_derivations.name = derivation_outputs.derivation_name +WHERE output = :output +"))) + + (sqlite-bind-arguments + statement + #:derivation start-derivation-name + #:output output) + + (let ((result + (match (sqlite-step statement) + (#f #f) + (#(derivation) derivation)))) + (sqlite-reset statement) + + result))))) + (define (insert-derivation-and-return-outputs db derivation) (define derivation-name (derivation-file-name derivation)) diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm index e4b2bff..0006a95 100644 --- a/guix-build-coordinator/hooks.scm +++ b/guix-build-coordinator/hooks.scm @@ -337,39 +337,34 @@ (build-coordinator-datastore build-coordinator)) (let ((build (datastore-find-build datastore build-id))) - (let ((derivation-inputs - (datastore-find-derivation-inputs datastore - (assq-ref build 'derivation-name)))) - (simple-format #t "missing-inputs: ~A\n~A\n" - build-id - (string-join (map (lambda (input) - (string-append " - " input)) - missing-inputs) - "\n")) - (for-each (lambda (missing-input) - (let ((input-derivation - (any (lambda (derivation-input) - (if (string=? (assq-ref derivation-input 'output) - missing-input) - (assq-ref derivation-input 'derivation) - #f)) - derivation-inputs))) - (unless input-derivation - (error "couldn't find a derivation for " missing-input)) - - (let ((builds-for-output - (datastore-list-builds-for-output datastore - missing-input))) - (if (null? builds-for-output) - (begin - (simple-format #t - "submitting build for ~A\n" - input-derivation) - (submit-build build-coordinator input-derivation)) - (simple-format #t "~A builds exist for ~A, skipping\n" - (length builds-for-output) - missing-input))))) - missing-inputs)))) + (simple-format #t "missing-inputs: ~A\n~A\n" + build-id + (string-join (map (lambda (input) + (string-append " - " input)) + missing-inputs) + "\n")) + (for-each (lambda (missing-input) + (let ((input-derivation + (datastore-find-derivation-for-output + datastore + (assq-ref build 'derivation-name) + missing-input))) + (unless input-derivation + (error "couldn't find a derivation for " missing-input)) + + (let ((builds-for-output + (datastore-list-builds-for-output datastore + missing-input))) + (if (null? builds-for-output) + (begin + (simple-format #t + "submitting build for ~A\n" + input-derivation) + (submit-build build-coordinator input-derivation)) + (simple-format #t "~A builds exist for ~A, skipping\n" + (length builds-for-output) + missing-input))))) + missing-inputs))) (define %default-hooks `((build-submitted . ,default-build-submitted-hook) |