mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
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
4 changed files with 104 additions and 4 deletions
|
@ -26,6 +26,7 @@
|
||||||
#:use-module (guix-data-service model derivation)
|
#:use-module (guix-data-service model derivation)
|
||||||
#:use-module (guix-data-service model system)
|
#:use-module (guix-data-service model system)
|
||||||
#:export (select-build-stats
|
#:export (select-build-stats
|
||||||
|
select-build-outputs
|
||||||
select-builds-with-context
|
select-builds-with-context
|
||||||
select-builds-with-context-by-derivation-file-name
|
select-builds-with-context-by-derivation-file-name
|
||||||
select-builds-with-context-by-derivation-output
|
select-builds-with-context-by-derivation-output
|
||||||
|
@ -121,6 +122,40 @@ ORDER BY status"))
|
||||||
((sql . value) value))
|
((sql . value) value))
|
||||||
(filter pair? criteria))))))
|
(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
|
(define* (select-builds-with-context conn build-statuses build-server-ids
|
||||||
#:key revision-commit
|
#:key revision-commit
|
||||||
system target
|
system target
|
||||||
|
|
|
@ -20,16 +20,21 @@
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 threads)
|
#:use-module (ice-9 threads)
|
||||||
|
#:use-module (fibers)
|
||||||
|
#:use-module (fibers channels)
|
||||||
#:use-module (guix substitutes)
|
#:use-module (guix substitutes)
|
||||||
#:use-module (guix narinfo)
|
#:use-module (guix narinfo)
|
||||||
#:use-module (guix-data-service utils)
|
#:use-module (guix-data-service utils)
|
||||||
#:use-module (guix-data-service database)
|
#: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 build-server)
|
||||||
#:use-module (guix-data-service model git-branch)
|
#:use-module (guix-data-service model git-branch)
|
||||||
#:use-module (guix-data-service model git-repository)
|
#:use-module (guix-data-service model git-repository)
|
||||||
#:use-module (guix-data-service model nar)
|
#:use-module (guix-data-service model nar)
|
||||||
#:export (query-build-server-substitutes
|
#:export (query-build-server-substitutes
|
||||||
start-substitute-query-thread))
|
start-substitute-query-threads
|
||||||
|
|
||||||
|
request-query-of-build-server-substitutes))
|
||||||
|
|
||||||
(define verbose-output?
|
(define verbose-output?
|
||||||
(make-parameter #f))
|
(make-parameter #f))
|
||||||
|
@ -130,7 +135,63 @@
|
||||||
total-requested
|
total-requested
|
||||||
total-narinfos))))))
|
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
|
(call-with-new-thread
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(while #t
|
(while #t
|
||||||
|
|
|
@ -23,6 +23,7 @@
|
||||||
#:use-module (fibers)
|
#:use-module (fibers)
|
||||||
#:use-module (guix-data-service utils)
|
#:use-module (guix-data-service utils)
|
||||||
#:use-module (guix-data-service database)
|
#: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 render)
|
||||||
#:use-module (guix-data-service web query-parameters)
|
#:use-module (guix-data-service web query-parameters)
|
||||||
#:use-module (guix-data-service jobs load-new-guix-revision)
|
#:use-module (guix-data-service jobs load-new-guix-revision)
|
||||||
|
@ -233,7 +234,10 @@
|
||||||
(lambda (ids)
|
(lambda (ids)
|
||||||
(call-via-thread-pool-channel
|
(call-via-thread-pool-channel
|
||||||
(lambda (conn)
|
(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
|
(with-build-ids-for-status
|
||||||
items
|
items
|
||||||
|
|
|
@ -293,6 +293,6 @@
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(backfill-guix-revision-package-derivation-distribution-counts)))))
|
(backfill-guix-revision-package-derivation-distribution-counts)))))
|
||||||
|
|
||||||
(start-substitute-query-thread)
|
(start-substitute-query-threads)
|
||||||
|
|
||||||
(join-thread server-thread))))
|
(join-thread server-thread))))
|
||||||
|
|
Loading…
Reference in a new issue