bug#26489: [PATCH] substitute: Ignore bad responses.

[Tobias Geerinckx-Rice]

* guix/scripts/substitute.scm (http-multiple-get): Catch BAD-RESPONSE
exceptions and keep going.
---

Guix,

One weird HTTP response from a server will kill ‘guix substitute’:

  updating list of substitutes from 'https://foo'...  50.0%Backtrace:
  ...
  guix/ui.scm:1229:8: In procedure run-guix-command:
  guix/ui.scm:1229:8: Throw to key `bad-response' with args
                      `("Bad Response-Line: ~s" (""))'.
  error: build failed: substituter `substitute' died unexpectedly

Attached is a patch to ignore such bad responses. The offending .narinfo
will be ignored for that session, and not cached at all. The result:

  updating list of substitutes from 'https://bar'... 100.0%
  updating list of substitutes from 'https://foo'...   2.9% (bad response)
  updating list of substitutes from 'https://foo'...   5.9% (bad response)

As a nice bonus, guix doesn't keel over and die.

Is this the best solution? A good one? Should it be made more obvious
that only READ-RESPONSE can throw, and that PROC will never be called
with, a bad response? No idea. I haven't had enough free time to learn
good the Guile like I'd so hoped to do at the beginning of the year. :c

Be gentle, dear reader, and all that,

T G-R

 guix/scripts/substitute.scm | 30 ++++++++++++++++++------------
 1 file changed, 18 insertions(+), 12 deletions(-)

diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index d3bccf4dd..7eccf9831 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -564,18 +564,24 @@ initial connection on which HTTP requests are sent."
           (()
            (reverse result))
           ((head tail ...)
-           (let* ((resp   (read-response p))
-                  (body   (response-body-port resp))
-                  (result (proc head resp body result)))
-             ;; The server can choose to stop responding at any time, in which
-             ;; case we have to try again.  Check whether that is the case.
-             ;; Note that even upon "Connection: close", we can read from BODY.
-             (match (assq 'connection (response-headers resp))
-               (('connection 'close)
-                (close-connection p)
-                (connect #f tail result))         ;try again
-               (_
-                (loop tail result))))))))))       ;keep going
+           (catch 'bad-response
+             (lambda ()
+               (let* ((resp   (read-response p))
+                      (body   (response-body-port resp))
+                      (result (proc head resp body result)))
+                 ;; The server can stop responding at any time, in which case
+                 ;; we have to try again.  Check whether that's the case.  Note
+                 ;; that we can read from BODY even upon "Connection: close".
+                 (match (assq 'connection (response-headers resp))
+                   (('connection 'close)
+                    (close-connection p)
+                    (connect #f tail result)) ; try again
+                   (_
+                    (loop tail result))))) ; keep going
+             (lambda args
+               ;; This message appears on the same line as the progress report.
+               (format (current-error-port) " (bad response)~%")
+               (loop tail result))))))))) ; keep going
 
 (define (read-to-eof port)
   "Read from PORT until EOF is reached.  The data are discarded."
-- 
2.12.2