X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-simple-streams%2Fsocket.lisp;h=65357ac4a7aece7e65885f4080effdd4a8f5b417;hb=f057566fe993f008a9b34dc87b026e7c8ef2611d;hp=d08cb17e237f4fa6955d5a3076955a57075d99c7;hpb=cc9a73604f696b6e69842a95b1e11f40f8cdd7bf;p=sbcl.git

diff --git a/contrib/sb-simple-streams/socket.lisp b/contrib/sb-simple-streams/socket.lisp
index d08cb17..65357ac 100644
--- a/contrib/sb-simple-streams/socket.lisp
+++ b/contrib/sb-simple-streams/socket.lisp
@@ -3,7 +3,7 @@
 ;;; **********************************************************************
 ;;; This code was written by Paul Foley and has been placed in the public
 ;;; domain.
-;;; 
+;;;
 
 ;;; Sbcl port by Rudi Schlatte.
 
@@ -20,6 +20,20 @@
    (socket :initform nil :type (or sb-bsd-sockets:socket null)
            :initarg :socket)))
 
+(defmethod print-object ((object socket-simple-stream) stream)
+  (print-unreadable-object (object stream :type nil :identity nil)
+    (with-stream-class (socket-simple-stream object)
+      (cond ((not (any-stream-instance-flags object :simple))
+             (princ "Invalid " stream))
+            ((not (any-stream-instance-flags object :input :output))
+             (princ "Closed " stream)))
+      (format stream "~:(~A~)"
+              (type-of object))
+      (when (any-stream-instance-flags object :input :output)
+        (multiple-value-bind (host port)
+            (sb-bsd-sockets:socket-peername (sm socket object))
+          (format stream " connected to host ~S, port ~S" host port))))))
+
 (def-stream-class socket-base-simple-stream (dual-channel-simple-stream)
   ())
 
@@ -29,45 +43,46 @@
          (socket (make-instance 'sb-bsd-sockets:inet-socket
                                 :type :stream :protocol :tcp)))
     (unless (and remote-host remote-port)
-      (error "~S requires :remote-host and :remote-port arguments"
+      (error "device-open on ~S requires :remote-host and :remote-port arguments"
              'socket-simple-stream))
     (with-stream-class (socket-simple-stream stream)
       (ecase (getf options :direction :input)
-	(:input (add-stream-instance-flags stream :input))
-	(:output (add-stream-instance-flags stream :output))
-	(:io (add-stream-instance-flags stream :input :output)))
+        (:input (add-stream-instance-flags stream :input))
+        (:output (add-stream-instance-flags stream :output))
+        (:io (add-stream-instance-flags stream :input :output)))
       (setf (sm socket stream) socket)
       (sb-bsd-sockets:socket-connect socket remote-host remote-port)
       (let ((fd (sb-bsd-sockets:socket-file-descriptor socket)))
         (when fd
-	  (add-stream-instance-flags stream :dual :simple)
-	  (when (any-stream-instance-flags stream :input)
-	    (setf (sm input-handle stream) fd)
-	    (unless (sm buffer stream)
-	      (let ((length (device-buffer-length stream)))
-		(setf (sm buffer stream) (allocate-buffer length)
-		      (sm buffpos stream) 0
-		      (sm buffer-ptr stream) 0
-		      (sm buf-len stream) length))))
-	  (when (any-stream-instance-flags stream :output)
-	    (setf (sm output-handle stream) fd)
-	    (unless (sm out-buffer stream)
-	      (let ((length (device-buffer-length stream)))
-		(setf (sm out-buffer stream) (allocate-buffer length)
-		      (sm outpos stream) 0
-		      (sm max-out-pos stream) length)))
-	    (setf (sm control-out stream) *std-control-out-table*))          
+          (add-stream-instance-flags stream :dual :simple)
+          (when (any-stream-instance-flags stream :input)
+            (setf (sm input-handle stream) fd)
+            (unless (sm buffer stream)
+              (let ((length (device-buffer-length stream)))
+                (setf (sm buffer stream) (allocate-buffer length)
+                      (sm buffpos stream) 0
+                      (sm buffer-ptr stream) 0
+                      (sm buf-len stream) length))))
+          (when (any-stream-instance-flags stream :output)
+            (setf (sm output-handle stream) fd)
+            (unless (sm out-buffer stream)
+              (let ((length (device-buffer-length stream)))
+                (setf (sm out-buffer stream) (allocate-buffer length)
+                      (sm outpos stream) 0
+                      (sm max-out-pos stream) length)))
+            (setf (sm control-out stream) *std-control-out-table*))
           (sb-ext:cancel-finalization socket)
           (sb-ext:finalize stream
                            (lambda ()
                              (sb-unix:unix-close fd)
                              (format *debug-io*
-                                     "~&;;; ** closed socket (fd ~D)~%" fd)))
-	  ;; this should be done with (setf stream-external-format)
-	  (let ((efmt (getf options :external-format :default)))
-	    (compose-encapsulating-streams stream efmt)
-	    (install-dual-channel-character-strategy (melding-stream stream)
-						     efmt))
+                                     "~&;;; ** closed socket (fd ~D)~%" fd))
+                           :dont-save t)
+          ;; this should be done with (setf stream-external-format)
+          (let ((efmt (getf options :external-format :default)))
+            (compose-encapsulating-streams stream efmt)
+            (install-dual-channel-character-strategy (melding-stream stream)
+                                                     efmt))
           stream)))))
 
 (defmethod device-close ((stream socket-simple-stream) abort)