diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-05-14 20:49:46 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-05-14 20:49:46 +0100 |
| commit | 9e0f37cacb67d5592d38086385ef30fd8ab5a3d7 (patch) | |
| tree | 8900ee7a87926bcf5090495b9b2a5180c4e67423 | |
| parent | b85646c564f4fbf615cbccd034ec74341e3fe2cc (diff) | |
| download | nar-herder-9e0f37cacb67d5592d38086385ef30fd8ab5a3d7.tar nar-herder-9e0f37cacb67d5592d38086385ef30fd8ab5a3d7.tar.gz | |
Add a fast path for downloading nars when there's no storage limit
| -rw-r--r-- | nar-herder/storage.scm | 34 |
1 files changed, 31 insertions, 3 deletions
diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm index 63754b5..51a089b 100644 --- a/nar-herder/storage.scm +++ b/nar-herder/storage.scm @@ -354,8 +354,7 @@ (define (download-nars initial-storage-size) ;; If there's free space, then consider downloading missing nars - (when (or no-storage-limit? - (< initial-storage-size storage-limit)) + (when (< initial-storage-size storage-limit) (let loop ((storage-size initial-storage-size) (missing-nar-files (get-nar-files database storage-root metrics-registry @@ -391,13 +390,42 @@ (loop storage-size (cdr missing-nar-files))))))))) + (define (fast-download-nars) + (define parallelism 3) + + (let ((missing-nar-files (get-nar-files + database storage-root metrics-registry + #:stored? #f))) + (n-par-for-each + 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))) + (define (run-mirror-pass) (log-msg 'DEBUG "running mirror pass") (let ((initial-storage-size (with-time-logging "getting storage size" (get-storage-size storage-root)))) (metric-set storage-size-metric initial-storage-size) - (download-nars initial-storage-size)) + (if no-storage-limit? + (fast-download-nars) + (download-nars initial-storage-size))) (log-msg 'DEBUG "finished mirror pass")) (call-with-new-thread |