aboutsummaryrefslogtreecommitdiff
path: root/nar-herder
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2022-05-14 20:49:46 +0100
committerChristopher Baines <mail@cbaines.net>2022-05-14 20:49:46 +0100
commit9e0f37cacb67d5592d38086385ef30fd8ab5a3d7 (patch)
tree8900ee7a87926bcf5090495b9b2a5180c4e67423 /nar-herder
parentb85646c564f4fbf615cbccd034ec74341e3fe2cc (diff)
downloadnar-herder-9e0f37cacb67d5592d38086385ef30fd8ab5a3d7.tar
nar-herder-9e0f37cacb67d5592d38086385ef30fd8ab5a3d7.tar.gz
Add a fast path for downloading nars when there's no storage limit
Diffstat (limited to 'nar-herder')
-rw-r--r--nar-herder/storage.scm34
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