diff options
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/model/build.scm | 35 | ||||
| -rw-r--r-- | guix-data-service/substitutes.scm | 65 | ||||
| -rw-r--r-- | guix-data-service/web/build-server/controller.scm | 6 |
3 files changed, 103 insertions, 3 deletions
diff --git a/guix-data-service/model/build.scm b/guix-data-service/model/build.scm index 4f347f5..ea4ce65 100644 --- a/guix-data-service/model/build.scm +++ b/guix-data-service/model/build.scm @@ -26,6 +26,7 @@ #:use-module (guix-data-service model derivation) #:use-module (guix-data-service model system) #:export (select-build-stats + select-build-outputs select-builds-with-context select-builds-with-context-by-derivation-file-name select-builds-with-context-by-derivation-output @@ -121,6 +122,40 @@ ORDER BY status")) ((sql . value) value)) (filter pair? criteria)))))) +(define (select-build-outputs conn build-id) + (match (exec-query + conn + " +SELECT derivation_file_name, derivation_output_details_set_id +FROM builds +WHERE builds.id = $1" + (list (number->string build-id))) + (((derivation-file-name output-details-set-id)) + + (if output-details-set-id + (exec-query + conn + " +SELECT derivation_output_details.path +FROM derivation_output_details +INNER JOIN derivation_output_details_sets + ON ARRAY[derivation_output_details.id] && + derivation_output_details_sets.derivation_output_details_ids +WHERE derivation_output_details_sets.id = $1" + (list output-details-set-id)) + (exec-query + conn + " +SELECT derivation_output_details.path +FROM derivations +INNER JOIN derivation_outputs + ON derivations.id = derivation_outputs.derivation_id +INNER JOIN derivation_output_details + ON derivation_outputs.derivation_output_details_id + = derivation_output_details.id +WHERE derivations.file_name = $1" + (list derivation-file-name)))))) + (define* (select-builds-with-context conn build-statuses build-server-ids #:key revision-commit system target diff --git a/guix-data-service/substitutes.scm b/guix-data-service/substitutes.scm index d0e0a6a..335d3f3 100644 --- a/guix-data-service/substitutes.scm +++ b/guix-data-service/substitutes.scm @@ -20,16 +20,21 @@ #:use-module (srfi srfi-19) #:use-module (ice-9 match) #:use-module (ice-9 threads) + #:use-module (fibers) + #:use-module (fibers channels) #:use-module (guix substitutes) #:use-module (guix narinfo) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) + #:use-module (guix-data-service model build) #:use-module (guix-data-service model build-server) #:use-module (guix-data-service model git-branch) #:use-module (guix-data-service model git-repository) #:use-module (guix-data-service model nar) #:export (query-build-server-substitutes - start-substitute-query-thread)) + start-substitute-query-threads + + request-query-of-build-server-substitutes)) (define verbose-output? (make-parameter #f)) @@ -130,7 +135,63 @@ total-requested total-narinfos)))))) -(define (start-substitute-query-thread) +(define %substitute-query-channel #f) + +(define (request-query-of-build-server-substitutes build-server-id + build-ids) + (spawn-fiber + (lambda () + (and=> %substitute-query-channel + (lambda (channel) + (put-message channel (cons build-server-id build-ids))))))) + +(define (start-substitute-query-threads) + (define channel + (make-channel)) + + (set! %substitute-query-channel channel) + + (call-with-new-thread + (lambda () + (while #t + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception in request substitute query thread: ~A\n" + exn)) + (lambda () + (with-throw-handler #t + (lambda () + (with-postgresql-connection + "request-substitute-query-thread" + (lambda (conn) + (while #t + (match (get-message channel) + ((build-server-id . build-ids) + + (let ((outputs + (delete-duplicates! + (append-map! + (lambda (build-id) + (select-build-outputs conn build-id)) + build-ids)))) + + (simple-format + (current-output-port) + "querying for ~A outputs from build server ~A\n" + (length outputs) + build-server-id) + + (query-build-server-substitutes + conn + (list build-server-id) + #f + outputs)))))))) + (lambda _ + (backtrace)))) + #:unwind? #t)))) + (call-with-new-thread (lambda () (while #t diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm index babf59d..7c31cf1 100644 --- a/guix-data-service/web/build-server/controller.scm +++ b/guix-data-service/web/build-server/controller.scm @@ -23,6 +23,7 @@ #:use-module (fibers) #:use-module (guix-data-service utils) #:use-module (guix-data-service database) + #:use-module (guix-data-service substitutes) #:use-module (guix-data-service web render) #:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service jobs load-new-guix-revision) @@ -233,7 +234,10 @@ (lambda (ids) (call-via-thread-pool-channel (lambda (conn) - (handle-removing-blocking-build-entries-for-successful-builds conn ids))))) + (handle-removing-blocking-build-entries-for-successful-builds conn ids))) + + (request-query-of-build-server-substitutes build-server-id + ids))) (with-build-ids-for-status items |