Re: imap.el workaround for Exchange 2007

[Dave Love <fx@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 1257 bytes --]

Reiner Steib <reinersteib+gmane@imap.cc> writes:

> You meant "*:*" (i.e. the variant used if
> `imap-enable-exchange-bug-workaround' is t)?

Oops, yes.

> If I recall the
> discussion correctly, this is much slower.
> Cf. <http://thread.gmane.org/gmane.emacs.gnus.general/66635>.

That refers to a different sequence set but anyhow see below.  I haven't
checked the traffic with anything except exchange.

>> Alternatively, perhaps it should check for Exchange and set it
>> (per-server?) automatically, 
>
> This has been discussed, but nobody implemented it yet.  I also think
> this would be the right thing.

I think the change below DTRT, as it checks for the exact problem.  I've
tested it with our exchange server.  Sorry it's conflated with some
random doc/commentary changes -- I should use darcs in parallel...  You
might want to note or zap the `fixme' comments in particular.

>> or otherwise at least provide a user variable to customize.
>
> Making `imap-enable-exchange-bug-workaround' customizable?

Yes, but that's moot if this change is OK.

> Installed.  (IIRC you still have write access to the repository, don't
> you?)

I don't know, but as my access to the Emacs repository was chopped, I
don't suppose I should be using it anyway.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 11422 bytes --]

2008-12-23  Dave Love  <fx@gnu.org>

	* imap.el: Doc fixes.
	(imap-fetch-safe): New.
	(imap-message-copyuid-1, imap-message-appenduid-1): Use it.
	(imap-parse-flag-list): Disambiguate assertion.

	* nnimap.el: Fix author address.
	(nnimap-debug): Doc fix.
	(nnimap-find-minmax-uid): Use imap-fetch-safe.

Index: nnimap.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/nnimap.el,v
retrieving revision 7.55
diff -u -F^( -r7.55 nnimap.el
--- nnimap.el	3 Dec 2008 20:33:34 -0000	7.55
+++ nnimap.el	23 Dec 2008 11:41:37 -0000
@@ -3,7 +3,7 @@
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
 ;;   2007, 2008  Free Software Foundation, Inc.
 
-;; Author: Simon Josefsson <jas@pdc.kth.se>
+;; Author: Simon Josefsson <simon@josefsson.org>
 ;;         Jim Radford <radford@robby.caltech.edu>
 ;; Keywords: mail
 
@@ -163,6 +163,8 @@ (defcustom nnimap-split-rule nil
 before, either a function, or a list with group/regexp or
 group/function elements."
   :group 'nnimap
+  ;; fixme: doesn't allow `("my2server" ("INBOX" nnimap-split-fancy))'
+  ;; per example above.
   :type '(choice :tag "Rule type"
 		 (repeat :menu-tag "Single-server"
 			 :tag "Single-server list"
@@ -460,11 +462,17 @@ (defcustom nnimap-id nil
 		 (plist :key-type string :value-type string)))
 
 (defcustom nnimap-debug nil
-  "If non-nil, random debug spews are placed in *nnimap-debug* buffer.
+  "If non-nil, trace nnimap- functions into `nnimap-debug-buffer'.
+Uses `trace-function-background', so you can turn it off with,
+say, `untrace-all'.
+
 Note that username, passwords and other privacy sensitive
-information (such as e-mail) may be stored in the *nnimap-debug*
-buffer.  It is not written to disk, however.  Do not enable this
-variable unless you are comfortable with that."
+information (such as e-mail) may be stored in the buffer.
+It is not written to disk, however.  Do not enable this
+variable unless you are comfortable with that.
+
+This variable only takes effect when loading the `nnimap' library.
+See also `nnimap-log'."
   :group 'nnimap
   :type 'boolean)
 
@@ -555,8 +562,7 @@ (defun nnimap-find-minmax-uid (group &op
 	      (imap-mailbox-select group examine))
       (let (minuid maxuid)
 	(when (> (imap-mailbox-get 'exists) 0)
-	  (imap-fetch (if imap-enable-exchange-bug-workaround "1,*:*" "1,*")
-		      "UID" nil 'nouidfetch)
+	  (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch)
 	  (imap-message-map (lambda (uid Uid)
 			      (setq minuid (if minuid (min minuid uid) uid)
 				    maxuid (if maxuid (max maxuid uid) uid)))
Index: imap.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/imap.el,v
retrieving revision 7.48
diff -u -F^( -r7.48 imap.el
--- imap.el	22 Dec 2008 22:38:50 -0000	7.48
+++ imap.el	23 Dec 2008 15:36:08 -0000
@@ -212,12 +212,12 @@ (defcustom imap-shell-program '("ssh %s 
 
 (defcustom imap-process-connection-type nil
   "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
-The `process-connection-type' variable control type of device
+The `process-connection-type' variable controls the type of device
 used to communicate with subprocesses.  Values are nil to use a
 pipe, or t or `pty' to use a pty.  The value has no effect if the
 system has no ptys or if all ptys are busy: then a pipe is used
-in any case.  The value takes effect when a IMAP server is
-opened, changing it after that has no effect."
+in any case.  The value takes effect when an IMAP server is
+opened; changing it after that has no effect."
   :version "22.1"
   :group 'imap
   :type 'boolean)
@@ -242,10 +242,13 @@ (defcustom imap-log nil
   :type 'boolean)
 
 (defcustom imap-debug nil
-  "If non-nil, random debug spews are placed in *imap-debug* buffer.
+  "If non-nil, trace imap- functions into `imap-debug-buffer'.
+Uses `trace-function-background', so you can turn it off with,
+say, `untrace-all'.
+
 Note that username, passwords and other privacy sensitive
-information (such as e-mail) may be stored in the *imap-debug*
-buffer.  It is not written to disk, however.  Do not enable this
+information (such as e-mail) may be stored in the buffer.
+It is not written to disk, however.  Do not enable this
 variable unless you are comfortable with that.
 
 This variable only takes effect when loading the `imap' library.
@@ -717,6 +720,15 @@ (defun imap-tls-open (name buffer server
 	 (process (open-tls-stream name buffer server port)))
     (when process
       (while (and (memq (process-status process) '(open run))
+		  ;; Fixme:  Per the "blue moon" comment, the
+		  ;; process/buffer handling here, and elsewhere in
+		  ;; functions which open streams, looks confused.
+		  ;; Obviously we can change buffers if a different
+		  ;; process handler kicks in from
+		  ;; `accept-process-output' or `sit-for' below, and
+		  ;; TRT seems to be to `save-buffer' around those
+		  ;; calls.  (I wonder why `sit-for' is used with a
+		  ;; non-zero wait.)  -- fx
 		  (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
 		  (goto-char (point-max))
 		  (forward-line -1)
@@ -1087,7 +1099,7 @@ (defun imap-open-1 (buffer)
 	   imap-process))))
 
 (defun imap-open (server &optional port stream auth buffer)
-  "Open a IMAP connection to host SERVER at PORT returning a buffer.
+  "Open an IMAP connection to host SERVER at PORT returning a buffer.
 If PORT is unspecified, a default value is used (143 except
 for SSL which use 993).
 STREAM indicates the stream to use, see `imap-streams' for available
@@ -1726,6 +1738,7 @@ (defmacro imap-message-body (uid &option
   `(with-current-buffer (or ,buffer (current-buffer))
      (imap-message-get ,uid 'BODY)))
 
+;; Fixme:  Should this try to use CHARSET?
 (defun imap-search (predicate &optional buffer)
   (with-current-buffer (or buffer (current-buffer))
     (imap-mailbox-put 'search 'dummy)
@@ -1772,9 +1785,38 @@ (defun imap-string-to-integer (string &o
   (let ((number (string-to-number string base)))
     (if (> number most-positive-fixnum)
 	(error
-	 (format "String %s cannot be converted to a lisp integer" number))
+	 (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'."
+  ;; We don't unconditionally use the alternative (valid) form, since
+  ;; this is said to be significantly inefficient.  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 connexions to multiple servers),
+  ;; then re-try with the alternative UIDS spec.
+  (condition-case data
+      (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)
+	      (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))
@@ -1784,11 +1826,7 @@ (defun imap-message-copyuid-1 (mailbox)
 	  (imap-message-data (make-vector 2 0)))
       (when (imap-mailbox-examine-1 mailbox)
 	(prog1
-	    (and (imap-fetch
-		  ;; why the switch here, since they seem to be
-		  ;; equivalent, and ~ no-one is going to find this
-		  ;; switch?  -- fx
-		  (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
+	    (and (imap-fetch-safe '("*" . "*:*") "UID")
 		 (list (imap-mailbox-get-1 'uidvalidity mailbox)
 		       (apply 'max (imap-message-map
 				    (lambda (uid prop) uid) 'UID))))
@@ -1824,6 +1862,8 @@ (defun imap-message-copy (articles mailb
 	    (or no-copyuid
 		(imap-message-copyuid-1 mailbox)))))))
 
+;; Fixme: Amalgamate with imap-message-copyuid-1, using an extra arg,
+;; since it shares most of the code?
 (defun imap-message-appenduid-1 (mailbox)
   (if (imap-capability 'UIDPLUS)
       (imap-mailbox-get-1 'appenduid mailbox)
@@ -1832,8 +1872,7 @@ (defun imap-message-appenduid-1 (mailbox
 	  (imap-message-data (make-vector 2 0)))
       (when (imap-mailbox-examine-1 mailbox)
 	(prog1
-	    (and (imap-fetch
-		  (if imap-enable-exchange-bug-workaround "*:*" "*") "UID")
+	    (and (imap-fetch-safe '("*" "*:*") "UID")
 		 (list (imap-mailbox-get-1 'uidvalidity mailbox)
 		       (apply 'max (imap-message-map
 				    (lambda (uid prop) uid) 'UID))))
@@ -2210,7 +2249,7 @@ (defsubst imap-parse-mailbox ()
 ;;   resp-cond-bye   = "BYE" SP resp-text
 
 (defun imap-parse-greeting ()
-  "Parse a IMAP greeting."
+  "Parse an IMAP greeting."
   (cond ((looking-at "\\* OK ")
 	 (setq imap-state 'nonauth))
 	((looking-at "\\* PREAUTH ")
@@ -2255,7 +2294,7 @@ (defun imap-parse-greeting ()
 ;;                       ; capability.
 
 (defun imap-parse-response ()
-  "Parse a IMAP command response."
+  "Parse an IMAP command response."
   (let (token)
     (case (setq token (read (current-buffer)))
       (+ (setq imap-continuation
@@ -2637,7 +2676,7 @@ (defun imap-parse-flag-list ()
 			      (point)))
 		(> (skip-chars-forward "^ )" (point-at-eol)) 0))
       (push (buffer-substring start (point)) flag-list))
-    (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
+    (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list 2")
     (imap-forward)
     (nreverse flag-list)))
 
@@ -2866,9 +2905,10 @@ (defun imap-parse-body ()
 	(imap-forward)
 	(push (imap-parse-nstring) body) ;; body-fld-desc
 	(imap-forward)
-	;; next `or' for Sun SIMS bug, it regard body-fld-enc as a
-	;; nstring and return nil instead of defaulting back to 7BIT
+	;; Next `or' for Sun SIMS bug.  It regards body-fld-enc as a
+	;; nstring and returns nil instead of defaulting back to 7BIT
 	;; as the standard says.
+	;; Exchange (2007, at least) does this as well.
 	(push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
 	(imap-forward)
 	;; Exchange 2007 can return -1, contrary to the spec...
@@ -2878,15 +2918,15 @@ (defun imap-parse-body ()
 	      (push nil body))
 	  (push (imap-parse-number) body)) ;; body-fld-octets
 
-   ;; ok, we're done parsing the required parts, what comes now is one
+	;; ok, we're done parsing the required parts, what comes now is one
 	;; of three things:
 	;;
 	;; envelope       (then we're parsing body-type-msg)
 	;; body-fld-lines (then we're parsing body-type-text)
 	;; body-ext-1part (then we're parsing body-type-basic)
 	;;
-  ;; the problem is that the two first are in turn optionally followed
-;; by the third.  So we parse the first two here (if there are any)...
+	;; the problem is that the two first are in turn optionally followed
+	;; by the third.  So we parse the first two here (if there are any)...
 
 	(when (eq (char-after) ?\ )
 	  (imap-forward)