Mercurial > emacs
annotate lisp/net/tls.el @ 91204:53108e6cea98
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-294
author | Miles Bader <miles@gnu.org> |
---|---|
date | Thu, 06 Dec 2007 09:51:45 +0000 |
parents | 880960b70474 781256628613 |
children | 606f2d163a64 |
rev | line source |
---|---|
50313 | 1 ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS |
2 | |
64701
34bd8e434dd7
Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64085
diff
changeset
|
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004, |
75347 | 4 ;; 2005, 2006, 2007 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 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
78230
84cf1e2214c5
Switch license to GPLv3 or later.
Glenn Morris <rgm@gnu.org>
parents:
77021
diff
changeset
|
13 ;; the Free Software Foundation; either version 3, or (at your option) |
50313 | 14 ;; any later version. |
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 | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
64085 | 23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 ;; Boston, MA 02110-1301, USA. | |
50313 | 25 |
26 ;;; Commentary: | |
27 | |
28 ;; This package implements a simple wrapper around "gnutls-cli" to | |
29 ;; make Emacs support TLS/SSL. | |
30 ;; | |
31 ;; Usage is the same as `open-network-stream', i.e.: | |
32 ;; | |
33 ;; (setq tmp (open-tls-stream "test" (current-buffer) "news.mozilla.org" 563)) | |
34 ;; ... | |
35 ;; #<process test> | |
36 ;; (process-send-string tmp "mode reader\n") | |
37 ;; 200 secnews.netscape.com Netscape-Collabra/3.52 03615 NNRP ready ... | |
38 ;; nil | |
39 ;; (process-send-string tmp "quit\n") | |
40 ;; 205 | |
41 ;; nil | |
42 | |
43 ;; To use this package as a replacement for ssl.el by William M. Perry | |
44 ;; <wmperry@cs.indiana.edu>, you need to evaluate the following: | |
45 ;; | |
46 ;; (defalias 'open-ssl-stream 'open-tls-stream) | |
47 | |
48 ;;; Code: | |
49 | |
50 (eval-and-compile | |
51 (autoload 'format-spec "format-spec") | |
52 (autoload 'format-spec-make "format-spec")) | |
53 | |
54 (defgroup tls nil | |
55 "Transport Layer Security (TLS) parameters." | |
56 :group 'comm) | |
57 | |
79332
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
58 (defcustom tls-end-of-info |
85918
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
59 (concat |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
60 "\\(" |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
61 ;; `openssl s_client' regexp. See ssl/ssl_txt.c lines 219-220. |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
62 ;; According to apps/s_client.c line 1515 `---' is always the last |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
63 ;; line that is printed by s_client before the real data. |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
64 "^ Verify return code: .+\n---\n\\|" |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
65 ;; `gnutls' regexp. See src/cli.c lines 721-. |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
66 "^- Simple Client Mode:\n" |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
67 "\\(\n\\|" ; ignore blank lines |
85964 | 68 ;; According to GnuTLS v2.1.5 src/cli.c lines 640-650 and 705-715 |
85986 | 69 ;; in `main' the handshake will start after this message. If the |
85964 | 70 ;; handshake fails, the programs will abort. |
85918
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
71 "^\\*\\*\\* Starting TLS handshake\n\\)*" |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
72 "\\)") |
79332
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
73 "Regexp matching end of TLS client informational messages. |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
74 Client data stream begins after the last character matched by |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
75 this. The default matches `openssl s_client' (version 0.9.8c) |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
76 and `gnutls-cli' (version 2.0.1) output." |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
77 :version "22.2" |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
78 :type 'regexp |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
79 :group 'tls) |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
80 |
50313 | 81 (defcustom tls-program '("gnutls-cli -p %p %h" |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
82 "gnutls-cli -p %p %h --protocols ssl3" |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
83 "openssl s_client -connect %h:%p -no_ssl2") |
50313 | 84 "List of strings containing commands to start TLS stream to a host. |
85 Each entry in the list is tried until a connection is successful. | |
76521
dc6ada4b3839
(tls-program): Doc fix.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
76125
diff
changeset
|
86 %h is replaced with server hostname, %p with port to connect to. |
50313 | 87 The program should read input on stdin and write output to |
87097 | 88 stdout. |
89 | |
90 See `tls-checktrust' on how to check trusted root certs. | |
91 | |
92 Also see `tls-success' for what the program should output after | |
93 successful negotiation." | |
94 :type | |
95 '(choice | |
96 (list :tag "Choose commands" | |
97 :value | |
98 ("gnutls-cli -p %p %h" | |
99 "gnutls-cli -p %p %h --protocols ssl3" | |
100 "openssl s_client -connect %h:%p -no_ssl2") | |
101 (set :inline t | |
102 ;; FIXME: add brief `:tag "..."' descriptions. | |
103 ;; (repeat :inline t :tag "Other" (string)) | |
104 ;; See `tls-checktrust': | |
105 (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h") | |
106 (const "gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3") | |
107 (const "openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2") | |
108 ;; No trust check: | |
109 (const "gnutls-cli -p %p %h") | |
110 (const "gnutls-cli -p %p %h --protocols ssl3") | |
111 (const "openssl s_client -connect %h:%p -no_ssl2")) | |
112 (repeat :inline t :tag "Other" (string))) | |
113 (const :tag "Default list of commands" | |
114 ("gnutls-cli -p %p %h" | |
115 "gnutls-cli -p %p %h --protocols ssl3" | |
116 "openssl s_client -connect %h:%p -no_ssl2")) | |
117 (list :tag "List of commands" | |
118 (repeat :tag "Command" (string)))) | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
119 :version "22.1" |
50313 | 120 :group 'tls) |
121 | |
122 (defcustom tls-process-connection-type nil | |
87097 | 123 "Value for `process-connection-type' to use when starting TLS process." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
124 :version "22.1" |
50313 | 125 :type 'boolean |
126 :group 'tls) | |
127 | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
128 (defcustom tls-success "- Handshake was completed\\|SSL handshake has read " |
87097 | 129 "Regular expression indicating completed TLS handshakes. |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
130 The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
131 \"openssl s_client\" outputs." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
132 :version "22.1" |
50313 | 133 :type 'regexp |
134 :group 'tls) | |
135 | |
87097 | 136 (defcustom tls-checktrust nil |
137 "Indicate if certificates should be checked against trusted root certs. | |
138 If this is `ask', the user can decide whether to accept an | |
139 untrusted certificate. You may have to adapt `tls-program' in | |
140 order to make this feature work properly, i.e., to ensure that | |
141 the external program knows about the root certificates you | |
142 consider trustworthy, e.g.: | |
143 | |
144 \(setq tls-program | |
145 '(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\" | |
146 \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h --protocols ssl3\" | |
147 \"openssl s_client -connect %h:%p -CAfile /etc/ssl/certs/ca-certificates.crt -no_ssl2\"))" | |
148 :type '(choice (const :tag "Always" t) | |
149 (const :tag "Never" nil) | |
150 (const :tag "Ask" ask)) | |
151 :version "23.0" ;; No Gnus | |
152 :group 'tls) | |
153 | |
154 (defcustom tls-untrusted | |
155 "- Peer's certificate is NOT trusted\\|Verify return code: \\([^0] \\|.[^ ]\\)" | |
156 "Regular expression indicating failure of TLS certificate verification. | |
157 The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's | |
158 \"openssl s_client\" return in the event of unsuccessful | |
159 verification." | |
160 :type 'regexp | |
161 :version "23.0" ;; No Gnus | |
162 :group 'tls) | |
163 | |
164 (defcustom tls-hostmismatch | |
165 "# The hostname in the certificate does NOT match" | |
166 "Regular expression indicating a host name mismatch in certificate. | |
167 When the host name specified in the certificate doesn't match the | |
168 name of the host you are connecting to, gnutls-cli issues a | |
169 warning to this effect. There is no such feature in openssl. Set | |
170 this to nil if you want to ignore host name mismatches." | |
171 :type 'regexp | |
172 :version "23.0" ;; No Gnus | |
173 :group 'tls) | |
174 | |
57448
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
175 (defcustom tls-certtool-program (executable-find "certtool") |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
176 "Name of GnuTLS certtool. |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
177 Used by `tls-certificate-information'." |
59996
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
178 :version "22.1" |
76125
428a3ee993db
(tls-certtool-program): Fix custom type.
John Paul Wallington <jpw@pobox.com>
parents:
75347
diff
changeset
|
179 :type 'string |
57448
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
180 :group 'tls) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
181 |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
182 (defun tls-certificate-information (der) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
183 "Parse X.509 certificate in DER format into an assoc list." |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
184 (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
185 (base64-encode-string der) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
186 "\n-----END CERTIFICATE-----\n")) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
187 (exit-code 0)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
188 (with-current-buffer (get-buffer-create " *certtool*") |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
189 (erase-buffer) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
190 (insert certificate) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
191 (setq exit-code (condition-case () |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
192 (call-process-region (point-min) (point-max) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
193 tls-certtool-program |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
194 t (list (current-buffer) nil) t |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
195 "--certificate-info") |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
196 (error -1))) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
197 (if (/= exit-code 0) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
198 nil |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
199 (let ((vals nil)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
200 (goto-char (point-min)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
201 (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
202 (push (cons (match-string 1) (match-string 2)) vals)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
203 (nreverse vals)))))) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
204 |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
205 (defun open-tls-stream (name buffer host port) |
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
206 "Open a TLS connection for a port to a host. |
50313 | 207 Returns a subprocess-object to represent the connection. |
208 Input and output work as for subprocesses; `delete-process' closes it. | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
209 Args are NAME BUFFER HOST PORT. |
50313 | 210 NAME is name for process. It is modified if necessary to make it unique. |
87097 | 211 BUFFER is the buffer (or buffer name) to associate with the process. |
50313 | 212 Process output goes at end of that buffer, unless you specify |
213 an output stream or filter function to handle the output. | |
214 BUFFER may be also nil, meaning that this process is not associated | |
215 with any buffer | |
216 Third arg is name of the host to connect to, or its IP address. | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
217 Fourth arg PORT is an integer specifying a port to connect to." |
77020 | 218 (let ((cmds tls-program) |
219 (use-temp-buffer (null buffer)) | |
220 process cmd done) | |
221 (if use-temp-buffer | |
222 (setq buffer (generate-new-buffer " TLS"))) | |
85918
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
223 (with-current-buffer buffer |
79332
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
224 (message "Opening TLS connection to `%s'..." host) |
85917
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
225 (while (and (not done) (setq cmd (pop cmds))) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
226 (message "Opening TLS connection with `%s'..." cmd) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
227 (let ((process-connection-type tls-process-connection-type) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
228 response) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
229 (setq process (start-process |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
230 name buffer shell-file-name shell-command-switch |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
231 (format-spec |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
232 cmd |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
233 (format-spec-make |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
234 ?h host |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
235 ?p (if (integerp port) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
236 (int-to-string port) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
237 port))))) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
238 (while (and process |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
239 (memq (process-status process) '(open run)) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
240 (progn |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
241 (goto-char (point-min)) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
242 (not (setq done (re-search-forward tls-success nil t))))) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
243 (unless (accept-process-output process 1) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
244 (sit-for 1))) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
245 (message "Opening TLS connection with `%s'...%s" cmd |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
246 (if done "done" "failed")) |
87097 | 247 (if done |
248 (setq done process) | |
249 (delete-process process)))) | |
250 (when done | |
251 (save-excursion | |
252 (set-buffer buffer) | |
253 (when | |
254 (or | |
255 (and tls-checktrust | |
256 (progn | |
257 (goto-char (point-min)) | |
258 (re-search-forward tls-untrusted nil t)) | |
259 (or | |
260 (and (not (eq tls-checktrust 'ask)) | |
261 (message "The certificate presented by `%s' is NOT trusted." host)) | |
262 (not (yes-or-no-p | |
263 (format "The certificate presented by `%s' is NOT trusted. Accept anyway? " host))))) | |
264 (and tls-hostmismatch | |
265 (progn | |
266 (goto-char (point-min)) | |
267 (re-search-forward tls-hostmismatch nil t)) | |
268 (not (yes-or-no-p | |
269 (format "Host name in certificate doesn't match `%s'. Connect anyway? " host))))) | |
270 (setq done nil) | |
271 (delete-process process)))) | |
85917
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
272 (message "Opening TLS connection to `%s'...%s" |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
273 host (if done "done" "failed"))) |
77020 | 274 (when use-temp-buffer |
77021 | 275 (if done (set-process-buffer process nil)) |
77020 | 276 (kill-buffer buffer)) |
50313 | 277 done)) |
278 | |
279 (provide 'tls) | |
280 | |
52401 | 281 ;;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac |
50313 | 282 ;;; tls.el ends here |