aboutsummaryrefslogtreecommitdiff
path: root/scripts
diff options
context:
space:
mode:
Diffstat (limited to 'scripts')
-rw-r--r--scripts/nar-herder.in59
1 files changed, 43 insertions, 16 deletions
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