[Sbcl-commits] CVS: sbcl/contrib/sb-bsd-sockets inet.lisp, 1.12, 1.13 local.lisp, 1.7, 1.8 sockets.lisp, 1.27, 1.28

[Nikodemus S. <de...@us...>]

Update of /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv6689/contrib/sb-bsd-sockets

Modified Files:
	inet.lisp local.lisp sockets.lisp 
Log Message:
1.0.37.21: :AUTO-CLOSE and better FD-STREAM-NAME for socket streams

 Fixed launchpad bug #540413.


Index: inet.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/inet.lisp,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- inet.lisp	14 Mar 2008 20:41:26 -0000	1.12
+++ inet.lisp	1 Apr 2010 12:52:05 -0000	1.13
@@ -17,6 +17,16 @@
 ;;; XXX should we *...* this?
 (defparameter inet-address-any (vector 0 0 0 0))
 
+(defmethod socket-namestring ((socket inet-socket))
+  (ignore-errors
+    (multiple-value-bind (addr port) (socket-name socket)
+      (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
+
+(defmethod socket-peerstring ((socket inet-socket))
+  (ignore-errors
+    (multiple-value-bind (addr port) (socket-peername socket)
+      (format nil "~{~A~^.~}:~A" (coerce addr 'list) port))))
+
 ;;; binding a socket to an address and port.  Doubt that anyone's
 ;;; actually using this much, to be honest.
 

Index: local.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/local.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- local.lisp	16 Jul 2008 11:48:55 -0000	1.7
+++ local.lisp	1 Apr 2010 12:52:05 -0000	1.8
@@ -5,6 +5,12 @@
   (:documentation "Class representing local domain (AF_LOCAL) sockets,
 also known as unix-domain sockets."))
 
+(defmethod socket-namestring ((socket local-socket))
+  (ignore-errors (socket-name socket)))
+
+(defmethod socket-peerstring ((socket local-socket))
+  (ignore-errors (socket-peername socket)))
+
 (defmethod make-sockaddr-for ((socket local-socket)
                               &optional sockaddr &rest address &aux (filename (first address)))
   (let ((sockaddr (or sockaddr (sockint::allocate-sockaddr-un))))

Index: sockets.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-bsd-sockets/sockets.lisp,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- sockets.lisp	30 Jul 2009 11:02:22 -0000	1.27
+++ sockets.lisp	1 Apr 2010 12:52:05 -0000	1.28
@@ -25,9 +25,20 @@
 
 (defmethod print-object ((object socket) stream)
   (print-unreadable-object (object stream :type t :identity t)
-                           (princ "descriptor " stream)
-                           (princ (slot-value object 'file-descriptor) stream)))
+    (format stream "~@[~A, ~]~@[peer: ~A, ~]fd: ~A"
+            (socket-namestring object)
+            (socket-peerstring object)
+            (slot-value object 'file-descriptor))))
+
+(defgeneric socket-namestring (socket))
+
+(defmethod socket-namestring (socket)
+  nil)
 
+(defgeneric socket-peerstring (socket))
+
+(defmethod socket-peerstring (socket)
+  nil)
 
 (defmethod shared-initialize :after ((socket socket) slot-names
                                      &key protocol type
@@ -362,28 +373,34 @@
                                (element-type 'character)
                                (buffering :full)
                                (external-format :default)
-                               timeout)
-  "Default method for SOCKET objects.  An ELEMENT-TYPE of :DEFAULT
-will construct a bivalent stream.  Acceptable values for BUFFERING
-are :FULL, :LINE and :NONE.  Streams will have no TIMEOUT
-by default.
-  The stream for SOCKET will be cached, and a second invocation of this
-method will return the same stream.  This may lead to oddities if this
-function is invoked with inconsistent arguments \(e.g., one might request
-an input stream and get an output stream in response\)."
+                               timeout
+                               auto-close)
+  "Default method for SOCKET objects. An ELEMENT-TYPE of :DEFAULT will
+construct a bivalent stream. Acceptable values for BUFFERING are :FULL, :LINE
+and :NONE. Streams will have no TIMEOUT by default. If AUTO-CLOSE is true, the
+underlying OS socket is automatically closed after the stream and the socket
+have been garbage collected.
+
+The stream for SOCKET will be cached, and a second invocation of this method
+will return the same stream. This may lead to oddities if this function is
+invoked with inconsistent arguments \(e.g., one might request an input stream
+and get an output stream in response\)."
   (let ((stream
          (and (slot-boundp socket 'stream) (slot-value socket 'stream))))
     (unless stream
       (setf stream (sb-sys:make-fd-stream
                     (socket-file-descriptor socket)
-                    :name "a socket"
+                    :name (format nil "socket~@[ ~A~]~@[, peer: ~A~]"
+                                  (socket-namestring socket)
+                                  (socket-peerstring socket))
                     :dual-channel-p t
                     :input input
                     :output output
                     :element-type element-type
                     :buffering buffering
                     :external-format external-format
-                    :timeout timeout)))
+                    :timeout timeout
+                    :auto-close auto-close)))
       (setf (slot-value socket 'stream) stream)
     (sb-ext:cancel-finalization socket)
     stream))