X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=contrib%2Fsb-simple-streams%2Fsimple-streams.lisp;h=e762c9ff024e5c73f223baa342fed0e61231c326;hb=3eedd5a020356291b2c1c2e426ef9fc7dd5928d9;hp=1c4e316e14d85ceb0c9c9e00d07c058547dd8a71;hpb=ac85367426b222612311c5cf7b061ff89c64d825;p=sbcl.git

diff --git a/contrib/sb-simple-streams/simple-streams.lisp b/contrib/sb-simple-streams/simple-streams.lisp
index 1c4e316..e762c9f 100644
--- a/contrib/sb-simple-streams/simple-streams.lisp
+++ b/contrib/sb-simple-streams/simple-streams.lisp
@@ -184,7 +184,10 @@
 				      (t (return (- -10 errno)))))
 			       ((zerop count) (return -1))
 			       (t (return count)))))))))))
-	(t (error "implement me"))))))
+        ;; Handle encapsulated stream.  FIXME: perhaps handle
+        ;; sbcl-vintage ansi-stream type in read-octets too?
+        (stream (read-octets fd buffer start end blocking))
+	(t (error "Don't know how to handle input handle &A" fd))))))
 
 (defun write-octets (stream buffer start end blocking)
   (declare (type simple-stream stream)
@@ -213,12 +216,16 @@
 			 (incf count bytes)
 			 (incf start bytes))
 		       (cond ((null bytes)
-			      (format t "~&;; UNIX-WRITE: errno=~D~%" errno)
+			      (format *debug-io* "~&;; UNIX-WRITE: errno=~D~%"
+                                      errno)
 			      (cond ((= errno sb-unix:eintr) (go again))
 				    ;; don't block for subsequent chars
 				    (t (return (- -10 errno)))))
 			     (t (return count)))))))))))
-	(t (error "implement me"))))))
+        ;; Handle encapsulated stream.  FIXME: perhaps handle
+        ;; sbcl-vintage ansi-stream type in write-octets too?
+        (stream (write-octets fd buffer start end blocking))
+	(t (error "Don't know how to handle output handle &A" fd))))))
 
 
 ;;;
@@ -238,7 +245,7 @@
   stream)
 
 (defun open-file-stream (stream options)
-  (let ((filename (getf options :filename))
+  (let ((filename (pathname (getf options :filename)))
 	(direction (getf options :direction :input))
 	(if-exists (getf options :if-exists))
 	(if-exists-given (not (getf options :if-exists t)))
@@ -371,8 +378,44 @@
   stream)
 
 (defmethod device-open ((stream socket-simple-stream) options)
-  #| do something |#
-  stream)
+  (with-stream-class (socket-simple-stream stream)
+     (let* ((remote-host (getf options :remote-host))
+            (remote-port (getf options :remote-port))
+            (socket (make-instance 'sb-bsd-sockets:inet-socket
+                                   :type :stream :protocol :tcp)))
+       (setf (sm socket stream) socket)
+       (sb-bsd-sockets:socket-connect socket remote-host remote-port)
+       (let ((fd (sb-bsd-sockets:socket-file-descriptor socket)))
+         ;; Connect stream to socket, ...
+         (setf (sm input-handle stream) fd)
+         (setf (sm output-handle stream) fd)
+         ;; ... and socket to stream.
+         (setf (slot-value socket 'stream) stream)
+         (sb-ext:cancel-finalization socket)
+         (sb-ext:finalize stream
+                          (lambda ()
+                            (sb-unix:unix-close fd)
+                            (format *terminal-io*
+                                    "~&;;; ** closed socket (fd ~D)~%" fd))))
+       ;; Now frob the stream slots.
+       (add-stream-instance-flags stream :simple :input :output :dual)
+       (unless (sm buffer stream)
+         (let ((length (device-buffer-length stream)))
+           ;; Buffer should be array of (unsigned-byte 8), in general
+           ;; use strings for now so it's easy to read the content...
+           (setf (sm buffer stream) (make-string length)
+                 (sm buffpos stream) 0
+                 (sm buffer-ptr stream) 0
+                 (sm buf-len stream) length)))
+       (unless (sm out-buffer stream)
+	(let ((length (device-buffer-length stream)))
+	  (setf (sm out-buffer stream) (make-string length)
+		(sm max-out-pos stream) length)))
+       (setf (sm control-in stream) *terminal-control-in-table*)
+       (setf (sm control-out stream) *std-control-out-table*)
+       (install-dual-channel-character-strategy
+        stream (getf options :external-format :default)))
+     stream))
 
 (defmethod device-open ((stream terminal-simple-stream) options)
   (with-stream-class (terminal-simple-stream stream)
@@ -428,7 +471,7 @@
 	   ))
     (if (sm input-handle stream)
 	(sb-unix:unix-close (sm input-handle stream))
-	(sb-unix:unix-close (sm output-handle stream)))
+      (sb-unix:unix-close (sm output-handle stream)))
     (setf (sm buffer stream) nil))
   t)
 
@@ -449,6 +492,15 @@
     (sb-unix:unix-close (sm input-handle stream)))
   t)
 
+(defmethod device-close ((stream socket-simple-stream) abort)
+  ;; Abort argument is handled by :around method on base class
+  (declare (ignore abort))
+  (with-stream-class (socket-simple-stream stream)
+    (sb-unix:unix-close (sm input-handle stream))
+    (setf (sm buffer stream) nil)
+    (setf (sm out-buffer stream) nil))
+  (sb-ext:cancel-finalization stream)
+  t)
 
 (defmethod device-buffer-length ((stream simple-stream))
   4096)