Query for outputs when build events arrive
This will keep the substitute information more up to date.
This commit is contained in:
parent
7524d23b44
commit
5c9ec28cb5
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -293,6 +293,6 @@
|
|||
(lambda ()
|
||||
(backfill-guix-revision-package-derivation-distribution-counts)))))
|
||||
|
||||
(start-substitute-query-thread)
|
||||
(start-substitute-query-threads)
|
||||
|
||||
(join-thread server-thread))))
|
||||
|
|
Loading…
Reference in New Issue