diff options
| author | Christopher Baines <mail@cbaines.net> | 2022-05-14 20:43:39 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2022-05-14 20:43:39 +0100 |
| commit | b85646c564f4fbf615cbccd034ec74341e3fe2cc (patch) | |
| tree | bf83abe323e92eedc36c1ae5f442b5483a47dd53 /nar-herder | |
| parent | f41e801764c4cd25490c58d33876a1ec9e7d8241 (diff) | |
| download | nar-herder-b85646c564f4fbf615cbccd034ec74341e3fe2cc.tar nar-herder-b85646c564f4fbf615cbccd034ec74341e3fe2cc.tar.gz | |
Split out the downloading of nars
Diffstat (limited to 'nar-herder')
| -rw-r--r-- | nar-herder/storage.scm | 83 |
1 files changed, 43 insertions, 40 deletions
diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm index f13b98b..63754b5 100644 --- a/nar-herder/storage.scm +++ b/nar-herder/storage.scm @@ -300,6 +300,9 @@ (define (start-mirroring-thread database mirror storage-limit storage-root metrics-registry) + (define no-storage-limit? + (not (integer? storage-limit))) + (define storage-size-metric (make-gauge-metric metrics-registry "storage_size_bytes")) @@ -349,52 +352,52 @@ (metric-decrement nar-files-metric #:label-values '((stored . "false"))))))) - (define (run-mirror-pass) - (define no-storage-limit? - (not (integer? storage-limit))) + (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)) + (let loop ((storage-size initial-storage-size) + (missing-nar-files (get-nar-files + database storage-root metrics-registry + #:stored? #f))) + (unless (null? missing-nar-files) + (let ((file (car missing-nar-files))) + (log-msg 'DEBUG "considering " + (assq-ref file 'url)) + (let ((file-bytes (assq-ref file 'size))) + (if (or no-storage-limit? + (< (+ storage-size file-bytes) + storage-limit)) + (let ((success? + (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))) + (loop (if success? + (+ storage-size file-bytes) + storage-size) + (cdr missing-nar-files))) + ;; This file won't fit, so try the next one + (loop storage-size + (cdr 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) - ;; If there's free space, then consider downloading missing nars - (when (or no-storage-limit? - (< initial-storage-size storage-limit)) - (let loop ((storage-size initial-storage-size) - (missing-nar-files (get-nar-files - database storage-root metrics-registry - #:stored? #f))) - (unless (null? missing-nar-files) - (let ((file (car missing-nar-files))) - (log-msg 'DEBUG "considering " - (assq-ref file 'url)) - (let ((file-bytes (assq-ref file 'size))) - (if (or no-storage-limit? - (< (+ storage-size file-bytes) - storage-limit)) - (let ((success? - (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))) - (loop (if success? - (+ storage-size file-bytes) - storage-size) - (cdr missing-nar-files))) - ;; This file won't fit, so try the next one - (loop storage-size - (cdr missing-nar-files))))))))) + (download-nars initial-storage-size)) (log-msg 'DEBUG "finished mirror pass")) (call-with-new-thread |