[cl-plus-ssl-cvs] CVS cl+ssl
dlichteblau
dlichteblau at common-lisp.net
Sat Jul 7 16:26:11 UTC 2007
Update of /project/cl-plus-ssl/cvsroot/cl+ssl
In directory clnet:/tmp/cvs-serv15254
Modified Files:
index.html package.lisp streams.lisp test.lisp
Log Message:
+ Re-introduced support for direct access to file descriptors as
+ an optimization. New function <tt>stream-fd</tt>.
--- /project/cl-plus-ssl/cvsroot/cl+ssl/index.html 2007/07/07 15:26:13 1.10
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/index.html 2007/07/07 16:26:11 1.11
@@ -17,11 +17,20 @@
<h3>News</h3>
<p>
- 2007-07-07: Improved clisp support, thanks
- to <a
- href="http://web.kepibu.org/code/lisp/cl+ssl/">Pixel
- // pinterface</a>, as well as client certificate support.
+ 2007-07-07
</p>
+ <ul>
+ <li>
+ Improved clisp support, thanks
+ to <a
+ href="http://web.kepibu.org/code/lisp/cl+ssl/">Pixel
+ // pinterface</a>, as well as client certificate support.
+ </li>
+ <li>
+ Re-introduced support for direct access to file descriptors as
+ an optimization. New function <tt>stream-fd</tt>.
+ </li>
+ </ul>
<p>
2007-01-16: CL+SSL is now available under an MIT-style license.
</p>
@@ -118,8 +127,17 @@
<h3>API functions</h3>
<p>
- <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (stream &key external-format certificate key)</div>
- Return an SSL stream for the client socket <tt>stream</tt>.
+ <div class="def">Function CL+SSL:STREAM-FD (stream)
+ Return <tt>stream</tt>'s file descriptor as an integer, if
+ known. Otherwise return <tt>stream</tt> itself. Pass the
+ return value of this function to <tt>make-ssl-client-stream</tt>
+ or <tt>make-ssl-servre-stream</tt>, which are faster when
+ accessing file descriptors directly.
+ </div>
+ </p>
+ <p>
+ <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (fd-or-stream &key external-format certificate key)</div>
+ Return an SSL stream for the client socket <tt>fd-or-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.
<tt>certificate</tt> is the path to a file containing the PEM-encoded
@@ -134,8 +152,8 @@
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
+ <div class="def">Function CL+SSL:MAKE-SSL-SERVER-STREAM (fd-or-stream &key external-format certificate key)</div>
+ Return an SSL stream for the server socket <tt>fd-or-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
standard <tt>close</tt> function.
--- /project/cl-plus-ssl/cvsroot/cl+ssl/package.lisp 2005/11/16 17:07:53 1.2
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/package.lisp 2007/07/07 16:26:11 1.3
@@ -10,5 +10,6 @@
(:use :common-lisp :trivial-gray-streams)
(:export #:ensure-initialized
#:reload
+ #:stream-fd
#:make-ssl-client-stream
#:make-ssl-server-stream))
--- /project/cl-plus-ssl/cvsroot/cl+ssl/streams.lisp 2007/07/07 15:26:13 1.7
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/streams.lisp 2007/07/07 16:26:11 1.8
@@ -53,7 +53,8 @@
(force-output stream)
(ssl-free (ssl-stream-handle stream))
(setf (ssl-stream-handle stream) nil)
- (close (ssl-stream-socket stream)))
+ (when (streamp (ssl-stream-socket stream))
+ (close (ssl-stream-socket stream))))
(defmethod open-stream-p ((stream ssl-stream))
(and (ssl-stream-handle stream) t))
@@ -160,7 +161,9 @@
(let ((stream (make-instance 'ssl-stream :socket socket))
(handle (ssl-new *ssl-global-context*)))
(setf (ssl-stream-handle stream) handle)
- (ssl-set-bio handle (bio-new-lisp) (bio-new-lisp))
+ (etypecase socket
+ (integer (ssl-set-fd handle socket))
+ (stream (ssl-set-bio handle (bio-new-lisp) (bio-new-lisp))))
(ssl-set-connect-state handle)
(when key
(unless (eql 1 (ssl-use-rsa-privatekey-file handle
@@ -190,10 +193,14 @@
:socket socket
:certificate certificate
:key key))
- (handle (ssl-new *ssl-global-context*))
- (bio (bio-new-lisp)))
+ (handle (ssl-new *ssl-global-context*)))
(setf (ssl-stream-handle stream) handle)
- (ssl-set-bio handle bio bio)
+ (etypecase socket
+ (integer
+ (ssl-set-fd handle socket))
+ (stream
+ (let ((bio (bio-new-lisp)))
+ (ssl-set-bio handle bio bio))))
(ssl-set-accept-state handle)
(when (zerop (ssl-set-cipher-list handle "ALL"))
(error 'ssl-error-initialize :reason "Can't set SSL cipher list"))
@@ -213,3 +220,23 @@
(flexi-streams:make-flexi-stream stream
:external-format external-format)
stream)))
+
+(defgeneric stream-fd (stream))
+(defmethod stream-fd (stream) stream)
+
+#+sbcl
+(defmethod stream-fd ((stream sb-sys:fd-stream))
+ (sb-sys:fd-stream-fd stream))
+
+#+cmu
+(defmethod stream-fd ((stream system:fd-stream))
+ (system:fd-stream-fd stream))
+
+#+openmcl
+(defmethod stream-fd ((stream ccl::basic-stream))
+ (ccl::ioblock-device (ccl::stream-ioblock stream t)))
+
+#+clisp
+(defmethod stream-fd ((stream stream))
+ ;; sockets appear to be direct instances of STREAM
+ (ignore-errors (socket:stream-handles stream)))
--- /project/cl-plus-ssl/cvsroot/cl+ssl/test.lisp 2005/11/25 20:14:04 1.2
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/test.lisp 2007/07/07 16:26:11 1.3
@@ -45,9 +45,13 @@
;; open an HTTPS connection to a secure web server and make a
;; HEAD request
(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 :external-format :iso-8859-1)))
+ (let* ((socket (trivial-sockets:open-stream
+ host
+ port
+ :element-type '(unsigned-byte 8)))
+ (https (cl+ssl:make-ssl-client-stream
+ (cl+ssl:stream-fd socket)
+ :external-format :iso-8859-1)))
(unwind-protect
(progn
(format https "HEAD / HTTP/1.0~%Host: ~a~%~%" host)
@@ -55,6 +59,7 @@
(loop :for line = (read-line-crlf https nil)
:while line :do
(format t "HTTPS> ~a~%" line)))
+ (close socket)
(close https))))
;; start a simple HTTPS server. See the mod_ssl documentation at
@@ -72,13 +77,14 @@
(format t "~&SSL server listening on port ~d~%" port)
(trivial-sockets:with-server (server (:port port))
(loop
- (let ((client (cl+ssl:make-ssl-server-stream
- (trivial-sockets:accept-connection
+ (let* ((socket (trivial-sockets:accept-connection
server
- :element-type '(unsigned-byte 8))
- :external-format :iso-8859-1
- :certificate cert
- :key key)))
+ :element-type '(unsigned-byte 8)))
+ (client (cl+ssl:make-ssl-server-stream
+ (cl+ssl:stream-fd socket)
+ :external-format :iso-8859-1
+ :certificate cert
+ :key key)))
(unwind-protect
(progn
(loop :for line = (read-line-crlf client nil)
@@ -93,4 +99,5 @@
(format client "CL+SSL running in ~A ~A~%"
(lisp-implementation-type)
(lisp-implementation-version)))
+ (close socket)
(close client))))))
More information about the cl-plus-ssl-cvs
mailing list