Merge pull request #182 from fukamachi/reconnect-on-eintr

Retry INTR error only once while "connect".

Author: fukamachi

src/backend/usocket.lisp

@@ -399,6 +399,24 @@
 (defmethod open-stream-p ((u usocket-wrapped-stream))
   (open-stream-p (usocket-wrapped-stream-stream u)))
 
+(defun socket-connect/retry (uri &key timeout)
+  (declare (ignorable timeout))
+  (let ((retried nil))
+    (tagbody
+     retry
+      (handler-bind (#+sbcl
+                     (sb-bsd-sockets:interrupted-error
+                       (lambda (e)
+                         (declare (ignore e))
+                         (unless retried
+                           (setf retried t)
+                           (go retry)))))
+        (return-from socket-connect/retry
+          (usocket:socket-connect (uri-host uri)
+                                  (uri-port uri)
+                                  #-(or ecl clasp clisp allegro) :timeout #-(or ecl clasp clisp allegro) timeout
+                                  :element-type '(unsigned-byte 8)))))))
+
 (defun-careful request (uri &rest args
                             &key (method :get) (version 1.1)
                             content headers
@@ -427,10 +445,7 @@
   (labels ((make-new-connection (uri)
              (restart-case
                  (let* ((con-uri (quri:uri (or proxy uri)))
-                        (connection (usocket:socket-connect (uri-host con-uri)
-                                                            (uri-port con-uri)
-                                                            #-(or ecl clasp clisp allegro) :timeout #-(or ecl clasp clisp allegro) connect-timeout
-                                                            :element-type '(unsigned-byte 8)))
+                        (connection (socket-connect/retry con-uri :timeout connect-timeout))
                         (stream
                           (usocket:socket-stream connection))
                         (scheme (uri-scheme uri)))