Revision: miles@gnu.org--gnu-2005/gnus--devo--0--patch-182

[gnus] / lisp / tls.el

diff --git a/lisp/tls.el b/lisp/tls.el
index 7027077..ceebe4b 100644 (file)
--- a/lisp/tls.el
+++ b/lisp/tls.el
@@ -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 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@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:
 
@@ -66,16 +67,48 @@ after successful negotiation."
   :group 'tls)
 
 (defcustom tls-process-connection-type nil
-  "*Value for `process-connection-type' to use when starting process."
+  "*Value for `process-connection-type' to use when starting TLS process."
+  :version "22.1"
   :type 'boolean
   :group 'tls)
 
 (defcustom tls-success "- Handshake was completed"
   "*Regular expression indicating completed TLS handshakes.
 The default is what GNUTLS's \"gnutls-cli\" outputs."
+  :version "22.1"
   :type 'regexp
   :group 'tls)
 
+(defcustom tls-certtool-program (executable-find "certtool")
+  "Name of  GnuTLS certtool.
+Used by `tls-certificate-information'."
+  :version "22.1"
+  :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 service)
   "Open a TLS connection for a service to a host.
 Returns a subprocess-object to represent the connection.
@@ -124,4 +157,5 @@ specifying a port number to connect to."
 
 (provide 'tls)
 
+;;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac
 ;;; tls.el ends here