From 18965008d19ace53d4adea3eec5ea1168a7e3942 Mon Sep 17 00:00:00 2001 From: Simon Josefsson Date: Tue, 12 Oct 2004 09:40:45 +0000 Subject: [PATCH] (tls-certtool-program): New variable. (tls-certificate-information): New function, based on ssl-certificate-information. --- lisp/net/tls.el | 31 ++++++++++++++++++++++++++++++- 1 file changed, 30 insertions(+), 1 deletion(-) diff --git a/lisp/net/tls.el b/lisp/net/tls.el index d7c8a47a2c0..5f57c084f9b 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -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 ;; Keywords: comm, tls, gnutls, ssl @@ -76,6 +76,35 @@ The default is what GNUTLS's \"gnutls-cli\" outputs." :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. -- 2.39.5