substitute: Cache transient HTTP errors for 10mn.

* guix/scripts/substitute.scm (fetch-narinfos)[handle-narinfo-response]:
Cache transient errors for 10mn.
(%narinfo-transient-error-ttl): New variable.
master
Ludovic Courtès 2016-03-17 21:49:05 +01:00
parent 14d6ca3e4d
commit 958fb14cdb
1 changed files with 25 additions and 25 deletions

View File

@ -113,9 +113,13 @@ disabled!~%"))
(* 36 3600))
(define %narinfo-negative-ttl
;; Likewise, but for negative lookups---i.e., cached lookup failures.
;; Likewise, but for negative lookups---i.e., cached lookup failures (404).
(* 3 3600))
(define %narinfo-transient-error-ttl
;; Likewise, but for transient errors such as 504 ("Gateway timeout").
(* 10 60))
(define %narinfo-expired-cache-entry-removal-delay
;; How often we want to remove files corresponding to expired cache entries.
(* 7 24 3600))
@ -585,34 +589,30 @@ if file doesn't exist, and the narinfo otherwise."
(set! done (+ 1 done)))))
(define (handle-narinfo-response request response port result)
(let* ((len (response-content-length response))
(let* ((code (response-code response))
(len (response-content-length response))
(cache (response-cache-control response))
(ttl (and cache (assoc-ref cache 'max-age))))
;; Make sure to read no more than LEN bytes since subsequent bytes may
;; belong to the next response.
(case (response-code response)
((200) ; hit
(let ((narinfo (read-narinfo port url #:size len)))
(cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
(update-progress!)
(cons narinfo result)))
((404) ; failure
(let* ((path (uri-path (request-uri request)))
(hash-part (string-drop-right path 8))) ; drop ".narinfo"
(if len
(get-bytevector-n port len)
(read-to-eof port))
(cache-narinfo! url
(find (cut string-contains <> hash-part) paths)
#f ttl)
(update-progress!)
result))
(else ; transient failure: 504...
(if len
(get-bytevector-n port len)
(read-to-eof port))
(update-progress!)
result))))
(if (= code 200) ; hit
(let ((narinfo (read-narinfo port url #:size len)))
(cache-narinfo! url (narinfo-path narinfo) narinfo ttl)
(update-progress!)
(cons narinfo result))
(let* ((path (uri-path (request-uri request)))
(hash-part (string-drop-right path 8))) ; drop ".narinfo"
(if len
(get-bytevector-n port len)
(read-to-eof port))
(cache-narinfo! url
(find (cut string-contains <> hash-part) paths)
#f
(if (= 404 code)
ttl
%narinfo-transient-error-ttl))
(update-progress!)
result))))
(define (do-fetch uri port)
(case (and=> uri uri-scheme)