Mercurial > emacs
changeset 57448:821d95294db5
(tls-certtool-program): New variable.
(tls-certificate-information): New function, based on
ssl-certificate-information.
| author | Simon Josefsson <jas@extundo.com> |
|---|---|
| date | Tue, 12 Oct 2004 09:40:45 +0000 |
| parents | 9984b3382a7a |
| children | 202c408c174b |
| files | lisp/net/tls.el |
| diffstat | 1 files changed, 30 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- 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.