Mercurial > emacs
annotate lisp/net/tls.el @ 99150:cdad15e238e0
Add arch tagline
author | Miles Bader <miles@gnu.org> |
---|---|
date | Mon, 27 Oct 2008 02:05:42 +0000 |
parents | aa00c07b3f62 |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
50313 | 1 ;;; tls.el --- TLS/SSL support via wrapper around GnuTLS |
2 | |
95623
5358d3f9137d
Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents:
94677
diff
changeset
|
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2003, 2004, 2005, 2006, |
5358d3f9137d
Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents:
94677
diff
changeset
|
4 ;; 2007, 2008 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
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94209
diff
changeset
|
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
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94209
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94209
diff
changeset
|
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
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94209
diff
changeset
|
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
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94209
diff
changeset
|
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
5358d3f9137d
Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents:
94677
diff
changeset
|
48 (autoload 'format-spec "format-spec") |
5358d3f9137d
Remove unnecessary eval-and-compile.
Glenn Morris <rgm@gnu.org>
parents:
94677
diff
changeset
|
49 (autoload 'format-spec-make "format-spec") |
50313 | 50 |
51 (defgroup tls nil | |
52 "Transport Layer Security (TLS) parameters." | |
53 :group 'comm) | |
54 | |
79332
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
55 (defcustom tls-end-of-info |
85918
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
56 (concat |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
57 "\\(" |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
58 ;; `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
|
59 ;; 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
|
60 ;; 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
|
61 "^ Verify return code: .+\n---\n\\|" |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
62 ;; `gnutls' regexp. See src/cli.c lines 721-. |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
63 "^- Simple Client Mode:\n" |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
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
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
68 "^\\*\\*\\* Starting TLS handshake\n\\)*" |
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
69 "\\)") |
79332
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
70 "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
|
71 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
|
72 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
|
73 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
|
74 :version "22.2" |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
75 :type 'regexp |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
76 :group 'tls) |
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
77 |
50313 | 78 (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
|
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
dc6ada4b3839
(tls-program): Doc fix.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
76125
diff
changeset
|
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
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
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
aac0a33f5772
Change release version from 21.4 to 22.1 throughout.
Kim F. Storm <storm@cua.dk>
parents:
57856
diff
changeset
|
121 :version "22.1" |
50313 | 122 :type 'boolean |
123 :group 'tls) | |
124 | |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
125 (defcustom tls-success "- Handshake was completed\\|SSL handshake has read " |
87097 | 126 "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
|
127 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
|
128 \"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
|
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
592894a86ca5
(tls-checktrust, tls-untrusted, tls-hostmismatch):
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
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
592894a86ca5
(tls-checktrust, tls-untrusted, tls-hostmismatch):
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
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
592894a86ca5
(tls-checktrust, tls-untrusted, tls-hostmismatch):
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
169 :version "23.1" ;; No Gnus |
87097 | 170 :group 'tls) |
171 | |
57448
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
172 (defcustom tls-certtool-program (executable-find "certtool") |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
173 "Name of GnuTLS certtool. |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
174 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
|
175 :version "22.1" |
76125
428a3ee993db
(tls-certtool-program): Fix custom type.
John Paul Wallington <jpw@pobox.com>
parents:
75347
diff
changeset
|
176 :type 'string |
57448
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
177 :group 'tls) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
178 |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
179 (defun tls-certificate-information (der) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
180 "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
|
181 (let ((certificate (concat "-----BEGIN CERTIFICATE-----\n" |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
182 (base64-encode-string der) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
183 "\n-----END CERTIFICATE-----\n")) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
184 (exit-code 0)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
185 (with-current-buffer (get-buffer-create " *certtool*") |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
186 (erase-buffer) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
187 (insert certificate) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
188 (setq exit-code (condition-case () |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
189 (call-process-region (point-min) (point-max) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
190 tls-certtool-program |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
191 t (list (current-buffer) nil) t |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
192 "--certificate-info") |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
193 (error -1))) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
194 (if (/= exit-code 0) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
195 nil |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
196 (let ((vals nil)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
197 (goto-char (point-min)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
198 (while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
199 (push (cons (match-string 1) (match-string 2)) vals)) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
200 (nreverse vals)))))) |
821d95294db5
(tls-certtool-program): New variable.
Simon Josefsson <jas@extundo.com>
parents:
56927
diff
changeset
|
201 |
67643
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
202 (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
|
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
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
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
1c477099d3ac
Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-676
Miles Bader <miles@gnu.org>
parents:
64701
diff
changeset
|
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>
parents:
95623
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>
parents:
95623
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>
parents:
95623
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>
parents:
95623
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>
parents:
95623
diff
changeset
|
223 (generate-new-buffer buffer))) |
85918
8f26c84d222f
Don't require rx when compiling.
Glenn Morris <rgm@gnu.org>
parents:
85917
diff
changeset
|
224 (with-current-buffer buffer |
79332
3b71ad7b480c
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
225 (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
|
226 (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
|
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>
parents:
96779
diff
changeset
|
228 (formatted-cmd |
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
parents:
96779
diff
changeset
|
229 (format-spec |
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
parents:
96779
diff
changeset
|
230 cmd |
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
parents:
96779
diff
changeset
|
231 (format-spec-make |
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
parents:
96779
diff
changeset
|
232 ?h host |
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
parents:
96779
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>
parents:
96779
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>
parents:
96779
diff
changeset
|
235 port)))) |
85917
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
236 response) |
98453
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
parents:
96779
diff
changeset
|
237 (message "Opening TLS connection with `%s'..." formatted-cmd) |
85917
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
238 (setq process (start-process |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
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>
parents:
96779
diff
changeset
|
240 formatted-cmd)) |
85917
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
241 (while (and process |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
242 (memq (process-status process) '(open run)) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
243 (progn |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
244 (goto-char (point-min)) |
92414
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
245 (not (setq done (re-search-forward |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
246 tls-success nil t))))) |
85917
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
247 (unless (accept-process-output process 1) |
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
248 (sit-for 1))) |
98453
aa00c07b3f62
net/tls.el (open-tls-stream): Show the actual command being executed,
Magnus Henoch <mange@freemail.hu>
parents:
96779
diff
changeset
|
249 (message "Opening TLS connection with `%s'...%s" formatted-cmd |
85917
97bb0fd6c11d
Riccardo Murri <riccardo.murri at gmail.com>
Glenn Morris <rgm@gnu.org>
parents:
78230
diff
changeset
|
250 (if done "done" "failed")) |
92414
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
251 (if (not done) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
252 (delete-process process) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
253 ;; advance point to after all informational messages that |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
254 ;; `openssl s_client' and `gnutls' print |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
255 (let ((start-of-data nil)) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
256 (while |
93084
b4e2fb288547
(open-tls-stream): Reindent.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
92414
diff
changeset
|
257 (not (setq start-of-data |
b4e2fb288547
(open-tls-stream): Reindent.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
92414
diff
changeset
|
258 ;; the string matching `tls-end-of-info' |
b4e2fb288547
(open-tls-stream): Reindent.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
92414
diff
changeset
|
259 ;; might come in separate chunks from |
b4e2fb288547
(open-tls-stream): Reindent.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
92414
diff
changeset
|
260 ;; `accept-process-output', so start the |
b4e2fb288547
(open-tls-stream): Reindent.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
92414
diff
changeset
|
261 ;; search where `tls-success' ended |
b4e2fb288547
(open-tls-stream): Reindent.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
92414
diff
changeset
|
262 (save-excursion |
b4e2fb288547
(open-tls-stream): Reindent.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
92414
diff
changeset
|
263 (if (re-search-forward tls-end-of-info nil t) |
b4e2fb288547
(open-tls-stream): Reindent.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
92414
diff
changeset
|
264 (match-end 0))))) |
92414
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
265 (accept-process-output process 1)) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
266 (if start-of-data |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
267 ;; move point to start of client data |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
268 (goto-char start-of-data))) |
93084
b4e2fb288547
(open-tls-stream): Reindent.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
92414
diff
changeset
|
269 (setq done process)))) |
92414
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
270 (when (and done |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
271 (or |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
272 (and tls-checktrust |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
273 (save-excursion |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
274 (goto-char (point-min)) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
275 (re-search-forward tls-untrusted nil t)) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
276 (or |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
277 (and (not (eq tls-checktrust 'ask)) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
278 (message "The certificate presented by `%s' is \ |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
279 NOT trusted." host)) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
280 (not (yes-or-no-p |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
281 (format "The certificate presented by `%s' is \ |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
282 NOT trusted. Accept anyway? " host))))) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
283 (and tls-hostmismatch |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
284 (save-excursion |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
285 (goto-char (point-min)) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
286 (re-search-forward tls-hostmismatch nil t)) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
287 (not (yes-or-no-p |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
288 (format "Host name in certificate doesn't \ |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
289 match `%s'. Connect anyway? " host)))))) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
290 (setq done nil) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
291 (delete-process process))) |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
292 (message "Opening TLS connection to `%s'...%s" |
4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
Glenn Morris <rgm@gnu.org>
parents:
92333
diff
changeset
|
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
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93084
diff
changeset
|
301 ;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac |
50313 | 302 ;;; tls.el ends here |