From 958fb14cdb5970ecf846e7b85c076a8ed3fe093b Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 17 Mar 2016 21:49:05 +0100
Subject: 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.
---
 guix/scripts/substitute.scm | 50 ++++++++++++++++++++++-----------------------
 1 file 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)
-- 
cgit v1.2.3