cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Further tweak fetching narinfos

Browse source 
Move the batching to the database, which should reduce memory usage while
removing the limit on the number of fetched narinfos.
This commit is contained in:
Christopher Baines 2023-04-28 22:33:41 +02:00
parent 8a19bcba13
commit 639c6ff183
2 changed files with 76 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

29
guix-data-service/model/nar.scm
View file

@ -381,7 +381,9 @@ ORDER BY COUNT(*) DESC")
build-server-id
guix-revision-commits
#:key
build-success-after)
build-success-after
after-id
(limit 2000))
(define query
(string-append
"
@ -440,16 +442,25 @@ WHERE derivation_output_details.path NOT IN (
",")
")
)"))
(if after-id
(string-append
"
AND derivation_output_details.id > " after-id)
"")
"
ORDER BY derivation_output_details.id DESC
LIMIT 100000"))
ORDER BY derivation_output_details.id ASC"
(if limit
(string-append
"
LIMIT " (number->string limit))
"")))
(map car (exec-query conn
query
`(,(number->string build-server-id)
,@(if build-success-after
(list (date->string build-success-after "~1 ~3"))
'())))))
(exec-query conn
query
`(,(number->string build-server-id)
,@(if build-success-after
(list (date->string build-success-after "~1 ~3"))
'()))))
(define (select-nars-for-output conn output-file-name)
(define query

102
guix-data-service/substitutes.scm
View file

@ -50,7 +50,6 @@
(simple-format #t "\nQuerying ~A\n" url)
(catch #t
(lambda ()
(simple-format #t "\nFetching narinfo files\n")
(fetch-narinfo-files conn id url revision-commits
#:specific-outputs
outputs))
@ -69,56 +68,67 @@
(define* (fetch-narinfo-files conn build-server-id build-server-url
revision-commits
#:key specific-outputs)
(define outputs
(or specific-outputs
(select-outputs-without-known-nar-entries
conn
build-server-id
revision-commits
#:build-success-after
(if (null? revision-commits)
(time-utc->date
(subtract-duration (current-time)
(make-time time-duration 0 (* 60 5)))
0) ; tz-offset
#f))))
(let loop ((last-id #f)
(requests 0)
(success-responses 0))
(let ((outputs-chunk
(or specific-outputs
(select-outputs-without-known-nar-entries
conn
build-server-id
revision-commits
#:build-success-after
(if (null? revision-commits)
(time-utc->date
(subtract-duration (current-time)
(make-time time-duration 0 (* 60 5)))
0) ; tz-offset
#f)
#:after-id last-id))))
(simple-format #t "Querying ~A outputs\n"
(length outputs))
(unless (null? outputs-chunk)
(let* ((narinfos
(lookup-narinfos (string-trim-right build-server-url #\/)
(map car outputs-chunk)))
(narinfos-count
(length narinfos))
(total-requested
(+ requests (length outputs-chunk)))
(total-narinfos
(+ success-responses narinfos-count)))
(chunk-for-each!
(lambda (outputs-chunk)
(let ((narinfos
(lookup-narinfos (string-trim-right build-server-url #\/)
outputs-chunk)))
(simple-format #t "Fetched ~A narinfos from ~A (total requested: ~A, total narinfos: ~A)\n"
(length narinfos)
build-server-url
total-requested
total-narinfos)
(simple-format #t "Got ~A narinfo files\n"
(length narinfos))
(let ((filtered-narinfos
(filter-map
(lambda (narinfo)
(if (> (narinfo-size narinfo)
%narinfo-max-size)
(begin
(simple-format (current-error-port)
"narinfo ~A has excessive size ~A\n"
(narinfo-path narinfo)
(narinfo-size narinfo))
#f)
narinfo))
narinfos)))
(let ((filtered-narinfos
(filter-map
(lambda (narinfo)
(if (> (narinfo-size narinfo)
%narinfo-max-size)
(begin
(simple-format (current-error-port)
"narinfo ~A has excessive size ~A\n"
(narinfo-path narinfo)
(narinfo-size narinfo))
#f)
narinfo))
narinfos)))
(unless (null? filtered-narinfos)
(with-postgresql-transaction
conn
(lambda (conn)
(record-narinfo-details-and-return-ids
(unless (null? filtered-narinfos)
(with-postgresql-transaction
conn
build-server-id
filtered-narinfos)))))))
2000
outputs))
(lambda (conn)
(record-narinfo-details-and-return-ids
conn
build-server-id
filtered-narinfos)))))
(loop (second (last outputs-chunk))
total-requested
total-narinfos))))))
(define (start-substitute-query-thread)
(call-with-new-thread