summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-03-17 21:49:05 +0100
committerLudovic Courtès <ludo@gnu.org>2016-03-17 23:53:53 +0100
commit958fb14cdb5970ecf846e7b85c076a8ed3fe093b (patch)
treea572c60e7d7df57bdb665954fc3fdc3426ea7f45 /guix/scripts
parent14d6ca3e4dd23ee92adb5e2fcf58546e67534631 (diff)
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.
Diffstat (limited to 'guix/scripts')
-rwxr-xr-xguix/scripts/substitute.scm50
1 files changed, 25 insertions, 25 deletions
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index efbcfe78ca..c9e2ca3b83 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -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)