nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2016-03-17 21:49:05 +01:00
parent 14d6ca3e4d
commit 958fb14cdb
1 changed files with 25 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
guix/scripts/substitute.scm
View File

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