Mercurial > emacs
comparison lisp/net/tls.el @ 92414:4e8cdba11b18
(open-tls-stream): Restore the 2007-11-04 change accidentally removed
by the 2007-12-05 merge from Gnus.
| author | Glenn Morris <rgm@gnu.org> |
|---|---|
| date | Mon, 03 Mar 2008 02:10:49 +0000 |
| parents | 592894a86ca5 |
| children | b4e2fb288547 |
comparison
equal
deleted
inserted
replaced
| 92413:dc438f2fa078 | 92414:4e8cdba11b18 |
|---|---|
| 237 port))))) | 237 port))))) |
| 238 (while (and process | 238 (while (and process |
| 239 (memq (process-status process) '(open run)) | 239 (memq (process-status process) '(open run)) |
| 240 (progn | 240 (progn |
| 241 (goto-char (point-min)) | 241 (goto-char (point-min)) |
| 242 (not (setq done (re-search-forward tls-success nil t))))) | 242 (not (setq done (re-search-forward |
| 243 tls-success nil t))))) | |
| 243 (unless (accept-process-output process 1) | 244 (unless (accept-process-output process 1) |
| 244 (sit-for 1))) | 245 (sit-for 1))) |
| 245 (message "Opening TLS connection with `%s'...%s" cmd | 246 (message "Opening TLS connection with `%s'...%s" cmd |
| 246 (if done "done" "failed")) | 247 (if done "done" "failed")) |
| 247 (if done | 248 (if (not done) |
| 248 (setq done process) | 249 (delete-process process) |
| 249 (delete-process process)))) | 250 ;; advance point to after all informational messages that |
| 250 (when done | 251 ;; `openssl s_client' and `gnutls' print |
| 251 (save-excursion | 252 (let ((start-of-data nil)) |
| 252 (set-buffer buffer) | 253 (while |
| 253 (when | 254 (not (setq start-of-data |
| 254 (or | 255 ;; the string matching `tls-end-of-info' |
| 255 (and tls-checktrust | 256 ;; might come in separate chunks from |
| 256 (progn | 257 ;; `accept-process-output', so start the |
| 257 (goto-char (point-min)) | 258 ;; search where `tls-success' ended |
| 258 (re-search-forward tls-untrusted nil t)) | 259 (save-excursion |
| 259 (or | 260 (if (re-search-forward tls-end-of-info nil t) |
| 260 (and (not (eq tls-checktrust 'ask)) | 261 (match-end 0))))) |
| 261 (message "The certificate presented by `%s' is NOT trusted." host)) | 262 (accept-process-output process 1)) |
| 262 (not (yes-or-no-p | 263 (if start-of-data |
| 263 (format "The certificate presented by `%s' is NOT trusted. Accept anyway? " host))))) | 264 ;; move point to start of client data |
| 264 (and tls-hostmismatch | 265 (goto-char start-of-data))) |
| 265 (progn | 266 (setq done process)))) |
| 266 (goto-char (point-min)) | 267 (when (and done |
| 267 (re-search-forward tls-hostmismatch nil t)) | 268 (or |
| 268 (not (yes-or-no-p | 269 (and tls-checktrust |
| 269 (format "Host name in certificate doesn't match `%s'. Connect anyway? " host))))) | 270 (save-excursion |
| 270 (setq done nil) | 271 (goto-char (point-min)) |
| 271 (delete-process process)))) | 272 (re-search-forward tls-untrusted nil t)) |
| 272 (message "Opening TLS connection to `%s'...%s" | 273 (or |
| 273 host (if done "done" "failed"))) | 274 (and (not (eq tls-checktrust 'ask)) |
| 275 (message "The certificate presented by `%s' is \ | |
| 276 NOT trusted." host)) | |
| 277 (not (yes-or-no-p | |
| 278 (format "The certificate presented by `%s' is \ | |
| 279 NOT trusted. Accept anyway? " host))))) | |
| 280 (and tls-hostmismatch | |
| 281 (save-excursion | |
| 282 (goto-char (point-min)) | |
| 283 (re-search-forward tls-hostmismatch nil t)) | |
| 284 (not (yes-or-no-p | |
| 285 (format "Host name in certificate doesn't \ | |
| 286 match `%s'. Connect anyway? " host)))))) | |
| 287 (setq done nil) | |
| 288 (delete-process process))) | |
| 289 (message "Opening TLS connection to `%s'...%s" | |
| 290 host (if done "done" "failed")) | |
| 274 (when use-temp-buffer | 291 (when use-temp-buffer |
| 275 (if done (set-process-buffer process nil)) | 292 (if done (set-process-buffer process nil)) |
| 276 (kill-buffer buffer)) | 293 (kill-buffer buffer)) |
| 277 done)) | 294 done)) |
| 278 | 295 |