[cl-plus-ssl-cvs] CVS update: cl+ssl/bio.lisp cl+ssl/cl+ssl.asd cl+ssl/ffi.lisp cl+ssl/index.html cl+ssl/streams.lisp cl+ssl/test.lisp
David Lichteblau
dlichteblau at common-lisp.net
Fri Nov 25 20:14:06 UTC 2005
Update of /project/cl-plus-ssl/cvsroot/cl+ssl
In directory common-lisp.net:/tmp/cvs-serv30043
Modified Files:
bio.lisp cl+ssl.asd ffi.lisp index.html streams.lisp test.lisp
Log Message:
* flexi-streams benutzen
* buffering
Date: Fri Nov 25 21:14:04 2005
Author: dlichteblau
Index: cl+ssl/bio.lisp
diff -u cl+ssl/bio.lisp:1.1.1.1 cl+ssl/bio.lisp:1.2
--- cl+ssl/bio.lisp:1.1.1.1 Wed Nov 9 23:10:44 2005
+++ cl+ssl/bio.lisp Fri Nov 25 21:14:04 2005
@@ -85,19 +85,18 @@
+BIO_FLAGS_READ+
+BIO_FLAGS_SHOULD_RETRY+)))
-;; not sure whether we should block or not...
-(defvar *block* t)
-
(cffi:defcallback lisp-read :int ((bio :pointer) (buf :pointer) (n :int))
bio buf n
(let ((i 0))
(handler-case
(unless (or (cffi:null-ptr-p buf) (null n))
(clear-retry-flags bio)
- (setf (cffi:mem-ref buf :unsigned-char i) (read-byte *socket*))
- (incf i)
+ (when (or *blockp* (listen *socket*))
+ (setf (cffi:mem-ref buf :unsigned-char i) (read-byte *socket*))
+ (incf i))
(loop
- while (and (< i n) (or *block* (listen *socket*)))
+ while (and (< i n)
+ (or (null *partial-read-p*) (listen *socket*)))
do
(setf (cffi:mem-ref buf :unsigned-char i) (read-byte *socket*))
(incf i))
Index: cl+ssl/cl+ssl.asd
diff -u cl+ssl/cl+ssl.asd:1.1.1.1 cl+ssl/cl+ssl.asd:1.2
--- cl+ssl/cl+ssl.asd:1.1.1.1 Wed Nov 9 23:10:44 2005
+++ cl+ssl/cl+ssl.asd Fri Nov 25 21:14:04 2005
@@ -15,7 +15,7 @@
(defparameter *libssl-pathname* "/usr/lib/libssl.so")
(defsystem :cl+ssl
- :depends-on (:cffi :trivial-gray-streams)
+ :depends-on (:cffi :trivial-gray-streams :flexi-streams)
:serial t
:components
((:file "reload")
Index: cl+ssl/ffi.lisp
diff -u cl+ssl/ffi.lisp:1.2 cl+ssl/ffi.lisp:1.3
--- cl+ssl/ffi.lisp:1.2 Wed Nov 16 18:07:53 2005
+++ cl+ssl/ffi.lisp Fri Nov 25 21:14:04 2005
@@ -16,6 +16,9 @@
(defvar *ssl-global-method* nil)
(defvar *bio-lisp-method* nil)
+(defparameter *blockp* t)
+(defparameter *partial-read-p* nil)
+
(defun ssl-initialized-p ()
(and *ssl-global-context* *ssl-global-method*))
@@ -29,6 +32,12 @@
(defconstant +ssl-filetype-default+ 3)
(defconstant +SSL_CTRL_SET_SESS_CACHE_MODE+ 44)
+
+
+;;; Misc
+;;;
+(defmacro while (cond &body body)
+ `(do () ((not ,cond)) , at body))
;;; Function definitions
Index: cl+ssl/index.html
diff -u cl+ssl/index.html:1.2 cl+ssl/index.html:1.3
--- cl+ssl/index.html:1.2 Wed Nov 16 18:07:53 2005
+++ cl+ssl/index.html Fri Nov 25 21:14:04 2005
@@ -16,6 +16,9 @@
</ul>
<h3>Download</h3>
+ <p>
+ Anonymous CVS (<a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=cl-plus-ssl">browse</a>):
+ </p>
<pre>$ export CVSROOT=:pserver:anonymous at common-lisp.net:/project/cl-plus-ssl/cvsroot
$ cvs login
password: anonymous
@@ -76,13 +79,13 @@
<tr>
<td>CL+SSL</td>
<td>CFFI</td>
- <td>gray, non-buffering</td>
+ <td>gray<sup>1</sup>, buffering output</td>
<td>yes</td>
</tr>
<tr>
<td>CL-SSL</td>
<td>UFFI</td>
- <td>gray, buffering [<em>part of ACL-COMPAT</em>]</td>
+ <td>gray, buffering I/O [<em>part of ACL-COMPAT</em>]</td>
<td>no</td>
</tr>
<tr>
@@ -92,6 +95,11 @@
<td>no</td>
</tr>
</table>
+ <p>
+ <sup>1</sup> Character I/O and external formats in CL+SSL
+ are provided
+ using <a href="http://weitz.de/flexi-streams/">flexi-streams</a>.
+ </p>
<h3>API functions</h3>
<p>
@@ -102,13 +110,20 @@
load-op'ing the system.
</p>
<p>
- <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (stream)</div>
+ <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (stream &key external-format)</div>
Return an SSL stream for the client socket <tt>stream</tt>.
All reads and writes to this SSL stream will be pushed through the
SSL connection can be closed using the standard <tt>close</tt> function.
</p>
<p>
- <div class="def">Function CL+SSL:MAKE-SSL-SERVER-STREAM (stream &key certificate key)</div>
+ If <tt>external-format</tt> is <tt>nil</tt> (the default), a plain
+ <tt>(unsigned-byte 8)</tt> SSL stream is returned. With a
+ non-null <tt>external-format</tt>, a flexi-stream capable of
+ character I/O will be returned instead, with the specified value
+ as its initial external format.
+ </p>
+ <p>
+ <div class="def">Function CL+SSL:MAKE-SSL-SERVER-STREAM (stream &key external-format certificate key)</div>
Return an SSL stream for the server socket <tt>stream</tt>. 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 @@
<tt>certificate</tt> is the path to a file containing the PEM-encoded
certificate for your server. <tt>key</tt> is the path to the PEM-encoded
key for the server, which must not be associated with a
- passphrase.
+ passphrase. See above for <tt>external-format</tt> handling.
</p>
<p>
<div class="def">Function CL+SSL:RELOAD ()</div>
- Reload <tt>libssl<tt>. Call this function after restarting a Lisp
+ Reload <tt>libssl</tt>. Call this function after restarting a Lisp
core with CL+SSL dumped into it on Lisp implementations that do
not reload shared libraries automatically.
</p>
@@ -165,13 +180,7 @@
<h3>TODO</h3>
<ul>
<li>Profile and optimize if needed. (CLISP?)</li>
- <li>Implement remaining gray streams methods.</li>
- <li>Add external format support on Unicode-capable Lisps.</li>
- </ul>
- <h3>Maybe</h3>
- <ul>
- <li>Add buffering to gray streams layer?</li>
- <li>Add simple-streams layer instead of gray streams?</li>
+ <li>CNAME checking!</li>
</ul>
<a name="trivial-https">
@@ -185,7 +194,7 @@
</p>
<p>
- <a href="">README</a>
+ <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/*checkout*/trivial-https/README?rev=HEAD&cvsroot=cl-plus-ssl&content-type=text/plain">README</a>
</p>
<a name="trivial-gray-streams">
@@ -197,7 +206,7 @@
</p>
<p>
- <a href="">README</a>
+ <a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/*checkout*/trivial-gray-streams/README?rev=HEAD&cvsroot=cl-plus-ssl&content-type=text/plain">README</a>
</p>
</body>
</html>
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
More information about the cl-plus-ssl-cvs
mailing list