publish: Advertise a short TTL for "baking" 404s.

* guix/scripts/publish.scm (not-found): Add #:phrase and #:ttl
parameters and honor them.
* tests/publish.scm ("with cache"): Check the 'cache-control' header on
of the 404 response.
This commit is contained in:
Ludovic Courtès 2017-05-11 10:23:27 +02:00
parent 5899fafbfe
commit 24b21720f7
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 18 additions and 4 deletions

View File

@ -300,10 +300,15 @@ References: ~a~%~a"
(canonical-sexp->string (signed-string info))))) (canonical-sexp->string (signed-string info)))))
(format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature))) (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
(define (not-found request) (define* (not-found request
#:key (phrase "Resource not found")
ttl)
"Render 404 response for REQUEST." "Render 404 response for REQUEST."
(values (build-response #:code 404) (values (build-response #:code 404
(string-append "Resource not found: " #:headers (if ttl
`((cache-control (max-age . ,ttl)))
'()))
(string-append phrase ": "
(uri-path (request-uri request))))) (uri-path (request-uri request)))))
(define (render-nix-cache-info) (define (render-nix-cache-info)
@ -434,7 +439,9 @@ requested using POOL."
(file-expiration-time ttl) (file-expiration-time ttl)
#:delete-entry delete-entry #:delete-entry delete-entry
#:cleanup-period ttl)))) #:cleanup-period ttl))))
(not-found request)) (not-found request
#:phrase "We're baking it"
#:ttl 300)) ;should be available within 5m
(else (else
(not-found request))))) (not-found request)))))

View File

@ -355,6 +355,13 @@ FileSize: ~a~%"
(basename %item) ".nar")) (basename %item) ".nar"))
(response (http-get url))) (response (http-get url)))
(and (= 404 (response-code response)) (and (= 404 (response-code response))
;; We should get an explicitly short TTL for 404 in this case
;; because it's going to become 200 shortly.
(match (assq-ref (response-headers response) 'cache-control)
((('max-age . ttl))
(< ttl 3600)))
(wait-for-file cached) (wait-for-file cached)
(let* ((body (http-get-port url)) (let* ((body (http-get-port url))
(compressed (http-get nar-url)) (compressed (http-get nar-url))