part of ACL-COMPAT

$ export CVSROOT=:pserver:anonymous at common-lisp.net:/project/cl-plus-ssl/cvsroot
 $ cvs login
 password: anonymous
@@ -76,13 +79,13 @@
       
         CL+SSL
         CFFI
-        gray, non-buffering
+        gray¹, buffering output
         yes
       
       
         CL-SSL
         UFFI
-        gray, buffering [part of ACL-COMPAT]
+        gray, buffering I/O [part of ACL-COMPAT]
         no
       
       
@@ -92,6 +95,11 @@
         no
       
     
+    
+      ¹ Character I/O and external formats in CL+SSL
+      are provided
+      using flexi-streams.
+    
 
     API functions
     
@@ -102,13 +110,20 @@
       load-op'ing the system.
     
     
-      
Function CL+SSL:MAKE-SSL-CLIENT-STREAM (stream)
+      Function CL+SSL:MAKE-SSL-CLIENT-STREAM (stream &key external-format)
       Return an SSL stream for the client socket stream.
       All reads and writes to this SSL stream will be pushed through the
       SSL connection can be closed using the standard close function.
     
     
-      
Function CL+SSL:MAKE-SSL-SERVER-STREAM (stream &key certificate key)
+      If external-format is nil (the default), a plain
+      (unsigned-byte 8) SSL stream is returned.  With a
+      non-null external-format, a flexi-stream capable of
+      character I/O will be returned instead, with the specified value
+      as its initial external format.
+    
+    
+      
Function CL+SSL:MAKE-SSL-SERVER-STREAM (stream &key external-format certificate key)
       Return an SSL stream for the server socket stream.  All
       reads and writes to this server stream will be pushed through the
       OpenSSL library. The SSL connection can be closed using the
@@ -116,11 +131,11 @@
       certificate is the path to a file containing the PEM-encoded
       certificate for your server. key is the path to the PEM-encoded
       key for the server, which must not be associated with a
-      passphrase.
+      passphrase.  See above for external-format handling.
     
     
       
Function CL+SSL:RELOAD ()
-      Reload libssl.  Call this function after restarting a Lisp
+      Reload libssl.  Call this function after restarting a Lisp
       core with CL+SSL dumped into it on Lisp implementations that do
       not reload shared libraries automatically.
     
@@ -165,13 +180,7 @@
     TODO
     
       Profile and optimize if needed. (CLISP?)
-      Implement remaining gray streams methods.
-      Add external format support on Unicode-capable Lisps.
-    
-    Maybe
-    
-      Add buffering to gray streams layer?
-      Add simple-streams layer instead of gray streams?
+      CNAME checking!
     
 
     
@@ -185,7 +194,7 @@
     
 
     
-      README
+      README
     
 
     
@@ -197,7 +206,7 @@
     
 
     
-      README
+      README
     
   
 


Index: cl+ssl/streams.lisp
diff -u cl+ssl/streams.lisp:1.2 cl+ssl/streams.lisp:1.3

--- cl+ssl/streams.lisp:1.2	Wed Nov 16 18:13:17 2005
+++ cl+ssl/streams.lisp	Fri Nov 25 21:14:04 2005
@@ -13,9 +13,7 @@
 
 (defclass ssl-stream
     (fundamental-binary-input-stream
-     fundamental-binary-output-stream
-     fundamental-character-input-stream
-     fundamental-character-output-stream
+     fundamental-binary-output-stream 
      trivial-gray-stream-mixin)
   ((ssl-stream-socket
     :initarg :socket
@@ -23,9 +21,18 @@
    (handle
     :initform nil
     :accessor ssl-stream-handle)
-   (io-buffer
+   (output-buffer
     :initform (cffi-sys::make-shareable-byte-vector +initial-buffer-size+)
-    :accessor ssl-stream-io-buffer)))
+    :accessor ssl-stream-output-buffer)
+   (output-pointer
+    :initform 0
+    :accessor ssl-stream-output-pointer)
+   (input-buffer
+    :initform (cffi-sys::make-shareable-byte-vector +initial-buffer-size+)
+    :accessor ssl-stream-input-buffer)
+   (peeked-byte
+    :initform nil
+    :accessor ssl-stream-peeked-byte)))
 
 (defmethod print-object ((object ssl-stream) stream)
   (print-unreadable-object (object stream :type t)
@@ -44,104 +51,124 @@
 ;;;
 (defmethod close ((stream ssl-stream) &key abort)
   (declare (ignore abort))
+  (force-output stream)
   (ssl-free (ssl-stream-handle stream))
+  (setf (ssl-stream-handle stream) nil)
   (close (ssl-stream-socket stream)))
 
+(defmethod open-stream-p ((stream ssl-stream))
+  (and (ssl-stream-handle stream) t))
+
+(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)))))
+
 (defmethod stream-read-byte ((stream ssl-stream))
-  (let ((buf (ssl-stream-io-buffer stream)))
-    (handler-case
-        (cffi-sys::with-pointer-to-vector-data (ptr buf)
-          (ensure-ssl-funcall (ssl-stream-socket stream)
-                              (ssl-stream-handle stream)
-                              #'ssl-read
-			      5.5
-                              (ssl-stream-handle stream)
-                              ptr
-			      1)
-          (elt buf 0))
-      ;; SSL_read returns 0 on end-of-file
-      (ssl-error-zero-return ()
-        :eof))))
+  (or (ssl-stream-peeked-byte stream)
+      (let ((buf (ssl-stream-input-buffer stream)))
+        (handler-case
+            (cffi-sys::with-pointer-to-vector-data (ptr buf)
+              (ensure-ssl-funcall (ssl-stream-socket stream)
+                                  (ssl-stream-handle stream)
+                                  #'ssl-read
+                                  5.5
+                                  (ssl-stream-handle stream)
+                                  ptr
+                                  1)
+              (elt buf 0))
+          (ssl-error-zero-return ()     ;SSL_read returns 0 on end-of-file
+            :eof)))))
+
+(defmethod stream-read-sequence ((stream ssl-stream) thing start end &key)
+  (check-type thing (simple-array (unsigned-byte 8) (*)))
+  (when (and (< start end) (ssl-stream-peeked-byte stream))
+    (setf (elt thing start) (ssl-stream-peeked-byte stream))
+    (setf (ssl-stream-peeked-byte stream) nil)
+    (incf start))
+  (let ((buf (ssl-stream-input-buffer stream)))
+    (loop
+        for length = (min (- end start) (length buf))
+        while (plusp length)
+        do
+          (handler-case
+              (cffi-sys::with-pointer-to-vector-data (ptr buf)
+                (ensure-ssl-funcall (ssl-stream-socket stream)
+                                    (ssl-stream-handle stream)
+                                    #'ssl-read
+                                    5.5
+                                    (ssl-stream-handle stream)
+                                    ptr
+                                    length)
+                (replace thing buf :start1 start :end1 (+ start length))
+                (incf start length))
+            (ssl-error-zero-return ()   ;SSL_read returns 0 on end-of-file
+              (return))))
+    start))
 
 (defmethod stream-write-byte ((stream ssl-stream) b)
-  (let ((buf (ssl-stream-io-buffer stream))
-        (handle (ssl-stream-handle stream))
-        (socket (ssl-stream-socket stream)))
-    (setf (elt buf 0) b)
-    (cffi-sys::with-pointer-to-vector-data (ptr buf)
-      (ensure-ssl-funcall socket handle #'ssl-write 0.5 handle ptr 1)))
+  (let ((buf (ssl-stream-output-buffer stream)))
+    (when (eql (length buf) (ssl-stream-output-pointer stream))
+      (force-output stream))
+    (setf (elt buf (ssl-stream-output-pointer stream)) b)
+    (incf (ssl-stream-output-pointer stream)))
   b)
 
-(defmethod stream-write-sequence
-    ((stream ssl-stream) (thing array)
-     &optional (start 0) end)
+(defmethod stream-write-sequence ((stream ssl-stream) thing start end &key)
   (check-type thing (simple-array (unsigned-byte 8) (*)))
-  (setf end (or end (length thing)))
-  (let ((buf (ssl-stream-io-buffer stream))
-        (handle (ssl-stream-handle stream))
-	(socket (ssl-stream-socket stream))
-	(length (- end start)))
-    (when (> length (length buf))
-      (setf buf (cffi-sys::make-shareable-byte-vector (- end start)))
-      (setf (ssl-stream-io-buffer stream) buf))
-    ;; unfortunately, we cannot count on being able to use THING as an
-    ;; argument to WITH-POINTER-TO-VECTOR-DATA, so we need to copy all data:
-    (replace buf thing :start2 start :end2 end)
-    (cffi-sys::with-pointer-to-vector-data (ptr buf)
-      (ensure-ssl-funcall socket handle #'ssl-write 0.5 handle ptr length)))
+  (let ((buf (ssl-stream-output-buffer stream))
+	(socket (ssl-stream-socket stream)))
+    (when (> (+ (- end start) (ssl-stream-output-pointer stream)) (length buf))
+      ;; not enough space left?  flush buffer.
+      (force-output stream)
+      ;; still doesn't fit?
+      (while (> (- end start) (length buf))
+        (replace buf thing :start2 start)
+        (incf start (length buf))
+        (setf (ssl-stream-output-pointer stream) (length buf))
+        (force-output stream)))
+    (replace buf thing
+             :start1 (ssl-stream-output-pointer stream)
+             :start2 start
+             :end2 end)
+    (incf (ssl-stream-output-pointer stream) (- end start)))
   thing)
 
+(defmethod stream-finish-output ((stream ssl-stream))
+  (stream-force-output stream))
 
-;;; minimal character stream implementation
-;;; no support for external formats, no support for unread-char
-;;;
-(defmethod stream-read-char ((stream ssl-stream))
-  (let ((b (stream-read-byte stream)))
-    (if (eql b :eof)
-	:eof
-	(code-char b))))
-
-(defmethod stream-write-char ((stream ssl-stream) char)
-  (stream-write-byte stream (char-code char))
-  char)
-
-(defmethod stream-write-sequence
-    ((stream ssl-stream) (thing string) &optional start end)
-  (let ((bytes (map '(simple-array (unsigned-byte 8) (*)) #'char-code thing)))
-    (stream-write-sequence stream bytes start end)))
-
-(defmethod stream-line-column ((stream ssl-stream))
-  nil)
-
-(defmethod stream-listen ((stream ssl-stream))
-  (warn "stream-listen")
-  (call-next-method))
-
-(defmethod stream-read-char-no-hang ((stream ssl-stream))
-  (warn "stream-read-char-no-hang")
-  (call-next-method))
-
-(defmethod stream-peek-char ((stream ssl-stream))
-  (warn "stream-peek-char")
-  (call-next-method))
+(defmethod stream-force-output ((stream ssl-stream))
+  (let ((buf (ssl-stream-output-buffer stream))
+        (fill-ptr (ssl-stream-output-pointer stream))
+        (handle (ssl-stream-handle stream))
+	(socket (ssl-stream-socket stream)))
+    (when (plusp fill-ptr)
+      (cffi-sys::with-pointer-to-vector-data (ptr buf)
+        (ensure-ssl-funcall socket handle #'ssl-write 0.5 handle ptr fill-ptr))
+      (setf (ssl-stream-output-pointer stream) 0))))
 
 
 ;;; interface functions
 ;;;
-(defun make-ssl-client-stream (socket &key (method 'ssl-v23-method))
+(defun make-ssl-client-stream
+    (socket &key (method 'ssl-v23-method) external-format)
   "Returns an SSL stream for the client socket descriptor SOCKET."
   (ensure-initialized method)
   (let ((stream (make-instance 'ssl-stream :socket socket))
         (handle (ssl-new *ssl-global-context*)))
     (setf (ssl-stream-handle stream) handle)
-    ;; (let ((bio (bio-new-socket socket 0))) (ssl-set-bio handle bio bio))
     (ssl-set-bio handle (bio-new-lisp) (bio-new-lisp))
     (ssl-set-connect-state handle)
     (ensure-ssl-funcall socket handle #'ssl-connect 0.25 handle)
-    stream))
+    (if external-format
+        (flexi-streams:make-flexi-stream stream
+                                         :external-format external-format)
+        stream)))
 
 (defun make-ssl-server-stream
-    (socket &key certificate key (method 'ssl-v23-method))
+    (socket &key certificate key (method 'ssl-v23-method) external-format)
   "Returns an SSL stream for the server socket descriptor SOCKET.
 CERTIFICATE is the path to a file containing the PEM-encoded certificate for
  your server. KEY is the path to the PEM-encoded key for the server, which
@@ -170,4 +197,7 @@
         (error 'ssl-error-initialize
 	       :reason "Can't load certificate ~A" certificate)))
     (ensure-ssl-funcall socket handle #'ssl-accept 0.25 handle)
-    stream))
+    (if external-format
+        (flexi-streams:make-flexi-stream stream
+                                         :external-format external-format)
+        stream)))


Index: cl+ssl/test.lisp
diff -u cl+ssl/test.lisp:1.1.1.1 cl+ssl/test.lisp:1.2
--- cl+ssl/test.lisp:1.1.1.1	Wed Nov  9 23:10:44 2005
+++ cl+ssl/test.lisp	Fri Nov 25 21:14:04 2005
@@ -33,7 +33,7 @@
 (defun test-nntps-client (&optional (host "snews.gmane.org") (port 563))
   (let* ((fd (trivial-sockets:open-stream host port
 					  :element-type '(unsigned-byte 8)))
-         (nntps (cl+ssl:make-ssl-client-stream fd)))
+         (nntps (cl+ssl:make-ssl-client-stream fd :external-format :iso-8859-1)))
     (format t "NNTPS> ~A~%" (read-line-crlf nntps))
     (write-line "HELP" nntps)
     (force-output nntps)
@@ -47,7 +47,7 @@
 (defun test-https-client (host &optional (port 443))
   (let* ((fd (trivial-sockets:open-stream host port
 					  :element-type '(unsigned-byte 8)))
-         (https (cl+ssl:make-ssl-client-stream fd)))
+         (https (cl+ssl:make-ssl-client-stream fd :external-format :iso-8859-1)))
     (unwind-protect
 	(progn
 	  (format https "HEAD / HTTP/1.0~%Host: ~a~%~%" host)
@@ -76,6 +76,7 @@
 		     (trivial-sockets:accept-connection
 		      server
 		      :element-type '(unsigned-byte 8))
+                     :external-format :iso-8859-1
 		     :certificate cert
 		     :key key)))
 	(unwind-protect



From dlichteblau at common-lisp.net  Fri Nov 25 22:39:43 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Fri, 25 Nov 2005 23:39:43 +0100 (CET)
Subject: [cl-plus-ssl-cvs] CVS update: cl+ssl/streams.lisp 
Message-ID: <20051125223943.891DD880D7@common-lisp.net>

Update of /project/cl-plus-ssl/cvsroot/cl+ssl
In directory common-lisp.net:/tmp/cvs-serv8507

Modified Files:
	streams.lisp 
Log Message:
stream-element-type implementiert

Date: Fri Nov 25 23:39:43 2005
Author: dlichteblau

Index: cl+ssl/streams.lisp
diff -u cl+ssl/streams.lisp:1.3 cl+ssl/streams.lisp:1.4
--- cl+ssl/streams.lisp:1.3	Fri Nov 25 21:14:04 2005
+++ cl+ssl/streams.lisp	Fri Nov 25 23:39:42 2005
@@ -46,9 +46,9 @@
     :initarg :key
     :accessor ssl-stream-key)))
 
+(defmethod stream-element-type ((stream ssl-stream))
+  '(unsigned-byte 8))
 
-;;; binary stream implementation
-;;;
 (defmethod close ((stream ssl-stream) &key abort)
   (declare (ignore abort))
   (force-output stream)



From dlichteblau at common-lisp.net  Fri Nov 25 22:40:12 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Fri, 25 Nov 2005 23:40:12 +0100 (CET)
Subject: [cl-plus-ssl-cvs] CVS update: trivial-gray-streams/mixin.lisp 
Message-ID: <20051125224012.AFBF3880D7@common-lisp.net>

Update of /project/cl-plus-ssl/cvsroot/trivial-gray-streams
In directory common-lisp.net:/tmp/cvs-serv8529

Modified Files:
	mixin.lisp 
Log Message:
stream-read/write-char-sequence fuer clisp

Date: Fri Nov 25 23:40:12 2005
Author: dlichteblau

Index: trivial-gray-streams/mixin.lisp
diff -u trivial-gray-streams/mixin.lisp:1.2 trivial-gray-streams/mixin.lisp:1.3
--- trivial-gray-streams/mixin.lisp:1.2	Fri Nov 25 21:08:44 2005
+++ trivial-gray-streams/mixin.lisp	Fri Nov 25 23:40:12 2005
@@ -69,6 +69,14 @@
       (error "this stream does not support the NO-HANG argument"))
     (when interactive
       (error "this stream does not support the INTERACTIVE argument"))
+    (stream-write-sequence s seq start end))
+
+  (defmethod gray:stream-read-char-sequence
+      ((s trivial-gray-stream-mixin) seq &optional start end)
+    (stream-read-sequence s seq start end))
+
+  (defmethod gray:stream-write-char-sequence
+      ((s trivial-gray-stream-mixin) seq &optional start end)
     (stream-write-sequence s seq start end)))
 
 #+sbcl



From dlichteblau at common-lisp.net  Fri Nov 25 22:55:19 2005
From: dlichteblau at common-lisp.net (David Lichteblau)
Date: Fri, 25 Nov 2005 23:55:19 +0100 (CET)
Subject: [cl-plus-ssl-cvs] CVS update: cl+ssl/index.html 
Message-ID: <20051125225519.5F0A5880D7@common-lisp.net>

Update of /project/cl-plus-ssl/cvsroot/cl+ssl
In directory common-lisp.net:/tmp/cvs-serv9672

Modified Files:
	index.html 
Log Message:
tarball link

Date: Fri Nov 25 23:55:18 2005
Author: dlichteblau

Index: cl+ssl/index.html
diff -u cl+ssl/index.html:1.3 cl+ssl/index.html:1.4
--- cl+ssl/index.html:1.3	Fri Nov 25 21:14:04 2005
+++ cl+ssl/index.html	Fri Nov 25 23:55:18 2005
@@ -26,6 +26,9 @@
 $ cvs co trivial-gray-streams
 $ cvs co trivial-https

Portability

Download

API functions

TODO

Maybe