diff options
author | Christopher Baines <mail@cbaines.net> | 2024-03-25 12:00:10 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2024-03-25 14:00:41 +0000 |
commit | 57ca998207b11f4f149470bfd20a159cf119bf49 (patch) | |
tree | b38f1d1b3efc747bdb11b2c732ae41c3385fddf4 | |
parent | 860f257551ccbc4eb431433794751354bedd7e68 (diff) | |
download | nar-herder-57ca998207b11f4f149470bfd20a159cf119bf49.tar nar-herder-57ca998207b11f4f149470bfd20a159cf119bf49.tar.gz |
Move all the database operations for cached nars to one fiber
The management fiber. This adds the complexity of replying from the
management fiber, but hopefully having all the database operations in
one place makes things simpler.
-rw-r--r-- | nar-herder/cached-compression.scm | 108 |
1 files changed, 61 insertions, 47 deletions
diff --git a/nar-herder/cached-compression.scm b/nar-herder/cached-compression.scm index 835faf4..0cb7e1d 100644 --- a/nar-herder/cached-compression.scm +++ b/nar-herder/cached-compression.scm @@ -297,7 +297,8 @@ (list 'cached-narinfo-added narinfo-id compression - new-bytes)))))))) + new-bytes + #f)))))))) compressions-with-space))))))) (spawn-fiber @@ -330,7 +331,7 @@ (((and (or 'cached-narinfo-added 'cached-narinfo-removed) action) - narinfo-id compression size) + narinfo-id compression size reply) (let ((updated-bytes ((if (eq? action 'cached-narinfo-added) + @@ -351,15 +352,42 @@ nar-cache-files #:label-values `((compression . ,compression))) - (when (eq? action 'cached-narinfo-added) - (database-insert-cached-narinfo-file - database - narinfo-id - size - compression) + ;; Use an explicit transaction as it handles the + ;; database being busy, + (database-call-with-transaction + database + (lambda _ + (if (eq? action 'cached-narinfo-added) + (database-insert-cached-narinfo-file + database + narinfo-id + size + compression) + (let ((cached-narinfo-details + (database-select-cached-narinfo-file-by-narinfo-id-and-compression + database + narinfo-id + compression))) + + ;; 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)))))) + + (hash-remove! nar-cached-compression-usage-hash-table + narinfo-id) - (hash-remove! nar-cached-compression-usage-hash-table - narinfo-id)) + (when reply + (put-message reply #t)) (loop (alist-cons cached-bytes-by-compression @@ -474,34 +502,6 @@ cached-compression-management-channel enabled-cached-compressions) - (define (remove id narinfo-id compression store-path) - ;; Use an explicit transaction as it handles the - ;; database being busy, - (database-call-with-transaction - database - (lambda _ - (database-delete-scheduled-cached-narinfo-removal - database - 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)))) - - (let ((directory - (assq-ref (assq-ref enabled-cached-compressions - compression) - 'directory))) - (let ((filename - (string-append - directory "/" - (basename store-path)))) - (log-msg 'DEBUG "deleting " filename) - (delete-file filename)))) - (define wakeup-channel (make-channel)) @@ -527,14 +527,29 @@ 'size)) (store-path (assq-ref scheduled-cached-narinfo-removal 'store-path))) - (remove id narinfo-id compression store-path) - - (put-message - cached-compression-management-channel - (list 'cached-narinfo-removed - narinfo-id - compression - size))) + (let ((reply (make-channel))) + (put-message + cached-compression-management-channel + (list 'cached-narinfo-removed + narinfo-id + compression + size + reply)) + + ;; Wait for the management fiber to delete the + ;; database entry before removing the file. + (get-message reply)) + + (let ((directory + (assq-ref (assq-ref enabled-cached-compressions + compression) + 'directory))) + (let ((filename + (string-append + directory "/" + (basename store-path)))) + (log-msg 'DEBUG "deleting " filename) + (delete-file filename)))) (let ((duration (time-difference @@ -549,7 +564,6 @@ ;; Sleep until woken (get-message wakeup-channel)))) - (spawn-fiber (lambda () (while #t |