Author: ctian Date: Thu Mar 10 05:17:43 2011 New Revision: 575
Log: [SBCL] Merge a patch from Nikodemus Siivola (SBCL maintainer), for "better SOCKET-CONNECT for SBCL".
Modified: usocket/trunk/backend/sbcl.lisp
Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Thu Mar 10 05:17:43 2011 @@ -199,6 +199,11 @@ (if usock-cond (signal usock-cond :socket socket))))))
+(defvar *dummy-stream* + (let ((stream (make-broadcast-stream))) + (close stream) + stream)) + (defun socket-connect (host port &key (protocol :stream) (element-type 'character) timeout deadline (nodelay t nodelay-specified) local-host local-port @@ -219,47 +224,53 @@ (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type protocol :protocol (case protocol - (:stream :tcp) - (:datagram :udp))))) - (handler-case - (ecase protocol - (:stream - (let* ((stream - (sb-bsd-sockets:socket-make-stream socket - :input t - :output t - :buffering :full - #+sbcl #+sbcl - :timeout timeout - :element-type element-type)) - ;;###FIXME: The above line probably needs an :external-format - (usocket (make-stream-socket :stream stream :socket socket)) - (ip (host-to-vector-quad host))) - ;; binghe: use SOCKOPT-TCP-NODELAY as internal symbol - ;; to pass compilation on ECL without it. - (when (and nodelay-specified sockopt-tcp-nodelay-p) - (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) nodelay)) - (when (or local-host local-port) - (sb-bsd-sockets:socket-bind socket - (host-to-vector-quad - (or local-host *wildcard-host*)) - (or local-port *auto-port*))) - (with-mapped-conditions (usocket) - (sb-bsd-sockets:socket-connect socket ip port)) - usocket)) - (:datagram - (when (or local-host local-port) - (sb-bsd-sockets:socket-bind socket - (host-to-vector-quad - (or local-host *wildcard-host*)) - (or local-port *auto-port*))) - (when (and host port) - (sb-bsd-sockets:socket-connect socket (host-to-vector-quad host) port)) - (make-datagram-socket socket))) - (t (c) - ;; Make sure we don't leak filedescriptors - (sb-bsd-sockets:socket-close socket) - (error c))))) + (:stream :tcp) + (:datagram :udp)))) + (ip (host-to-vector-quad host)) + (local-host (host-to-vector-quad (or local-host *wildcard-host*))) + (local-port (or local-port *auto-port*)) + usocket ok) + (unwind-protect + (progn + (ecase protocol + (:stream + ;; If make a real socket stream before the socket is + ;; connected, it gets a misleading name so supply a + ;; dummy value to start with. + (setf usocket (make-stream-socket :socket socket :stream *dummy-stream*)) + ;; binghe: use SOCKOPT-TCP-NODELAY as internal symbol + ;; to pass compilation on ECL without it. + (when (and nodelay-specified sockopt-tcp-nodelay-p) + (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) nodelay)) + (when (or local-host local-port) + (sb-bsd-sockets:socket-bind socket local-host local-port)) + (with-mapped-conditions (usocket) + (sb-bsd-sockets:socket-connect socket ip port) + ;; Now that we're connected make the stream. + (setf (socket-stream usocket) + (sb-bsd-sockets:socket-make-stream socket + :input t + :output t + :buffering :full + #+sbcl #+sbcl + :timeout timeout + :element-type element-type)))) + (:datagram + (when (or local-host local-port) + (sb-bsd-sockets:socket-bind socket + (host-to-vector-quad + (or local-host *wildcard-host*)) + (or local-port *auto-port*))) + (setf usocket (make-datagram-socket socket)) + (when (and host port) + (with-mapped-conditions (usocket) + (sb-bsd-sockets:socket-connect socket ip port) + (setf (connected-p usocket) t))))) + (setf ok t)) + ;; Clean up in case of an error. + (unless ok + (sb-bsd-sockets:socket-close socket :abort t))) + usocket))
(defun socket-listen (host port &key reuseaddress