X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-bsd-sockets%2Fsockets.lisp;h=bb4e7c1b959e49e2c9c57a89c13569441f7fb322;hb=ad3beba970fab6e451a461c9f9b14faf4ef17718;hp=4a5249f55c53d7ec17ac55d52ab9dd4872d9f28d;hpb=8a3c76ab9725a199aa06a0abc018e096271a0f75;p=sbcl.git

diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp
index 4a5249f..bb4e7c1 100644
--- 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))