Skip to content

Commit

Permalink
Retry INTR error only once while "connect".
Browse files Browse the repository at this point in the history
  • Loading branch information
fukamachi committed Sep 24, 2024
1 parent d2717a4 commit 43ace47
Showing 1 changed file with 19 additions and 4 deletions.
23 changes: 19 additions & 4 deletions src/backend/usocket.lisp
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)))
Expand Down

0 comments on commit 43ace47

Please sign in to comment.