diff options
Diffstat (limited to 'nar-herder/storage.scm')
| -rw-r--r-- | nar-herder/storage.scm | 41 |
1 files changed, 26 insertions, 15 deletions
diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm index fc49b2d..e85d745 100644 --- a/nar-herder/storage.scm +++ b/nar-herder/storage.scm @@ -41,6 +41,7 @@ remove-nar-files-by-hash initialise-storage-metrics + update-nar-files-metric check-storage removal-channel-remove-nar-from-storage @@ -91,6 +92,8 @@ (define (get-storage-size storage-root) (define enter? (const #t)) (define (leaf name stat result) + ;; Allow other fibers to run + (sleep 0) (+ result (or (and=> (stat:blocks stat) (lambda (blocks) @@ -166,8 +169,7 @@ (unrecognised-files . ,(hash-map->list (lambda (key _) key) files-hash))))) -;; TODO Maybe remove the metrics-registry argument? -(define* (fold-nar-files database storage-root metrics-registry +(define* (fold-nar-files database storage-root proc init #:key stored?) (define stored-files-count 0) @@ -181,8 +183,10 @@ (uri-decode (assq-ref nar 'url))) (nar-stored? - (file-exists? - (string-append storage-root url)))) + (if storage-root + (file-exists? + (string-append storage-root url)) + #f))) (if nar-stored? (set! stored-files-count (1+ stored-files-count)) @@ -202,7 +206,9 @@ (define* (update-nar-files-metric metrics-registry nar-file-counts - #:key fetched-count removed-count) + #:key fetched-count removed-count + not-stored-addition-count + stored-addition-count) ;; Avoid incrementing or decrementing the metric if it hasn't been ;; set yet @@ -245,7 +251,17 @@ #:label-values '((stored . "true"))) (metric-increment nar-files-metric #:by removed-count - #:label-values '((stored . "false"))))))) + #:label-values '((stored . "false")))) + + (when not-stored-addition-count + (metric-increment nar-files-metric + #:by not-stored-addition-count + #:label-values '((stored . "false")))) + + (when stored-addition-count + (metric-increment nar-files-metric + #:by stored-addition-count + #:label-values '((stored . "true"))))))) (define (initialise-storage-metrics database storage-root metrics-registry) ;; Use a database transaction to block changes @@ -258,7 +274,6 @@ (fold-nar-files database storage-root - metrics-registry (const #f) #f #:stored? 'both))) @@ -279,7 +294,6 @@ (fold-nar-files database storage-root - metrics-registry (lambda (file _) (let* ((full-filename (string-append storage-root @@ -447,7 +461,6 @@ When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." (fold-nar-files database storage-root - metrics-registry (lambda (nar result) (match result ((storage-size . removed-count) @@ -616,7 +629,6 @@ When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." (fold-nar-files database storage-root - metrics-registry (lambda (file result) (log-msg 'DEBUG "considering " (assq-ref file 'url)) @@ -694,7 +706,6 @@ When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." (fold-nar-files database storage-root - metrics-registry (lambda (nar _) (put-message channel (assq-ref nar 'url)) @@ -742,10 +753,10 @@ When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." (lambda (exn) (log-msg 'ERROR "failed to mirror " file ": " exn)) (lambda () - (fetch-file file) - (update-nar-files-metric metrics-registry - '() - #:fetched-count 1)) + (unless (file-exists? + (string-append storage-root + (uri-decode file))) + (fetch-file file))) #:unwind? #t)))))) (spawn-fiber |