;;; imap.el --- imap library
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: mail
(eval-when-compile (require 'cl))
(eval-and-compile
+ ;; For Emacs <22.2 and XEmacs.
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
(autoload 'starttls-open-stream "starttls")
(autoload 'starttls-negotiate "starttls")
The function should take two arguments, the first the IMAP tag and the
second the status (OK, NO, BAD etc) of the command.")
+(defvar imap-enable-exchange-bug-workaround nil
+ "Send FETCH UID commands as *:* instead of *.
+
+When non-nil, use an alternative UIDS form. Enabling appears to
+be required for some servers (e.g., Microsoft Exchange 2007)
+which otherwise would trigger a response 'BAD The specified
+message set is invalid.'. We don't unconditionally use this
+form, since this is said to be significantly inefficient.
+
+This variable is set to t automatically per server if the
+canonical form fails.")
+
\f
;; Utility functions:
(format "String %s cannot be converted to a Lisp integer" number))
number)))
+(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer)
+ "Like `imap-fetch', but DTRT with Exchange 2007 bug.
+However, UIDS here is a cons, where the car is the canonical form
+of the UIDS specification, and the cdr is the one which works with
+Exchange 2007 or, potentially, other buggy servers.
+See `imap-enable-exchange-bug-workaround'."
+ ;; The first time we get here for a given, we'll try the canonical
+ ;; form. If we get the known error from the buggy server, set the
+ ;; flag buffer-locally (to account for connections to multiple
+ ;; servers), then re-try with the alternative UIDS spec. We don't
+ ;; unconditionally use the alternative form, since the
+ ;; currently-used alternatives are seriously inefficient with some
+ ;; servers (although they are valid).
+ ;;
+ ;; FIXME: Maybe it would be cleaner to have a flag to not signal
+ ;; the error (which otherwise gives a message), and test
+ ;; `imap-failed-tags'. Also, Other IMAP clients use other forms of
+ ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:*
+ ;; (UID)" rather than "FETCH UID 1,*". Is there a good reason not
+ ;; to do the same?
+ (condition-case data
+ ;; Binding `debug-on-error' allows us to get the error from
+ ;; `imap-parse-response' -- it's normally caught by Emacs around
+ ;; execution of a process filter.
+ (let ((debug-on-error t))
+ (imap-fetch (if imap-enable-exchange-bug-workaround
+ (cdr uids)
+ (car uids))
+ props receive nouidfetch buffer))
+ (error
+ (if (and (not imap-enable-exchange-bug-workaround)
+ ;; This is the Exchange 2007 response. It may be more
+ ;; robust just to check for a BAD response to the
+ ;; attempted fetch.
+ (string-match "The specified message set is invalid"
+ (cadr data)))
+ (with-current-buffer (or buffer (current-buffer))
+ (set (make-local-variable 'imap-enable-exchange-bug-workaround)
+ t)
+ (imap-fetch (cdr uids) props receive nouidfetch))
+ (signal (car data) (cdr data))))))
+
(defun imap-message-copyuid-1 (mailbox)
(if (imap-capability 'UIDPLUS)
(list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
- (and (imap-fetch "*:*" "UID")
+ (and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
(imap-message-data (make-vector 2 0)))
(when (imap-mailbox-examine-1 mailbox)
(prog1
- (and (imap-fetch "*:*" "UID")
+ (and (imap-fetch-safe '("*" . "*:*") "UID")
(list (imap-mailbox-get-1 'uidvalidity mailbox)
(apply 'max (imap-message-map
(lambda (uid prop) uid) 'UID))))
imap-list-to-message-set
imap-fetch-asynch
imap-fetch
+ imap-fetch-safe
imap-message-put
imap-message-get
imap-message-map