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'.
This commit is contained in:
Ludovic Courtès 2017-07-21 17:02:19 +02:00
parent deac674ab4
commit c95644f017
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 21 additions and 2 deletions

View File

@ -6960,7 +6960,8 @@ guarantee that the store items it provides will indeed remain available
for as long as @var{ttl}.
Additionally, when @option{--cache} is used, cached entries that have
not been accessed for @var{ttl} may be deleted.
not been accessed for @var{ttl} and that no longer have a corresponding
item in the store, may be deleted.
@item --nar-path=@var{path}
Use @var{path} as the prefix for the URLs of ``nar'' files

View File

@ -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