Support removing nar files

1 files changed, 30 insertions, 0 deletions

diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm
index fab8966..386bacf 100644
--- a/nar-herder/storage.scm
+++ b/nar-herder/storage.scm
@@ -34,6 +34,7 @@
   #:use-module (nar-herder utils)
   #:use-module (nar-herder database)
   #:export (store-item-in-local-storage?
+            remove-nar-files-by-hash
 
             get-nar-files
 
@@ -51,6 +52,35 @@
                               (assq-ref file 'url)))))
            narinfo-files)))
 
+(define (remove-nar-files-by-hash database storage-root metrics-registry
+                                  hash)
+  (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 ((narinfo-files (database-select-narinfo-files database hash)))
+    (when (null? narinfo-files)
+      (error "no narinfo files"))
+    (for-each
+     (lambda (file)
+       (let* ((filename
+               (string-append storage-root
+                              (uri-decode
+                               (assq-ref file 'url))))
+              (exists?
+               (file-exists? filename)))
+         (when exists?
+           (remove-nar-from-storage storage-root
+                                    (assq-ref file 'url)))
+
+         (metric-decrement nar-files-metric
+                           #:label-values
+                           `((stored . ,(if exists? "true" "false"))))))
+     narinfo-files)))
+
 (define (get-storage-size storage-root)
   (define enter? (const #t))
   (define (leaf name stat result)