1 |
;;; tls.el --- TLS/SSL support via wrapper around GnuTLS |
;;; tls.el --- TLS/SSL support via wrapper around GnuTLS |
2 |
|
|
3 |
;; Copyright (C) 2003 Free Software Foundation, Inc. |
;; Copyright (C) 1996-1999, 2003, 2004 Free Software Foundation, Inc. |
4 |
|
|
5 |
;; Author: Simon Josefsson <simon@josefsson.org> |
;; Author: Simon Josefsson <simon@josefsson.org> |
6 |
;; Keywords: comm, tls, gnutls, ssl |
;; Keywords: comm, tls, gnutls, ssl |
76 |
:type 'regexp |
:type 'regexp |
77 |
:group 'tls) |
:group 'tls) |
78 |
|
|
79 |
|
(defcustom tls-certtool-program (executable-find "certtool") |
80 |
|
"Name of GnuTLS certtool. |
81 |
|
Used by `tls-certificate-information'." |
82 |
|
:type '(repeat string) |
83 |
|
:group 'tls) |
84 |
|
|
85 |
|
(defun tls-certificate-information (der) |
86 |
|
"Parse X.509 certificate in DER format into an assoc list." |
87 |
|
(let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" |
88 |
|
(base64-encode-string der) |
89 |
|
"\n-----END CERTIFICATE-----\n")) |
90 |
|
(exit-code 0)) |
91 |
|
(with-current-buffer (get-buffer-create " *certtool*") |
92 |
|
(erase-buffer) |
93 |
|
(insert certificate) |
94 |
|
(setq exit-code (condition-case () |
95 |
|
(call-process-region (point-min) (point-max) |
96 |
|
tls-certtool-program |
97 |
|
t (list (current-buffer) nil) t |
98 |
|
"--certificate-info") |
99 |
|
(error -1))) |
100 |
|
(if (/= exit-code 0) |
101 |
|
nil |
102 |
|
(let ((vals nil)) |
103 |
|
(goto-char (point-min)) |
104 |
|
(while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t) |
105 |
|
(push (cons (match-string 1) (match-string 2)) vals)) |
106 |
|
(nreverse vals)))))) |
107 |
|
|
108 |
(defun open-tls-stream (name buffer host service) |
(defun open-tls-stream (name buffer host service) |
109 |
"Open a TLS connection for a service to a host. |
"Open a TLS connection for a service to a host. |
110 |
Returns a subprocess-object to represent the connection. |
Returns a subprocess-object to represent the connection. |