diff --git a/src/backend/usocket.lisp b/src/backend/usocket.lisp index e17ea3f..cbf585e 100644 --- a/src/backend/usocket.lisp +++ b/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)))