[bknr-cvs] hans changed trunk/thirdparty/cl+ssl/
BKNR Commits
bknr at bknr.net
Thu Apr 9 05:57:33 UTC 2009
Revision: 4371
Author: hans
URL: http://bknr.net/trac/changeset/4371
update from upstream
U trunk/thirdparty/cl+ssl/CVS/Entries
U trunk/thirdparty/cl+ssl/example.lisp
U trunk/thirdparty/cl+ssl/ffi-buffer-clisp.lisp
U trunk/thirdparty/cl+ssl/ffi.lisp
U trunk/thirdparty/cl+ssl/index.html
U trunk/thirdparty/cl+ssl/package.lisp
U trunk/thirdparty/cl+ssl/streams.lisp
Modified: trunk/thirdparty/cl+ssl/CVS/Entries
===================================================================
--- trunk/thirdparty/cl+ssl/CVS/Entries 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/CVS/Entries 2009-04-09 05:57:32 UTC (rev 4371)
@@ -1,17 +1,17 @@
-/LICENSE/1.4/Mon Jun 23 13:16:26 2008//
-/Makefile/1.1.1.1/Mon Jun 23 13:16:26 2008//
-/bio.lisp/1.3/Mon Jun 23 13:16:26 2008//
-/cl+ssl.asd/1.6/Mon Jun 23 13:16:26 2008//
-/conditions.lisp/1.3/Mon Jun 23 13:16:26 2008//
-/example.lisp/1.1/Mon Jun 23 13:16:26 2008//
-/ffi-buffer-all.lisp/1.1/Mon Jun 23 13:16:26 2008//
-/ffi-buffer-clisp.lisp/1.1/Mon Jun 23 13:16:26 2008//
-/ffi-buffer.lisp/1.1/Mon Jun 23 13:16:26 2008//
-/ffi.lisp/1.8/Mon Jun 23 13:16:26 2008//
-/index.css/1.2/Mon Jun 23 13:16:26 2008//
-/index.html/1.15/Mon Jun 23 13:16:26 2008//
-/package.lisp/1.3/Mon Jun 23 13:16:26 2008//
-/reload.lisp/1.5/Mon Jun 23 13:16:26 2008//
-/test.lisp/1.4/Mon Jun 23 13:16:26 2008//
-/streams.lisp/1.13/Mon Oct 27 10:03:01 2008//
+/LICENSE/1.4/Fri Jan 23 19:29:58 2009//
+/Makefile/1.1.1.1/Fri Jan 23 19:29:58 2009//
+/bio.lisp/1.3/Fri Jan 23 19:29:58 2009//
+/cl+ssl.asd/1.6/Fri Jan 23 19:29:58 2009//
+/conditions.lisp/1.3/Fri Jan 23 19:29:58 2009//
+/ffi-buffer-all.lisp/1.1/Fri Jan 23 19:29:58 2009//
+/ffi-buffer.lisp/1.1/Fri Jan 23 19:29:58 2009//
+/index.css/1.2/Fri Jan 23 19:29:58 2009//
+/reload.lisp/1.5/Fri Jan 23 19:29:58 2009//
+/test.lisp/1.4/Fri Jan 23 19:29:58 2009//
+/example.lisp/1.5/Thu Apr 9 05:57:19 2009//
+/ffi-buffer-clisp.lisp/1.2/Thu Apr 9 05:57:19 2009//
+/ffi.lisp/1.12/Thu Apr 9 05:57:19 2009//
+/index.html/1.24/Thu Apr 9 05:57:19 2009//
+/package.lisp/1.5/Thu Apr 9 05:57:19 2009//
+/streams.lisp/1.16/Thu Apr 9 05:57:19 2009//
D
Modified: trunk/thirdparty/cl+ssl/example.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/example.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/example.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -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 :external-format :iso-8859-1)))
+ (nntps (cl+ssl:make-ssl-client-stream fd :external-format '(:iso-8859-1 :eol-style :lf))))
(format t "NNTPS> ~A~%" (read-line-crlf nntps))
(write-line "HELP" nntps)
(force-output nntps)
@@ -60,7 +60,7 @@
(cl+ssl:make-ssl-client-stream
socket
:unwrap-stream-p t
- :external-format :iso-8859-1))))
+ :external-format '(:iso-8859-1 :eol-style :lf)))))
(unwind-protect
(progn
(format https "GET / HTTP/1.0~%Host: ~a~%~%" host)
@@ -68,8 +68,7 @@
(loop :for line = (read-line-crlf https nil)
:while line :do
(format t "HTTPS> ~a~%" line)))
- (close socket)
- (close https))))
+ (close https))))
;; start a simple HTTPS server. See the mod_ssl documentation at
;; <URL:http://www.modssl.org/> for information on generating the
@@ -90,8 +89,8 @@
server
:element-type '(unsigned-byte 8)))
(client (cl+ssl:make-ssl-server-stream
- (cl+ssl:stream-fd socket)
- :external-format :iso-8859-1
+ socket
+ :external-format '(:iso-8859-1 :eol-style :lf)
:certificate cert
:key key)))
(unwind-protect
@@ -108,5 +107,4 @@
(format client "CL+SSL running in ~A ~A~%"
(lisp-implementation-type)
(lisp-implementation-version)))
- (close socket)
(close client))))))
Modified: trunk/thirdparty/cl+ssl/ffi-buffer-clisp.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/ffi-buffer-clisp.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/ffi-buffer-clisp.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -13,13 +13,27 @@
(setf (ffi:memory-as buf 'ffi:uint8 index) val))
(defsetf buffer-elt set-buffer-elt)
-(defun v/b-replace (vec buf &key (start1 0) end1 (start2 0) (end2 +initial-buffer-size+))
+(declaim
+ (inline calc-buf-end))
+
+;; to calculate non NIL value of the buffer end index
+(defun calc-buf-end (buf-start vec vec-start vec-end)
+ (+ buf-start
+ (- (or vec-end (length vec))
+ vec-start)))
+
+(defun v/b-replace (vec buf &key (start1 0) end1 (start2 0) end2)
+ (when (null end2)
+ (setf end2 (calc-buf-end start2 vec start1 end1)))
(replace
vec
(ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end2 start2))) start2)
:start1 start1
:end1 end1))
-(defun b/v-replace (buf vec &key (start1 0) (end1 +initial-buffer-size+) (start2 0) end2)
+
+(defun b/v-replace (buf vec &key (start1 0) end1 (start2 0) end2)
+ (when (null end1)
+ (setf end1 (calc-buf-end start1 vec start2 end2)))
(setf
(ffi:memory-as buf (ffi:parse-c-type `(ffi:c-array ffi:uint8 ,(- end1 start1))) start1)
(subseq vec start2 end2)))
Modified: trunk/thirdparty/cl+ssl/ffi.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/ffi.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/ffi.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -25,8 +25,6 @@
;;; Constants
;;;
-(defconstant +random-entropy+ 256)
-
(defconstant +ssl-filetype-pem+ 1)
(defconstant +ssl-filetype-asn1+ 2)
(defconstant +ssl-filetype-default+ 3)
@@ -176,6 +174,10 @@
(ssl ssl-pointer)
(str :string)
(type :int))
+(cffi:defcfun ("SSL_CTX_use_certificate_chain_file" ssl-ctx-use-certificate-chain-file)
+ :int
+ (ctx ssl-ctx)
+ (str :string))
(cffi:defcfun ("SSL_CTX_load_verify_locations" ssl-ctx-load-verify-locations)
:int
(ctx ssl-ctx)
@@ -196,6 +198,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
;;;
@@ -303,36 +309,93 @@
(warn "non-blocking stream encountered unexpectedly"))
+;;; Encrypted PEM files support
+;;;
+
+;; based on 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 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)))
+
+(defun init-prng (seed-byte-sequence)
+ (let* ((length (length seed-byte-sequence))
+ (buf (cffi-sys::make-shareable-byte-vector length)))
+ (dotimes (i length)
+ (setf (elt buf i) (elt seed-byte-sequence i)))
(cffi-sys::with-pointer-to-vector-data (ptr buf)
- (rand-seed ptr +random-entropy+))))
+ (rand-seed ptr length))))
(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))
+(defun initialize (&key (method 'ssl-v23-method) rand-seed)
(setf *bio-lisp-method* (make-bio-lisp-method))
(ssl-load-error-strings)
(ssl-library-init)
- (init-prng)
+ (when rand-seed
+ (init-prng rand-seed))
(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))
+(defun ensure-initialized (&key (method 'ssl-v23-method) (rand-seed nil))
+ "In most cases you do *not* need to call this function, because it
+is called automatically by all other functions. The only reason to
+call it explicitly is to supply the RAND-SEED parameter. In this case
+do it before calling any other functions.
+
+Just leave the default value for the METHOD parameter.
+
+RAND-SEED is an octet sequence to initialize OpenSSL random number generator.
+On many platforms, including Linux and Windows, it may be leaved NIL (default),
+because OpenSSL initializes the random number generator from OS specific service.
+But for example on Solaris it may be necessary to supply this value.
+The minimum length required by OpenSSL is 128 bits.
+See ttp://www.openssl.org/support/faq.html#USER1 for details.
+
+Hint: do not use Common Lisp RANDOM function to generate the RAND-SEED,
+because the function usually returns predictable values."
(unless (ssl-initialized-p)
- (initialize method))
+ (initialize :method method :rand-seed rand-seed))
(unless *bio-lisp-method*
(setf *bio-lisp-method* (make-bio-lisp-method))))
+(defun use-certificate-chain-file (certificate-chain-file)
+ "Loads a PEM encoded certificate chain file CERTIFICATE-CHAIN-FILE
+and adds the chain to global context. The certificates must be sorted
+starting with the subject's certificate (actual client or server certificate),
+followed by intermediate CA certificates if applicable, and ending at
+the highest level (root) CA. Note: the RELOAD function clears the global
+context and in particular the loaded certificate chain."
+ (ensure-initialized)
+ (ssl-ctx-use-certificate-chain-file *ssl-global-context* certificate-chain-file))
+
(defun reload ()
(cffi:load-foreign-library 'libssl)
(cffi:load-foreign-library 'libeay32)
Modified: trunk/thirdparty/cl+ssl/index.html
===================================================================
--- trunk/thirdparty/cl+ssl/index.html 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/index.html 2009-04-09 05:57:32 UTC (rev 4371)
@@ -34,7 +34,7 @@
<p>
Anonymous CVS (<a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/?cvsroot=cl-plus-ssl">browse</a>):
</p>
- <pre>$ cvs -d :pserver:anonymous:anonymous at common-lisp.net:/project/cl-plus-ssl/cvsroot cl+ssl</pre>
+ <pre>$ cvs -z3 -d :pserver:anonymous:anonymous at common-lisp.net:/project/cl-plus-ssl/cvsroot co cl+ssl</pre>
<p>
<a
href="http://common-lisp.net/project/cl-plus-ssl/download/">Tarballs</a>
@@ -94,8 +94,32 @@
<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:ENSURE-INITIALIZED (&key (method 'ssl-v23-method) (rand-seed nil))</div>
+ In most cases you <strong>do not</strong> need to call this function, because it is called
+ automatically. The only reason to call it explicitly is to supply the <tt>rand-seed</tt> parameter.
+ In this case do it before calling any other functions.
+ </p>
+ <p>
+ Keyword arguments:
+ </p>
+ <p>
+ <tt>method</tt>. Just leave its default value.
+ </p>
+ <p>
+ <tt>rand-seed</tt> is an octet sequence to initialize OpenSSL random number generator.
+ On many platforms, including Linux and Windows, it may be leaved NIL (default),
+ because OpenSSL initializes the random number generator from OS specific service. But for
+ example on Solaris it may be necessary to supply this value. The minimum length required
+ by OpenSSL is 128 bits. See here <a href="http://www.openssl.org/support/faq.html#USER1">
+ http://www.openssl.org/support/faq.html#USER1</a> for the details.
+ </p>
+ <p>
+ Hint: do not use Common Lisp RANDOM function to generate the <tt>rand-seed</tt>, because the function
+ usually returns predictable values.
+ </p>
+ <p>
+ <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,10 +145,13 @@
</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
<tt>(unsigned-byte 8)</tt> SSL stream is returned. With a
non-null <tt>external-format</tt>, a flexi-stream capable of
@@ -132,6 +159,18 @@
as its initial external format.
</p>
<p>
+ <div class="def">Function CL+SSL:USE-CERTIFICATE-CHAIN-FILE (certificate-chain-file)</div>
+ Loads a PEM encoded certificate chain file <tt>certificate-chain-file</tt>
+ and adds the chain to global context. The certificates must be sorted
+ starting with the subject's certificate (actual client or server certificate),
+ followed by intermediate CA certificates if applicable, and ending at
+ the highest level (root) CA.
+ </p>
+ <p>
+ Note: the RELOAD function clears the global
+ context and in particular the loaded certificate chain.
+ </p>
+ <p>
<div class="def">Function CL+SSL:RELOAD ()</div>
Reload <tt>libssl</tt>. Call this function after restarting a Lisp
core with CL+SSL dumped into it on Lisp implementations that do
@@ -194,13 +233,25 @@
<li>
Support for I/O deadlines (Clozure CL and SBCL).
</li>
+ <li>
+ Support for encrypted keys, thanks to Vsevolod Dyomkin.
+ </li>
+ <li>
+ Chained certificates support, thanks to Juhani Ränkimies.
+ </li>
+ <li>
+ More secure initialization of OpenSSL random number generator.
+ </li>
+ <li>
+ Minor CLISP-specific fixes.
+ </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>
@@ -208,7 +259,7 @@
</p>
<ul>
<li>
- Improved clisp support, thanks
+ Improved CLISP support, thanks
to <a
href="http://web.kepibu.org/code/lisp/cl+ssl/">Pixel
// pinterface</a>, as well as client certificate support.
Modified: trunk/thirdparty/cl+ssl/package.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/package.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/package.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -10,6 +10,7 @@
(:use :common-lisp :trivial-gray-streams)
(:export #:ensure-initialized
#:reload
- #:stream-fd
- #:make-ssl-client-stream
- #:make-ssl-server-stream))
+ #:stream-fd
+ #:make-ssl-client-stream
+ #:make-ssl-server-stream
+ #:use-certificate-chain-file))
Modified: trunk/thirdparty/cl+ssl/streams.lisp
===================================================================
--- trunk/thirdparty/cl+ssl/streams.lisp 2009-04-08 16:23:39 UTC (rev 4370)
+++ trunk/thirdparty/cl+ssl/streams.lisp 2009-04-09 05:57:32 UTC (rev 4371)
@@ -165,8 +165,14 @@
#+clozure-common-lisp
(defun install-nonblock-flag (fd)
- (ccl::fd-set-flags fd (logior (ccl::fd-get-flags fd) #$O_NONBLOCK)))
-
+ (ccl::fd-set-flags fd (logior (ccl::fd-get-flags fd)
+ #.(read-from-string "#$O_NONBLOCK"))))
+ ;; read-from-string is necessary because
+ ;; CLISP and perhaps other Lisps are confused
+ ;; by #$, signaling"undefined dispatch character $",
+ ;; even though the defun in conditionalized by
+ ;; #+clozure-common-lisp
+
#+(and sbcl (not win32))
(defun install-nonblock-flag (fd)
(sb-posix:fcntl fd
@@ -220,32 +226,33 @@
;; 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."
- (ensure-initialized method)
+may be associated with the passphrase PASSWORD."
+ (ensure-initialized :method method)
(let ((stream (make-instance 'ssl-stream
:socket socket
:close-callback close-callback))
(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."
- (ensure-initialized method)
+may be associated with the passphrase PASSWORD."
+ (ensure-initialized :method method)
(let ((stream (make-instance 'ssl-server-stream
:socket socket
:close-callback close-callback
@@ -256,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 Bknr-cvs
mailing list