Commit | Line | Data |
---|---|---|
01b2d1dd SJ |
1 | ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS |
2 | ||
3c5fa30a | 3 | ;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004, 2005, 2006, |
114f9c96 | 4 | ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
01b2d1dd SJ |
5 | |
6 | ;; Author: Simon Josefsson <simon@josefsson.org> | |
7 | ;; Keywords: comm, tls, gnutls, ssl | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
874a927a | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
01b2d1dd | 12 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
01b2d1dd SJ |
15 | |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
874a927a | 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
01b2d1dd SJ |
19 | ;; GNU General Public License for more details. |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
874a927a | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
01b2d1dd SJ |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; This package implements a simple wrapper around "gnutls-cli" to | |
27 | ;; make Emacs support TLS/SSL. | |
28 | ;; | |
29 | ;; Usage is the same as `open-network-stream', i.e.: | |
30 | ;; | |
31 | ;; (setq tmp (open-tls-stream "test" (current-buffer) "news.mozilla.org" 563)) | |
32 | ;; ... | |
33 | ;; #<process test> | |
34 | ;; (process-send-string tmp "mode reader\n") | |
35 | ;; 200 secnews.netscape.com Netscape-Collabra/3.52 03615 NNRP ready ... | |
36 | ;; nil | |
37 | ;; (process-send-string tmp "quit\n") | |
38 | ;; 205 | |
39 | ;; nil | |
40 | ||
41 | ;; To use this package as a replacement for ssl.el by William M. Perry | |
42 | ;; <wmperry@cs.indiana.edu>, you need to evaluate the following: | |
43 | ;; | |
44 | ;; (defalias 'open-ssl-stream 'open-tls-stream) | |
45 | ||
46 | ;;; Code: | |
47 | ||
3c5fa30a GM |
48 | (autoload 'format-spec "format-spec") |
49 | (autoload 'format-spec-make "format-spec") | |
01b2d1dd SJ |
50 | |
51 | (defgroup tls nil | |
52 | "Transport Layer Security (TLS) parameters." | |
53 | :group 'comm) | |
54 | ||
59c95dc2 | 55 | (defcustom tls-end-of-info |
cd6db47c GM |
56 | (concat |
57 | "\\(" | |
58 | ;; `openssl s_client' regexp. See ssl/ssl_txt.c lines 219-220. | |
59 | ;; According to apps/s_client.c line 1515 `---' is always the last | |
60 | ;; line that is printed by s_client before the real data. | |
61 | "^ Verify return code: .+\n---\n\\|" | |
62 | ;; `gnutls' regexp. See src/cli.c lines 721-. | |
63 | "^- Simple Client Mode:\n" | |
64 | "\\(\n\\|" ; ignore blank lines | |
2cddada0 | 65 | ;; According to GnuTLS v2.1.5 src/cli.c lines 640-650 and 705-715 |
7b63c073 | 66 | ;; in `main' the handshake will start after this message. If the |
2cddada0 | 67 | ;; handshake fails, the programs will abort. |
cd6db47c GM |
68 | "^\\*\\*\\* Starting TLS handshake\n\\)*" |
69 | "\\)") | |
59c95dc2 GM |
70 | "Regexp matching end of TLS client informational messages. |
71 | Client data stream begins after the last character matched by | |
72 | this. The default matches `openssl s_client' (version 0.9.8c) | |
73 | and `gnutls-cli' (version 2.0.1) output." | |
74 | :version "22.2" | |
75 | :type 'regexp | |
76 | :group 'tls) | |
77 | ||
6b958814 | 78 | (defvar tls-starttls-switches |
aecb42aa | 79 | '(("openssl" "-starttls imap")) |
6b958814 G |
80 | "Alist of programs and the switches necessary to get starttls behaviour.") |
81 | ||
aecb42aa LMI |
82 | (defcustom tls-program '("gnutls-cli --insecure -p %p %h" |
83 | "gnutls-cli --insecure -p %p %h --protocols ssl3" | |
6b958814 | 84 | "openssl s_client %s -connect %h:%p -no_ssl2 -ign_eof") |
01b2d1dd SJ |
85 | "List of strings containing commands to start TLS stream to a host. |
86 | Each entry in the list is tried until a connection is successful. | |
4a3c7686 | 87 | %h is replaced with server hostname, %p with port to connect to. |
01b2d1dd | 88 | The program should read input on stdin and write output to |
b890d447 MB |
89 | stdout. |
90 | ||
91 | See `tls-checktrust' on how to check trusted root certs. | |
92 | ||
93 | Also see `tls-success' for what the program should output after | |
94 | successful negotiation." | |
95 | :type | |
96 | '(choice | |
97 | (list :tag "Choose commands" | |
98 | :value | |
99 | ("gnutls-cli -p %p %h" | |
100 | "gnutls-cli -p %p %h --protocols ssl3" | |
d55fe5bb | 101 | "openssl s_client -connect %h:%p -no_ssl2 -ign_eof") |
b890d447 MB |
102 | (set :inline t |
103 | ;; FIXME: add brief `:tag "..."' descriptions. | |
104 | ;; (repeat :inline t :tag "Other" (string)) | |
105 | ;; See `tls-checktrust': | |
106 | (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h") | |
107 | (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3") | |
d55fe5bb | 108 | (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof") |
b890d447 MB |
109 | ;; No trust check: |
110 | (const "gnutls-cli -p %p %h") | |
111 | (const "gnutls-cli -p %p %h --protocols ssl3") | |
d55fe5bb | 112 | (const "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) |
b890d447 MB |
113 | (repeat :inline t :tag "Other" (string))) |
114 | (const :tag "Default list of commands" | |
115 | ("gnutls-cli -p %p %h" | |
116 | "gnutls-cli -p %p %h --protocols ssl3" | |
d55fe5bb | 117 | "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")) |
b890d447 MB |
118 | (list :tag "List of commands" |
119 | (repeat :tag "Command" (string)))) | |
3031d8b0 | 120 | :version "22.1" |
01b2d1dd SJ |
121 | :group 'tls) |
122 | ||
123 | (defcustom tls-process-connection-type nil | |
b890d447 | 124 | "Value for `process-connection-type' to use when starting TLS process." |
bf247b6e | 125 | :version "22.1" |
01b2d1dd SJ |
126 | :type 'boolean |
127 | :group 'tls) | |
128 | ||
3031d8b0 | 129 | (defcustom tls-success "- Handshake was completed\\|SSL handshake has read " |
b890d447 | 130 | "Regular expression indicating completed TLS handshakes. |
3031d8b0 MB |
131 | The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's |
132 | \"openssl s_client\" outputs." | |
bf247b6e | 133 | :version "22.1" |
01b2d1dd SJ |
134 | :type 'regexp |
135 | :group 'tls) | |
136 | ||
b890d447 MB |
137 | (defcustom tls-checktrust nil |
138 | "Indicate if certificates should be checked against trusted root certs. | |
139 | If this is `ask', the user can decide whether to accept an | |
140 | untrusted certificate. You may have to adapt `tls-program' in | |
141 | order to make this feature work properly, i.e., to ensure that | |
142 | the external program knows about the root certificates you | |
143 | consider trustworthy, e.g.: | |
144 | ||
145 | \(setq tls-program | |
146 | '(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\" | |
147 | \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\" | |
d55fe5bb | 148 | \"openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof\"))" |
b890d447 MB |
149 | :type '(choice (const :tag "Always" t) |
150 | (const :tag "Never" nil) | |
151 | (const :tag "Ask" ask)) | |
dd22fbf6 | 152 | :version "23.1" ;; No Gnus |
b890d447 MB |
153 | :group 'tls) |
154 | ||
155 | (defcustom tls-untrusted | |
156 | "- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)" | |
157 | "Regular expression indicating failure of TLS certificate verification. | |
158 | The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's | |
159 | \"openssl s_client\" return in the event of unsuccessful | |
160 | verification." | |
161 | :type 'regexp | |
dd22fbf6 | 162 | :version "23.1" ;; No Gnus |
b890d447 MB |
163 | :group 'tls) |
164 | ||
165 | (defcustom tls-hostmismatch | |
166 | "# The hostname in the certificate does NOT match" | |
167 | "Regular expression indicating a host name mismatch in certificate. | |
168 | When the host name specified in the certificate doesn't match the | |
169 | name of the host you are connecting to, gnutls-cli issues a | |
170 | warning to this effect. There is no such feature in openssl. Set | |
171 | this to nil if you want to ignore host name mismatches." | |
172 | :type 'regexp | |
dd22fbf6 | 173 | :version "23.1" ;; No Gnus |
b890d447 MB |
174 | :group 'tls) |
175 | ||
18965008 SJ |
176 | (defcustom tls-certtool-program (executable-find "certtool") |
177 | "Name of GnuTLS certtool. | |
178 | Used by `tls-certificate-information'." | |
bf247b6e | 179 | :version "22.1" |
9bdd0e16 | 180 | :type 'string |
18965008 SJ |
181 | :group 'tls) |
182 | ||
183 | (defun tls-certificate-information (der) | |
184 | "Parse X.509 certificate in DER format into an assoc list." | |
185 | (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" | |
186 | (base64-encode-string der) | |
187 | "\n-----END CERTIFICATE-----\n")) | |
188 | (exit-code 0)) | |
189 | (with-current-buffer (get-buffer-create " *certtool*") | |
190 | (erase-buffer) | |
191 | (insert certificate) | |
192 | (setq exit-code (condition-case () | |
193 | (call-process-region (point-min) (point-max) | |
194 | tls-certtool-program | |
195 | t (list (current-buffer) nil) t | |
196 | "--certificate-info") | |
197 | (error -1))) | |
198 | (if (/= exit-code 0) | |
199 | nil | |
200 | (let ((vals nil)) | |
201 | (goto-char (point-min)) | |
202 | (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t) | |
203 | (push (cons (match-string 1) (match-string 2)) vals)) | |
204 | (nreverse vals)))))) | |
205 | ||
6b958814 | 206 | (defun open-tls-stream (name buffer host port &optional starttlsp) |
3031d8b0 | 207 | "Open a TLS connection for a port to a host. |
01b2d1dd SJ |
208 | Returns a subprocess-object to represent the connection. |
209 | Input and output work as for subprocesses; `delete-process' closes it. | |
3031d8b0 | 210 | Args are NAME BUFFER HOST PORT. |
01b2d1dd | 211 | NAME is name for process. It is modified if necessary to make it unique. |
b890d447 | 212 | BUFFER is the buffer (or buffer name) to associate with the process. |
01b2d1dd SJ |
213 | Process output goes at end of that buffer, unless you specify |
214 | an output stream or filter function to handle the output. | |
215 | BUFFER may be also nil, meaning that this process is not associated | |
216 | with any buffer | |
217 | Third arg is name of the host to connect to, or its IP address. | |
3031d8b0 | 218 | Fourth arg PORT is an integer specifying a port to connect to." |
0ad32c54 CY |
219 | (let ((cmds tls-program) |
220 | (use-temp-buffer (null buffer)) | |
221 | process cmd done) | |
222 | (if use-temp-buffer | |
3c2dbd94 KY |
223 | (setq buffer (generate-new-buffer " TLS")) |
224 | ;; BUFFER is a string but does not exist as a buffer object. | |
225 | (unless (and (get-buffer buffer) | |
226 | (buffer-name (get-buffer buffer))) | |
227 | (generate-new-buffer buffer))) | |
cd6db47c | 228 | (with-current-buffer buffer |
59c95dc2 GM |
229 | (message "Opening TLS connection to `%s'..." host) |
230 | (while (and (not done) (setq cmd (pop cmds))) | |
59c95dc2 | 231 | (let ((process-connection-type tls-process-connection-type) |
8ed4a859 MH |
232 | (formatted-cmd |
233 | (format-spec | |
234 | cmd | |
235 | (format-spec-make | |
6b958814 G |
236 | ?s (if starttlsp |
237 | (tls-find-starttls-argument cmd) | |
238 | "") | |
8ed4a859 MH |
239 | ?h host |
240 | ?p (if (integerp port) | |
241 | (int-to-string port) | |
242 | port)))) | |
59c95dc2 | 243 | response) |
8ed4a859 | 244 | (message "Opening TLS connection with `%s'..." formatted-cmd) |
59c95dc2 GM |
245 | (setq process (start-process |
246 | name buffer shell-file-name shell-command-switch | |
8ed4a859 | 247 | formatted-cmd)) |
2696d88f G |
248 | (funcall (if (fboundp 'set-process-query-on-exit-flag) |
249 | 'set-process-query-on-exit-flag | |
250 | 'process-kill-without-query) | |
251 | process nil) | |
59c95dc2 GM |
252 | (while (and process |
253 | (memq (process-status process) '(open run)) | |
254 | (progn | |
255 | (goto-char (point-min)) | |
0a4d4654 GM |
256 | (not (setq done (re-search-forward |
257 | tls-success nil t))))) | |
59c95dc2 GM |
258 | (unless (accept-process-output process 1) |
259 | (sit-for 1))) | |
8ed4a859 | 260 | (message "Opening TLS connection with `%s'...%s" formatted-cmd |
59c95dc2 | 261 | (if done "done" "failed")) |
0a4d4654 GM |
262 | (if (not done) |
263 | (delete-process process) | |
264 | ;; advance point to after all informational messages that | |
265 | ;; `openssl s_client' and `gnutls' print | |
266 | (let ((start-of-data nil)) | |
267 | (while | |
ea666a77 RS |
268 | (not (setq start-of-data |
269 | ;; the string matching `tls-end-of-info' | |
270 | ;; might come in separate chunks from | |
271 | ;; `accept-process-output', so start the | |
272 | ;; search where `tls-success' ended | |
273 | (save-excursion | |
274 | (if (re-search-forward tls-end-of-info nil t) | |
275 | (match-end 0))))) | |
0a4d4654 GM |
276 | (accept-process-output process 1)) |
277 | (if start-of-data | |
278 | ;; move point to start of client data | |
279 | (goto-char start-of-data))) | |
ea666a77 | 280 | (setq done process)))) |
0a4d4654 GM |
281 | (when (and done |
282 | (or | |
283 | (and tls-checktrust | |
284 | (save-excursion | |
285 | (goto-char (point-min)) | |
286 | (re-search-forward tls-untrusted nil t)) | |
287 | (or | |
288 | (and (not (eq tls-checktrust 'ask)) | |
289 | (message "The certificate presented by `%s' is \ | |
290 | NOT trusted." host)) | |
291 | (not (yes-or-no-p | |
292 | (format "The certificate presented by `%s' is \ | |
293 | NOT trusted. Accept anyway? " host))))) | |
294 | (and tls-hostmismatch | |
295 | (save-excursion | |
296 | (goto-char (point-min)) | |
297 | (re-search-forward tls-hostmismatch nil t)) | |
298 | (not (yes-or-no-p | |
299 | (format "Host name in certificate doesn't \ | |
300 | match `%s'. Connect anyway? " host)))))) | |
301 | (setq done nil) | |
302 | (delete-process process))) | |
303 | (message "Opening TLS connection to `%s'...%s" | |
304 | host (if done "done" "failed")) | |
0ad32c54 | 305 | (when use-temp-buffer |
b7131d2f | 306 | (if done (set-process-buffer process nil)) |
0ad32c54 | 307 | (kill-buffer buffer)) |
01b2d1dd SJ |
308 | done)) |
309 | ||
6b958814 G |
310 | (defun tls-find-starttls-argument (command) |
311 | (let ((command (car (split-string command)))) | |
312 | (or (cadr (assoc command tls-starttls-switches)) | |
313 | ""))) | |
314 | ||
01b2d1dd SJ |
315 | (provide 'tls) |
316 | ||
317 | ;;; tls.el ends here |