[cl-plus-ssl-cvs] CVS cl+ssl

[avodonosov]

Update of /project/cl-plus-ssl/cvsroot/cl+ssl
In directory cl-net:/tmp/cvs-serv30751

Modified Files:
	ffi.lisp streams.lisp test.lisp 
Log Message:
Two LISTEN bugs: http://common-lisp.net/pipermail/cl-plus-ssl-devel/2010-May/000178.html

--- /project/cl-plus-ssl/cvsroot/cl+ssl/ffi.lisp	2009/10/24 20:09:40	1.13
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/ffi.lisp	2010/05/23 23:24:38	1.14
@@ -230,6 +230,21 @@
 	   (t
 	    (ssl-signal-error handle func error nbytes)))))))
 
+(declaim (inline nonblocking-ssl-funcall))
+(defun nonblocking-ssl-funcall (stream handle func &rest args)
+  (loop
+     (let ((nbytes
+	    (let ((*socket* stream))	;for Lisp-BIO callbacks
+	      (apply func args))))
+       (when (plusp nbytes)
+	 (return nbytes))
+       (let ((error (ssl-get-error handle nbytes)))
+	 (case error
+	   ((#.+ssl-error-want-read+ #.+ssl-error-want-write+)
+	    (return nbytes))
+	   (t
+	    (ssl-signal-error handle func error nbytes)))))))
+
 
 ;;; Waiting for output to be possible
 
--- /project/cl-plus-ssl/cvsroot/cl+ssl/streams.lisp	2009/10/24 20:09:40	1.18
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/streams.lisp	2010/05/23 23:24:38	1.19
@@ -83,12 +83,21 @@
 (defmethod stream-listen ((stream ssl-stream))
   (or (ssl-stream-peeked-byte stream)
       (setf (ssl-stream-peeked-byte stream)
-            (let* ((*blockp* nil)
-                   (b (stream-read-byte stream)))
-              (if (eql b :eof) nil b)))))
+	    (let ((buf (ssl-stream-input-buffer stream)))
+	      (with-pointer-to-vector-data (ptr buf)
+		(let* ((*blockp* nil) ;; for the Lisp-BIO
+		       (n (nonblocking-ssl-funcall stream
+						   (ssl-stream-handle stream)
+						   #'ssl-read
+						   (ssl-stream-handle stream)
+						   ptr
+						   1)))
+		  (and (> n 0) (buffer-elt buf 0))))))))
 
 (defmethod stream-read-byte ((stream ssl-stream))
-  (or (ssl-stream-peeked-byte stream)
+  (or (prog1 
+	  (ssl-stream-peeked-byte stream) 
+	(setf (ssl-stream-peeked-byte stream) nil))
       (let ((buf (ssl-stream-input-buffer stream)))
         (handler-case
             (with-pointer-to-vector-data (ptr buf)
--- /project/cl-plus-ssl/cvsroot/cl+ssl/test.lisp	2008/03/07 21:27:44	1.4
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/test.lisp	2010/05/23 23:24:38	1.5
@@ -365,7 +365,23 @@
 		 (assert (> n 100))))
 	  (handler-case
 	      (close-socket socket :abort t)
-	    (sb-sys:deadline-timeout ())))))))
+	    (sb-sys:deadline-timeout ()))))))
+
+  #+sbcl
+  (deftests read-char-no-hang/test (usp nil t :caller)
+    (with-thread ("echo server for read-char-no-hang test"
+		  (lambda () (init-server :unwrap-stream-p usp))
+		  #'test-server)
+      (sb-sys:with-deadline (:seconds 3)
+	(with-open-stream (socket (init-client :unwrap-stream-p usp))
+	  (write-line "test" socket)
+	  (force-output socket)
+	  (assert (equal (read-line socket) "(echo test)"))
+	  (handler-case
+	      (when (read-char-no-hang socket)
+		(error "unexpected data"))
+	    (sb-sys:deadline-timeout ()
+	      (error "read-char-no-hang hangs"))))))))
 
 #+(or)
 (run-all-tests)