commit 343a215d31327870de4cc7cc0c2bda78b8457c48
Author: dlichteblau <dlichteblau>
Date:   Wed Nov 9 22:10:44 2005 +0000

    Initial revision

diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..bf7273a
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,17 @@
+;; Copyright (C) 2001, 2003  Eric Marsden
+;; Copyright (C) 2005  David Lichteblau
+;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
+;;   
+;;     This library is free software; you can redistribute it and/or
+;;     modify it under the terms of the GNU Library General Public
+;;     License as published by the Free Software Foundation; either
+;;     version 2 of the License, or (at your option) any later version.
+;;   
+;;     This library is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;     Library General Public License for more details.
+;;   
+;;     You should have received a copy of the GNU Library General Public
+;;     License along with this library; if not, write to the Free
+;;     Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..f6d297c
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,3 @@
+.PHONY: clean
+clean:
+	rm -f *.fasl *.x86f *.fas *.ufsl *.lib *.pfsl
diff --git a/bio.lisp b/bio.lisp
new file mode 100644
index 0000000..1010342
--- /dev/null
+++ b/bio.lisp
@@ -0,0 +1,137 @@
+;;; Copyright (C) 2005  David Lichteblau
+;;;
+;;; See LICENSE for details.
+
+(in-package cl+ssl)
+
+(defconstant +bio-type-socket+ (logior 5 #x0400 #x0100))
+(defconstant +BIO_FLAGS_READ+ 1)
+(defconstant +BIO_FLAGS_WRITE+ 2)
+(defconstant +BIO_FLAGS_SHOULD_RETRY+ 8)
+(defconstant +BIO_CTRL_FLUSH+ 11)
+
+(cffi:defcstruct bio-method
+  (type :int)
+  (name :pointer)
+  (bwrite :pointer)
+  (bread :pointer)
+  (bputs :pointer)
+  (bgets :pointer)
+  (ctrl :pointer)
+  (create :pointer)
+  (destroy :pointer)
+  (callback-ctrl :pointer))
+
+(cffi:defcstruct bio
+  (method :pointer)
+  (callback :pointer)
+  (cb-arg :pointer)
+  (init :int)
+  (shutdown :int)
+  (flags :int)
+  (retry-reason :int)
+  (num :int)
+  (ptr :pointer)
+  (next-bio :pointer)
+  (prev-bio :pointer)
+  (references :int)
+  (num-read :unsigned-long)
+  (num-write :unsigned-long)
+  (crypto-ex-data-stack :pointer)
+  (crypto-ex-data-dummy :int))
+
+(defun make-bio-lisp-method ()
+  (let ((m (cffi:foreign-alloc 'bio-method)))
+    (setf (cffi:foreign-slot-value m 'bio-method 'type)
+	  ;; fixme: this is wrong, but presumably still better than some
+	  ;; random value here.
+	  +bio-type-socket+)
+    (macrolet ((slot (name)
+		 `(cffi:foreign-slot-value m 'bio-method ,name)))
+      (setf (slot 'name) (cffi:foreign-string-alloc "lisp"))
+      (setf (slot 'bwrite) (cffi:callback lisp-write))
+      (setf (slot 'bread) (cffi:callback lisp-read))
+      (setf (slot 'bputs) (cffi:callback lisp-puts))
+      (setf (slot 'bgets) (cffi:null-ptr))
+      (setf (slot 'ctrl) (cffi:callback lisp-ctrl))
+      (setf (slot 'create) (cffi:callback lisp-create))
+      (setf (slot 'destroy) (cffi:callback lisp-destroy))
+      (setf (slot 'callback-ctrl) (cffi:null-ptr)))
+    m))
+
+(defun bio-new-lisp ()
+  (bio-new *bio-lisp-method*))
+
+
+;;; "cargo cult"
+
+(cffi:defcallback lisp-write :int ((bio :pointer) (buf :pointer) (n :int))
+  bio
+  (dotimes (i n)
+    (write-byte (cffi:mem-ref buf :unsigned-char i) *socket*))
+  (finish-output *socket*)
+  n)
+
+(defun clear-retry-flags (bio)
+  (setf (cffi:foreign-slot-value bio 'bio 'flags)
+	(logandc2 (cffi:foreign-slot-value bio 'bio 'flags)
+		  (logior +BIO_FLAGS_READ+
+			  +BIO_FLAGS_WRITE+
+			  +BIO_FLAGS_SHOULD_RETRY+))))
+
+(defun set-retry-read (bio)
+  (setf (cffi:foreign-slot-value bio 'bio 'flags)
+	(logior (cffi:foreign-slot-value bio 'bio 'flags)
+		+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)
+	  (loop
+	      while (and (< i n) (or *block* (listen *socket*)))
+	      do
+		(setf (cffi:mem-ref buf :unsigned-char i) (read-byte *socket*))
+		(incf i))
+	  #+(or)
+	  (when (zerop i) (set-retry-read bio)))
+      (end-of-file ()))
+    i))
+
+(cffi:defcallback lisp-puts :int ((bio :pointer) (buf :string))
+  bio buf
+  (error "lisp-puts not implemented"))
+
+(cffi:defcallback lisp-ctrl :int
+  ((bio :pointer) (cmd :int) (larg :long) (parg :pointer))
+  bio larg parg
+  (cond 
+    ((eql cmd +BIO_CTRL_FLUSH+) 1)
+    (t
+      ;; (warn "lisp-ctrl(~A,~A,~A)" cmd larg parg)
+      0)))
+
+(cffi:defcallback lisp-create :int ((bio :pointer))
+  (setf (cffi:foreign-slot-value bio 'bio 'init) 1)
+  (setf (cffi:foreign-slot-value bio 'bio 'num) 0)
+  (setf (cffi:foreign-slot-value bio 'bio 'ptr) (cffi:null-ptr))
+  (setf (cffi:foreign-slot-value bio 'bio 'flags) 0)
+  1)
+
+(cffi:defcallback lisp-destroy :int ((bio :pointer))
+  (cond
+    ((cffi:null-ptr-p bio) 0)
+    (t
+      (setf (cffi:foreign-slot-value bio 'bio 'init) 0)
+      (setf (cffi:foreign-slot-value bio 'bio 'flags) 0)
+      1)))
+
+(setf *bio-lisp-method* nil)		;force reinit if anything changed here
diff --git a/cl+ssl.asd b/cl+ssl.asd
new file mode 100644
index 0000000..2b09589
--- /dev/null
+++ b/cl+ssl.asd
@@ -0,0 +1,26 @@
+;;; -*- mode: lisp -*-
+;;;
+;;; Copyright (C) 2001, 2003  Eric Marsden
+;;; Copyright (C) 2005  David Lichteblau
+;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
+;;;
+;;; See LICENSE for details.
+
+(defpackage :cl+ssl-system
+  (:use :cl :asdf)
+  (:export #:*libssl-pathname*))
+
+(in-package :cl+ssl-system)
+
+(defparameter *libssl-pathname* "/usr/lib/libssl.so")
+
+(defsystem :cl+ssl
+  :depends-on (:cffi :trivial-gray-streams)
+  :serial t
+  :components
+   ((:file "reload")
+    (:file "package")
+    (:file "conditions")
+    (:file "ffi")
+    (:file "streams")
+    (:file "bio")))
diff --git a/conditions.lisp b/conditions.lisp
new file mode 100644
index 0000000..dd44dc2
--- /dev/null
+++ b/conditions.lisp
@@ -0,0 +1,211 @@
+;;; Copyright (C) 2001, 2003  Eric Marsden
+;;; Copyright (C) 2005  David Lichteblau
+;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
+;;;
+;;; See LICENSE for details.
+
+(in-package :cl+ssl)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant +ssl-error-none+ 0)
+  (defconstant +ssl-error-ssl+ 1)
+  (defconstant +ssl-error-want-read+ 2)
+  (defconstant +ssl-error-want-write+ 3)
+  (defconstant +ssl-error-want-x509-lookup+ 4)
+  (defconstant +ssl-error-syscall+ 5)
+  (defconstant +ssl-error-zero-return+ 6)
+  (defconstant +ssl-error-want-connect+ 7))
+
+
+;;; Condition hierarchy
+;;;
+(define-condition ssl-error (error)
+  ((queue :initform nil :initarg :queue :reader ssl-error-queue)))
+
+(define-condition ssl-error/handle (ssl-error)
+  ((ret :initarg :ret
+        :reader ssl-error-ret)
+   (handle :initarg :handle
+           :reader ssl-error-handle))
+  (:report (lambda (condition stream)
+             (format stream "Unspecified error ~A on handle ~A" 
+                     (ssl-error-ret condition)
+                     (ssl-error-handle condition))
+	     (write-sequence (ssl-error-queue condition) stream))))
+
+(define-condition ssl-error-initialize (ssl-error)
+  ((reason  :initarg :reason
+            :reader ssl-error-reason))
+  (:report (lambda (condition stream)
+             (format stream "SSL initialization error: ~A"
+                     (ssl-error-reason condition))
+	     (write-sequence (ssl-error-queue condition) stream))))
+
+
+(define-condition ssl-error-want-something (ssl-error/handle)
+  ())
+
+;;;SSL_ERROR_NONE
+(define-condition ssl-error-none (ssl-error/handle)
+  ()
+  (:documentation
+   "The TLS/SSL I/O operation completed. This result code is returned if and
+    only if ret > 0.")
+  (:report (lambda (condition stream)
+             (format stream "The TLS/SSL operation on handle ~A completed. (return code:  ~A)"
+                     (ssl-error-handle condition)
+                     (ssl-error-ret condition))
+	     (write-sequence (ssl-error-queue condition) stream))))
+
+;; SSL_ERROR_ZERO_RETURN
+(define-condition ssl-error-zero-return (ssl-error/handle)
+  ()
+  (:documentation
+   "The TLS/SSL connection has been closed. If the protocol version is SSL 3.0
+    or TLS 1.0, this result code is returned only if a closure alert has
+    occurred in the protocol, i.e. if the connection has been closed cleanly.
+    Note that in this case SSL_ERROR_ZERO_RETURN
+    does not necessarily indicate that the underlying transport has been
+    closed.")
+  (:report (lambda (condition stream)
+             (format stream "The TLS/SSL connection on handle ~A has been closed. (return code:  ~A)"
+                     (ssl-error-handle condition)
+                     (ssl-error-ret condition))
+	     (write-sequence (ssl-error-queue condition) stream))))
+
+;; SSL_ERROR_WANT_READ
+(define-condition ssl-error-want-read (ssl-error-want-something)
+  ()
+  (:documentation
+   "The operation did not complete; the same TLS/SSL I/O function should be
+    called again later. If, by then, the underlying BIO has data available for 
+    reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data
+    (SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place,
+    i.e. at least part of an TLS/SSL record will be read or written. Note that
+    the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE
+    condition. There is no fixed upper limit for the number of iterations that
+    may be necessary until progress becomes visible at application protocol
+    level.")
+  (:report (lambda (condition stream)
+             (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a READ. (return code:  ~A)"
+                     (ssl-error-handle condition)
+                     (ssl-error-ret condition))
+	     (write-sequence (ssl-error-queue condition) stream))))
+
+;; SSL_ERROR_WANT_WRITE
+(define-condition ssl-error-want-write (ssl-error-want-something)
+  ()
+  (:documentation
+   "The operation did not complete; the same TLS/SSL I/O function should be
+    called again later. If, by then, the underlying BIO has data available for 
+    reading (if the result code is SSL_ERROR_WANT_READ) or allows writing data
+    (SSL_ERROR_WANT_WRITE), then some TLS/SSL protocol progress will take place,
+    i.e. at least part of an TLS/SSL record will be read or written. Note that
+    the retry may again lead to a SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE
+    condition. There is no fixed upper limit for the number of iterations that
+    may be necessary until progress becomes visible at application protocol
+    level.")
+  (:report (lambda (condition stream)
+             (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a WRITE. (return code:  ~A)"
+                     (ssl-error-handle condition)
+                     (ssl-error-ret condition))
+	     (write-sequence (ssl-error-queue condition) stream))))
+
+;; SSL_ERROR_WANT_CONNECT
+(define-condition ssl-error-want-connect (ssl-error-want-something)
+  ()
+  (:documentation
+   "The operation did not complete; the same TLS/SSL I/O function should be
+    called again later. The underlying BIO was not connected yet to the peer
+    and the call would block in connect()/accept(). The SSL
+    function should be called again when the connection is established. These
+    messages can only appear with a BIO_s_connect() or
+    BIO_s_accept() BIO, respectively. In order to find out, when
+    the connection has been successfully established, on many platforms
+    select() or poll() for writing on the socket file
+    descriptor can be used.")
+  (:report (lambda (condition stream)
+            (format stream "The TLS/SSL operation on handle ~A did not complete: It wants a connect first. (return code:  ~A)"
+                     (ssl-error-handle condition)
+                     (ssl-error-ret condition))
+	    (write-sequence (ssl-error-queue condition) stream))))
+
+;; SSL_ERROR_WANT_X509_LOOKUP
+(define-condition ssl-error-want-x509-lookup (ssl-error-want-something)
+  ()
+  (:documentation
+   "The operation did not complete because an application callback set by
+    SSL_CTX_set_client_cert_cb() has asked to be called again. The
+    TLS/SSL I/O function should be called again later. Details depend on the
+    application.")
+  (:report (lambda (condition stream)
+             (format stream "The TLS/SSL operation on handle ~A did not complete: An application callback wants to be called again. (return code:  ~A)"
+                     (ssl-error-handle condition)
+                     (ssl-error-ret condition))
+	     (write-sequence (ssl-error-queue condition) stream))))
+
+;; SSL_ERROR_SYSCALL
+(define-condition ssl-error-syscall (ssl-error/handle)
+  ((syscall :initarg :syscall))
+  (:documentation
+   "Some I/O error occurred. The OpenSSL error queue may contain more
+    information on the error. If the error queue is empty (i.e. ERR_get_error() returns 0),
+    ret can be used to find out more about the error: If ret == 0, an EOF was observed that
+    violates the protocol. If ret == -1, the underlying BIO reported an I/O error (for socket
+    I/O on Unix systems, consult errno for details).")
+  (:report (lambda (condition stream)
+             (if (zerop (err-get-error))
+                 (case (ssl-error-ret condition)
+                   (0 (format stream "An I/O error occurred: An unexpected EOF was observed on handle ~A. (return code:  ~A)"
+                              (ssl-error-handle condition)
+                              (ssl-error-ret condition)))
+                   (-1 (format stream "An I/O error occurred in the underlying BIO. (return code:  ~A)"
+                               (ssl-error-ret condition)))
+                   (otherwise (format stream "An I/O error occurred: undocumented reason. (return code:  ~A)"
+                                      (ssl-error-ret condition))))
+                 (format stream "An UNKNOWN I/O error occurred in the underlying BIO. (return code:  ~A)"
+                         (ssl-error-ret condition)))
+	     (write-sequence (ssl-error-queue condition) stream))))
+
+;; SSL_ERROR_SSL
+(define-condition ssl-error-ssl (ssl-error/handle)
+  ()
+  (:documentation
+   "A failure in the SSL library occurred, usually a protocol error. The
+    OpenSSL error queue contains more information on the error.")
+  (:report (lambda (condition stream)
+             (format stream
+		     "A failure in the SSL library occurred on handle ~A. (Return code: ~A)"
+                     (ssl-error-handle condition)
+                     (ssl-error-ret condition))
+	     (write-sequence (ssl-error-queue condition) stream))))
+
+(defun write-ssl-error-queue (stream)
+  (format stream "SSL error queue: ~%")
+  (loop
+      for error-code = (err-get-error)
+      until (zerop error-code)
+      do (format stream "~a~%" (err-error-string error-code (cffi:null-ptr)))))
+
+(defun ssl-signal-error (handle syscall error-code original-error)
+  (let ((queue (with-output-to-string (s) (write-ssl-error-queue s))))
+    (if (and (eql error-code #.+ssl-error-syscall+)
+	     (not (zerop original-error)))
+	(error 'ssl-error-syscall
+	       :handle handle
+	       :ret error-code
+	       :queue queue
+	       :syscall syscall)
+      (error (case error-code
+	       (#.+ssl-error-none+ 'ssl-error-none)
+	       (#.+ssl-error-ssl+ 'ssl-error-ssl)
+	       (#.+ssl-error-want-read+ 'ssl-error-want-read)
+	       (#.+ssl-error-want-write+ 'ssl-error-want-write)
+	       (#.+ssl-error-want-x509-lookup+ 'ssl-error-want-x509-lookup)
+	       (#.+ssl-error-zero-return+ 'ssl-error-zero-return)
+	       (#.+ssl-error-want-connect+ 'ssl-error-want-connect)
+	       (#.+ssl-error-syscall+ 'ssl-error-zero-return)
+	       (t 'ssl-error/handle))
+	     :handle handle
+	     :ret error-code
+	     :queue queue))))
diff --git a/ffi.lisp b/ffi.lisp
new file mode 100644
index 0000000..168d97b
--- /dev/null
+++ b/ffi.lisp
@@ -0,0 +1,234 @@
+;;; Copyright (C) 2001, 2003  Eric Marsden
+;;; Copyright (C) 2005  David Lichteblau
+;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
+;;;
+;;; See LICENSE for details.
+
+(declaim
+ (optimize (speed 3) (space 1) (safety 1) (debug 0) (compilation-speed 0)))
+
+(in-package :cl+ssl)
+
+
+;;; Global state
+;;;
+(defvar *ssl-global-context* nil)
+(defvar *ssl-global-method* nil)
+(defvar *bio-lisp-method* nil)
+
+(defun ssl-initialized-p ()
+  (and *ssl-global-context* *ssl-global-method*))
+
+
+;;; Constants
+;;;
+(defconstant +random-entropy+ 256)
+
+(defconstant +ssl-filetype-pem+ 1)
+(defconstant +ssl-filetype-asn1+ 2)
+(defconstant +ssl-filetype-default+ 3)
+
+(defconstant +SSL_CTRL_SET_SESS_CACHE_MODE+ 44)
+
+
+;;; Function definitions
+;;;
+(declaim (inline ssl-write ssl-read ssl-connect ssl-accept))
+
+(cffi:defctype ssl-method :pointer)
+(cffi:defctype ssl-ctx :pointer)
+(cffi:defctype ssl-pointer :pointer)
+
+(cffi:defcfun ("SSL_get_version" ssl-get-version)
+    :string
+  (ssl ssl-pointer))
+(cffi:defcfun ("SSL_load_error_strings" ssl-load-error-strings)
+    :void)
+(cffi:defcfun ("SSL_library_init" ssl-library-init)
+    :int)
+(cffi:defcfun ("SSLv2_client_method" ssl-v2-client-method)
+    ssl-method)
+(cffi:defcfun ("SSLv23_client_method" ssl-v23-client-method)
+    ssl-method)
+(cffi:defcfun ("SSLv23_server_method" ssl-v23-server-method)
+    ssl-method)
+(cffi:defcfun ("SSLv23_method" ssl-v23-method)
+    ssl-method)
+(cffi:defcfun ("SSLv3_client_method" ssl-v3-client-method)
+    ssl-method)
+(cffi:defcfun ("SSLv3_server_method" ssl-v3-server-method)
+    ssl-method)
+(cffi:defcfun ("SSLv3_method" ssl-v3-method)
+    ssl-method)
+(cffi:defcfun ("TLSv1_client_method" ssl-TLSv1-client-method)
+    ssl-method)
+(cffi:defcfun ("TLSv1_server_method" ssl-TLSv1-server-method)
+    ssl-method)
+(cffi:defcfun ("TLSv1_method" ssl-TLSv1-method)
+    ssl-method)
+
+(cffi:defcfun ("SSL_CTX_new" ssl-ctx-new)
+    ssl-ctx
+  (method ssl-method))
+(cffi:defcfun ("SSL_new" ssl-new)
+    ssl-pointer
+  (ctx ssl-ctx))
+(cffi:defcfun ("SSL_set_fd" ssl-set-fd)
+    :int
+  (ssl ssl-pointer)
+  (fd :int))
+(cffi:defcfun ("SSL_set_bio" ssl-set-bio)
+    :void
+  (ssl ssl-pointer)
+  (rbio :pointer)
+  (wbio :pointer))
+(cffi:defcfun ("SSL_get_error" ssl-get-error)
+    :int
+  (ssl ssl-pointer)
+  (ret :int))
+(cffi:defcfun ("SSL_set_connect_state" ssl-set-connect-state)
+    :void
+  (ssl ssl-pointer))
+(cffi:defcfun ("SSL_set_accept_state" ssl-set-accept-state)
+    :void
+  (ssl ssl-pointer))
+(cffi:defcfun ("SSL_connect" ssl-connect)
+    :int
+  (ssl ssl-pointer))
+(cffi:defcfun ("SSL_accept" ssl-accept)
+    :int
+  (ssl ssl-pointer))
+(cffi:defcfun ("SSL_write" ssl-write)
+    :int
+  (ssl ssl-pointer)
+  (buf :pointer)
+  (num :int))
+(cffi:defcfun ("SSL_read" ssl-read)
+    :int
+  (ssl ssl-pointer)
+  (buf :pointer)
+  (num :int))
+(cffi:defcfun ("SSL_shutdown" ssh-shutdown)
+    :void
+  (ssl ssl-pointer))
+(cffi:defcfun ("SSL_free" ssl-free)
+    :void
+  (ssl ssl-pointer))
+(cffi:defcfun ("SSL_CTX_free" ssl-ctx-free)
+    :void
+  (ctx ssl-ctx))
+(cffi:defcfun ("RAND_seed" rand-seed)
+    :void
+  (buf :pointer)
+  (num :int))
+(cffi:defcfun ("BIO_ctrl" bio-set-fd)
+    :long
+  (bio :pointer)
+  (cmd :int)
+  (larg :long)
+  (parg :pointer))
+(cffi:defcfun ("BIO_new_socket" bio-new-socket)
+    :pointer
+  (fd :int)
+  (close-flag :int))
+(cffi:defcfun ("BIO_new" bio-new)
+    :pointer
+  (method :pointer))
+
+(cffi:defcfun ("ERR_get_error" err-get-error)
+    :unsigned-long)
+(cffi:defcfun ("ERR_error_string" err-error-string)
+    :string
+  (e :unsigned-long)
+  (buf :pointer))
+
+(cffi:defcfun ("SSL_set_cipher_list" ssl-set-cipher-list)
+    :int
+  (ssl ssl-pointer)
+  (str :string))
+(cffi:defcfun ("SSL_use_RSAPrivateKey_file" ssl-use-rsa-privatekey-file)
+    :int
+  (ssl ssl-pointer)
+  (str :string)
+  ;; either +ssl-filetype-pem+ or +ssl-filetype-asn1+
+  (type :int))
+(cffi:defcfun
+    ("SSL_CTX_use_RSAPrivateKey_file" ssl-ctx-use-rsa-privatekey-file)
+    :int
+  (ctx ssl-ctx)
+  (type :int))
+(cffi:defcfun ("SSL_use_certificate_file" ssl-use-certificate-file)
+    :int
+  (ssl ssl-pointer)
+  (str :string)
+  (type :int))
+(cffi:defcfun ("SSL_CTX_load_verify_locations" ssl-ctx-load-verify-locations)
+    :int
+  (ctx ssl-ctx)
+  (CAfile :string)
+  (CApath :string))
+(cffi:defcfun ("SSL_CTX_set_client_CA_list" ssl-ctx-set-client-ca-list)
+    :void
+  (ctx ssl-ctx)
+  (list ssl-pointer))
+(cffi:defcfun ("SSL_load_client_CA_file" ssl-load-client-ca-file)
+    ssl-pointer
+  (file :string))
+
+(cffi:defcfun ("SSL_CTX_ctrl" ssl-ctx-ctrl)
+    :long
+  (ctx ssl-ctx)
+  (cmd :int)
+  (larg :long)
+  (parg :long))
+
+
+;;; Funcall wrapper
+;;;
+(defvar *socket*)
+
+(declaim (inline ensure-ssl-funcall))
+(defun ensure-ssl-funcall (*socket* handle func sleep-time &rest args)
+  (loop
+    (handler-case
+	(let ((rc (apply func args)))
+	  (when (plusp rc)
+	    (return rc))
+	  (ssl-signal-error handle func (ssl-get-error handle rc) rc))
+      (ssl-error-want-something (condition)
+	(declare (ignore condition))
+	;; FIXME: what is this SLEEP business for?
+	;; Do we still need this?
+	(warn "sleeping in ensure-ssl-funcall")
+	(sleep sleep-time)))))
+
+
+;;; Initialization
+;;;
+(defun init-prng ()
+  ;; this initialization of random entropy is not necessary on
+  ;; Linux, since the OpenSSL library automatically reads from
+  ;; /dev/urandom if it exists. On Solaris it is necessary.
+  (let ((buf (cffi-sys::make-shareable-byte-vector +random-entropy+)))
+    (dotimes (i +random-entropy+)
+      (setf (elt buf i) (random 256)))
+    (cffi-sys::with-pointer-to-vector-data (ptr buf)
+      (rand-seed ptr +random-entropy+))))
+
+(defun ssl-ctx-set-session-cache-mode (ctx mode)
+  (ssl-ctx-ctrl ctx +SSL_CTRL_SET_SESS_CACHE_MODE+ mode 0))
+
+(defun initialize (&optional (method 'ssl-v23-method))
+  (setf *bio-lisp-method* (make-bio-lisp-method))
+  (ssl-load-error-strings)
+  (ssl-library-init)
+  (init-prng)
+  (setf *ssl-global-method* (funcall method))
+  (setf *ssl-global-context* (ssl-ctx-new *ssl-global-method*))
+  (ssl-ctx-set-session-cache-mode *ssl-global-context* 3))
+
+(defun ensure-initialized (&optional (method 'ssl-v23-method))
+  (unless (ssl-initialized-p)
+    (initialize method))
+  (unless *bio-lisp-method*
+    (setf *bio-lisp-method* (make-bio-lisp-method))))
diff --git a/index.css b/index.css
new file mode 100644
index 0000000..e1633d5
--- /dev/null
+++ b/index.css
@@ -0,0 +1,66 @@
+div.sidebar {
+  float: right;
+  background-color: #eeeeee;
+  border: 2pt solid black;
+  margin: 0em 2pt 1em 2em;
+  min-width: 15%;
+  padding: 0pt 5pt 5pt 5pt;
+}
+
+div.sidebar ul {
+  padding: 0pt 0pt 0pt 1em;
+  margin: 0 0 1em;
+}
+
+body {
+  color: #000000;
+  background-color: #ffffff;
+  margin-right: 0pt;
+  margin-bottom: 10%;
+  padding-left: 30px;
+}
+
+h1,h2 {
+  background-color: darkred;
+  color: white;
+  margin-left: -30px;
+}
+
+th {
+  background-color: darkred;
+  color: white;
+  text-align: left;
+}
+
+pre {
+  background-color: #eeeeee;
+  border: solid 1px #d0d0d0;
+  padding: 1em;
+  margin-right: 10%;
+}
+
+.def {
+  background-color: #ddddff;
+  font-weight: bold;
+}
+
+.nomargin {
+  margin-bottom: 0;
+  margin-top: 0;
+}
+
+.working {
+  background-color: #60c060;
+}
+
+.broken {
+  background-color: #ff6060;
+}
+
+.incomplete {
+  background-color: #ffff60;
+}
+
+.unknown {
+  background-color: #cccccc;
+}
diff --git a/index.html b/index.html
new file mode 100644
index 0000000..841fbe1
--- /dev/null
+++ b/index.html
@@ -0,0 +1,199 @@
+<?xml version="1.0" encoding="iso-8859-1"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
+  <head>
+    <title>CL+SSL</title>
+    <link rel="stylesheet" type="text/css" href="index.css"/>
+  </head>
+  <body>
+    <h1>CL<em style="font-weight: normal">plus</em>SSL</h1>
+
+    <h3>Subprojects</h3>
+    <ul>
+      <li><a href="#cl+ssl">CL+SSL</a></li>
+      <li><a href="#trivial-https">trivial-https</a></li>
+      <li><a href="#trivial-gray-streams">trivial-gray-streams</a></li>
+    </ul>
+
+    <h3>Download</h3>
+    <pre>$ export CVSROOT=:pserver:anonymous@common-lisp.net:/project/cl-plus-ssl/cvsroot
+$ cvs login
+password: anonymous
+$ cvs co cl+ssl
+$ cvs co trivial-gray-streams
+$ cvs co trivial-https</pre>
+    <p>
+      Note that you need the <tt>libssl-dev</tt> package on Debian to
+      load this package without manual configuration.
+    </p>
+
+    <p>
+      Send bug reports to <a
+      href="mailto:cl-plus-ssl-devel@common-lisp.net">cl-plus-ssl-devel@common-lisp.net</a>
+      (<a
+      href="http://common-lisp.net/cgi-bin/mailman/listinfo/cl-plus-ssl-devel">list
+      information</a>)
+      or <a href="mailto:david@lichteblau.com">David Lichteblau</a>.
+    </p>
+
+    <a name="cl+ssl">
+    <h2>CL+SSL</h2>
+
+    <p>A simple Common Lisp interface to OpenSSL.</p>
+
+    <h3>About</h3>
+
+    <p>
+      This library is a fork of <a
+      href="http://www.cliki.net/SSL-CMUCL">SSL-CMUCL</a>.  The original
+      SSL-CMUCL source code was written by Eric Marsden and includes
+      contributions by Jochen Schmidt.  License: LGPL.
+    </p>
+
+    <ul>
+      <li>
+        CL+SSL is portable code based on CFFI and gray streams.
+      </li>
+      <li>
+        It defines its own libssl BIO method, so that SSL I/O is
+        actually written over portable Lisp streams instead of bypassing
+	the streams and sending data over Unix file descriptors directly.
+      </li>
+    </ul>
+
+    <p>
+      Comparison chart:
+    </p>
+    <table border="1" cellpadding="2" cellspacing="0">
+      <thead>
+        <tr>
+          <th></th>
+          <th><b>FFI</b></th>
+          <th><b>Streams</b></th>
+          <th><b>Lisp-BIO</b></th>
+        </tr>
+      </thead>
+      <tr>
+        <td>CL+SSL</td>
+        <td>CFFI</td>
+        <td>gray, non-buffering</td>
+        <td>yes</td>
+      </tr>
+      <tr>
+        <td>CL-SSL</td>
+        <td>UFFI</td>
+        <td>gray, buffering [<em>part of ACL-COMPAT</em>]</td>
+        <td>no</td>
+      </tr>
+      <tr>
+        <td>SSL-CMUCL</td>
+        <td>CMUCL/ALIEN</td>
+        <td>CMUCL, non-buffering</td>
+        <td>no</td>
+      </tr>
+    </table>
+
+    <h3>API functions</h3>
+    <p>
+      <div class="def">Variable CL+SSL-SYSTEM:*LIBSSL-PATHNAME*</div>
+      Full pathname of the SSL library.  Defaults
+      to <tt>/usr/lib/libssl.so</tt>. If the default is not correct for
+      your system, set this variable between loading the .asd file and
+      load-op'ing the system.
+    </p>
+    <p>
+      <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (stream)</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>
+      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
+      standard <tt>close</tt> function.
+    </p>
+    <p>
+      <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.
+    </p>
+
+    <h3>Portability</h3>
+    <p>
+      CL+SSL requires CFFI with callback support.
+    </p>
+    <p>
+      Test results for Linux/x86, except OpenMCL which was tested on
+      Linux/PPC:
+    </p>
+    <table border="1" cellpadding="2" cellspacing="0">
+      <thead>
+        <tr>
+          <th><b>Lisp Implementation</b></th>
+          <th><b>Status</b></th>
+          <th><b>Comments</b></th>
+        </tr>
+      </thead>
+      <tr><td>OpenMCL</td><td class="working">Working</td></tr>
+      <tr><td>SBCL</td><td class="working">Working</td></tr>
+      <tr><td>CMU CL</td><td class="working">Working</td></tr>
+      <tr>
+        <td>CLISP</td>
+        <td class="incomplete">Working</td>
+        <td>Extremely slow?</td>
+      </tr>
+      <tr><td>LispWorks</td><td class="working">Working</td></tr>
+      <tr>
+        <td>Allegro</td>
+        <td class="broken">Broken</td>
+        <td>segfault</td>
+      </tr>
+      <tr><td>Corman CL</td><td class="unknown">Unknown</td></tr>
+      <tr><td>Digitool MCL</td><td class="unknown">Unknown</td></tr>
+      <tr><td>Scieneer CL</td><td class="unknown">Unknown</td></tr>
+      <tr><td>ECL</td><td class="unknown">Unknown</td></tr>
+      <tr><td>GCL</td><td class="unknown">Unknown</td></tr>
+    </table>
+
+    <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>
+    </ul>
+
+    <a name="trivial-https">
+    <h2>trivial-https</h2>
+
+    <p>
+      trivial-https is a fork of Brian
+      Mastenbrook's <a
+      href="http://www.cliki.net/trivial-http">trivial-http</a> adding
+      support for HTTPS using CL+SSL.
+    </p>
+
+    <p>
+      <a href="">README</a>
+    </p>
+
+    <a name="trivial-gray-streams">
+    <h2>trivial-gray-streams</h2>
+
+    <p>
+      trivial-gray-streams provides an extremely thin compatibility
+      layer for gray streams.
+    </p>
+
+    <p>
+      <a href="">README</a>
+    </p>
+  </body>
+</html>
diff --git a/package.lisp b/package.lisp
new file mode 100644
index 0000000..51b58ce
--- /dev/null
+++ b/package.lisp
@@ -0,0 +1,13 @@
+;;; Copyright (C) 2001, 2003  Eric Marsden
+;;; Copyright (C) 2005  David Lichteblau
+;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
+;;;
+;;; See LICENSE for details.
+
+(in-package :cl-user)
+
+(defpackage :cl+ssl
+  (:use :common-lisp :trivial-gray-streams)
+  (:export #:ensure-initialized
+	   #:make-ssl-client-stream
+           #:make-ssl-server-stream))
diff --git a/reload.lisp b/reload.lisp
new file mode 100644
index 0000000..90e8f64
--- /dev/null
+++ b/reload.lisp
@@ -0,0 +1,17 @@
+;;; Copyright (C) 2001, 2003  Eric Marsden
+;;; Copyright (C) 2005  David Lichteblau
+;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
+;;;
+;;; See LICENSE for details.
+
+;;; We do this in an extra file so that it happens
+;;;   - after the asd file has been loaded, so that users can
+;;;     customize *libssl-pathname* between loading the asd and LOAD-OPing
+;;;     the actual sources
+;;;   - before ssl.lisp is loaded, which needs the library at compilation
+;;;     time on some implemenations
+;;;   - but not every time ssl.lisp is re-loaded as would happen if we
+;;;     put this directly into ssl.lisp
+
+(in-package :cl+ssl-system)
+(cffi:load-foreign-library *libssl-pathname*)
diff --git a/streams.lisp b/streams.lisp
new file mode 100644
index 0000000..d78feea
--- /dev/null
+++ b/streams.lisp
@@ -0,0 +1,171 @@
+;;; Copyright (C) 2001, 2003  Eric Marsden
+;;; Copyright (C) 2005  David Lichteblau
+;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
+;;;
+;;; See LICENSE for details.
+
+(declaim
+ (optimize (speed 3) (space 1) (safety 1) (debug 0) (compilation-speed 0)))
+
+(in-package :cl+ssl)
+
+(defconstant +initial-buffer-size+ 2048)
+
+(defclass ssl-stream
+    (fundamental-binary-input-stream
+     fundamental-binary-output-stream
+     fundamental-character-input-stream
+     fundamental-character-output-stream
+     trivial-gray-stream-mixin)
+  ((ssl-stream-socket
+    :initarg :socket
+    :accessor ssl-stream-socket)
+   (handle
+    :initform nil
+    :accessor ssl-stream-handle)
+   (io-buffer
+    :initform (cffi-sys::make-shareable-byte-vector +initial-buffer-size+)
+    :accessor ssl-stream-io-buffer)))
+
+(defmethod print-object ((object ssl-stream) stream)
+  (print-unreadable-object (object stream :type t)
+    (format stream "for ~A" (ssl-stream-socket object))))
+
+(defclass ssl-server-stream (ssl-stream) 
+  ((certificate
+    :initarg :certificate
+    :accessor ssl-stream-certificate)
+   (key
+    :initarg :key
+    :accessor ssl-stream-key)))
+
+
+;;; binary stream implementation
+;;;
+(defmethod close ((stream ssl-stream) &key abort)
+  (declare (ignore abort))
+  (ssl-free (ssl-stream-handle stream))
+  (close (ssl-stream-socket stream)))
+
+(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))))
+
+(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)))
+  b)
+
+(defmethod stream-write-sequence
+    ((stream ssl-stream) (thing array)
+     &optional (start 0) (end (length thing)))
+  (check-type thing (simple-array (unsigned-byte 8) (*)))
+  (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))))
+
+
+;;; 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))
+
+
+;;; interface functions
+;;;
+(defun make-ssl-client-stream (socket &key (method 'ssl-v23-method))
+  "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))
+
+(defun make-ssl-server-stream
+    (socket &key certificate key (method 'ssl-v23-method))
+  "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
+must not be associated with a passphrase."
+  (ensure-initialized method)
+  (let ((stream (make-instance 'ssl-server-stream
+		 :socket socket
+		 :certificate certificate
+		 :key key))
+        (handle (ssl-new *ssl-global-context*))
+	(bio (bio-new-lisp)))
+    (setf (ssl-stream-handle stream) handle)
+    (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"))
+    (when key
+      (unless (eql 1 (ssl-use-rsa-privatekey-file handle
+						  key
+						  +ssl-filetype-pem+))
+        (error 'ssl-error-initialize :reason "Can't load RSA private key ~A")))
+    (when certificate
+      (unless (eql 1 (ssl-use-certificate-file handle
+					       certificate
+					       +ssl-filetype-pem+))
+        (error 'ssl-error-initialize
+	       :reason "Can't load certificate ~A" certificate)))
+    (ensure-ssl-funcall socket handle #'ssl-accept 0.25 handle)
+    stream))
diff --git a/test.lisp b/test.lisp
new file mode 100644
index 0000000..3b89f8b
--- /dev/null
+++ b/test.lisp
@@ -0,0 +1,95 @@
+;;; Copyright (C) 2001, 2003  Eric Marsden
+;;; Copyright (C) 2005  David Lichteblau
+;;; "the conditions and ENSURE-SSL-FUNCALL are by Jochen Schmidt."
+;;;
+;;; See LICENSE for details.
+
+#|
+(load "test.lisp")
+(ssl-test::test-https-client "www.google.com")
+(ssl-test::test-https-server)
+|#
+
+(defpackage :ssl-test
+  (:use :cl))
+(in-package :ssl-test)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (asdf:operate 'asdf:load-op :trivial-sockets))
+
+(defun read-line-crlf (stream &optional eof-error-p)
+  (let ((s (make-string-output-stream)))
+    (loop
+        for empty = t then nil
+	for c = (read-char stream eof-error-p nil)
+	while (and c (not (eql c #\return)))
+	do
+	  (unless (eql c #\newline)
+	    (write-char c s))
+	finally
+	  (return
+	    (if empty nil (get-output-stream-string s))))))
+
+(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)))
+    (format t "NNTPS> ~A~%" (read-line-crlf nntps))
+    (write-line "HELP" nntps)
+    (force-output nntps)
+    (loop :for line = (read-line-crlf nntps nil)
+          :until (string-equal "." line)
+          :do (format t "NNTPS> ~A~%" line))))
+
+
+;; 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)))
+    (unwind-protect
+	(progn
+	  (format https "HEAD / HTTP/1.0~%Host: ~a~%~%" host)
+	  (force-output https)
+	  (loop :for line = (read-line-crlf https nil)
+			    :while line :do
+			    (format t "HTTPS> ~a~%" line)))
+      (close https))))
+
+;; start a simple HTTPS server. See the mod_ssl documentation at
+;; <URL:http://www.modssl.org/> for information on generating the
+;; server certificate and key
+;;
+;; You can stress-test the server with
+;;
+;;    siege -c 10 -u https://host:8080/foobar
+;;
+(defun test-https-server
+    (&key (port 8080)
+	  (cert "/home/david/newcert.pem")
+	  (key "/home/david/newkey.pem"))
+  (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
+		      server
+		      :element-type '(unsigned-byte 8))
+		     :certificate cert
+		     :key key)))
+	(unwind-protect
+	    (progn
+	      (loop :for line = (read-line-crlf client nil)
+				:while (> (length line) 1) :do
+				(format t "HTTPS> ~a~%" line))
+	      (format client "HTTP/1.0 200 OK~%")
+	      (format client "Server: SSL-CMUCL/1.1~%")
+	      (format client "Content-Type: text/plain~%")
+	      (terpri client)
+	      (format client "G'day at ~A!~%"
+		      (multiple-value-list (get-decoded-time)))
+	      (format client "CL+SSL running in ~A ~A~%"
+		      (lisp-implementation-type)
+		      (lisp-implementation-version)))
+	  (close client))))))