diff options
| -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 |