From 10b16ec09294b13bf67b3f58d93ca05e013cbd7b Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 22 Jun 2020 14:40:33 +0200 Subject: Create build products as soon as the build succeeded. When searching for successful builds in Cuirass, it is expected that the build products are already available. Hence, make sure that build products are computed before the build is marked as successful. * src/cuirass/base.scm (spawn-builds): Add a spec argument, (handle-build-event): ditto, and call create-build-outputs when the build-succeeded event is received, (create-build-outputs): take a single build argument instead of a builds list and adapt accordingly, (build-packages): pass spec argument to spawn-builds and remove create-build-outputs call. --- src/cuirass/base.scm | 29 ++++++++++++++++------------- 1 file changed, 16 insertions(+), 13 deletions(-) (limited to 'src') diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 61cbde7..3db9c4e 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -478,7 +478,9 @@ and returns the values RESULTS." (apply values results))))) (define* (spawn-builds store drv - #:key (max-batch-size 200)) + #:key + (max-batch-size 200) + spec) "Build the derivations listed in DRV, updating the database as builds complete. Derivations are submitted in batches of at most MAX-BATCH-SIZE items." @@ -529,7 +531,7 @@ items." ;; from PORT and eventually close it. (catch #t (lambda () - (handle-build-event event)) + (handle-build-event spec event)) (exception-reporter state))) #t) (close-port port) @@ -545,7 +547,7 @@ items." (loop rest (max (- count max-batch-size) 0)))))) -(define* (handle-build-event event) +(define* (handle-build-event spec event) "Handle EVENT, a build event sexp as produced by 'build-event-output-port', updating the database accordingly." (define (valid? file) @@ -575,6 +577,9 @@ updating the database accordingly." (if (valid? drv) (begin (log-message "build succeeded: '~a'" drv) + (when spec + (create-build-outputs (db-get-build drv) + (assq-ref spec #:build-outputs))) (db-update-build-status! drv (build-status succeeded)) (for-each (match-lambda @@ -639,14 +644,12 @@ started)." (spawn-builds store valid) (log-message "done with restarted builds")))) -(define (create-build-outputs builds product-specs) +(define (create-build-outputs build product-specs) "Given BUILDS a list of built derivations, save the build products described by PRODUCT-SPECS." - (define (find-build job-regex) - (find (lambda (build) - (let ((job-name (assq-ref build #:job-name))) - (string-match job-regex job-name))) - builds)) + (define (build-has-products? job-regex) + (let ((job-name (assq-ref build #:job-name))) + (string-match job-regex job-name))) (define* (find-product build spec) (let* ((outputs (assq-ref build #:outputs)) @@ -663,8 +666,8 @@ by PRODUCT-SPECS." (stat:size (stat file))) (for-each (lambda (spec) - (let* ((build (find-build (assq-ref spec #:job))) - (product (find-product build spec))) + (let ((product (and (build-has-products? (assq-ref spec #:job)) + (find-product build spec)))) (when (and product (file-exists? product)) (db-add-build-product `((#:build . ,(assq-ref build #:id)) (#:type . ,(assq-ref spec #:type)) @@ -715,7 +718,8 @@ by PRODUCT-SPECS." eval-id (length derivations)) (db-set-evaluation-done eval-id) - (spawn-builds store derivations) + (spawn-builds store derivations + #:spec spec) (let* ((results (filter-map (cut db-get-build <>) derivations)) (status (map (cut assq-ref <> #:status) results)) @@ -729,7 +733,6 @@ by PRODUCT-SPECS." outputs)) (fail (- (length derivations) success))) - (create-build-outputs results (assq-ref spec #:build-outputs)) (log-message "outputs:\n~a" (string-join outs "\n")) (log-message "success: ~a, fail: ~a" success fail) results)) -- cgit v1.2.3