User: simon Date: 06/03/08 11:00:36 Modified: packages/xemacs-packages/mail-lib tls.el Log: Sync with GNU Emacs, adds support for OpenSSL. Revision Changes Path 1.3 +45 -14 XEmacs/packages/xemacs-packages/mail-lib/tls.el Index: tls.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/mail-lib/tls.el,v retrieving revision 1.2 retrieving revision 1.3 diff -u -p -r1.2 -r1.3 --- tls.el 2004/09/16 13:01:29 1.2 +++ tls.el 2006/03/08 10:00:35 1.3 ＠＠ -1,6 +1,7 ＠＠ ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS -;; Copyright (C) 2003 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004, +;; 2005, 2006 Free Software Foundation, Inc. ;; Author: Simon Josefsson <simon(a)josefsson.org&gt; ;; Keywords: comm, tls, gnutls, ssl ＠＠ -19,8 +20,8 ＠＠ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: ＠＠ -55,7 +56,8 ＠＠ :group 'comm) (defcustom tls-program '("gnutls-cli -p %p %h" - "gnutls-cli -p %p %h --protocols ssl3") + "gnutls-cli -p %p %h --protocols ssl3" + "openssl s_client -connect %h:%p -no_ssl2") "List of strings containing commands to start TLS stream to a host. Each entry in the list is tried until a connection is successful. %s is replaced with server hostname, %p with port to connect to. ＠＠ -70,17 +72,47 ＠＠ after successful negotiation." :type 'boolean :group 'tls) -(defcustom tls-success "- Handshake was completed" +(defcustom tls-success "- Handshake was completed\\|SSL handshake has read " "*Regular expression indicating completed TLS handshakes. -The default is what GNUTLS's \"gnutls-cli\" outputs." +The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's +\"openssl s_client\" outputs." :type 'regexp :group 'tls) -(defun open-tls-stream (name buffer host service) - "Open a TLS connection for a service to a host. +(defcustom tls-certtool-program (executable-find "certtool") + "Name of GnuTLS certtool. +Used by `tls-certificate-information'." +:type '(repeat string) +:group 'tls) + +(defun tls-certificate-information (der) + "Parse X.509 certificate in DER format into an assoc list." + (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" + (base64-encode-string der) + "\n-----END CERTIFICATE-----\n")) + (exit-code 0)) + (with-current-buffer (get-buffer-create " *certtool*") + (erase-buffer) + (insert certificate) + (setq exit-code (condition-case () + (call-process-region (point-min) (point-max) + tls-certtool-program + t (list (current-buffer) nil) t + "--certificate-info") + (error -1))) + (if (/= exit-code 0) + nil + (let ((vals nil)) + (goto-char (point-min)) + (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t) + (push (cons (match-string 1) (match-string 2)) vals)) + (nreverse vals)))))) + +(defun open-tls-stream (name buffer host port) + "Open a TLS connection for a port to a host. Returns a subprocess-object to represent the connection. Input and output work as for subprocesses; `delete-process' closes it. -Args are NAME BUFFER HOST SERVICE. +Args are NAME BUFFER HOST PORT. NAME is name for process. It is modified if necessary to make it unique. BUFFER is the buffer (or buffer-name) to associate with the process. Process output goes at end of that buffer, unless you specify ＠＠ -88,8 +120,7 ＠＠ BUFFER is the buffer (or buffer-name) to BUFFER may be also nil, meaning that this process is not associated with any buffer Third arg is name of the host to connect to, or its IP address. -Fourth arg SERVICE is name of the service desired, or an integer -specifying a port number to connect to." +Fourth arg PORT is an integer specifying a port to connect to." (let ((cmds tls-program) cmd done) (message "Opening TLS connection to `%s'..." host) (while (and (not done) (setq cmd (pop cmds))) ＠＠ -101,9 +132,9 ＠＠ specifying a port number to connect to." cmd (format-spec-make ?h host - ?p (if (integerp service) - (int-to-string service) - service))))) + ?p (if (integerp port) + (int-to-string port) + port))))) response) (while (and process (memq (process-status process) '(open run))