diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-04-02 14:40:55 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-04-02 14:40:55 +0100 |
| commit | a388e9ccfad7a5cea0ad60204c6da30780b4c81a (patch) | |
| tree | 18b4aac7a2b40628884e7f004bc531b4f9c5b831 | |
| parent | 7271a0cc2fd0f2ba2ad9a3308e3d9f38b194f258 (diff) | |
| download | nar-herder-a388e9ccfad7a5cea0ad60204c6da30780b4c81a.tar nar-herder-a388e9ccfad7a5cea0ad60204c6da30780b4c81a.tar.gz | |
Add more logging around scheduled removal of cached compressions
| -rw-r--r-- | nar-herder/cached-compression.scm | 79 |
1 files changed, 44 insertions, 35 deletions
diff --git a/nar-herder/cached-compression.scm b/nar-herder/cached-compression.scm index d201415..1167b0a 100644 --- a/nar-herder/cached-compression.scm +++ b/nar-herder/cached-compression.scm @@ -431,48 +431,57 @@ (not (member filename '("." "..")))))))) (define (schedule-removal compression compression-details) - (let* ((files (files-to-schedule-for-removal compression-details)) + (let* ((files + (let ((files + (with-time-logging "files-to-schedule-for-removal" + (files-to-schedule-for-removal compression-details)))) + (log-msg 'INFO "cached-compression-schedule-removal-fiber " + "looking at " (length files) " files") + files)) (all-cached-narinfo-file-details - (map - (lambda (file) - (database-select-cached-narinfo-file-by-hash - database - (string-take file 32) ; hash part - compression)) - files)) + (with-time-logging "getting all-cached-narinfo-file-details" + (map + (lambda (file) + (database-select-cached-narinfo-file-by-hash + database + (string-take file 32) ; hash part + compression)) + files))) (existing-scheduled-removals - (map - (lambda (cached-narinfo-file-details) - (database-select-scheduled-cached-narinfo-removal - database - (assq-ref cached-narinfo-file-details 'id))) - all-cached-narinfo-file-details)) + (with-time-logging "getting existing-scheduled-removals" + (map + (lambda (cached-narinfo-file-details) + (database-select-scheduled-cached-narinfo-removal + database + (assq-ref cached-narinfo-file-details 'id))) + all-cached-narinfo-file-details))) (count-metric (metrics-registry-fetch-metric metrics-registry "database_scheduled_cached_narinfo_removal_total"))) - (for-each - (lambda (file cached-narinfo-file-details existing-scheduled-removal) - (unless existing-scheduled-removal - (let ((removal-time - ;; The earliest this can be removed is the current - ;; time, plus the TTL - (add-duration - (current-time) - (make-time time-duration - 0 - (or (assq-ref compression-details 'ttl) - base-ttl))))) - (database-insert-scheduled-cached-narinfo-removal - database - (assq-ref cached-narinfo-file-details 'id) - removal-time) - - (metric-increment count-metric)))) - files - all-cached-narinfo-file-details - existing-scheduled-removals) + (with-time-logging "inserting scheduled-cached-narinfo-removals" + (for-each + (lambda (file cached-narinfo-file-details existing-scheduled-removal) + (unless existing-scheduled-removal + (let ((removal-time + ;; The earliest this can be removed is the current + ;; time, plus the TTL + (add-duration + (current-time) + (make-time time-duration + 0 + (or (assq-ref compression-details 'ttl) + base-ttl))))) + (database-insert-scheduled-cached-narinfo-removal + database + (assq-ref cached-narinfo-file-details 'id) + removal-time) + + (metric-increment count-metric)))) + files + all-cached-narinfo-file-details + existing-scheduled-removals)) (when (any not existing-scheduled-removals) ;; Wake the cached compression removal fiber in case one of |