diff options
| -rw-r--r-- | nar-herder/cached-compression.scm | 118 | ||||
| -rw-r--r-- | scripts/nar-herder.in | 11 |
2 files changed, 113 insertions, 16 deletions
diff --git a/nar-herder/cached-compression.scm b/nar-herder/cached-compression.scm index d82a9e2..2711154 100644 --- a/nar-herder/cached-compression.scm +++ b/nar-herder/cached-compression.scm @@ -156,25 +156,100 @@ (assq-ref details 'compression)))) database-entries-missing-files))) - ;; Remove cached files if the max size is exceeded - (for-each - (match-lambda - ((compression . cached-bytes) - (maybe-remove-cached-files-for-compression - database - enabled-cached-compressions - compression - cached-bytes-by-compression))) - cached-bytes-by-compression) - cached-bytes-by-compression)) (define (maybe-remove-cached-files-for-compression database enabled-cached-compressions compression - cached-bytes-by-compression) - ;; TODO Implement - #f) + cached-bytes-by-compression-box + nar-cache-bytes-metric) + (let* ((compression-details + (assq-ref enabled-cached-compressions + compression)) + (max-size + (assq-ref compression-details + 'directory-max-size))) + (when max-size + (let ((current-size + (assq-ref + (atomic-box-ref cached-bytes-by-compression-box) + compression))) + (when (> current-size max-size) + (let ((bytes-to-remove + (- current-size max-size))) + (log-msg 'DEBUG + "looking to remove " bytes-to-remove " bytes of " + compression " compressed nars") + + (match + (database-fold-cached-narinfo-files + database + (match-lambda* + ((details (finished? bytes result)) + (if finished? + (list finished? bytes result) + (if (eq? (assq-ref details 'compression) + compression) + (let ((new-bytes + (+ bytes + (assq-ref details 'size)))) + (cons + ;; finished if enough bytes are going + ;; to be removed + (> new-bytes bytes-to-remove) + (list new-bytes (cons details result)))) + (list #f bytes result))))) + '(#f 0 ())) + ((#t bytes-for-removal files-to-remove-details) + (log-msg 'DEBUG "removing " (length files-to-remove-details) + " " compression " compressed nars from the cache") + + ;; Remove all the database entries first, as that'll + ;; stop these files appearing in narinfos + (for-each + (lambda (details) + (database-remove-cached-narinfo-file + database + (assq-ref details 'narinfo-id) + (symbol->string compression))) + files-to-remove-details) + + (let ((directory + (assq-ref compression-details 'directory))) + (for-each + (lambda (details) + (let ((filename + (string-append + directory "/" + (basename (assq-ref details 'store-path))))) + (log-msg 'DEBUG "deleting " filename) + (delete-file filename))) + files-to-remove-details) + + (let* ((cached-bytes-by-compression + (atomic-box-ref cached-bytes-by-compression-box)) + (new-cached-bytes + (- (assq-ref cached-bytes-by-compression + compression) + bytes-for-removal))) + (atomic-box-set! + cached-bytes-by-compression-box + (alist-cons + compression + new-cached-bytes + (alist-delete + compression + cached-bytes-by-compression))) + + (metric-set + nar-cache-bytes-metric + new-cached-bytes + #:label-values `((compression . ,compression))) + + (log-msg 'DEBUG "finished removing " bytes-for-removal + " bytes of " compression + " cached nars from " directory + " (new size " new-cached-bytes ")"))))))))))) (define* (make-maybe-trigger-creation-of-compressed-nars database @@ -208,6 +283,18 @@ #:label-values `((compression . ,compression))))) (atomic-box-ref cached-bytes-by-compression-box)) + ;; Remove cached files if the max size is exceeded + (for-each + (match-lambda + ((compression . _) + (maybe-remove-cached-files-for-compression + database + enabled-cached-compressions + compression + cached-bytes-by-compression-box + nar-cache-bytes-metric))) + (atomic-box-ref cached-bytes-by-compression-box)) + (list cached-bytes-by-compression-box))) ;; Just make one thread, as this thread won't do much work ;; and relies on a hash table that shouldn't be accessed by @@ -296,7 +383,8 @@ database enabled-cached-compressions missing-compression - cached-bytes-by-compression))))) + cached-bytes-by-compression-box + nar-cache-bytes-metric))))) missing-compressions) (with-usage-hash-table diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in index 829b23a..2e2563c 100644 --- a/scripts/nar-herder.in +++ b/scripts/nar-herder.in @@ -461,6 +461,12 @@ (match-lambda (('cached-compression-directory . details) details) (_ #f)) + opts)) + (cached-compression-directories-max-sizes + (filter-map + (match-lambda + (('cached-compression-directory-max-size . details) details) + (_ #f)) opts))) (filter-map (match-lambda @@ -473,7 +479,10 @@ . ,(or (assq-ref explicit-cached-compression-directories compression) (simple-format #f "/var/cache/nar-herder/nar/~A" - compression))))))) + compression))) + (directory-max-size + . ,(assq-ref cached-compression-directories-max-sizes + compression)))))) (_ #f)) opts))) |