From 98135389e68d9872a82081d1dee7615bc8658257 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 25 Mar 2024 13:39:08 +0000
Subject: Improve handling of cached narinfos when deleting

---
 scripts/nar-herder.in | 59 +++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 43 insertions(+), 16 deletions(-)

(limited to 'scripts')

diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in
index e4ce9c2..7e5b35f 100644
--- a/scripts/nar-herder.in
+++ b/scripts/nar-herder.in
@@ -452,22 +452,49 @@
 
      (for-each
       (lambda (store-path)
-        (log-msg 'INFO "removing " store-path)
-
-        (if (assq-ref opts 'storage)
-            (begin
-              (remove-nar-files-by-hash
-               database
-               (assq-ref opts 'storage)
-               metrics-registry
-               (store-path-hash-part store-path)
-               #:error-unless-files-to-remove? #f))
-            (log-msg
-             'WARN "no --storage set, so just removing from the database"))
-
-        (let ((removed? (database-remove-narinfo database store-path)))
-          (unless removed?
-            (log-msg 'WARN store-path " not found to remove"))))
+        (let ((narinfo-details
+               (database-select-narinfo-by-hash
+                database
+                (store-path-hash-part store-path))))
+
+          (if narinfo-details
+              (let ((cached-narinfo-files
+                     (database-select-cached-narinfo-files-by-narinfo-id
+                      database
+                      (assq-ref narinfo-details 'id))))
+
+                (log-msg 'INFO "removing " store-path)
+
+                (if (assq-ref opts 'storage)
+                    (begin
+                      (remove-nar-files-by-hash
+                       database
+                       (assq-ref opts 'storage)
+                       metrics-registry
+                       (store-path-hash-part store-path)
+                       #:error-unless-files-to-remove? #f))
+                    (log-msg
+                     'WARN "no --storage set, so just removing from the database"))
+
+                (for-each
+                 (lambda (cached-narinfo-details)
+                   ;; It might not have been scheduled for
+                   ;; removal, but remove any schedule that
+                   ;; exists
+                   (database-delete-scheduled-cached-narinfo-removal
+                    database
+                    (assq-ref cached-narinfo-details 'id))
+
+                   ;; Remove all the database entries first, as
+                   ;; that'll stop these files appearing in narinfos
+                   (database-remove-cached-narinfo-file
+                    database
+                    narinfo-id
+                    (symbol->string compression)))
+                 cached-narinfo-files)
+
+                (database-remove-narinfo database store-path))
+              (log-msg 'WARN store-path " not found to remove"))))
       (assq-ref opts 'arguments))))
   (("check" rest ...)
    (let* ((opts (parse-options (append %base-options
-- 
cgit v1.2.3