Mercurial > emacs
comparison lisp/net/tls.el @ 77020:15108eee2bb3
Fix last change.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Sat, 07 Apr 2007 04:33:00 +0000 |
| parents | 5c43ac406461 |
| children | 26293d3a753d |
comparison
equal
deleted
inserted
replaced
| 77019:5c43ac406461 | 77020:15108eee2bb3 |
|---|---|
| 123 an output stream or filter function to handle the output. | 123 an output stream or filter function to handle the output. |
| 124 BUFFER may be also nil, meaning that this process is not associated | 124 BUFFER may be also nil, meaning that this process is not associated |
| 125 with any buffer | 125 with any buffer |
| 126 Third arg is name of the host to connect to, or its IP address. | 126 Third arg is name of the host to connect to, or its IP address. |
| 127 Fourth arg PORT is an integer specifying a port to connect to." | 127 Fourth arg PORT is an integer specifying a port to connect to." |
| 128 (let ((cmds tls-program) cmd done) | 128 (let ((cmds tls-program) |
| 129 (use-temp-buffer (null buffer)) | |
| 130 process cmd done) | |
| 131 (if use-temp-buffer | |
| 132 (setq buffer (generate-new-buffer " TLS"))) | |
| 129 (message "Opening TLS connection to `%s'..." host) | 133 (message "Opening TLS connection to `%s'..." host) |
| 130 (while (and (not done) (setq cmd (pop cmds))) | 134 (while (and (not done) (setq cmd (pop cmds))) |
| 131 (message "Opening TLS connection with `%s'..." cmd) | 135 (message "Opening TLS connection with `%s'..." cmd) |
| 132 (let* ((process-connection-type tls-process-connection-type) | 136 (let ((process-connection-type tls-process-connection-type) |
| 133 (process (start-process | 137 response) |
| 138 (setq process (start-process | |
| 134 name buffer shell-file-name shell-command-switch | 139 name buffer shell-file-name shell-command-switch |
| 135 (format-spec | 140 (format-spec |
| 136 cmd | 141 cmd |
| 137 (format-spec-make | 142 (format-spec-make |
| 138 ?h host | 143 ?h host |
| 139 ?p (if (integerp port) | 144 ?p (if (integerp port) |
| 140 (int-to-string port) | 145 (int-to-string port) |
| 141 port))))) | 146 port))))) |
| 142 response) | |
| 143 (while (and process | 147 (while (and process |
| 144 (memq (process-status process) '(open run)) | 148 (memq (process-status process) '(open run)) |
| 145 buffer | |
| 146 (save-excursion | 149 (save-excursion |
| 147 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | 150 (set-buffer buffer) ;; XXX "blue moon" nntp.el bug |
| 148 (goto-char (point-min)) | 151 (goto-char (point-min)) |
| 149 (not (setq done (re-search-forward tls-success nil t))))) | 152 (not (setq done (re-search-forward tls-success nil t))))) |
| 150 (unless (accept-process-output process 1) | 153 (unless (accept-process-output process 1) |
| 154 (if done | 157 (if done |
| 155 (setq done process) | 158 (setq done process) |
| 156 (delete-process process)))) | 159 (delete-process process)))) |
| 157 (message "Opening TLS connection to `%s'...%s" | 160 (message "Opening TLS connection to `%s'...%s" |
| 158 host (if done "done" "failed")) | 161 host (if done "done" "failed")) |
| 162 (when use-temp-buffer | |
| 163 (or done (set-process-buffer process nil)) | |
| 164 (kill-buffer buffer)) | |
| 159 done)) | 165 done)) |
| 160 | 166 |
| 161 (provide 'tls) | 167 (provide 'tls) |
| 162 | 168 |
| 163 ;;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac | 169 ;;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac |