Add more error handling in to call-with-streaming-http-request

As I think there's "Resource temporarily unavailable, try again." errors
coming from here...

1 files changed, 30 insertions, 23 deletions

diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index e5017d5..ea0dea0 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -268,29 +268,35 @@ upcoming chunk."
            #:port port)))
 
     (set-port-encoding! port "ISO-8859-1")
-    (let ((request (write-request request port)))
-      (let ((chunked-output-port
-             (make-chunked-output-port
-              port
-              #:buffering (expt 2 20)
-              #:keep-alive? #t)))
-
-        ;; A SIGPIPE will kill Guile, so ignore it
-        (sigaction SIGPIPE
-          (lambda (arg)
-            (simple-format (current-error-port) "warning: SIGPIPE\n")))
-
-        (set-port-encoding! chunked-output-port "ISO-8859-1")
-        (callback chunked-output-port)
-        (close-port chunked-output-port)
-        (display "\r\n" port)
-        (force-output port))
-
-      (let ((response (read-response port)))
-        (let ((body (read-response-body response)))
+    (with-exception-handler
+        (lambda (exp)
+          (simple-format #t "error: PUT ~A: ~A\n" (uri-path uri) exp)
           (close-port port)
-          (values response
-                  body))))))
+          (raise-exception exp))
+      (lambda ()
+        (let ((request (write-request request port)))
+          (let ((chunked-output-port
+                 (make-chunked-output-port
+                  port
+                  #:buffering (expt 2 20)
+                  #:keep-alive? #t)))
+
+            ;; A SIGPIPE will kill Guile, so ignore it
+            (sigaction SIGPIPE
+              (lambda (arg)
+                (simple-format (current-error-port) "warning: SIGPIPE\n")))
+
+            (set-port-encoding! chunked-output-port "ISO-8859-1")
+            (callback chunked-output-port)
+            (close-port chunked-output-port)
+            (display "\r\n" port)
+            (force-output port))
+
+          (let ((response (read-response port)))
+            (let ((body (read-response-body response)))
+              (close-port port)
+              (values response
+                      body))))))))
 
 (define (has-substiutes-no-cache? substitute-urls file)
   (define %narinfo-cache-directory
@@ -418,7 +424,8 @@ References: ~a~%"
            (begin
              (simple-format
               (current-error-port)
-              "error: ~A, retrying in ~A\n"
+              "error: ~A:\n  ~A,\n  retrying in ~A\n"
+              f
               exn
               delay)
              (sleep delay)