Switch to querying builds by output, rather than derivation
This is better, as Cuirass will return a build for the derivation it built to generate that output. This avoids having to query for multiple derivations that generate a single output, until the one that Cuirass used is found.
This commit is contained in:
parent
bd52629674
commit
cf407fe830
1 changed files with 114 additions and 2 deletions
|
|
@ -132,7 +132,7 @@ initial connection on which HTTP requests are sent."
|
||||||
(simple-format #t "\nFetching pending builds\n")
|
(simple-format #t "\nFetching pending builds\n")
|
||||||
(process-pending-builds conn id url)
|
(process-pending-builds conn id url)
|
||||||
(simple-format #t "\nFetching unseen derivations\n")
|
(simple-format #t "\nFetching unseen derivations\n")
|
||||||
(process-derivations conn id url revision-commits)
|
(process-derivation-outputs conn id url revision-commits)
|
||||||
(simple-format #t "\nFetching narinfo files\n")
|
(simple-format #t "\nFetching narinfo files\n")
|
||||||
(fetch-narinfo-files conn id url revision-commits))
|
(fetch-narinfo-files conn id url revision-commits))
|
||||||
|
|
||||||
|
|
@ -144,7 +144,9 @@ initial connection on which HTTP requests are sent."
|
||||||
|
|
||||||
(let* ((status-string
|
(let* ((status-string
|
||||||
(assq-ref build-statuses
|
(assq-ref build-statuses
|
||||||
(assoc-ref data "buildstatus")))
|
(or (assoc-ref data "buildstatus")
|
||||||
|
;; status is for the /output/ requests
|
||||||
|
(assoc-ref data "status"))))
|
||||||
(finished?
|
(finished?
|
||||||
(member status-string stop-statuses))
|
(member status-string stop-statuses))
|
||||||
(existing-status-entries
|
(existing-status-entries
|
||||||
|
|
@ -200,6 +202,31 @@ initial connection on which HTTP requests are sent."
|
||||||
(usleep 200)))
|
(usleep 200)))
|
||||||
(select-pending-builds conn build-server-id)))
|
(select-pending-builds conn build-server-id)))
|
||||||
|
|
||||||
|
(define (process-derivation-outputs conn build-server-id url revision-commits)
|
||||||
|
(define derivation-outputs
|
||||||
|
(select-derivation-outputs-with-no-known-build conn
|
||||||
|
build-server-id
|
||||||
|
revision-commits))
|
||||||
|
|
||||||
|
(simple-format (current-error-port) "Fetching ~A derivation outputs\n"
|
||||||
|
(length derivation-outputs))
|
||||||
|
(fetch-builds-by-output
|
||||||
|
url
|
||||||
|
derivation-outputs
|
||||||
|
(lambda (data)
|
||||||
|
(if data
|
||||||
|
(let ((build-id
|
||||||
|
(ensure-build-exists conn
|
||||||
|
build-server-id
|
||||||
|
(assoc-ref data "derivation"))))
|
||||||
|
(insert-build-statuses-from-data
|
||||||
|
conn
|
||||||
|
build-server-id
|
||||||
|
build-id
|
||||||
|
(assoc-ref data "build"))
|
||||||
|
(display "-"))
|
||||||
|
(display ".")))))
|
||||||
|
|
||||||
(define (process-derivations conn build-server-id url revision-commits)
|
(define (process-derivations conn build-server-id url revision-commits)
|
||||||
(define derivations
|
(define derivations
|
||||||
(select-derivations-with-no-known-build conn
|
(select-derivations-with-no-known-build conn
|
||||||
|
|
@ -289,6 +316,40 @@ initial connection on which HTTP requests are sent."
|
||||||
#:headers '((User-Agent . "Guix Data Service"))))
|
#:headers '((User-Agent . "Guix Data Service"))))
|
||||||
derivation-file-names)))
|
derivation-file-names)))
|
||||||
|
|
||||||
|
(define (fetch-builds-by-output url derivation-outputs handler)
|
||||||
|
(define (read-to-eof port)
|
||||||
|
"Read from PORT until EOF is reached. The data are discarded."
|
||||||
|
(dump-port port (%make-void-port "w")))
|
||||||
|
|
||||||
|
(http-multiple-get
|
||||||
|
(string->uri url)
|
||||||
|
(lambda (request response port result)
|
||||||
|
(let* ((len (response-content-length response))
|
||||||
|
(response-body
|
||||||
|
(if len
|
||||||
|
(get-bytevector-n port len)
|
||||||
|
(read-to-eof port))))
|
||||||
|
(handler
|
||||||
|
(cond
|
||||||
|
((eq? (response-code response) 200)
|
||||||
|
(json-string->scm
|
||||||
|
(bytevector->string response-body
|
||||||
|
"utf-8")))
|
||||||
|
(else
|
||||||
|
#f)))))
|
||||||
|
'()
|
||||||
|
(map (lambda (output-file-name)
|
||||||
|
(build-request
|
||||||
|
(string->uri
|
||||||
|
(string-append url
|
||||||
|
"output"
|
||||||
|
(string-drop
|
||||||
|
output-file-name
|
||||||
|
(string-length "/gnu/store"))))
|
||||||
|
#:method 'GET
|
||||||
|
#:headers '((User-Agent . "Guix Data Service"))))
|
||||||
|
derivation-outputs)))
|
||||||
|
|
||||||
(define (select-pending-builds conn build-server-id)
|
(define (select-pending-builds conn build-server-id)
|
||||||
(define query
|
(define query
|
||||||
"
|
"
|
||||||
|
|
@ -362,6 +423,57 @@ LIMIT 15000"))
|
||||||
|
|
||||||
(exec-query conn query (list (number->string build-server-id))))
|
(exec-query conn query (list (number->string build-server-id))))
|
||||||
|
|
||||||
|
|
||||||
|
(define (select-derivation-outputs-with-no-known-build conn
|
||||||
|
build-server-id
|
||||||
|
revision-commits)
|
||||||
|
(define query
|
||||||
|
;; Only select derivations that are in the package_derivations table, as
|
||||||
|
;; Cuirass doesn't build the intermediate derivations
|
||||||
|
(string-append
|
||||||
|
"
|
||||||
|
SELECT derivation_output_details.path
|
||||||
|
FROM derivation_output_details
|
||||||
|
INNER JOIN derivation_output_details_sets
|
||||||
|
ON derivation_output_details.id =
|
||||||
|
derivation_output_details_sets.derivation_output_details_ids[1]
|
||||||
|
WHERE NOT EXISTS (
|
||||||
|
SELECT 1
|
||||||
|
FROM builds
|
||||||
|
WHERE builds.derivation_output_details_set_id =
|
||||||
|
derivation_output_details_sets.id
|
||||||
|
AND build_server_id = $1
|
||||||
|
) AND derivation_output_details_sets.id IN (
|
||||||
|
SELECT derivation_output_details_set_id
|
||||||
|
FROM package_derivations
|
||||||
|
INNER JOIN derivations_by_output_details_set
|
||||||
|
ON package_derivations.derivation_id =
|
||||||
|
derivations_by_output_details_set.derivation_id
|
||||||
|
INNER JOIN build_servers_build_config
|
||||||
|
ON build_servers_build_config.build_server_id = $1
|
||||||
|
AND build_servers_build_config.system = package_derivations.system
|
||||||
|
AND build_servers_build_config.target = package_derivations.target
|
||||||
|
"
|
||||||
|
(if (null? revision-commits)
|
||||||
|
""
|
||||||
|
(string-append
|
||||||
|
"
|
||||||
|
INNER JOIN guix_revision_package_derivations
|
||||||
|
ON package_derivations.id =
|
||||||
|
guix_revision_package_derivations.package_derivation_id
|
||||||
|
INNER JOIN guix_revisions
|
||||||
|
ON guix_revisions.id = guix_revision_package_derivations.revision_id
|
||||||
|
WHERE guix_revisions.commit IN ("
|
||||||
|
(string-join (map quote-string revision-commits) ",")
|
||||||
|
")"))
|
||||||
|
"
|
||||||
|
)
|
||||||
|
ORDER BY derivation_output_details_sets.id, derivation_output_details.id
|
||||||
|
LIMIT 15000"))
|
||||||
|
|
||||||
|
(map first
|
||||||
|
(exec-query conn query (list (number->string build-server-id)))))
|
||||||
|
|
||||||
(define (fetch-narinfo-files conn build-server-id build-server-url revision-commits)
|
(define (fetch-narinfo-files conn build-server-id build-server-url revision-commits)
|
||||||
(define outputs
|
(define outputs
|
||||||
(select-outputs-without-known-nar-entries
|
(select-outputs-without-known-nar-entries
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue