Tweak fetching narinfos

Currently I'm seeing failures due to guile-gnutls not supporting suspendable
ports (write_wait_fd), so batch the requested outputs to try and avoid this.
This commit is contained in:
Christopher Baines 2023-04-28 20:42:31 +02:00
parent 688f4cd79d
commit 8a19bcba13

View file

@ -22,6 +22,7 @@
#:use-module (ice-9 threads) #:use-module (ice-9 threads)
#: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 database) #:use-module (guix-data-service database)
#: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)
@ -85,34 +86,39 @@
(simple-format #t "Querying ~A outputs\n" (simple-format #t "Querying ~A outputs\n"
(length outputs)) (length outputs))
(let ((narinfos (chunk-for-each!
(lookup-narinfos (string-trim-right build-server-url #\/) outputs))) (lambda (outputs-chunk)
(let ((narinfos
(lookup-narinfos (string-trim-right build-server-url #\/)
outputs-chunk)))
(simple-format #t "Got ~A narinfo files\n" (simple-format #t "Got ~A narinfo files\n"
(length narinfos)) (length narinfos))
(let ((filtered-narinfos (let ((filtered-narinfos
(filter-map (filter-map
(lambda (narinfo) (lambda (narinfo)
(if (> (narinfo-size narinfo) (if (> (narinfo-size narinfo)
%narinfo-max-size) %narinfo-max-size)
(begin (begin
(simple-format (current-error-port) (simple-format (current-error-port)
"narinfo ~A has excessive size ~A\n" "narinfo ~A has excessive size ~A\n"
(narinfo-path narinfo) (narinfo-path narinfo)
(narinfo-size narinfo)) (narinfo-size narinfo))
#f) #f)
narinfo)) narinfo))
narinfos))) narinfos)))
(unless (null? filtered-narinfos) (unless (null? filtered-narinfos)
(with-postgresql-transaction (with-postgresql-transaction
conn
(lambda (conn)
(record-narinfo-details-and-return-ids
conn conn
build-server-id (lambda (conn)
filtered-narinfos))))))) (record-narinfo-details-and-return-ids
conn
build-server-id
filtered-narinfos)))))))
2000
outputs))
(define (start-substitute-query-thread) (define (start-substitute-query-thread)
(call-with-new-thread (call-with-new-thread