publish: Remove expired cache entries when '--ttl' is used.

* guix/scripts/publish.scm (narinfo-files): New procedure.
(render-narinfo/cached)[delete-file]: New procedure.  Add call to
'maybe-remove-expired-cache-entries'.
* doc/guix.texi (Invoking guix publish): Document the interation between
--cache and --ttl.
This commit is contained in:
Ludovic Courtès 2017-04-18 23:12:35 +02:00
parent 2ea2aac6e9
commit d72b42064b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 35 additions and 2 deletions

View file

@ -6600,6 +6600,9 @@ The ``baking'' process is performed by worker threads. By default, one
thread per CPU core is created, but this can be customized. See
@option{--workers} below.
When @option{--ttl} is used, cached entries are automatically deleted
when they have expired.
@item --workers=@var{N}
When @option{--cache} is used, request the allocation of @var{N} worker
threads to ``bake'' archives.
@ -6614,6 +6617,9 @@ This allows the user's Guix to keep substitute information in cache for
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.
@item --nar-path=@var{path}
Use @var{path} as the prefix for the URLs of ``nar'' files
(@pxref{Invoking guix archive, normalized archives}).

View file

@ -50,11 +50,13 @@ (define-module (guix scripts publish)
#:use-module (guix store)
#:use-module ((guix serialization) #:select (write-file))
#:use-module (guix zlib)
#:use-module (guix cache)
#:use-module (guix ui)
#:use-module (guix scripts)
#:use-module ((guix utils)
#:select (with-atomic-file-output compressed-file?))
#:use-module ((guix build utils) #:select (dump-port mkdir-p))
#:use-module ((guix build utils)
#:select (dump-port mkdir-p find-files))
#:export (%public-key
%private-key
@ -365,6 +367,14 @@ (define-syntax-rule (single-baker item exp ...)
(run-single-baker item (lambda () exp ...)))
(define (narinfo-files cache)
"Return the list of .narinfo files under CACHE."
(if (file-is-directory? cache)
(find-files cache
(lambda (file stat)
(string-suffix? ".narinfo" file)))
'()))
(define* (render-narinfo/cached store request hash
#:key ttl (compression %no-compression)
(nar-path "nar")
@ -372,6 +382,14 @@ (define* (render-narinfo/cached store request hash
"Respond to the narinfo request for REQUEST. If the narinfo is available in
CACHE, then send it; otherwise, return 404 and \"bake\" that nar and narinfo
requested using POOL."
(define (delete-entry narinfo)
;; Delete NARINFO and the corresponding nar from CACHE.
(let ((nar (string-append (string-drop-right narinfo
(string-length ".narinfo"))
".nar")))
(delete-file* narinfo)
(delete-file* nar)))
(let* ((item (hash-part->path store hash))
(compression (actual-compression item compression))
(cached (and (not (string-null? item))
@ -398,7 +416,16 @@ (define* (render-narinfo/cached store request hash
(bake-narinfo+nar cache item
#:ttl ttl
#:compression compression
#:nar-path nar-path)))
#:nar-path nar-path))
(when ttl
(single-baker 'cache-cleanup
(maybe-remove-expired-cache-entries cache
narinfo-files
#:entry-expiration
(file-expiration-time ttl)
#:delete-entry delete-entry
#:cleanup-period ttl))))
(not-found request))
(else
(not-found request)))))