# HG changeset patch
# User Simon Josefsson <jas@extundo.com>
# Date 1097574045 0
# Node ID 821d95294db576610b6c6d1fafbd2bc12e2569c8
# Parent  9984b3382a7add56125f8d2bfdde35b245bcb2d1
(tls-certtool-program): New variable.
(tls-certificate-information): New function, based on
ssl-certificate-information.

diff -r 9984b3382a7a -r 821d95294db5 lisp/net/tls.el
--- a/lisp/net/tls.el	Tue Oct 12 07:37:37 2004 +0000
+++ b/lisp/net/tls.el	Tue Oct 12 09:40:45 2004 +0000
@@ -1,6 +1,6 @@
 ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
 
-;; Copyright (C) 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1996-1999, 2003, 2004 Free Software Foundation, Inc.
 
 ;; Author: Simon Josefsson <simon@josefsson.org>
 ;; Keywords: comm, tls, gnutls, ssl
@@ -76,6 +76,35 @@
   :type 'regexp
   :group 'tls)
 
+(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 service)
   "Open a TLS connection for a service to a host.
 Returns a subprocess-object to represent the connection.