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

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

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

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

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