[usocket-cvs] r424 - usocket/trunk/backend

[ehuelsmann at common-lisp.net]

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)