Mercurial > emacs
comparison lisp/gnus/starttls.el @ 90261:7beb78bc1f8e
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-97
Merge from emacs--cvs-trunk--0
Patches applied:
* emacs--cvs-trunk--0 (patch 616-696)
- Add lisp/mh-e/.arch-inventory
- Update from CVS
- Merge from gnus--rel--5.10
- Update from CVS: lisp/smerge-mode.el: Add 'tools' to file keywords.
- lisp/gnus/ChangeLog: Remove duplicate entry
* gnus--rel--5.10 (patch 147-181)
- Update from CVS
- Merge from emacs--cvs-trunk--0
- Update from CVS: lisp/mml.el (mml-preview): Doc fix.
- Update from CVS: texi/message.texi: Fix default values.
- Update from CVS: texi/gnus.texi (RSS): Addition.
author | Miles Bader <miles@gnu.org> |
---|---|
date | Mon, 16 Jan 2006 08:37:27 +0000 |
parents | 2d92f5c9d6ae 1c477099d3ac |
children | c5406394f567 |
comparison
equal
deleted
inserted
replaced
90260:0ca0d9181b5e | 90261:7beb78bc1f8e |
---|---|
30 ;; This module defines some utility functions for STARTTLS profiles. | 30 ;; This module defines some utility functions for STARTTLS profiles. |
31 | 31 |
32 ;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP" | 32 ;; [RFC 2595] "Using TLS with IMAP, POP3 and ACAP" |
33 ;; by Chris Newman <chris.newman@innosoft.com> (1999/06) | 33 ;; by Chris Newman <chris.newman@innosoft.com> (1999/06) |
34 | 34 |
35 ;; This file now contain a combination of the two previous | 35 ;; This file now contains a combination of the two previous |
36 ;; implementations both called "starttls.el". The first one is Daiki | 36 ;; implementations both called "starttls.el". The first one is Daiki |
37 ;; Ueno's starttls.el which uses his own "starttls" command line tool, | 37 ;; Ueno's starttls.el which uses his own "starttls" command line tool, |
38 ;; and the second one is Simon Josefsson's starttls.el which uses | 38 ;; and the second one is Simon Josefsson's starttls.el which uses |
39 ;; "gnutls-cli" from GNUTLS. | 39 ;; "gnutls-cli" from GNUTLS. |
40 ;; | 40 ;; |
42 ;; "gnutls-cli", for backwards compatibility. Use | 42 ;; "gnutls-cli", for backwards compatibility. Use |
43 ;; `starttls-use-gnutls' to toggle between implementations if you have | 43 ;; `starttls-use-gnutls' to toggle between implementations if you have |
44 ;; both tools installed. It is recommended to use GNUTLS, though, as | 44 ;; both tools installed. It is recommended to use GNUTLS, though, as |
45 ;; it performs more verification of the certificates. | 45 ;; it performs more verification of the certificates. |
46 | 46 |
47 ;; The GNUTLS support require GNUTLS 0.9.90 (released 2003-10-08) or | 47 ;; The GNUTLS support requires GNUTLS 0.9.90 (released 2003-10-08) or |
48 ;; later, from <http://www.gnu.org/software/gnutls/>, or "starttls" | 48 ;; later, from <http://www.gnu.org/software/gnutls/>, or "starttls" |
49 ;; from <ftp://ftp.opaopa.org/pub/elisp/>. | 49 ;; from <ftp://ftp.opaopa.org/pub/elisp/>. |
50 | 50 |
51 ;; Usage is similar to `open-network-stream'. For example: | 51 ;; Usage is similar to `open-network-stream'. For example: |
52 ;; | 52 ;; |
56 ;; (process-send-string tmp "STARTTLS\n") | 56 ;; (process-send-string tmp "STARTTLS\n") |
57 ;; (accept-process-output tmp 15) | 57 ;; (accept-process-output tmp 15) |
58 ;; (message "STARTTLS output:\n%s" (starttls-negotiate tmp)) | 58 ;; (message "STARTTLS output:\n%s" (starttls-negotiate tmp)) |
59 ;; (process-send-string tmp "EHLO foo\n")) | 59 ;; (process-send-string tmp "EHLO foo\n")) |
60 | 60 |
61 ;; An example run yield the following output: | 61 ;; An example run yields the following output: |
62 ;; | 62 ;; |
63 ;; 220 yxa.extundo.com ESMTP Sendmail 8.12.11/8.12.11/Debian-3; Wed, 26 May 2004 19:12:29 +0200; (No UCE/UBE) logging access from: c494102a.s-bi.bostream.se(OK)-c494102a.s-bi.bostream.se [217.215.27.65] | 63 ;; 220 yxa.extundo.com ESMTP Sendmail 8.12.11/8.12.11/Debian-3; Wed, 26 May 2004 19:12:29 +0200; (No UCE/UBE) logging access from: c494102a.s-bi.bostream.se(OK)-c494102a.s-bi.bostream.se [217.215.27.65] |
64 ;; 220 2.0.0 Ready to start TLS | 64 ;; 220 2.0.0 Ready to start TLS |
65 ;; 250-yxa.extundo.com Hello c494102a.s-bi.bostream.se [217.215.27.65], pleased to meet you | 65 ;; 250-yxa.extundo.com Hello c494102a.s-bi.bostream.se [217.215.27.65], pleased to meet you |
66 ;; 250-ENHANCEDSTATUSCODES | 66 ;; 250-ENHANCEDSTATUSCODES |
144 :type 'boolean | 144 :type 'boolean |
145 :group 'starttls) | 145 :group 'starttls) |
146 | 146 |
147 (defcustom starttls-extra-args nil | 147 (defcustom starttls-extra-args nil |
148 "Extra arguments to `starttls-program'. | 148 "Extra arguments to `starttls-program'. |
149 This program is used when the `starttls' command is used, | 149 These apply when the `starttls' command is used, i.e. when |
150 i.e. when `starttls-use-gnutls' is nil." | 150 `starttls-use-gnutls' is nil." |
151 :type '(repeat string) | 151 :type '(repeat string) |
152 :group 'starttls) | 152 :group 'starttls) |
153 | 153 |
154 (defcustom starttls-extra-arguments nil | 154 (defcustom starttls-extra-arguments nil |
155 "Extra arguments to `starttls-program'. | 155 "Extra arguments to `starttls-program'. |
156 This program is used when GNUTLS is used, i.e. when | 156 These apply when GNUTLS is used, i.e. when `starttls-use-gnutls' is non-nil. |
157 `starttls-use-gnutls' is non-nil. | |
158 | 157 |
159 For example, non-TLS compliant servers may require | 158 For example, non-TLS compliant servers may require |
160 '(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to | 159 '(\"--protocols\" \"ssl3\"). Invoke \"gnutls-cli --help\" to |
161 find out which parameters are available." | 160 find out which parameters are available." |
162 :version "22.1" | 161 :version "22.1" |
170 :group 'starttls) | 169 :group 'starttls) |
171 | 170 |
172 (defcustom starttls-connect "- Simple Client Mode:\n\n" | 171 (defcustom starttls-connect "- Simple Client Mode:\n\n" |
173 "*Regular expression indicating successful connection. | 172 "*Regular expression indicating successful connection. |
174 The default is what GNUTLS's \"gnutls-cli\" outputs." | 173 The default is what GNUTLS's \"gnutls-cli\" outputs." |
175 ;; GNUTLS cli.c:main() print this string when it is starting to run | 174 ;; GNUTLS cli.c:main() prints this string when it is starting to run |
176 ;; in the application read/write phase. If the logic, or the string | 175 ;; in the application read/write phase. If the logic, or the string |
177 ;; itself, is modified, this must be updated. | 176 ;; itself, is modified, this must be updated. |
178 :version "22.1" | 177 :version "22.1" |
179 :type 'regexp | 178 :type 'regexp |
180 :group 'starttls) | 179 :group 'starttls) |
181 | 180 |
182 (defcustom starttls-failure "\\*\\*\\* Handshake has failed" | 181 (defcustom starttls-failure "\\*\\*\\* Handshake has failed" |
183 "*Regular expression indicating failed TLS handshake. | 182 "*Regular expression indicating failed TLS handshake. |
184 The default is what GNUTLS's \"gnutls-cli\" outputs." | 183 The default is what GNUTLS's \"gnutls-cli\" outputs." |
185 ;; GNUTLS cli.c:do_handshake() print this string on failure. If the | 184 ;; GNUTLS cli.c:do_handshake() prints this string on failure. If the |
186 ;; logic, or the string itself, is modified, this must be updated. | 185 ;; logic, or the string itself, is modified, this must be updated. |
187 :version "22.1" | 186 :version "22.1" |
188 :type 'regexp | 187 :type 'regexp |
189 :group 'starttls) | 188 :group 'starttls) |
190 | 189 |
198 :version "22.1" | 197 :version "22.1" |
199 :type 'regexp | 198 :type 'regexp |
200 :group 'starttls) | 199 :group 'starttls) |
201 | 200 |
202 (defun starttls-negotiate-gnutls (process) | 201 (defun starttls-negotiate-gnutls (process) |
203 "Negotiate TLS on process opened by `open-starttls-stream'. | 202 "Negotiate TLS on PROCESS opened by `open-starttls-stream'. |
204 This should typically only be done once. It typically return a | 203 This should typically only be done once. It typically returns a |
205 multi-line informational message with information about the | 204 multi-line informational message with information about the |
206 handshake, or NIL on failure." | 205 handshake, or nil on failure." |
207 (let (buffer info old-max done-ok done-bad) | 206 (let (buffer info old-max done-ok done-bad) |
208 (if (null (setq buffer (process-buffer process))) | 207 (if (null (setq buffer (process-buffer process))) |
209 ;; XXX How to remove/extract the TLS negotiation junk? | 208 ;; XXX How to remove/extract the TLS negotiation junk? |
210 (signal-process (process-id process) 'SIGALRM) | 209 (signal-process (process-id process) 'SIGALRM) |
211 (with-current-buffer buffer | 210 (with-current-buffer buffer |
241 (defalias 'starttls-set-process-query-on-exit-flag | 240 (defalias 'starttls-set-process-query-on-exit-flag |
242 'set-process-query-on-exit-flag) | 241 'set-process-query-on-exit-flag) |
243 (defalias 'starttls-set-process-query-on-exit-flag | 242 (defalias 'starttls-set-process-query-on-exit-flag |
244 'process-kill-without-query))) | 243 'process-kill-without-query))) |
245 | 244 |
246 (defun starttls-open-stream-gnutls (name buffer host service) | 245 (defun starttls-open-stream-gnutls (name buffer host port) |
247 (message "Opening STARTTLS connection to `%s'..." host) | 246 (message "Opening STARTTLS connection to `%s'..." host) |
248 (let* (done | 247 (let* (done |
249 (old-max (with-current-buffer buffer (point-max))) | 248 (old-max (with-current-buffer buffer (point-max))) |
250 (process-connection-type starttls-process-connection-type) | 249 (process-connection-type starttls-process-connection-type) |
251 (process (apply #'start-process name buffer | 250 (process (apply #'start-process name buffer |
252 starttls-gnutls-program "-s" host | 251 starttls-gnutls-program "-s" host |
253 "-p" (if (integerp service) | 252 "-p" (if (integerp port) |
254 (int-to-string service) | 253 (int-to-string port) |
255 service) | 254 port) |
256 starttls-extra-arguments))) | 255 starttls-extra-arguments))) |
257 (starttls-set-process-query-on-exit-flag process nil) | 256 (starttls-set-process-query-on-exit-flag process nil) |
258 (while (and (processp process) | 257 (while (and (processp process) |
259 (eq (process-status process) 'run) | 258 (eq (process-status process) 'run) |
260 (save-excursion | 259 (save-excursion |
271 (setq process nil)) | 270 (setq process nil)) |
272 (message "Opening STARTTLS connection to `%s'...%s" | 271 (message "Opening STARTTLS connection to `%s'...%s" |
273 host (if done "done" "failed")) | 272 host (if done "done" "failed")) |
274 process)) | 273 process)) |
275 | 274 |
276 (defun starttls-open-stream (name buffer host service) | 275 (defun starttls-open-stream (name buffer host port) |
277 "Open a TLS connection for a service to a host. | 276 "Open a TLS connection for a port to a host. |
278 Returns a subprocess-object to represent the connection. | 277 Returns a subprocess object to represent the connection. |
279 Input and output work as for subprocesses; `delete-process' closes it. | 278 Input and output work as for subprocesses; `delete-process' closes it. |
280 Args are NAME BUFFER HOST SERVICE. | 279 Args are NAME BUFFER HOST PORT. |
281 NAME is name for process. It is modified if necessary to make it unique. | 280 NAME is name for process. It is modified if necessary to make it unique. |
282 BUFFER is the buffer (or `buffer-name') to associate with the process. | 281 BUFFER is the buffer (or `buffer-name') to associate with the process. |
283 Process output goes at end of that buffer, unless you specify | 282 Process output goes at end of that buffer, unless you specify |
284 an output stream or filter function to handle the output. | 283 an output stream or filter function to handle the output. |
285 BUFFER may be also nil, meaning that this process is not associated | 284 BUFFER may be also nil, meaning that this process is not associated |
286 with any buffer | 285 with any buffer |
287 Third arg is name of the host to connect to, or its IP address. | 286 Third arg is name of the host to connect to, or its IP address. |
288 Fourth arg SERVICE is name of the service desired, or an integer | 287 Fourth arg PORT is an integer specifying a port to connect to. |
289 specifying a port number to connect to." | 288 If `starttls-use-gnutls' is nil, this may also be a service name, but |
289 GNUTLS requires a port number." | |
290 (if starttls-use-gnutls | 290 (if starttls-use-gnutls |
291 (starttls-open-stream-gnutls name buffer host service) | 291 (starttls-open-stream-gnutls name buffer host port) |
292 (let* ((process-connection-type starttls-process-connection-type) | 292 (let* ((process-connection-type starttls-process-connection-type) |
293 (process (apply #'start-process | 293 (process (apply #'start-process |
294 name buffer starttls-program | 294 name buffer starttls-program |
295 host (format "%s" service) | 295 host (format "%s" port) |
296 starttls-extra-args))) | 296 starttls-extra-args))) |
297 (starttls-set-process-query-on-exit-flag process nil) | 297 (starttls-set-process-query-on-exit-flag process nil) |
298 process))) | 298 process))) |
299 | 299 |
300 (provide 'starttls) | 300 (provide 'starttls) |