Author: ehuelsmann
Date: Thu Sep 18 11:44:23 2008
New Revision: 424
Modified:
usocket/trunk/backend/sbcl.lisp
Log:
Don't leak file descriptors.
Found by: Lars Nostdal <larsnostdal at gmail dot com>
Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp (original)
+++ usocket/trunk/backend/sbcl.lisp Thu Sep 18 11:44:23 2008
@@ -213,27 +213,33 @@
(not (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay)))
(unsupported 'nodelay 'socket-connect))
- (let* ((socket (make-instance 'sb-bsd-sockets:inet-socket
- :type :stream :protocol :tcp))
- (stream (sb-bsd-sockets:socket-make-stream socket
- :input t
- :output t
- :buffering :full
- :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)))
- (when (and nodelay-specified
- (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))
- (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))
+ (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+ :type :stream :protocol :tcp)))
+ (handler-case
+ (let* ((stream
+ (sb-bsd-sockets:socket-make-stream socket
+ :input t
+ :output t
+ :buffering :full
+ :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)))
+ (when (and nodelay-specified
+ (fboundp 'sb-bsd-sockets::sockopt-tcp-nodelay))
+ (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)
+ (t (c)
+ ;; Make sure we don't leak filedescriptors
+ (sb-bsd-sockets:socket-close socket)
+ (error c)))))
(defun socket-listen (host port
&key reuseaddress
@@ -244,11 +250,16 @@
(ip (host-to-vector-quad host))
(sock (make-instance 'sb-bsd-sockets:inet-socket
:type :stream :protocol :tcp)))
- (with-mapped-conditions ()
- (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress)
- (sb-bsd-sockets:socket-bind sock ip port)
- (sb-bsd-sockets:socket-listen sock backlog)
- (make-stream-server-socket sock :element-type element-type))))
+ (handler-case
+ (with-mapped-conditions ()
+ (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress)
+ (sb-bsd-sockets:socket-bind sock ip port)
+ (sb-bsd-sockets:socket-listen sock backlog)
+ (make-stream-server-socket sock :element-type element-type))
+ (t (c)
+ ;; Make sure we don't leak filedescriptors
+ (sb-bsd-sockets:socket-close sock)
+ (error c)))))
(defmethod socket-accept ((socket stream-server-usocket) &key element-type)
(with-mapped-conditions (socket)
