diff options
| -rw-r--r-- | nar-herder/storage.scm | 53 | ||||
| -rw-r--r-- | scripts/nar-herder.in | 1 |
2 files changed, 38 insertions, 16 deletions
diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm index 97fd334..565037c 100644 --- a/nar-herder/storage.scm +++ b/nar-herder/storage.scm @@ -27,6 +27,7 @@ #:use-module (web response) #:use-module (logging logger) #:use-module (logging port-log) + #:use-module (prometheus) #:use-module (json) #:use-module ((guix build utils) #:select (dump-port mkdir-p)) #:use-module ((guix store) #:select (store-path-hash-part)) @@ -124,8 +125,39 @@ (unrecognised-files . ,(hash-map->list (lambda (key _) key) files-hash))))) +(define* (get-nar-files database storage-root metrics-registry + #:key stored?) + (define nar-files-metric + (or (metrics-registry-fetch-metric metrics-registry + "nar_files_total") + (make-gauge-metric metrics-registry + "nar_files_total" + #:labels '(stored)))) + + (let* ((index (index-storage database storage-root)) + (selected-files + (filter + (lambda (file) + (eq? (assq-ref file 'stored?) stored?)) + (assq-ref index 'narinfo-files)))) + + (let ((selected-files-count + (length selected-files)) + (all-files-count + (length (assq-ref index 'narinfo-files)))) + + (metric-set nar-files-metric + selected-files-count + #:label-values `((stored . ,(if stored? "true" "false")))) + (metric-set nar-files-metric + (- all-files-count selected-files-count) + #:label-values `((stored . ,(if stored? "false" "true"))))) + + selected-files)) + (define (start-nar-removal-thread database storage-root storage-limit + metrics-registry nar-removal-criteria) (define (check-removal-criteria nar criteria) @@ -163,13 +195,6 @@ (check-removal-criteria nar criteria)) nar-removal-criteria)) - (define (get-stored-nar-files) - (let ((index (index-storage database storage-root))) - (filter - (lambda (file) - (assq-ref file 'stored?)) - (assq-ref index 'narinfo-files)))) - (define (run-removal-pass) (log-msg 'INFO "looking for nars to remove") (let ((initial-storage-size @@ -181,7 +206,8 @@ initial-storage-size) (stored-nar-files (with-time-logging "getting stored nar files" - (get-stored-nar-files)))) + (get-nar-files database storage-root metrics-registry + #:stored? #t)))) ;; Look through items in local storage, check if the removal ;; criteria have been met, and if so, delete it @@ -221,13 +247,6 @@ (make-gauge-metric metrics-registry "storage_size_bytes")) - (define (get-missing-nar-files) - (let ((index (index-storage database storage-root))) - (filter - (lambda (file) - (not (assq-ref file 'stored?))) - (assq-ref index 'narinfo-files)))) - (define (fetch-file file) (let* ((string-url (string-append mirror file)) @@ -274,7 +293,9 @@ (when (or no-storage-limit? (< initial-storage-size storage-limit)) (let loop ((storage-size initial-storage-size) - (missing-nar-files (get-missing-nar-files))) + (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 " diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index 2d5289b..655a1a9 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -373,6 +373,7 @@ (start-nar-removal-thread database canonical-storage (assq-ref opts 'storage-limit) + metrics-registry (filter-map (match-lambda ((key . val) |