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:
		
							parent
							
								
									deac674ab4
								
							
						
					
					
						commit
						c95644f017
					
				
					 2 changed files with 21 additions and 2 deletions
				
			
		|  | @ -6960,7 +6960,8 @@ 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 | 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} | @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 | ||||||
|  |  | ||||||
|  | @ -385,6 +385,24 @@ at a time." | ||||||
|                     (string-suffix? ".narinfo" file))) |                     (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 | (define* (render-narinfo/cached store request hash | ||||||
|                                 #:key ttl (compression %no-compression) |                                 #:key ttl (compression %no-compression) | ||||||
|                                 (nar-path "nar") |                                 (nar-path "nar") | ||||||
|  | @ -436,7 +454,7 @@ requested using POOL." | ||||||
|                  (maybe-remove-expired-cache-entries cache |                  (maybe-remove-expired-cache-entries cache | ||||||
|                                                      narinfo-files |                                                      narinfo-files | ||||||
|                                                      #:entry-expiration |                                                      #:entry-expiration | ||||||
|                                                      (file-expiration-time ttl) |                                                      (nar-expiration-time ttl) | ||||||
|                                                      #:delete-entry delete-entry |                                                      #:delete-entry delete-entry | ||||||
|                                                      #:cleanup-period ttl)))) |                                                      #:cleanup-period ttl)))) | ||||||
|            (not-found request |            (not-found request | ||||||
|  |  | ||||||
		Reference in a new issue