aboutsummaryrefslogtreecommitdiff
path: root/nar-herder
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2024-03-25 13:39:08 +0000
committerChristopher Baines <mail@cbaines.net>2024-03-25 14:00:41 +0000
commit98135389e68d9872a82081d1dee7615bc8658257 (patch)
tree2c18af703b04dc665959073ddd43a81e25c65edb /nar-herder
parent57ca998207b11f4f149470bfd20a159cf119bf49 (diff)
downloadnar-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.scm12
-rw-r--r--nar-herder/mirror.scm35
-rw-r--r--nar-herder/server.scm10
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