CVS update by simon packages/xemacs-packages/mail-lib ...
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>
;; 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))