50313
|
1 ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
|
|
2
|
95623
|
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004, 2005, 2006,
|
100908
|
4 ;; 2007, 2008, 2009 Free Software Foundation, Inc.
|
50313
|
5
|
|
6 ;; Author: Simon Josefsson <simon@josefsson.org>
|
|
7 ;; Keywords: comm, tls, gnutls, ssl
|
|
8
|
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
94677
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
|
50313
|
12 ;; it under the terms of the GNU General Public License as published by
|
94677
|
13 ;; the Free Software Foundation, either version 3 of the License, or
|
|
14 ;; (at your option) any later version.
|
50313
|
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
|
94677
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
50313
|
19 ;; GNU General Public License for more details.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
94677
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
50313
|
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
|
95623
|
48 (autoload 'format-spec "format-spec")
|
|
49 (autoload 'format-spec-make "format-spec")
|
50313
|
50
|
|
51 (defgroup tls nil
|
|
52 "Transport Layer Security (TLS) parameters."
|
|
53 :group 'comm)
|
|
54
|
79332
|
55 (defcustom tls-end-of-info
|
85918
|
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
|
85964
|
65 ;; According to GnuTLS v2.1.5 src/cli.c lines 640-650 and 705-715
|
85986
|
66 ;; in `main' the handshake will start after this message. If the
|
85964
|
67 ;; handshake fails, the programs will abort.
|
85918
|
68 "^\\*\\*\\* Starting TLS handshake\n\\)*"
|
|
69 "\\)")
|
79332
|
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
|
50313
|
78 (defcustom tls-program '("gnutls-cli -p %p %h"
|
67643
|
79 "gnutls-cli -p %p %h --protocols ssl3"
|
94209
|
80 "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")
|
50313
|
81 "List of strings containing commands to start TLS stream to a host.
|
|
82 Each entry in the list is tried until a connection is successful.
|
76521
|
83 %h is replaced with server hostname, %p with port to connect to.
|
50313
|
84 The program should read input on stdin and write output to
|
87097
|
85 stdout.
|
|
86
|
|
87 See `tls-checktrust' on how to check trusted root certs.
|
|
88
|
|
89 Also see `tls-success' for what the program should output after
|
|
90 successful negotiation."
|
|
91 :type
|
|
92 '(choice
|
|
93 (list :tag "Choose commands"
|
|
94 :value
|
|
95 ("gnutls-cli -p %p %h"
|
|
96 "gnutls-cli -p %p %h --protocols ssl3"
|
94209
|
97 "openssl s_client -connect %h:%p -no_ssl2 -ign_eof")
|
87097
|
98 (set :inline t
|
|
99 ;; FIXME: add brief `:tag "..."' descriptions.
|
|
100 ;; (repeat :inline t :tag "Other" (string))
|
|
101 ;; See `tls-checktrust':
|
|
102 (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h")
|
|
103 (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3")
|
94209
|
104 (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof")
|
87097
|
105 ;; No trust check:
|
|
106 (const "gnutls-cli -p %p %h")
|
|
107 (const "gnutls-cli -p %p %h --protocols ssl3")
|
94209
|
108 (const "openssl s_client -connect %h:%p -no_ssl2 -ign_eof"))
|
87097
|
109 (repeat :inline t :tag "Other" (string)))
|
|
110 (const :tag "Default list of commands"
|
|
111 ("gnutls-cli -p %p %h"
|
|
112 "gnutls-cli -p %p %h --protocols ssl3"
|
94209
|
113 "openssl s_client -connect %h:%p -no_ssl2 -ign_eof"))
|
87097
|
114 (list :tag "List of commands"
|
|
115 (repeat :tag "Command" (string))))
|
67643
|
116 :version "22.1"
|
50313
|
117 :group 'tls)
|
|
118
|
|
119 (defcustom tls-process-connection-type nil
|
87097
|
120 "Value for `process-connection-type' to use when starting TLS process."
|
59996
|
121 :version "22.1"
|
50313
|
122 :type 'boolean
|
|
123 :group 'tls)
|
|
124
|
67643
|
125 (defcustom tls-success "- Handshake was completed\\|SSL handshake has read "
|
87097
|
126 "Regular expression indicating completed TLS handshakes.
|
67643
|
127 The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
|
|
128 \"openssl s_client\" outputs."
|
59996
|
129 :version "22.1"
|
50313
|
130 :type 'regexp
|
|
131 :group 'tls)
|
|
132
|
87097
|
133 (defcustom tls-checktrust nil
|
|
134 "Indicate if certificates should be checked against trusted root certs.
|
|
135 If this is `ask', the user can decide whether to accept an
|
|
136 untrusted certificate. You may have to adapt `tls-program' in
|
|
137 order to make this feature work properly, i.e., to ensure that
|
|
138 the external program knows about the root certificates you
|
|
139 consider trustworthy, e.g.:
|
|
140
|
|
141 \(setq tls-program
|
|
142 '(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\"
|
|
143 \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\"
|
94209
|
144 \"openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2 -ign_eof\"))"
|
87097
|
145 :type '(choice (const :tag "Always" t)
|
|
146 (const :tag "Never" nil)
|
|
147 (const :tag "Ask" ask))
|
92333
|
148 :version "23.1" ;; No Gnus
|
87097
|
149 :group 'tls)
|
|
150
|
|
151 (defcustom tls-untrusted
|
|
152 "- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)"
|
|
153 "Regular expression indicating failure of TLS certificate verification.
|
|
154 The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
|
|
155 \"openssl s_client\" return in the event of unsuccessful
|
|
156 verification."
|
|
157 :type 'regexp
|
92333
|
158 :version "23.1" ;; No Gnus
|
87097
|
159 :group 'tls)
|
|
160
|
|
161 (defcustom tls-hostmismatch
|
|
162 "# The hostname in the certificate does NOT match"
|
|
163 "Regular expression indicating a host name mismatch in certificate.
|
|
164 When the host name specified in the certificate doesn't match the
|
|
165 name of the host you are connecting to, gnutls-cli issues a
|
|
166 warning to this effect. There is no such feature in openssl. Set
|
|
167 this to nil if you want to ignore host name mismatches."
|
|
168 :type 'regexp
|
92333
|
169 :version "23.1" ;; No Gnus
|
87097
|
170 :group 'tls)
|
|
171
|
57448
|
172 (defcustom tls-certtool-program (executable-find "certtool")
|
|
173 "Name of GnuTLS certtool.
|
|
174 Used by `tls-certificate-information'."
|
59996
|
175 :version "22.1"
|
76125
|
176 :type 'string
|
57448
|
177 :group 'tls)
|
|
178
|
|
179 (defun tls-certificate-information (der)
|
|
180 "Parse X.509 certificate in DER format into an assoc list."
|
|
181 (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
|
|
182 (base64-encode-string der)
|
|
183 "\n-----END CERTIFICATE-----\n"))
|
|
184 (exit-code 0))
|
|
185 (with-current-buffer (get-buffer-create " *certtool*")
|
|
186 (erase-buffer)
|
|
187 (insert certificate)
|
|
188 (setq exit-code (condition-case ()
|
|
189 (call-process-region (point-min) (point-max)
|
|
190 tls-certtool-program
|
|
191 t (list (current-buffer) nil) t
|
|
192 "--certificate-info")
|
|
193 (error -1)))
|
|
194 (if (/= exit-code 0)
|
|
195 nil
|
|
196 (let ((vals nil))
|
|
197 (goto-char (point-min))
|
|
198 (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
|
|
199 (push (cons (match-string 1) (match-string 2)) vals))
|
|
200 (nreverse vals))))))
|
|
201
|
67643
|
202 (defun open-tls-stream (name buffer host port)
|
|
203 "Open a TLS connection for a port to a host.
|
50313
|
204 Returns a subprocess-object to represent the connection.
|
|
205 Input and output work as for subprocesses; `delete-process' closes it.
|
67643
|
206 Args are NAME BUFFER HOST PORT.
|
50313
|
207 NAME is name for process. It is modified if necessary to make it unique.
|
87097
|
208 BUFFER is the buffer (or buffer name) to associate with the process.
|
50313
|
209 Process output goes at end of that buffer, unless you specify
|
|
210 an output stream or filter function to handle the output.
|
|
211 BUFFER may be also nil, meaning that this process is not associated
|
|
212 with any buffer
|
|
213 Third arg is name of the host to connect to, or its IP address.
|
67643
|
214 Fourth arg PORT is an integer specifying a port to connect to."
|
77020
|
215 (let ((cmds tls-program)
|
|
216 (use-temp-buffer (null buffer))
|
|
217 process cmd done)
|
|
218 (if use-temp-buffer
|
96779
2a63efc82880
(open-tls-stream): Make it work with the 2nd argument BUFFER that is a string
Katsumi Yamaoka <yamaoka@jpl.org>
diff
changeset
|
219 (setq buffer (generate-new-buffer " TLS"))
|
2a63efc82880
(open-tls-stream): Make it work with the 2nd argument BUFFER that is a string
Katsumi Yamaoka <yamaoka@jpl.org>
diff
changeset
|
220 ;; BUFFER is a string but does not exist as a buffer object.
|
2a63efc82880
(open-tls-stream): Make it work with the 2nd argument BUFFER that is a string
Katsumi Yamaoka <yamaoka@jpl.org>
diff
changeset
|
221 (unless (and (get-buffer buffer)
|
2a63efc82880
(open-tls-stream): Make it work with the 2nd argument BUFFER that is a string
Katsumi Yamaoka <yamaoka@jpl.org>
diff
changeset
|
222 (buffer-name (get-buffer buffer)))
|
2a63efc82880
(open-tls-stream): Make it work with the 2nd argument BUFFER that is a string
Katsumi Yamaoka <yamaoka@jpl.org>
diff
changeset
|
223 (generate-new-buffer buffer)))
|
85918
|
224 (with-current-buffer buffer
|
79332
|
225 (message "Opening TLS connection to `%s'..." host)
|
85917
|
226 (while (and (not done) (setq cmd (pop cmds)))
|
|
227 (let ((process-connection-type tls-process-connection-type)
|
98453
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
228 (formatted-cmd
|
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
229 (format-spec
|
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
230 cmd
|
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
231 (format-spec-make
|
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
232 ?h host
|
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
233 ?p (if (integerp port)
|
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
234 (int-to-string port)
|
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
235 port))))
|
85917
|
236 response)
|
98453
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
237 (message "Opening TLS connection with `%s'..." formatted-cmd)
|
85917
|
238 (setq process (start-process
|
|
239 name buffer shell-file-name shell-command-switch
|
98453
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
240 formatted-cmd))
|
85917
|
241 (while (and process
|
|
242 (memq (process-status process) '(open run))
|
|
243 (progn
|
|
244 (goto-char (point-min))
|
92414
|
245 (not (setq done (re-search-forward
|
|
246 tls-success nil t)))))
|
85917
|
247 (unless (accept-process-output process 1)
|
|
248 (sit-for 1)))
|
98453
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
diff
changeset
|
249 (message "Opening TLS connection with `%s'...%s" formatted-cmd
|
85917
|
250 (if done "done" "failed"))
|
92414
|
251 (if (not done)
|
|
252 (delete-process process)
|
|
253 ;; advance point to after all informational messages that
|
|
254 ;; `openssl s_client' and `gnutls' print
|
|
255 (let ((start-of-data nil))
|
|
256 (while
|
93084
|
257 (not (setq start-of-data
|
|
258 ;; the string matching `tls-end-of-info'
|
|
259 ;; might come in separate chunks from
|
|
260 ;; `accept-process-output', so start the
|
|
261 ;; search where `tls-success' ended
|
|
262 (save-excursion
|
|
263 (if (re-search-forward tls-end-of-info nil t)
|
|
264 (match-end 0)))))
|
92414
|
265 (accept-process-output process 1))
|
|
266 (if start-of-data
|
|
267 ;; move point to start of client data
|
|
268 (goto-char start-of-data)))
|
93084
|
269 (setq done process))))
|
92414
|
270 (when (and done
|
|
271 (or
|
|
272 (and tls-checktrust
|
|
273 (save-excursion
|
|
274 (goto-char (point-min))
|
|
275 (re-search-forward tls-untrusted nil t))
|
|
276 (or
|
|
277 (and (not (eq tls-checktrust 'ask))
|
|
278 (message "The certificate presented by `%s' is \
|
|
279 NOT trusted." host))
|
|
280 (not (yes-or-no-p
|
|
281 (format "The certificate presented by `%s' is \
|
|
282 NOT trusted. Accept anyway? " host)))))
|
|
283 (and tls-hostmismatch
|
|
284 (save-excursion
|
|
285 (goto-char (point-min))
|
|
286 (re-search-forward tls-hostmismatch nil t))
|
|
287 (not (yes-or-no-p
|
|
288 (format "Host name in certificate doesn't \
|
|
289 match `%s'. Connect anyway? " host))))))
|
|
290 (setq done nil)
|
|
291 (delete-process process)))
|
|
292 (message "Opening TLS connection to `%s'...%s"
|
|
293 host (if done "done" "failed"))
|
77020
|
294 (when use-temp-buffer
|
77021
|
295 (if done (set-process-buffer process nil))
|
77020
|
296 (kill-buffer buffer))
|
50313
|
297 done))
|
|
298
|
|
299 (provide 'tls)
|
|
300
|
93975
|
301 ;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac
|
50313
|
302 ;;; tls.el ends here
|