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

avodonosov avodonosov at common-lisp.net
Mon Nov 3 09:25:39 UTC 2008


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

Modified Files:
	ffi.lisp index.html streams.lisp 
Log Message:
Support for encrypted keys, thanks to Vsevolod Dyomkin.

--- /project/cl-plus-ssl/cvsroot/cl+ssl/ffi.lisp	2008/04/17 20:58:29	1.8
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/ffi.lisp	2008/11/03 09:25:39	1.9
@@ -196,6 +196,10 @@
   (larg :long)
   (parg :long))
 
+(cffi:defcfun ("SSL_CTX_set_default_passwd_cb" ssl-ctx-set-default-passwd-cb)
+    :void
+  (ctx ssl-ctx)
+  (pem_passwd_cb :pointer))
 
 ;;; Funcall wrapper
 ;;;
@@ -318,6 +322,35 @@
 (defun ssl-ctx-set-session-cache-mode (ctx mode)
   (ssl-ctx-ctrl ctx +SSL_CTRL_SET_SESS_CACHE_MODE+ mode 0))
 
+;;;;; Encrypted PEM files support
+
+;; see http://www.openssl.org/docs/ssl/SSL_CTX_set_default_passwd_cb.html
+
+(defvar *pem-password* ""
+  "The callback registered with SSL_CTX_set_default_passwd_cb
+will use this value.")
+
+;; The callback itself
+(cffi:defcallback pem-password-callback :int
+    ((buf :pointer) (size :int) (rwflag :int) (unused :pointer))
+  (let* ((password-str (coerce *pem-password* 'base-string))
+         (tmp (cffi:foreign-string-alloc password-str)))
+    (cffi:foreign-funcall "strncpy"
+                          :pointer buf
+                          :pointer tmp
+                          :int size)
+    (cffi:foreign-string-free tmp)
+    (setf (cffi:mem-ref buf :char (1- size)) 0)
+    (cffi:foreign-funcall "strlen" :pointer buf :int)))
+
+;; The macro to be used by other code to provide password
+;; when loading PEM file.
+(defmacro with-pem-password ((password) &body body)
+  `(let ((*pem-password* (or ,password "")))
+         , at body))
+
+;;;;; Initialization
+
 (defun initialize (&optional (method 'ssl-v23-method))
   (setf *bio-lisp-method* (make-bio-lisp-method))
   (ssl-load-error-strings)
@@ -325,7 +358,9 @@
   (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))
+  (ssl-ctx-set-session-cache-mode *ssl-global-context* 3)
+  (ssl-ctx-set-default-passwd-cb *ssl-global-context* 
+                                 (cffi:callback pem-password-callback)))
 
 (defun ensure-initialized (&optional (method 'ssl-v23-method))
   (unless (ssl-initialized-p)
--- /project/cl-plus-ssl/cvsroot/cl+ssl/index.html	2008/11/01 05:18:43	1.18
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/index.html	2008/11/03 09:25:39	1.19
@@ -94,8 +94,8 @@
 
     <h3>API functions</h3>
     <p>
-      <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (fd-or-stream &key external-format certificate key close-callback (unwrap-streams-p t))<br/><br/>
-      Function CL+SSL:MAKE-SSL-SERVER-STREAM (fd-or-stream &key external-format certificate key close-callback (unwrap-streams-p t))</div>
+      <div class="def">Function CL+SSL:MAKE-SSL-CLIENT-STREAM (fd-or-stream &key external-format certificate key password close-callback (unwrap-streams-p t))<br/><br/>
+      Function CL+SSL:MAKE-SSL-SERVER-STREAM (fd-or-stream &key external-format certificate key password close-callback (unwrap-streams-p t))</div>
       Return an SSL stream for the client (server)
       socket <tt>fd-or-stream</tt>.  All reads and writes to this
       stream will be pushed through the OpenSSL library.
@@ -121,8 +121,11 @@
     </p>
     <p>
       <tt>certificate</tt> is the path to a file containing the PEM-encoded
-      certificate for your client. <tt>key</tt> is the path to the PEM-encoded
-      key for the client, which must not be associated with a passphrase.
+      certificate. 
+    </p>
+	<p>
+	  <tt>key</tt> is the path to the PEM-encoded key, which may be associated 
+      with the passphrase <tt>password</tt>.
     </p>
     <p>
       If <tt>external-format</tt> is <tt>nil</tt> (the default), a plain
@@ -194,13 +197,16 @@
       <li>
 	Support for I/O deadlines (Clozure CL and SBCL).
       </li>
+      <li>
+	Support for encrypted keys, thanks to Vsevolod Dyomkin.
+      </li>
     </ul>
     <p>
       2007-xx-yy
     </p>
     <ul>
       <li>
-	Fixed windows support, thanks to Matthew Kennedy and Vodonosov Anton.
+	Fixed windows support, thanks to Matthew Kennedy and Anton Vodonosov.
       </li>
     </ul>
     <p>
--- /project/cl-plus-ssl/cvsroot/cl+ssl/streams.lisp	2008/11/01 02:56:07	1.14
+++ /project/cl-plus-ssl/cvsroot/cl+ssl/streams.lisp	2008/11/03 09:25:39	1.15
@@ -226,12 +226,12 @@
 
 ;; fixme: free the context when errors happen in this function
 (defun make-ssl-client-stream
-    (socket &key certificate key (method 'ssl-v23-method) external-format
+    (socket &key certificate key password (method 'ssl-v23-method) external-format
                  close-callback (unwrap-stream-p t))
   "Returns an SSL stream for the client socket descriptor SOCKET.
 CERTIFICATE is the path to a file containing the PEM-encoded certificate for
  your client. KEY is the path to the PEM-encoded key for the client, which
-must not be associated with a passphrase."
+may be associated with the passphrase PASSWORD."
   (ensure-initialized method)
   (let ((stream (make-instance 'ssl-stream
 			       :socket socket
@@ -239,18 +239,19 @@
         (handle (ssl-new *ssl-global-context*)))
     (setf socket (install-handle-and-bio stream handle socket unwrap-stream-p))
     (ssl-set-connect-state handle)
-    (install-key-and-cert handle key certificate)
+    (with-pem-password (password)
+      (install-key-and-cert handle key certificate))
     (ensure-ssl-funcall stream handle #'ssl-connect handle)
     (handle-external-format stream external-format)))
 
 ;; fixme: free the context when errors happen in this function
 (defun make-ssl-server-stream
-    (socket &key certificate key (method 'ssl-v23-method) external-format
+    (socket &key certificate key password (method 'ssl-v23-method) external-format
                  close-callback (unwrap-stream-p t))
   "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."
+may be associated with the passphrase PASSWORD."
   (ensure-initialized method)
   (let ((stream (make-instance 'ssl-server-stream
 		 :socket socket
@@ -262,7 +263,8 @@
     (ssl-set-accept-state handle)
     (when (zerop (ssl-set-cipher-list handle "ALL"))
       (error 'ssl-error-initialize :reason "Can't set SSL cipher list"))
-    (install-key-and-cert handle key certificate)
+    (with-pem-password (password)
+      (install-key-and-cert handle key certificate))
     (ensure-ssl-funcall stream handle #'ssl-accept handle)
     (handle-external-format stream external-format)))
 





More information about the cl-plus-ssl-cvs mailing list