substitute: Time out unresponsive substitute servers.

Only connection establishment was bounded by a timeout, so a substitute server
that accepted a connection but then stalled would block 'substitute --query'
and nar downloads indefinitely.  Set a read timeout on substitute connections
so a stalled server is eventually abandoned and the next URL is tried.

* guix/scripts/substitute.scm (%fetch-read-timeout): New variable.
(open-connection-for-uri/cached): Add #:read-timeout defaulting to
%fetch-read-timeout; pass it to 'guix:open-connection-for-uri' and on the
recursive call.

guix/build/download.scm

@@ -381,11 +381,14 @@ host name without trailing dot."
    ((uri? uri-or-string) uri-or-string)
    (else (error "Invalid URI" uri-or-string))))
 
-(define* (open-socket-for-uri uri-or-string #:key timeout)
+(define* (open-socket-for-uri uri-or-string #:key timeout read-timeout)
   "Return an open input/output port for a connection to URI.  When TIMEOUT is
 not #f, it must be a (possibly inexact) number denoting the maximum duration
 in seconds to wait for the connection to complete; passed TIMEOUT, an
-ETIMEDOUT error is raised."
+ETIMEDOUT error is raised.  When READ-TIMEOUT is not #f, it must be a
+(possibly inexact) number denoting the maximum number of seconds to wait for
+incoming data on the established connection; past READ-TIMEOUT, a read returns
+EAGAIN instead of blocking."
   ;; Includes a fix for <http://bugs.gnu.org/15368> which affects Guile's
   ;; 'open-socket-for-uri' up to 2.0.11 included, uses 'connect*' instead
   ;; of 'connect', and uses AI_ADDRCONFIG.
@@ -413,6 +416,19 @@ ETIMEDOUT error is raised."
         (lambda ()
           (connect* s (addrinfo:addr ai) timeout)
 
+          ;; When READ-TIMEOUT is set, bound the time spent waiting for data
+          ;; on the socket so that a server that accepts the connection but
+          ;; then stops responding cannot block reads (or writes) forever:
+          ;; past the timeout, 'recv' returns EAGAIN.
+          (when read-timeout
+            (let* ((seconds (inexact->exact (floor read-timeout)))
+                   (value (cons seconds
+                                (inexact->exact
+                                 (round (* (- read-timeout seconds)
+                                           #e1e6))))))
+              (setsockopt s SOL_SOCKET SO_RCVTIMEO value)
+              (setsockopt s SOL_SOCKET SO_SNDTIMEO value)))
+
           ;; Buffer input and output on this port.
           (setvbuf s 'block)
           ;; If we're using a proxy, make a note of that.
@@ -442,9 +458,11 @@ ETIMEDOUT error is raised."
 (define* (open-connection-for-uri uri
                                   #:key
                                   timeout
+                                  read-timeout
                                   (verify-certificate? #t))
   "Like 'open-socket-for-uri', but also handle HTTPS connections.  When
-VERIFY-CERTIFICATE? is true, verify HTTPS server certificates."
+VERIFY-CERTIFICATE? is true, verify HTTPS server certificates.  TIMEOUT and
+READ-TIMEOUT are passed to 'open-socket-for-uri'."
   ;; Note: Guile 2.2.0's (web client) has a same-named export that's actually
   ;; undefined.  See Guile commit 011669af3b428e5626f7bbf66b11d57d9768c047.
 
@@ -468,7 +486,9 @@ VERIFY-CERTIFICATE? is true, verify HTTPS server certificates."
                            (thunk))
                          (thunk)))))))
     (with-https-proxy
-     (let ((s (open-socket-for-uri uri #:timeout timeout)))
+     (let ((s (open-socket-for-uri uri
+                                   #:timeout timeout
+                                   #:read-timeout read-timeout)))
        ;; Buffer input and output on this port.
        (setvbuf s 'block %http-receive-buffer-size)
 

guix/http-client.scm

@@ -94,6 +94,7 @@
                              (cons 'system-error (exception-args exception)))))
                  (memv errno (list ECONNRESET ECONNABORTED ETIMEDOUT
                                    ECONNREFUSED EHOSTUNREACH EPIPE
+                                   EAGAIN EWOULDBLOCK ;socket read/write timeout
                                    ENOENT))))     ;for "file://"
           (and (kind-and-args? exception)
                (memq (exception-kind exception)

guix/scripts/substitute.scm

@@ -323,16 +323,25 @@ authorized substitutes."
   ;; Number of seconds after which networking is considered "slow".
   5)
 
+(define %fetch-read-timeout
+  ;; Number of seconds of inactivity after which an established connection to a
+  ;; substitute server is considered unresponsive.  Without it, a server that
+  ;; accepts the connection but then stalls would block 'substitute --query'
+  ;; and nar downloads indefinitely.
+  60)
+
 (define open-connection-for-uri/cached
   (let ((cache '()))
-    (lambda* (uri #:key fresh? (timeout %fetch-timeout) verify-certificate?)
+    (lambda* (uri #:key fresh? (timeout %fetch-timeout)
+                  (read-timeout %fetch-read-timeout) verify-certificate?)
       "Return a connection for URI, possibly reusing a cached connection.
 When FRESH? is true, delete any cached connections for URI and open a new one.
 Return #f if URI's scheme is 'file' or #f.
 
-When true, TIMEOUT is the maximum number of seconds to wait for
-connection establishment.  When VERIFY-CERTIFICATE? is true, verify HTTPS
-server certificates."
+When true, TIMEOUT is the maximum number of seconds to wait for connection
+establishment.  When true, READ-TIMEOUT is the maximum number of seconds to
+wait for incoming data on the established connection.  When VERIFY-CERTIFICATE?
+is true, verify HTTPS server certificates."
       (define host (uri-host uri))
       (define scheme (uri-scheme uri))
       (define key (list host scheme (uri-port uri)))
@@ -346,7 +355,8 @@ server certificates."
                      (guix:open-connection-for-uri
                       uri
                       #:verify-certificate? verify-certificate?
-                      #:timeout timeout))
+                      #:timeout timeout
+                      #:read-timeout read-timeout))
                     (new-cache evicted
                                (at-most (- %max-cached-connections 1) cache)))
                 (for-each (match-lambda
@@ -361,6 +371,7 @@ server certificates."
                     (false-if-exception (close-port socket))
                     (set! cache (alist-delete key cache))
                     (open-connection-for-uri/cached uri #:timeout timeout
+                                                    #:read-timeout read-timeout
                                                     #:verify-certificate?
                                                     verify-certificate?))
                   (begin