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.
master
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 thread per CPU core is created, but this can be customized. See
@option{--workers} below. @option{--workers} below.
When @option{--ttl} is used, cached entries are automatically deleted
when they have expired.
@item --workers=@var{N} @item --workers=@var{N}
When @option{--cache} is used, request the allocation of @var{N} worker When @option{--cache} is used, request the allocation of @var{N} worker
threads to ``bake'' archives. 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 guarantee that the store items it provides will indeed remain available
for as long as @var{ttl}. 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} @item --nar-path=@var{path}
Use @var{path} as the prefix for the URLs of ``nar'' files Use @var{path} as the prefix for the URLs of ``nar'' files
(@pxref{Invoking guix archive, normalized archives}). (@pxref{Invoking guix archive, normalized archives}).

View File

@ -50,11 +50,13 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module ((guix serialization) #:select (write-file)) #:use-module ((guix serialization) #:select (write-file))
#:use-module (guix zlib) #:use-module (guix zlib)
#:use-module (guix cache)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module ((guix utils) #:use-module ((guix utils)
#:select (with-atomic-file-output compressed-file?)) #: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 #:export (%public-key
%private-key %private-key
@ -365,6 +367,14 @@ at a time."
(run-single-baker item (lambda () 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 (define* (render-narinfo/cached store request hash
#:key ttl (compression %no-compression) #:key ttl (compression %no-compression)
(nar-path "nar") (nar-path "nar")
@ -372,6 +382,14 @@ at a time."
"Respond to the narinfo request for REQUEST. If the narinfo is available in "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 CACHE, then send it; otherwise, return 404 and \"bake\" that nar and narinfo
requested using POOL." 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)) (let* ((item (hash-part->path store hash))
(compression (actual-compression item compression)) (compression (actual-compression item compression))
(cached (and (not (string-null? item)) (cached (and (not (string-null? item))
@ -398,7 +416,16 @@ requested using POOL."
(bake-narinfo+nar cache item (bake-narinfo+nar cache item
#:ttl ttl #:ttl ttl
#:compression compression #: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)) (not-found request))
(else (else
(not-found request))))) (not-found request)))))