diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-07-21 17:02:19 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-07-21 17:03:25 +0200 |
| commit | c95644f0172ba87822ee7ecee3d2743ebd2c84bc (patch) | |
| tree | c5dc31e4fabb6f1ab9c39085efb62984d46159d6 /guix/scripts | |
| parent | deac674ab4015e52fb6fb883f578e5c5891291a4 (diff) | |
publish: Make the cache eviction policy less aggressive.
Suggested by Mark H Weaver <mhw@netris.org>.
* guix/scripts/publish.scm (nar-expiration-time): New procedure.
(render-narinfo/cached): Use it as the #:entry-expiration passed to
'maybe-remove-expired-cache-entries'.
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/publish.scm | 20 |
1 files changed, 19 insertions, 1 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index cd57b13dc3..ade3c49a54 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -385,6 +385,24 @@ at a time." (string-suffix? ".narinfo" file))) '())) +(define (nar-expiration-time ttl) + "Return the narinfo expiration time (in seconds since the Epoch). The +expiration time is +inf.0 when passed an item that is still in the store; in +other cases, it is the last-access time of the item plus TTL. + +This policy allows us to keep cached nars that correspond to valid store +items. Failing that, we could eventually have to recompute them and return +404 in the meantime." + (let ((expiration-time (file-expiration-time ttl))) + (lambda (file) + (let ((item (string-append (%store-prefix) "/" + (basename file ".narinfo")))) + ;; Note: We don't need to use 'valid-path?' here because FILE would + ;; not exist if ITEM were not valid in the first place. + (if (file-exists? item) + +inf.0 + (expiration-time file)))))) + (define* (render-narinfo/cached store request hash #:key ttl (compression %no-compression) (nar-path "nar") @@ -436,7 +454,7 @@ requested using POOL." (maybe-remove-expired-cache-entries cache narinfo-files #:entry-expiration - (file-expiration-time ttl) + (nar-expiration-time ttl) #:delete-entry delete-entry #:cleanup-period ttl)))) (not-found request |