aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--nar-herder/storage.scm53
-rw-r--r--scripts/nar-herder.in1
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)