Mercurial > emacs
comparison lisp/net/tls.el @ 91085:880960b70474
Merge from emacs--devo--0
Revision: emacs@sv.gnu.org/emacs--unicode--0--patch-283
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sun, 11 Nov 2007 00:56:44 +0000 |
parents | f55f9811f5d7 55afdd9000d3 |
children | 53108e6cea98 |
comparison
equal
deleted
inserted
replaced
91084:a4347a111894 | 91085:880960b70474 |
---|---|
52 (autoload 'format-spec-make "format-spec")) | 52 (autoload 'format-spec-make "format-spec")) |
53 | 53 |
54 (defgroup tls nil | 54 (defgroup tls nil |
55 "Transport Layer Security (TLS) parameters." | 55 "Transport Layer Security (TLS) parameters." |
56 :group 'comm) | 56 :group 'comm) |
57 | |
58 (defcustom tls-end-of-info | |
59 (concat | |
60 "\\(" | |
61 ;; `openssl s_client' regexp. See ssl/ssl_txt.c lines 219-220. | |
62 ;; According to apps/s_client.c line 1515 `---' is always the last | |
63 ;; line that is printed by s_client before the real data. | |
64 "^ Verify return code: .+\n---\n\\|" | |
65 ;; `gnutls' regexp. See src/cli.c lines 721-. | |
66 "^- Simple Client Mode:\n" | |
67 "\\(\n\\|" ; ignore blank lines | |
68 ;; According to GnuTLS v2.1.5 src/cli.c lines 640-650 and 705-715 | |
69 ;; in `main' the handshake will start after this message. If the | |
70 ;; handshake fails, the programs will abort. | |
71 "^\\*\\*\\* Starting TLS handshake\n\\)*" | |
72 "\\)") | |
73 "Regexp matching end of TLS client informational messages. | |
74 Client data stream begins after the last character matched by | |
75 this. The default matches `openssl s_client' (version 0.9.8c) | |
76 and `gnutls-cli' (version 2.0.1) output." | |
77 :version "22.2" | |
78 :type 'regexp | |
79 :group 'tls) | |
57 | 80 |
58 (defcustom tls-program '("gnutls-cli -p %p %h" | 81 (defcustom tls-program '("gnutls-cli -p %p %h" |
59 "gnutls-cli -p %p %h --protocols ssl3" | 82 "gnutls-cli -p %p %h --protocols ssl3" |
60 "openssl s_client -connect %h:%p -no_ssl2") | 83 "openssl s_client -connect %h:%p -no_ssl2") |
61 "List of strings containing commands to start TLS stream to a host. | 84 "List of strings containing commands to start TLS stream to a host. |
128 (let ((cmds tls-program) | 151 (let ((cmds tls-program) |
129 (use-temp-buffer (null buffer)) | 152 (use-temp-buffer (null buffer)) |
130 process cmd done) | 153 process cmd done) |
131 (if use-temp-buffer | 154 (if use-temp-buffer |
132 (setq buffer (generate-new-buffer " TLS"))) | 155 (setq buffer (generate-new-buffer " TLS"))) |
133 (message "Opening TLS connection to `%s'..." host) | 156 (with-current-buffer buffer |
134 (while (and (not done) (setq cmd (pop cmds))) | 157 (message "Opening TLS connection to `%s'..." host) |
135 (message "Opening TLS connection with `%s'..." cmd) | 158 (while (and (not done) (setq cmd (pop cmds))) |
136 (let ((process-connection-type tls-process-connection-type) | 159 (message "Opening TLS connection with `%s'..." cmd) |
137 response) | 160 (let ((process-connection-type tls-process-connection-type) |
138 (setq process (start-process | 161 response) |
139 name buffer shell-file-name shell-command-switch | 162 (setq process (start-process |
140 (format-spec | 163 name buffer shell-file-name shell-command-switch |
141 cmd | 164 (format-spec |
142 (format-spec-make | 165 cmd |
143 ?h host | 166 (format-spec-make |
144 ?p (if (integerp port) | 167 ?h host |
145 (int-to-string port) | 168 ?p (if (integerp port) |
146 port))))) | 169 (int-to-string port) |
147 (while (and process | 170 port))))) |
148 (memq (process-status process) '(open run)) | 171 (while (and process |
149 (save-excursion | 172 (memq (process-status process) '(open run)) |
150 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | 173 (progn |
151 (goto-char (point-min)) | 174 (goto-char (point-min)) |
152 (not (setq done (re-search-forward tls-success nil t))))) | 175 (not (setq done (re-search-forward tls-success nil t))))) |
153 (unless (accept-process-output process 1) | 176 (unless (accept-process-output process 1) |
154 (sit-for 1))) | 177 (sit-for 1))) |
155 (message "Opening TLS connection with `%s'...%s" cmd | 178 (message "Opening TLS connection with `%s'...%s" cmd |
156 (if done "done" "failed")) | 179 (if done "done" "failed")) |
157 (if done | 180 (if (not done) |
158 (setq done process) | 181 (delete-process process) |
159 (delete-process process)))) | 182 ;; advance point to after all informational messages that |
160 (message "Opening TLS connection to `%s'...%s" | 183 ;; `openssl s_client' and `gnutls' print |
161 host (if done "done" "failed")) | 184 (let ((start-of-data nil)) |
185 (while | |
186 (not (setq start-of-data | |
187 ;; the string matching `tls-end-of-info' | |
188 ;; might come in separate chunks from | |
189 ;; `accept-process-output', so start the | |
190 ;; search where `tls-success' ended | |
191 (save-excursion | |
192 (if (re-search-forward tls-end-of-info nil t) | |
193 (match-end 0))))) | |
194 (accept-process-output process 1)) | |
195 (if start-of-data | |
196 ;; move point to start of client data | |
197 (goto-char start-of-data))) | |
198 (setq done process)))) | |
199 (message "Opening TLS connection to `%s'...%s" | |
200 host (if done "done" "failed"))) | |
162 (when use-temp-buffer | 201 (when use-temp-buffer |
163 (if done (set-process-buffer process nil)) | 202 (if done (set-process-buffer process nil)) |
164 (kill-buffer buffer)) | 203 (kill-buffer buffer)) |
165 done)) | 204 done)) |
166 | 205 |