Don't error when removing files that don't exist

This is useful when removing in bulk and restarting the process.

3 files changed, 39 insertions, 29 deletions

diff --git a/nar-herder/database.scm b/nar-herder/database.scm
index 183966e..8ddfe6f 100644
--- a/nar-herder/database.scm
+++ b/nar-herder/database.scm
@@ -650,7 +650,10 @@ SELECT id FROM narinfos WHERE store_path = :store_path"
        statement
        #:store_path store-path)
 
-      (let ((result (vector-ref (sqlite-step statement) 0)))
+      (let ((result
+             (and=> (sqlite-step statement)
+                    (lambda (row)
+                      (vector-ref row 0)))))
         (sqlite-reset statement)
 
         result)))
@@ -753,29 +756,31 @@ DELETE FROM narinfo_tags WHERE narinfo_id = :narinfo_id"
    database
    (lambda (db)
      (let ((narinfo-id (store-path->narinfo-id db)))
-       (if change-datetime
-           (insert-change-with-datetime db store-path
-                                        change-datetime)
-           (insert-change db store-path))
-
-       (remove-narinfo-files db narinfo-id)
-       (remove-narinfo-references db narinfo-id)
-       (remove-tags db narinfo-id)
-
-       (for-each
-        (lambda (cached-details)
-          (database-remove-cached-narinfo-file
-           database
-           narinfo-id
-           (symbol->string
-            (assq-ref cached-details 'compression))))
-        (database-select-cached-narinfo-files-by-narinfo-id
-         database
-         narinfo-id))
-
-       (remove-narinfo-record db narinfo-id)
-
-       #t))))
+       (if narinfo-id
+           (begin
+             (if change-datetime
+                 (insert-change-with-datetime db store-path
+                                              change-datetime)
+                 (insert-change db store-path))
+
+             (remove-narinfo-files db narinfo-id)
+             (remove-narinfo-references db narinfo-id)
+             (remove-tags db narinfo-id)
+
+             (for-each
+              (lambda (cached-details)
+                (database-remove-cached-narinfo-file
+                 database
+                 narinfo-id
+                 (symbol->string
+                  (assq-ref cached-details 'compression))))
+              (database-select-cached-narinfo-files-by-narinfo-id
+               database
+               narinfo-id))
+
+             (remove-narinfo-record db narinfo-id)
+             #t)
+           #f)))))
 
 (define (database-select-narinfo-by-hash database hash)
   (call-with-time-tracking
diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm
index 9c1d235..75e460f 100644
--- a/nar-herder/storage.scm
+++ b/nar-herder/storage.scm
@@ -55,8 +55,9 @@
                               (assq-ref file 'url)))))
            narinfo-files)))
 
-(define (remove-nar-files-by-hash database storage-root metrics-registry
-                                  hash)
+(define* (remove-nar-files-by-hash database storage-root metrics-registry
+                                   hash
+                                   #:key (error-unless-files-to-remove? #t))
   (define nar-files-metric
     (or (metrics-registry-fetch-metric metrics-registry
                                        "nar_files_total")
@@ -65,7 +66,8 @@
                            #:labels '(stored))))
 
   (let ((narinfo-files (database-select-narinfo-files database hash)))
-    (when (null? narinfo-files)
+    (when (and (null? narinfo-files)
+               error-unless-files-to-remove?)
       (error "no narinfo files"))
     (for-each
      (lambda (file)
diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in
index 1493d0b..1c1d4d0 100644
--- a/scripts/nar-herder.in
+++ b/scripts/nar-herder.in
@@ -359,11 +359,14 @@
                database
                (assq-ref opts 'storage)
                metrics-registry
-               (store-path-hash-part store-path)))
+               (store-path-hash-part store-path)
+               #:error-unless-files-to-remove? #f))
             (log-msg
              'WARN "no --storage set, so just removing from the database"))
 
-        (database-remove-narinfo database store-path))
+        (let ((removed? (database-remove-narinfo database store-path)))
+          (unless removed?
+            (log-msg 'WARN store-path " not found to remove"))))
       (assq-ref opts 'arguments))))
   (("check" rest ...)
    (let* ((opts (parse-options (append %base-options