0.9.2.38: thread cleanup, paranoid

[sbcl.git] / contrib / sb-bsd-sockets / sockets.lisp

diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index 4a5249f..bb4e7c1 100644 (file)
--- a/contrib/sb-bsd-sockets/sockets.lisp
+++ b/contrib/sb-bsd-sockets/sockets.lisp
@@ -221,10 +221,20 @@ grow to before new connection attempts are refused.  See also listen(2)"))
     (if (= r -1)
         (socket-error "listen"))))
 
+(defgeneric socket-open-p (socket)
+  (:documentation "Return true if SOCKET is open; otherwise, return false.")
+  (:method ((socket t)) (error 'type-error
+                              :datum socket :expected-type 'socket)))
+
+(defmethod socket-open-p ((socket socket))
+  (if (slot-boundp socket 'stream)
+      (open-stream-p (slot-value socket 'stream))
+      (/= -1 (socket-file-descriptor socket))))
+
 (defgeneric socket-close (socket)
-  (:documentation "Close SOCKET.  May throw any kind of error that write(2) would have
-thrown.  If SOCKET-MAKE-STREAM has been called, calls CLOSE on that
-stream instead"))
+  (:documentation "Close SOCKET.  May throw any kind of error that
+write(2) would have thrown.  If SOCKET-MAKE-STREAM has been called,
+calls CLOSE on that stream instead"))
 
 (defmethod socket-close ((socket socket))
   ;; the close(2) manual page has all kinds of warning about not
@@ -244,30 +254,34 @@ stream instead"))
     (cond ((eql fd -1) ; already closed
           nil)
          ((slot-boundp socket 'stream)
-          (close (slot-value socket 'stream)) ;; closes fd
-          (setf (slot-value socket 'file-descriptor) -1)
-          (slot-makunbound socket 'stream))
+          (unwind-protect (close (slot-value socket 'stream)) ;; closes fd
+            (setf (slot-value socket 'file-descriptor) -1)
+            (slot-makunbound socket 'stream)))
          (t
           (sb-ext:cancel-finalization socket)
           (handler-case
               (if (= (sockint::close fd) -1)
                   (socket-error "close"))
             (bad-file-descriptor-error (c) (declare (ignore c)) nil)
-            (:no-error (c)  (declare (ignore c)) nil))))))
+            (:no-error (c)
+               (declare (ignore c))
+               (setf (slot-value socket 'file-descriptor) -1)
+               nil))))))
 
     
-(defgeneric socket-make-stream (socket  &rest args)
-    (:documentation "Find or create a STREAM that can be used for IO
-on SOCKET (which must be connected).  ARGS are passed onto
+(defgeneric socket-make-stream (socket &rest args)
+  (:documentation "Find or create a STREAM that can be used for IO on
+SOCKET (which must be connected).  ARGS are passed onto
 SB-SYS:MAKE-FD-STREAM."))
 
-(defmethod socket-make-stream ((socket socket)  &rest args)
+(defmethod socket-make-stream ((socket socket) &rest args)
   (let ((stream
         (and (slot-boundp socket 'stream) (slot-value socket 'stream))))
     (unless stream
       (setf stream (apply #'sb-sys:make-fd-stream
                          (socket-file-descriptor socket)
                          :name "a constant string"
+                         :dual-channel-p t
                          args))
       (setf (slot-value socket 'stream) stream)
       (sb-ext:cancel-finalization socket))
@@ -321,7 +335,7 @@ SB-SYS:MAKE-FD-STREAM."))
 (define-socket-condition sockint::EPROTONOSUPPORT protocol-not-supported-error)
 (define-socket-condition sockint::ESOCKTNOSUPPORT socket-type-not-supported-error)
 (define-socket-condition sockint::ENETUNREACH network-unreachable-error)
-
+(define-socket-condition sockint::ENOTCONN not-connected-error)
 
 (defun condition-for-errno (err)
   (or (cdr (assoc err *conditions-for-errno* :test #'eql)) 'socket-error))