diff options
| author | Miles Bader | 2009-01-09 03:01:50 +0000 |
|---|---|---|
| committer | Miles Bader | 2009-01-09 03:01:50 +0000 |
| commit | e3e955fed38da9263f3904f15233ccfd0dbbbe43 (patch) | |
| tree | 6a34615ae6e5699c8b7dfba64dfae3486ded203f /lisp/net | |
| parent | 2188975fbff1202d011db2f82d728fc5fb5f9346 (diff) | |
| download | emacs-e3e955fed38da9263f3904f15233ccfd0dbbbe43.tar.gz emacs-e3e955fed38da9263f3904f15233ccfd0dbbbe43.zip | |
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1513
Diffstat (limited to 'lisp/net')
| -rw-r--r-- | lisp/net/dns.el | 41 | ||||
| -rw-r--r-- | lisp/net/imap.el | 178 |
2 files changed, 145 insertions, 74 deletions
diff --git a/lisp/net/dns.el b/lisp/net/dns.el index e4dc9aa08ab..e0aba3c32ea 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el | |||
| @@ -29,8 +29,8 @@ | |||
| 29 | "How many seconds to wait when doing DNS queries.") | 29 | "How many seconds to wait when doing DNS queries.") |
| 30 | 30 | ||
| 31 | (defvar dns-servers nil | 31 | (defvar dns-servers nil |
| 32 | "Which DNS servers to query. | 32 | "List of DNS servers to query. |
| 33 | If nil, /etc/resolv.conf will be consulted.") | 33 | If nil, /etc/resolv.conf and nslookup will be consulted.") |
| 34 | 34 | ||
| 35 | ;;; Internal code: | 35 | ;;; Internal code: |
| 36 | 36 | ||
| @@ -298,14 +298,24 @@ If TCP-P, the first two bytes of the package with be the length field." | |||
| 298 | (t string))) | 298 | (t string))) |
| 299 | (goto-char point)))) | 299 | (goto-char point)))) |
| 300 | 300 | ||
| 301 | (defun dns-parse-resolv-conf () | 301 | (defun dns-set-servers () |
| 302 | (when (file-exists-p "/etc/resolv.conf") | 302 | "Set `dns-servers' to a list of DNS servers or nil if none are found. |
| 303 | (with-temp-buffer | 303 | Parses \"/etc/resolv.conf\" or calls \"nslookup\"." |
| 304 | (insert-file-contents "/etc/resolv.conf") | 304 | (or (when (file-exists-p "/etc/resolv.conf") |
| 305 | (goto-char (point-min)) | 305 | (setq dns-servers nil) |
| 306 | (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t) | 306 | (with-temp-buffer |
| 307 | (push (match-string 1) dns-servers)) | 307 | (insert-file-contents "/etc/resolv.conf") |
| 308 | (setq dns-servers (nreverse dns-servers))))) | 308 | (goto-char (point-min)) |
| 309 | (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t) | ||
| 310 | (push (match-string 1) dns-servers)) | ||
| 311 | (setq dns-servers (nreverse dns-servers)))) | ||
| 312 | (when (executable-find "nslookup") | ||
| 313 | (with-temp-buffer | ||
| 314 | (call-process "nslookup" nil t nil "localhost") | ||
| 315 | (goto-char (point-min)) | ||
| 316 | (re-search-forward | ||
| 317 | "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t) | ||
| 318 | (setq dns-servers (list (match-string 1))))))) | ||
| 309 | 319 | ||
| 310 | (defun dns-read-txt (string) | 320 | (defun dns-read-txt (string) |
| 311 | (if (> (length string) 1) | 321 | (if (> (length string) 1) |
| @@ -351,23 +361,26 @@ If TCP-P, the first two bytes of the package with be the length field." | |||
| 351 | 361 | ||
| 352 | (defvar dns-cache (make-vector 4096 0)) | 362 | (defvar dns-cache (make-vector 4096 0)) |
| 353 | 363 | ||
| 354 | (defun query-dns-cached (name &optional type fullp reversep) | 364 | (defun dns-query-cached (name &optional type fullp reversep) |
| 355 | (let* ((key (format "%s:%s:%s:%s" name type fullp reversep)) | 365 | (let* ((key (format "%s:%s:%s:%s" name type fullp reversep)) |
| 356 | (sym (intern-soft key dns-cache))) | 366 | (sym (intern-soft key dns-cache))) |
| 357 | (if (and sym | 367 | (if (and sym |
| 358 | (boundp sym)) | 368 | (boundp sym)) |
| 359 | (symbol-value sym) | 369 | (symbol-value sym) |
| 360 | (let ((result (query-dns name type fullp reversep))) | 370 | (let ((result (dns-query name type fullp reversep))) |
| 361 | (set (intern key dns-cache) result) | 371 | (set (intern key dns-cache) result) |
| 362 | result)))) | 372 | result)))) |
| 363 | 373 | ||
| 364 | (defun query-dns (name &optional type fullp reversep) | 374 | ;; The old names `query-dns' and `query-dns-cached' weren't used in Emacs 23 |
| 375 | ;; yet, so no alias are provided. --rsteib | ||
| 376 | |||
| 377 | (defun dns-query (name &optional type fullp reversep) | ||
| 365 | "Query a DNS server for NAME of TYPE. | 378 | "Query a DNS server for NAME of TYPE. |
| 366 | If FULLP, return the entire record returned. | 379 | If FULLP, return the entire record returned. |
| 367 | If REVERSEP, look up an IP address." | 380 | If REVERSEP, look up an IP address." |
| 368 | (setq type (or type 'A)) | 381 | (setq type (or type 'A)) |
| 369 | (unless dns-servers | 382 | (unless dns-servers |
| 370 | (dns-parse-resolv-conf)) | 383 | (dns-set-servers)) |
| 371 | 384 | ||
| 372 | (when reversep | 385 | (when reversep |
| 373 | (setq name (concat | 386 | (setq name (concat |
diff --git a/lisp/net/imap.el b/lisp/net/imap.el index dc295d5b367..6f2b2d11f97 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el | |||
| @@ -3,7 +3,7 @@ | |||
| 3 | ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, | 3 | ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, |
| 4 | ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. | 4 | ;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. |
| 5 | 5 | ||
| 6 | ;; Author: Simon Josefsson <jas@pdc.kth.se> | 6 | ;; Author: Simon Josefsson <simon@josefsson.org> |
| 7 | ;; Keywords: mail | 7 | ;; Keywords: mail |
| 8 | 8 | ||
| 9 | ;; This file is part of GNU Emacs. | 9 | ;; This file is part of GNU Emacs. |
| @@ -23,7 +23,7 @@ | |||
| 23 | 23 | ||
| 24 | ;;; Commentary: | 24 | ;;; Commentary: |
| 25 | 25 | ||
| 26 | ;; imap.el is a elisp library providing an interface for talking to | 26 | ;; imap.el is an elisp library providing an interface for talking to |
| 27 | ;; IMAP servers. | 27 | ;; IMAP servers. |
| 28 | ;; | 28 | ;; |
| 29 | ;; imap.el is roughly divided in two parts, one that parses IMAP | 29 | ;; imap.el is roughly divided in two parts, one that parses IMAP |
| @@ -72,25 +72,25 @@ | |||
| 72 | ;; explanatory for someone that know IMAP. All functions have | 72 | ;; explanatory for someone that know IMAP. All functions have |
| 73 | ;; additional documentation on how to invoke them. | 73 | ;; additional documentation on how to invoke them. |
| 74 | ;; | 74 | ;; |
| 75 | ;; imap.el support RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1), implemented | 75 | ;; imap.el supports RFC1730/2060/RFC3501 (IMAP4/IMAP4rev1). The implemented |
| 76 | ;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342 | 76 | ;; IMAP extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342 |
| 77 | ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, | 77 | ;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS, |
| 78 | ;; LOGINDISABLED) (with use of external library starttls.el and | 78 | ;; LOGINDISABLED) (with use of external library starttls.el and |
| 79 | ;; program starttls), and the GSSAPI / kerberos V4 sections of RFC1731 | 79 | ;; program starttls), and the GSSAPI / Kerberos V4 sections of RFC1731 |
| 80 | ;; (with use of external program `imtest'), RFC2971 (ID). It also | 80 | ;; (with use of external program `imtest'), and RFC2971 (ID). It also |
| 81 | ;; takes advantage of the UNSELECT extension in Cyrus IMAPD. | 81 | ;; takes advantage of the UNSELECT extension in Cyrus IMAPD. |
| 82 | ;; | 82 | ;; |
| 83 | ;; Without the work of John McClary Prevost and Jim Radford this library | 83 | ;; Without the work of John McClary Prevost and Jim Radford this library |
| 84 | ;; would not have seen the light of day. Many thanks. | 84 | ;; would not have seen the light of day. Many thanks. |
| 85 | ;; | 85 | ;; |
| 86 | ;; This is a transcript of short interactive session for demonstration | 86 | ;; This is a transcript of a short interactive session for demonstration |
| 87 | ;; purposes. | 87 | ;; purposes. |
| 88 | ;; | 88 | ;; |
| 89 | ;; (imap-open "my.mail.server") | 89 | ;; (imap-open "my.mail.server") |
| 90 | ;; => " *imap* my.mail.server:0" | 90 | ;; => " *imap* my.mail.server:0" |
| 91 | ;; | 91 | ;; |
| 92 | ;; The rest are invoked with current buffer as the buffer returned by | 92 | ;; The rest are invoked with current buffer as the buffer returned by |
| 93 | ;; `imap-open'. It is possible to do all without this, but it would | 93 | ;; `imap-open'. It is possible to do it all without this, but it would |
| 94 | ;; look ugly here since `buffer' is always the last argument for all | 94 | ;; look ugly here since `buffer' is always the last argument for all |
| 95 | ;; imap.el API functions. | 95 | ;; imap.el API functions. |
| 96 | ;; | 96 | ;; |
| @@ -121,6 +121,7 @@ | |||
| 121 | ;; Todo: | 121 | ;; Todo: |
| 122 | ;; | 122 | ;; |
| 123 | ;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow. | 123 | ;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow. |
| 124 | ;; Use IEEE floats (which are effectively exact)? -- fx | ||
| 124 | ;; o Don't use `read' at all (important places already fixed) | 125 | ;; o Don't use `read' at all (important places already fixed) |
| 125 | ;; o Accept list of articles instead of message set string in most | 126 | ;; o Accept list of articles instead of message set string in most |
| 126 | ;; imap-message-* functions. | 127 | ;; imap-message-* functions. |
| @@ -131,7 +132,7 @@ | |||
| 131 | ;; - 19991218 added starttls/digest-md5 patch, | 132 | ;; - 19991218 added starttls/digest-md5 patch, |
| 132 | ;; by Daiki Ueno <ueno@ueda.info.waseda.ac.jp> | 133 | ;; by Daiki Ueno <ueno@ueda.info.waseda.ac.jp> |
| 133 | ;; NB! you need SLIM for starttls.el and digest-md5.el | 134 | ;; NB! you need SLIM for starttls.el and digest-md5.el |
| 134 | ;; - 19991023 commited to pgnus | 135 | ;; - 19991023 committed to pgnus |
| 135 | ;; | 136 | ;; |
| 136 | 137 | ||
| 137 | ;;; Code: | 138 | ;;; Code: |
| @@ -204,19 +205,19 @@ until a successful connection is made." | |||
| 204 | Within a string, %s is replaced with the server address, %p with port | 205 | Within a string, %s is replaced with the server address, %p with port |
| 205 | number on server, %g with `imap-shell-host', and %l with | 206 | number on server, %g with `imap-shell-host', and %l with |
| 206 | `imap-default-user'. The program should read IMAP commands from stdin | 207 | `imap-default-user'. The program should read IMAP commands from stdin |
| 207 | and write IMAP response to stdout. Each entry in the list is tried | 208 | and write IMAP response to stdout. Each entry in the list is tried |
| 208 | until a successful connection is made." | 209 | until a successful connection is made." |
| 209 | :group 'imap | 210 | :group 'imap |
| 210 | :type '(repeat string)) | 211 | :type '(repeat string)) |
| 211 | 212 | ||
| 212 | (defcustom imap-process-connection-type nil | 213 | (defcustom imap-process-connection-type nil |
| 213 | "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL. | 214 | "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL. |
| 214 | The `process-connection-type' variable control type of device | 215 | The `process-connection-type' variable controls the type of device |
| 215 | used to communicate with subprocesses. Values are nil to use a | 216 | used to communicate with subprocesses. Values are nil to use a |
| 216 | pipe, or t or `pty' to use a pty. The value has no effect if the | 217 | pipe, or t or `pty' to use a pty. The value has no effect if the |
| 217 | system has no ptys or if all ptys are busy: then a pipe is used | 218 | system has no ptys or if all ptys are busy: then a pipe is used |
| 218 | in any case. The value takes effect when a IMAP server is | 219 | in any case. The value takes effect when an IMAP server is |
| 219 | opened, changing it after that has no effect." | 220 | opened; changing it after that has no effect." |
| 220 | :version "22.1" | 221 | :version "22.1" |
| 221 | :group 'imap | 222 | :group 'imap |
| 222 | :type 'boolean) | 223 | :type 'boolean) |
| @@ -230,20 +231,28 @@ encoded mailboxes which doesn't translate into ISO-8859-1." | |||
| 230 | :type 'boolean) | 231 | :type 'boolean) |
| 231 | 232 | ||
| 232 | (defcustom imap-log nil | 233 | (defcustom imap-log nil |
| 233 | "If non-nil, a imap session trace is placed in *imap-log* buffer. | 234 | "If non-nil, an imap session trace is placed in `imap-log-buffer'. |
| 234 | Note that username, passwords and other privacy sensitive | 235 | Note that username, passwords and other privacy sensitive |
| 235 | information (such as e-mail) may be stored in the *imap-log* | 236 | information (such as e-mail) may be stored in the buffer. |
| 236 | buffer. It is not written to disk, however. Do not enable this | 237 | It is not written to disk, however. Do not enable this |
| 237 | variable unless you are comfortable with that." | 238 | variable unless you are comfortable with that. |
| 239 | |||
| 240 | See also `imap-debug'." | ||
| 238 | :group 'imap | 241 | :group 'imap |
| 239 | :type 'boolean) | 242 | :type 'boolean) |
| 240 | 243 | ||
| 241 | (defcustom imap-debug nil | 244 | (defcustom imap-debug nil |
| 242 | "If non-nil, random debug spews are placed in *imap-debug* buffer. | 245 | "If non-nil, trace imap- functions into `imap-debug-buffer'. |
| 246 | Uses `trace-function-background', so you can turn it off with, | ||
| 247 | say, `untrace-all'. | ||
| 248 | |||
| 243 | Note that username, passwords and other privacy sensitive | 249 | Note that username, passwords and other privacy sensitive |
| 244 | information (such as e-mail) may be stored in the *imap-debug* | 250 | information (such as e-mail) may be stored in the buffer. |
| 245 | buffer. It is not written to disk, however. Do not enable this | 251 | It is not written to disk, however. Do not enable this |
| 246 | variable unless you are comfortable with that." | 252 | variable unless you are comfortable with that. |
| 253 | |||
| 254 | This variable only takes effect when loading the `imap' library. | ||
| 255 | See also `imap-log'." | ||
| 247 | :group 'imap | 256 | :group 'imap |
| 248 | :type 'boolean) | 257 | :type 'boolean) |
| 249 | 258 | ||
| @@ -268,7 +277,7 @@ Shorter values mean quicker response, but is more CPU intensive." | |||
| 268 | :group 'imap) | 277 | :group 'imap) |
| 269 | 278 | ||
| 270 | (defcustom imap-store-password nil | 279 | (defcustom imap-store-password nil |
| 271 | "If non-nil, store session password without promting." | 280 | "If non-nil, store session password without prompting." |
| 272 | :group 'imap | 281 | :group 'imap |
| 273 | :type 'boolean) | 282 | :type 'boolean) |
| 274 | 283 | ||
| @@ -393,7 +402,7 @@ and `examine'.") | |||
| 393 | "Obarray with mailbox data.") | 402 | "Obarray with mailbox data.") |
| 394 | 403 | ||
| 395 | (defvar imap-mailbox-prime 997 | 404 | (defvar imap-mailbox-prime 997 |
| 396 | "Length of imap-mailbox-data.") | 405 | "Length of `imap-mailbox-data'.") |
| 397 | 406 | ||
| 398 | (defvar imap-current-message nil | 407 | (defvar imap-current-message nil |
| 399 | "Current message number.") | 408 | "Current message number.") |
| @@ -402,7 +411,7 @@ and `examine'.") | |||
| 402 | "Obarray with message data.") | 411 | "Obarray with message data.") |
| 403 | 412 | ||
| 404 | (defvar imap-message-prime 997 | 413 | (defvar imap-message-prime 997 |
| 405 | "Length of imap-message-data.") | 414 | "Length of `imap-message-data'.") |
| 406 | 415 | ||
| 407 | (defvar imap-capability nil | 416 | (defvar imap-capability nil |
| 408 | "Capability for server.") | 417 | "Capability for server.") |
| @@ -440,17 +449,23 @@ second the status (OK, NO, BAD etc) of the command.") | |||
| 440 | 449 | ||
| 441 | (defvar imap-enable-exchange-bug-workaround nil | 450 | (defvar imap-enable-exchange-bug-workaround nil |
| 442 | "Send FETCH UID commands as *:* instead of *. | 451 | "Send FETCH UID commands as *:* instead of *. |
| 443 | Enabling this appears to be required for some servers (e.g., | 452 | |
| 444 | Microsoft Exchange) which otherwise would trigger a response 'BAD | 453 | When non-nil, use an alternative UIDS form. Enabling appears to |
| 445 | The specified message set is invalid.'.") | 454 | be required for some servers (e.g., Microsoft Exchange 2007) |
| 455 | which otherwise would trigger a response 'BAD The specified | ||
| 456 | message set is invalid.'. We don't unconditionally use this | ||
| 457 | form, since this is said to be significantly inefficient. | ||
| 458 | |||
| 459 | This variable is set to t automatically per server if the | ||
| 460 | canonical form fails.") | ||
| 446 | 461 | ||
| 447 | 462 | ||
| 448 | ;; Utility functions: | 463 | ;; Utility functions: |
| 449 | 464 | ||
| 450 | (defun imap-remassoc (key alist) | 465 | (defun imap-remassoc (key alist) |
| 451 | "Delete by side effect any elements of LIST whose car is `equal' to KEY. | 466 | "Delete by side effect any elements of ALIST whose car is `equal' to KEY. |
| 452 | The modified LIST is returned. If the first member | 467 | The modified ALIST is returned. If the first member |
| 453 | of LIST has a car that is `equal' to KEY, there is no way to remove it | 468 | of ALIST has a car that is `equal' to KEY, there is no way to remove it |
| 454 | by side effect; therefore, write `(setq foo (remassoc key foo))' to be | 469 | by side effect; therefore, write `(setq foo (remassoc key foo))' to be |
| 455 | sure of changing the value of `foo'." | 470 | sure of changing the value of `foo'." |
| 456 | (when alist | 471 | (when alist |
| @@ -650,7 +665,7 @@ sure of changing the value of `foo'." | |||
| 650 | nil) | 665 | nil) |
| 651 | 666 | ||
| 652 | (defun imap-ssl-open (name buffer server port) | 667 | (defun imap-ssl-open (name buffer server port) |
| 653 | "Open a SSL connection to server." | 668 | "Open an SSL connection to SERVER." |
| 654 | (let ((cmds (if (listp imap-ssl-program) imap-ssl-program | 669 | (let ((cmds (if (listp imap-ssl-program) imap-ssl-program |
| 655 | (list imap-ssl-program))) | 670 | (list imap-ssl-program))) |
| 656 | cmd done) | 671 | cmd done) |
| @@ -711,6 +726,13 @@ sure of changing the value of `foo'." | |||
| 711 | (process (open-tls-stream name buffer server port))) | 726 | (process (open-tls-stream name buffer server port))) |
| 712 | (when process | 727 | (when process |
| 713 | (while (and (memq (process-status process) '(open run)) | 728 | (while (and (memq (process-status process) '(open run)) |
| 729 | ;; FIXME: Per the "blue moon" comment, the process/buffer | ||
| 730 | ;; handling here, and elsewhere in functions which open | ||
| 731 | ;; streams, looks confused. Obviously we can change buffers | ||
| 732 | ;; if a different process handler kicks in from | ||
| 733 | ;; `accept-process-output' or `sit-for' below, and TRT seems | ||
| 734 | ;; to be to `save-buffer' around those calls. (I wonder why | ||
| 735 | ;; `sit-for' is used with a non-zero wait.) -- fx | ||
| 714 | (set-buffer buffer) ;; XXX "blue moon" nntp.el bug | 736 | (set-buffer buffer) ;; XXX "blue moon" nntp.el bug |
| 715 | (goto-char (point-max)) | 737 | (goto-char (point-max)) |
| 716 | (forward-line -1) | 738 | (forward-line -1) |
| @@ -1081,7 +1103,7 @@ Returns t if login was successful, nil otherwise." | |||
| 1081 | imap-process)))) | 1103 | imap-process)))) |
| 1082 | 1104 | ||
| 1083 | (defun imap-open (server &optional port stream auth buffer) | 1105 | (defun imap-open (server &optional port stream auth buffer) |
| 1084 | "Open a IMAP connection to host SERVER at PORT returning a buffer. | 1106 | "Open an IMAP connection to host SERVER at PORT returning a buffer. |
| 1085 | If PORT is unspecified, a default value is used (143 except | 1107 | If PORT is unspecified, a default value is used (143 except |
| 1086 | for SSL which use 993). | 1108 | for SSL which use 993). |
| 1087 | STREAM indicates the stream to use, see `imap-streams' for available | 1109 | STREAM indicates the stream to use, see `imap-streams' for available |
| @@ -1402,7 +1424,7 @@ If EXAMINE is non-nil, do a read-only select." | |||
| 1402 | 1424 | ||
| 1403 | (defun imap-mailbox-expunge (&optional asynch buffer) | 1425 | (defun imap-mailbox-expunge (&optional asynch buffer) |
| 1404 | "Expunge articles in current folder in BUFFER. | 1426 | "Expunge articles in current folder in BUFFER. |
| 1405 | If ASYNCH, do not wait for succesful completion of the command. | 1427 | If ASYNCH, do not wait for successful completion of the command. |
| 1406 | If BUFFER is nil the current buffer is assumed." | 1428 | If BUFFER is nil the current buffer is assumed." |
| 1407 | (with-current-buffer (or buffer (current-buffer)) | 1429 | (with-current-buffer (or buffer (current-buffer)) |
| 1408 | (when (and imap-current-mailbox (not (eq imap-state 'examine))) | 1430 | (when (and imap-current-mailbox (not (eq imap-state 'examine))) |
| @@ -1412,7 +1434,7 @@ If BUFFER is nil the current buffer is assumed." | |||
| 1412 | 1434 | ||
| 1413 | (defun imap-mailbox-close (&optional asynch buffer) | 1435 | (defun imap-mailbox-close (&optional asynch buffer) |
| 1414 | "Expunge articles and close current folder in BUFFER. | 1436 | "Expunge articles and close current folder in BUFFER. |
| 1415 | If ASYNCH, do not wait for succesful completion of the command. | 1437 | If ASYNCH, do not wait for successful completion of the command. |
| 1416 | If BUFFER is nil the current buffer is assumed." | 1438 | If BUFFER is nil the current buffer is assumed." |
| 1417 | (with-current-buffer (or buffer (current-buffer)) | 1439 | (with-current-buffer (or buffer (current-buffer)) |
| 1418 | (when imap-current-mailbox | 1440 | (when imap-current-mailbox |
| @@ -1510,7 +1532,7 @@ passed to list command." | |||
| 1510 | (nreverse out))))) | 1532 | (nreverse out))))) |
| 1511 | 1533 | ||
| 1512 | (defun imap-mailbox-subscribe (mailbox &optional buffer) | 1534 | (defun imap-mailbox-subscribe (mailbox &optional buffer) |
| 1513 | "Send the SUBSCRIBE command on the mailbox to server in BUFFER. | 1535 | "Send the SUBSCRIBE command on the MAILBOX to server in BUFFER. |
| 1514 | Returns non-nil if successful." | 1536 | Returns non-nil if successful." |
| 1515 | (with-current-buffer (or buffer (current-buffer)) | 1537 | (with-current-buffer (or buffer (current-buffer)) |
| 1516 | (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \"" | 1538 | (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \"" |
| @@ -1518,7 +1540,7 @@ Returns non-nil if successful." | |||
| 1518 | "\""))))) | 1540 | "\""))))) |
| 1519 | 1541 | ||
| 1520 | (defun imap-mailbox-unsubscribe (mailbox &optional buffer) | 1542 | (defun imap-mailbox-unsubscribe (mailbox &optional buffer) |
| 1521 | "Send the SUBSCRIBE command on the mailbox to server in BUFFER. | 1543 | "Send the SUBSCRIBE command on the MAILBOX to server in BUFFER. |
| 1522 | Returns non-nil if successful." | 1544 | Returns non-nil if successful." |
| 1523 | (with-current-buffer (or buffer (current-buffer)) | 1545 | (with-current-buffer (or buffer (current-buffer)) |
| 1524 | (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE " | 1546 | (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE " |
| @@ -1528,8 +1550,8 @@ Returns non-nil if successful." | |||
| 1528 | (defun imap-mailbox-status (mailbox items &optional buffer) | 1550 | (defun imap-mailbox-status (mailbox items &optional buffer) |
| 1529 | "Get status items ITEM in MAILBOX from server in BUFFER. | 1551 | "Get status items ITEM in MAILBOX from server in BUFFER. |
| 1530 | ITEMS can be a symbol or a list of symbols, valid symbols are one of | 1552 | ITEMS can be a symbol or a list of symbols, valid symbols are one of |
| 1531 | the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity | 1553 | the STATUS data items -- i.e. `messages', `recent', `uidnext', `uidvalidity', |
| 1532 | or 'unseen. If ITEMS is a list of symbols, a list of values is | 1554 | or `unseen'. If ITEMS is a list of symbols, a list of values is |
| 1533 | returned, if ITEMS is a symbol only its value is returned." | 1555 | returned, if ITEMS is a symbol only its value is returned." |
| 1534 | (with-current-buffer (or buffer (current-buffer)) | 1556 | (with-current-buffer (or buffer (current-buffer)) |
| 1535 | (when (imap-ok-p | 1557 | (when (imap-ok-p |
| @@ -1550,7 +1572,7 @@ returned, if ITEMS is a symbol only its value is returned." | |||
| 1550 | (defun imap-mailbox-status-asynch (mailbox items &optional buffer) | 1572 | (defun imap-mailbox-status-asynch (mailbox items &optional buffer) |
| 1551 | "Send status item request ITEM on MAILBOX to server in BUFFER. | 1573 | "Send status item request ITEM on MAILBOX to server in BUFFER. |
| 1552 | ITEMS can be a symbol or a list of symbols, valid symbols are one of | 1574 | ITEMS can be a symbol or a list of symbols, valid symbols are one of |
| 1553 | the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity | 1575 | the STATUS data items -- i.e. 'messages, 'recent, 'uidnext, 'uidvalidity |
| 1554 | or 'unseen. The IMAP command tag is returned." | 1576 | or 'unseen. The IMAP command tag is returned." |
| 1555 | (with-current-buffer (or buffer (current-buffer)) | 1577 | (with-current-buffer (or buffer (current-buffer)) |
| 1556 | (imap-send-command (list "STATUS \"" | 1578 | (imap-send-command (list "STATUS \"" |
| @@ -1563,7 +1585,7 @@ or 'unseen. The IMAP command tag is returned." | |||
| 1563 | (list items)))))))) | 1585 | (list items)))))))) |
| 1564 | 1586 | ||
| 1565 | (defun imap-mailbox-acl-get (&optional mailbox buffer) | 1587 | (defun imap-mailbox-acl-get (&optional mailbox buffer) |
| 1566 | "Get ACL on mailbox from server in BUFFER." | 1588 | "Get ACL on MAILBOX from server in BUFFER." |
| 1567 | (let ((mailbox (imap-utf7-encode mailbox))) | 1589 | (let ((mailbox (imap-utf7-encode mailbox))) |
| 1568 | (with-current-buffer (or buffer (current-buffer)) | 1590 | (with-current-buffer (or buffer (current-buffer)) |
| 1569 | (when (imap-ok-p | 1591 | (when (imap-ok-p |
| @@ -1585,7 +1607,7 @@ or 'unseen. The IMAP command tag is returned." | |||
| 1585 | rights)))))) | 1607 | rights)))))) |
| 1586 | 1608 | ||
| 1587 | (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer) | 1609 | (defun imap-mailbox-acl-delete (identifier &optional mailbox buffer) |
| 1588 | "Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER." | 1610 | "Remove any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER." |
| 1589 | (let ((mailbox (imap-utf7-encode mailbox))) | 1611 | (let ((mailbox (imap-utf7-encode mailbox))) |
| 1590 | (with-current-buffer (or buffer (current-buffer)) | 1612 | (with-current-buffer (or buffer (current-buffer)) |
| 1591 | (imap-ok-p | 1613 | (imap-ok-p |
| @@ -1720,6 +1742,7 @@ is non-nil return these properties." | |||
| 1720 | `(with-current-buffer (or ,buffer (current-buffer)) | 1742 | `(with-current-buffer (or ,buffer (current-buffer)) |
| 1721 | (imap-message-get ,uid 'BODY))) | 1743 | (imap-message-get ,uid 'BODY))) |
| 1722 | 1744 | ||
| 1745 | ;; FIXME: Should this try to use CHARSET? -- fx | ||
| 1723 | (defun imap-search (predicate &optional buffer) | 1746 | (defun imap-search (predicate &optional buffer) |
| 1724 | (with-current-buffer (or buffer (current-buffer)) | 1747 | (with-current-buffer (or buffer (current-buffer)) |
| 1725 | (imap-mailbox-put 'search 'dummy) | 1748 | (imap-mailbox-put 'search 'dummy) |
| @@ -1766,9 +1789,38 @@ is non-nil return these properties." | |||
| 1766 | (let ((number (string-to-number string base))) | 1789 | (let ((number (string-to-number string base))) |
| 1767 | (if (> number most-positive-fixnum) | 1790 | (if (> number most-positive-fixnum) |
| 1768 | (error | 1791 | (error |
| 1769 | (format "String %s cannot be converted to a lisp integer" number)) | 1792 | (format "String %s cannot be converted to a Lisp integer" number)) |
| 1770 | number))) | 1793 | number))) |
| 1771 | 1794 | ||
| 1795 | (defun imap-fetch-safe (uids props &optional receive nouidfetch buffer) | ||
| 1796 | "Like `imap-fetch', but DTRT with Exchange 2007 bug. | ||
| 1797 | However, UIDS here is a cons, where the car is the canonical form | ||
| 1798 | of the UIDS specification, and the cdr is the one which works with | ||
| 1799 | Exchange 2007 or, potentially, other buggy servers. | ||
| 1800 | See `imap-enable-exchange-bug-workaround'." | ||
| 1801 | ;; We don't unconditionally use the alternative (valid) form, since | ||
| 1802 | ;; this is said to be significantly inefficient. The first time we | ||
| 1803 | ;; get here for a given, we'll try the canonical form. If we get | ||
| 1804 | ;; the known error from the buggy server, set the flag | ||
| 1805 | ;; buffer-locally (to account for connections to multiple servers), | ||
| 1806 | ;; then re-try with the alternative UIDS spec. | ||
| 1807 | (condition-case data | ||
| 1808 | (imap-fetch (if imap-enable-exchange-bug-workaround | ||
| 1809 | (cdr uids) | ||
| 1810 | (car uids)) | ||
| 1811 | props receive nouidfetch buffer) | ||
| 1812 | (error | ||
| 1813 | (if (and (not imap-enable-exchange-bug-workaround) | ||
| 1814 | (string-match | ||
| 1815 | "The specified message set is invalid" | ||
| 1816 | (cadr data))) | ||
| 1817 | (with-current-buffer (or buffer (current-buffer)) | ||
| 1818 | (set (make-local-variable | ||
| 1819 | 'imap-enable-exchange-bug-workaround) | ||
| 1820 | t) | ||
| 1821 | (imap-fetch (cdr uids) props receive nouidfetch)) | ||
| 1822 | (signal (car data) (cdr data)))))) | ||
| 1823 | |||
| 1772 | (defun imap-message-copyuid-1 (mailbox) | 1824 | (defun imap-message-copyuid-1 (mailbox) |
| 1773 | (if (imap-capability 'UIDPLUS) | 1825 | (if (imap-capability 'UIDPLUS) |
| 1774 | (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox)) | 1826 | (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox)) |
| @@ -1778,8 +1830,7 @@ is non-nil return these properties." | |||
| 1778 | (imap-message-data (make-vector 2 0))) | 1830 | (imap-message-data (make-vector 2 0))) |
| 1779 | (when (imap-mailbox-examine-1 mailbox) | 1831 | (when (imap-mailbox-examine-1 mailbox) |
| 1780 | (prog1 | 1832 | (prog1 |
| 1781 | (and (imap-fetch | 1833 | (and (imap-fetch-safe '("*" . "*:*") "UID") |
| 1782 | (if imap-enable-exchange-bug-workaround "*:*" "*") "UID") | ||
| 1783 | (list (imap-mailbox-get-1 'uidvalidity mailbox) | 1834 | (list (imap-mailbox-get-1 'uidvalidity mailbox) |
| 1784 | (apply 'max (imap-message-map | 1835 | (apply 'max (imap-message-map |
| 1785 | (lambda (uid prop) uid) 'UID)))) | 1836 | (lambda (uid prop) uid) 'UID)))) |
| @@ -1793,11 +1844,11 @@ is non-nil return these properties." | |||
| 1793 | 1844 | ||
| 1794 | (defun imap-message-copy (articles mailbox | 1845 | (defun imap-message-copy (articles mailbox |
| 1795 | &optional dont-create no-copyuid buffer) | 1846 | &optional dont-create no-copyuid buffer) |
| 1796 | "Copy ARTICLES (a string message set) to MAILBOX on server in | 1847 | "Copy ARTICLES to MAILBOX on server in BUFFER. |
| 1797 | BUFFER, creating mailbox if it doesn't exist. If dont-create is | 1848 | ARTICLES is a string message set. Create mailbox if it doesn't exist, |
| 1798 | non-nil, it will not create a mailbox. On success, return a list with | 1849 | unless DONT-CREATE is non-nil. On success, return a list with |
| 1799 | the UIDVALIDITY of the mailbox the article(s) was copied to as the | 1850 | the UIDVALIDITY of the mailbox the article(s) was copied to as the |
| 1800 | first element, rest of list contain the saved articles' UIDs." | 1851 | first element. The rest of list contains the saved articles' UIDs." |
| 1801 | (when articles | 1852 | (when articles |
| 1802 | (with-current-buffer (or buffer (current-buffer)) | 1853 | (with-current-buffer (or buffer (current-buffer)) |
| 1803 | (let ((mailbox (imap-utf7-encode mailbox))) | 1854 | (let ((mailbox (imap-utf7-encode mailbox))) |
| @@ -1815,6 +1866,8 @@ first element, rest of list contain the saved articles' UIDs." | |||
| 1815 | (or no-copyuid | 1866 | (or no-copyuid |
| 1816 | (imap-message-copyuid-1 mailbox))))))) | 1867 | (imap-message-copyuid-1 mailbox))))))) |
| 1817 | 1868 | ||
| 1869 | ;; FIXME: Amalgamate with imap-message-copyuid-1, using an extra arg, since it | ||
| 1870 | ;; shares most of the code? -- fx | ||
| 1818 | (defun imap-message-appenduid-1 (mailbox) | 1871 | (defun imap-message-appenduid-1 (mailbox) |
| 1819 | (if (imap-capability 'UIDPLUS) | 1872 | (if (imap-capability 'UIDPLUS) |
| 1820 | (imap-mailbox-get-1 'appenduid mailbox) | 1873 | (imap-mailbox-get-1 'appenduid mailbox) |
| @@ -1823,8 +1876,7 @@ first element, rest of list contain the saved articles' UIDs." | |||
| 1823 | (imap-message-data (make-vector 2 0))) | 1876 | (imap-message-data (make-vector 2 0))) |
| 1824 | (when (imap-mailbox-examine-1 mailbox) | 1877 | (when (imap-mailbox-examine-1 mailbox) |
| 1825 | (prog1 | 1878 | (prog1 |
| 1826 | (and (imap-fetch | 1879 | (and (imap-fetch-safe '("*" . "*:*") "UID") |
| 1827 | (if imap-enable-exchange-bug-workaround "*:*" "*") "UID") | ||
| 1828 | (list (imap-mailbox-get-1 'uidvalidity mailbox) | 1880 | (list (imap-mailbox-get-1 'uidvalidity mailbox) |
| 1829 | (apply 'max (imap-message-map | 1881 | (apply 'max (imap-message-map |
| 1830 | (lambda (uid prop) uid) 'UID)))) | 1882 | (lambda (uid prop) uid) 'UID)))) |
| @@ -2201,7 +2253,7 @@ Return nil if no complete line has arrived." | |||
| 2201 | ;; resp-cond-bye = "BYE" SP resp-text | 2253 | ;; resp-cond-bye = "BYE" SP resp-text |
| 2202 | 2254 | ||
| 2203 | (defun imap-parse-greeting () | 2255 | (defun imap-parse-greeting () |
| 2204 | "Parse a IMAP greeting." | 2256 | "Parse an IMAP greeting." |
| 2205 | (cond ((looking-at "\\* OK ") | 2257 | (cond ((looking-at "\\* OK ") |
| 2206 | (setq imap-state 'nonauth)) | 2258 | (setq imap-state 'nonauth)) |
| 2207 | ((looking-at "\\* PREAUTH ") | 2259 | ((looking-at "\\* PREAUTH ") |
| @@ -2623,7 +2675,7 @@ Return nil if no complete line has arrived." | |||
| 2623 | 2675 | ||
| 2624 | (defun imap-parse-flag-list () | 2676 | (defun imap-parse-flag-list () |
| 2625 | (let (flag-list start) | 2677 | (let (flag-list start) |
| 2626 | (assert (eq (char-after) ?\() nil "In imap-parse-flag-list") | 2678 | (assert (eq (char-after) ?\() nil "In imap-parse-flag-list 1") |
| 2627 | (while (and (not (eq (char-after) ?\))) | 2679 | (while (and (not (eq (char-after) ?\))) |
| 2628 | (setq start (progn | 2680 | (setq start (progn |
| 2629 | (imap-forward) | 2681 | (imap-forward) |
| @@ -2632,7 +2684,7 @@ Return nil if no complete line has arrived." | |||
| 2632 | (point))) | 2684 | (point))) |
| 2633 | (> (skip-chars-forward "^ )" (point-at-eol)) 0)) | 2685 | (> (skip-chars-forward "^ )" (point-at-eol)) 0)) |
| 2634 | (push (buffer-substring start (point)) flag-list)) | 2686 | (push (buffer-substring start (point)) flag-list)) |
| 2635 | (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list") | 2687 | (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list 2") |
| 2636 | (imap-forward) | 2688 | (imap-forward) |
| 2637 | (nreverse flag-list))) | 2689 | (nreverse flag-list))) |
| 2638 | 2690 | ||
| @@ -2828,7 +2880,7 @@ Return nil if no complete line has arrived." | |||
| 2828 | (let (subbody) | 2880 | (let (subbody) |
| 2829 | (while (and (eq (char-after) ?\() | 2881 | (while (and (eq (char-after) ?\() |
| 2830 | (setq subbody (imap-parse-body))) | 2882 | (setq subbody (imap-parse-body))) |
| 2831 | ;; buggy stalker communigate pro 3.0 insert a SPC between | 2883 | ;; buggy stalker communigate pro 3.0 inserts a SPC between |
| 2832 | ;; parts in multiparts | 2884 | ;; parts in multiparts |
| 2833 | (when (and (eq (char-after) ?\ ) | 2885 | (when (and (eq (char-after) ?\ ) |
| 2834 | (eq (char-after (1+ (point))) ?\()) | 2886 | (eq (char-after (1+ (point))) ?\()) |
| @@ -2861,22 +2913,28 @@ Return nil if no complete line has arrived." | |||
| 2861 | (imap-forward) | 2913 | (imap-forward) |
| 2862 | (push (imap-parse-nstring) body) ;; body-fld-desc | 2914 | (push (imap-parse-nstring) body) ;; body-fld-desc |
| 2863 | (imap-forward) | 2915 | (imap-forward) |
| 2864 | ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a | 2916 | ;; Next `or' for Sun SIMS bug. It regards body-fld-enc as a |
| 2865 | ;; nstring and return nil instead of defaulting back to 7BIT | 2917 | ;; nstring and returns nil instead of defaulting back to 7BIT |
| 2866 | ;; as the standard says. | 2918 | ;; as the standard says. |
| 2919 | ;; Exchange (2007, at least) does this as well. | ||
| 2867 | (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc | 2920 | (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc |
| 2868 | (imap-forward) | 2921 | (imap-forward) |
| 2869 | (push (imap-parse-number) body) ;; body-fld-octets | 2922 | ;; Exchange 2007 can return -1, contrary to the spec... |
| 2923 | (if (eq (char-after) ?-) | ||
| 2924 | (progn | ||
| 2925 | (skip-chars-forward "-0-9") | ||
| 2926 | (push nil body)) | ||
| 2927 | (push (imap-parse-number) body)) ;; body-fld-octets | ||
| 2870 | 2928 | ||
| 2871 | ;; ok, we're done parsing the required parts, what comes now is one | 2929 | ;; Ok, we're done parsing the required parts, what comes now is one of |
| 2872 | ;; of three things: | 2930 | ;; three things: |
| 2873 | ;; | 2931 | ;; |
| 2874 | ;; envelope (then we're parsing body-type-msg) | 2932 | ;; envelope (then we're parsing body-type-msg) |
| 2875 | ;; body-fld-lines (then we're parsing body-type-text) | 2933 | ;; body-fld-lines (then we're parsing body-type-text) |
| 2876 | ;; body-ext-1part (then we're parsing body-type-basic) | 2934 | ;; body-ext-1part (then we're parsing body-type-basic) |
| 2877 | ;; | 2935 | ;; |
| 2878 | ;; the problem is that the two first are in turn optionally followed | 2936 | ;; The problem is that the two first are in turn optionally followed |
| 2879 | ;; by the third. So we parse the first two here (if there are any)... | 2937 | ;; by the third. So we parse the first two here (if there are any)... |
| 2880 | 2938 | ||
| 2881 | (when (eq (char-after) ?\ ) | 2939 | (when (eq (char-after) ?\ ) |
| 2882 | (imap-forward) | 2940 | (imap-forward) |