diff options
| -rw-r--r-- | nar-herder/database.scm | 53 | ||||
| -rw-r--r-- | nar-herder/storage.scm | 8 | ||||
| -rw-r--r-- | scripts/nar-herder.in | 7 |
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 |