diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-09-08 09:24:46 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-09-08 10:58:42 +0100 |
| commit | 89303dee4b78735e8886ee22944a59e80e195055 (patch) | |
| tree | e7993259a7b3d7e467618c07665742ccbfcc55e8 | |
| parent | d5a7bcaee0aa5cd554b1786aa76eb1eeb0eff16a (diff) | |
| download | nar-herder-89303dee4b78735e8886ee22944a59e80e195055.tar nar-herder-89303dee4b78735e8886ee22944a59e80e195055.tar.gz | |
Avoid fast-download-nars from calling get-nar-files
As this is expensive when there are a large number of nars.
| -rw-r--r-- | nar-herder/storage.scm | 79 |
1 files changed, 54 insertions, 25 deletions
diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm index 34e4df0..a4335c5 100644 --- a/nar-herder/storage.scm +++ b/nar-herder/storage.scm @@ -26,6 +26,7 @@ #:use-module (web uri) #:use-module (web client) #:use-module (web response) + #:use-module (fibers channels) #:use-module (logging logger) #:use-module (logging port-log) #:use-module (prometheus) @@ -584,31 +585,59 @@ When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." (define (fast-download-nars) (define parallelism 3) - (let ((missing-nar-files (get-nar-files - database storage-root metrics-registry - #:stored? #f))) - (any - identity - (n-par-map - parallelism - (lambda (file) - (log-msg 'DEBUG "considering " - (assq-ref file 'url)) - (with-exception-handler - (lambda (exn) - (log-msg 'ERROR "failed to fetch " - (assq-ref file 'url) - ": " exn) - #f) - (lambda () - (retry-on-error - (lambda () - (fetch-file (assq-ref file 'url))) - #:times 3 - #:delay 5) - #t) - #:unwind? #t)) - missing-nar-files)))) + (let ((channel (make-channel))) + (for-each + (lambda _ + (call-with-new-thread + (lambda () + (catch 'system-error + (lambda () + (set-thread-name "fast download nars")) + (const #t)) + + (let loop ((any-change? #f)) + (match (get-message channel) + (('finished . reply) + (put-message reply any-change?)) + (url + (log-msg 'DEBUG "considering " url) + (loop + (or + any-change? + (with-exception-handler + (lambda (exn) + (log-msg 'ERROR "failed to fetch " url ": " exn) + #f) + (lambda () + (retry-on-error + (lambda () + (fetch-file url)) + #:times 3 + #:delay 5) + #t) + #:unwind? #t))))))))) + (iota parallelism)) + + (fold-nar-files + database + storage-root + metrics-registry + (lambda (nar _) + (put-message channel + (assq-ref nar 'url)) + #f) + #f + #:stored? #f) + + (let ((reply-channel (make-channel))) + (any + identity + (map + (lambda _ + (put-message channel + (cons 'finished reply-channel)) + (get-message reply-channel)) + (iota parallelism)))))) (define (run-mirror-pass) (log-msg 'DEBUG "running mirror pass") |