diff options
author | Christopher Baines <mail@cbaines.net> | 2024-03-25 13:39:08 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2024-03-25 14:00:41 +0000 |
commit | 98135389e68d9872a82081d1dee7615bc8658257 (patch) | |
tree | 2c18af703b04dc665959073ddd43a81e25c65edb /nar-herder | |
parent | 57ca998207b11f4f149470bfd20a159cf119bf49 (diff) | |
download | nar-herder-98135389e68d9872a82081d1dee7615bc8658257.tar nar-herder-98135389e68d9872a82081d1dee7615bc8658257.tar.gz |
Improve handling of cached narinfos when deleting
Diffstat (limited to 'nar-herder')
-rw-r--r-- | nar-herder/database.scm | 12 | ||||
-rw-r--r-- | nar-herder/mirror.scm | 35 | ||||
-rw-r--r-- | nar-herder/server.scm | 10 |
3 files changed, 38 insertions, 19 deletions
diff --git a/nar-herder/database.scm b/nar-herder/database.scm index 98c29d5..666c497 100644 --- a/nar-herder/database.scm +++ b/nar-herder/database.scm @@ -63,6 +63,7 @@ database-insert-cached-narinfo-file database-select-cached-narinfo-file-by-hash + database-select-cached-narinfo-file-by-narinfo-id-and-compression database-select-cached-narinfo-files-by-narinfo-id database-fold-cached-narinfo-files database-remove-cached-narinfo-file @@ -855,17 +856,6 @@ DELETE FROM narinfo_tags WHERE narinfo_id = :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))))) diff --git a/nar-herder/mirror.scm b/nar-herder/mirror.scm index 47ae549..a784165 100644 --- a/nar-herder/mirror.scm +++ b/nar-herder/mirror.scm @@ -31,6 +31,7 @@ #:use-module (logging logger) #:use-module (json) #:use-module (fibers) + #:use-module (fibers channels) #:use-module (guix narinfo) #:use-module ((guix store) #:select (store-path-hash-part)) #:use-module (nar-herder utils) @@ -38,8 +39,9 @@ #:use-module (nar-herder storage) #:export (start-fetch-changes-fiber)) -(define (start-fetch-changes-fiber database storage-root - mirror metrics-registry) +(define (start-fetch-changes-fiber database metrics-registry + storage-root mirror + cached-compression-management-channel) (define (request-recent-changes) (define latest-recent-change (database-select-latest-recent-change-datetime database)) @@ -141,18 +143,43 @@ store-path " (" (assq-ref change-details 'datetime) ")") + (let* ((hash (store-path-hash-part store-path)) + (narinfo-details + (database-select-narinfo-by-hash + database + hash))) + (when storage-root (remove-nar-files-by-hash database storage-root metrics-registry - (store-path-hash-part store-path))) + hash)) + + (let ((cached-narinfo-files + (database-select-cached-narinfo-files-by-narinfo-id + database + (assq-ref narinfo-details 'id)))) + (for-each + (lambda (cached-narinfo-file-details) + ;; TODO Delete the file as well + + (let ((reply (make-channel))) + (put-message + cached-compression-management-channel + (list 'cached-narinfo-removed + (assq-ref narinfo-details 'id) + (assq-ref cached-narinfo-files 'compression) + (assq-ref cached-narinfo-files 'size) + reply)) + (get-message reply))) + cached-narinfo-files)) (database-remove-narinfo database store-path #:change-datetime (assq-ref change-details - 'datetime)))) + 'datetime))))) (else (error "unimplemented")))))) recent-changes)) diff --git a/nar-herder/server.scm b/nar-herder/server.scm index 583b4a3..6d9d553 100644 --- a/nar-herder/server.scm +++ b/nar-herder/server.scm @@ -768,10 +768,12 @@ (and=> (assq-ref opts 'mirror) (lambda (mirror) - (start-fetch-changes-fiber database - canonical-storage - mirror - metrics-registry) + (start-fetch-changes-fiber + database + metrics-registry + canonical-storage + mirror + cached-compression-management-channel) (if (assq-ref opts 'storage) (start-mirroring-fiber database |