aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2024-03-13 17:50:47 +0000
committerChristopher Baines <mail@cbaines.net>2024-03-13 17:50:47 +0000
commit731b73587f1d7372bce0b03d891c9ae1dd911bfd (patch)
treedcb7a0d72670904e0f63a364b25d0b615c16e302
parent6813a96fd44f4793db6ab3528ba200855b2fda4e (diff)
downloadnar-herder-731b73587f1d7372bce0b03d891c9ae1dd911bfd.tar
nar-herder-731b73587f1d7372bce0b03d891c9ae1dd911bfd.tar.gz
Initialise the storage metrics
This used to happen, and this commit brings it back.
-rw-r--r--nar-herder/server.scm5
-rw-r--r--nar-herder/storage.scm22
2 files changed, 27 insertions, 0 deletions
diff --git a/nar-herder/server.scm b/nar-herder/server.scm
index 9153055..9e4c80a 100644
--- a/nar-herder/server.scm
+++ b/nar-herder/server.scm
@@ -680,6 +680,11 @@
(run-fibers
(lambda ()
+ (initialise-storage-metrics
+ database
+ canonical-storage
+ metrics-registry)
+
(start-recent-change-removal-and-database-dump-fiber
database
(let ((filename (assq-ref opts 'database-dump)))
diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm
index e5ba57e..7da9942 100644
--- a/nar-herder/storage.scm
+++ b/nar-herder/storage.scm
@@ -40,6 +40,7 @@
#:export (store-item-in-local-storage?
remove-nar-files-by-hash
+ initialise-storage-metrics
check-storage
start-nar-removal-fiber
@@ -163,6 +164,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
proc init
#:key stored?)
@@ -243,6 +245,26 @@
#:by removed-count
#:label-values '((stored . "false")))))))
+(define (initialise-storage-metrics database storage-root metrics-registry)
+ ;; Use a database transaction to block changes
+ (database-call-with-transaction
+ database
+ (lambda _
+ (log-msg 'INFO "starting to initialise storage metrics")
+ (let ((_
+ counts
+ (fold-nar-files
+ database
+ storage-root
+ metrics-registry
+ (const #f)
+ #f
+ #:stored? 'both)))
+ (update-nar-files-metric
+ metrics-registry
+ counts))
+ (log-msg 'INFO "finished initialising storage metrics"))))
+
(define (check-storage database storage-root metrics-registry)
(define files-count
(database-count-narinfo-files database))