mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 15:36:20 -05:00
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:
parent
2ea2aac6e9
commit
d72b42064b
2 changed files with 35 additions and 2 deletions
|
@ -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}).
|
||||
|
|
|
@ -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)))))
|
||||
|
|
Loading…
Reference in a new issue