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 ""))) + ,@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@common-lisp.net:/project/cl-plus-ssl/cvsroot cl+ssl</pre> + <pre>$ cvs -z3 -d :pserver:anonymous:anonymous@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)))