[VM] VM suddenly becoming slow on accessing imap server

[Robert Marshall]

Recently I found that vm has become very slow when querying the server
for new messages. At the start of an emacs session it is fast but it
gradually gets slower. At the moment it is taking around 30 seconds to
query the server during which the minibuffer displays
      Logging into the IMAP server...

when I then save the imap folder there's a similar delay (and the same
stage minibuffer message). On starting emacs the delay is around 1 sec!
When there's a long delay waiting for the messages to arrive emacs is
thrashing the CPU so it's not a network problem - or at least not one
where it's timing out on something. The imap server is within my local
home network. Kmail using the same server and same IMAP folder doesn't
show delays like this.


I've recently updated my emacs build (from bzr) - before the vm problem
appeared but on setting debug-on-quit and C-g during the wait it doesn't
look like a problem within emacs (rather than vm) though it could
be. Maybe I have a recently arrived email in my INBOX which causing the
issue?  (the INBOX has around 600 messages and the
~/Mail/imap-cache... file is 20 meg)

I've tried killing the imap/stunnel process and then getting but there's
the same delay

An example traceback on C-g follows (just the top few levels)
from vm-get-new-mail

(setq pl (cdr (nth 1 p)) flags nil)
(cond ((vm-imap-response-matches p (quote UID) (quote atom)) (setq tok
(nth 1 p)) (setq uid (buffer-substring (nth 1 tok) (nth 2 tok))) (setq p
(nthcdr 2 p))) ((vm-imap-response-matches p (quote RFC822\.SIZE) (quote
atom)) (setq tok (nth 1 p)) (setq size (buffer-substring (nth 1 tok)
(nth 2 tok))) (setq p (nthcdr 2 p))) ((vm-imap-response-matches p (quote
FLAGS) (quote list)) (setq pl (cdr (nth 1 p)) flags nil) (while pl (setq
tok (car pl)) (if (not (vm-imap-response-matches (list tok) (quote
atom))) (vm-imap-protocol-error "expected atom in FLAGS list in FETCH
response")) (setq flag (downcase (buffer-substring (nth 1 tok) (nth 2
tok))) flags (cons flag flags) pl (cdr pl))) (setq p (nthcdr 2 p))) (t
(vm-imap-protocol-error "expected UID, RFC822.SIZE and (FLAGS list) in
FETCH response")))

(while p (cond ((vm-imap-response-matches p (quote UID) (quote atom))
(setq tok (nth 1 p)) (setq uid (buffer-substring (nth 1 tok) (nth 2
tok))) (setq p (nthcdr 2 p))) ((vm-imap-response-matches p (quote
RFC822\.SIZE) (quote atom)) (setq tok (nth 1 p)) (setq size
(buffer-substring (nth 1 tok) (nth 2 tok))) (setq p (nthcdr 2 p)))
((vm-imap-response-matches p (quote FLAGS) (quote list)) (setq pl (cdr
(nth 1 p)) flags nil) (while pl (setq tok (car pl)) (if (not
(vm-imap-response-matches (list tok) (quote atom)))
(vm-imap-protocol-error "expected atom in FLAGS list in FETCH
response")) (setq flag (downcase (buffer-substring (nth 1 tok) (nth 2
tok))) flags (cons flag flags) pl (cdr pl))) (setq p (nthcdr 2 p))) (t
(vm-imap-protocol-error "expected UID, RFC822.SIZE and (FLAGS list) in
FETCH response"))))

(cond ((vm-imap-response-matches response (quote *) (quote atom) (quote
FETCH) (quote list)) (setq p (cdr (nth 3 response))) (setq tok (nth 1
response)) (goto-char (nth 1 tok)) (setq msg-num (read imap-buffer))
(while p (cond ((vm-imap-response-matches p (quote UID) (quote atom))
(setq tok (nth 1 p)) (setq uid (buffer-substring (nth 1 tok) (nth 2
tok))) (setq p (nthcdr 2 p))) ((vm-imap-response-matches p (quote
RFC822\.SIZE) (quote atom)) (setq tok (nth 1 p)) (setq size
(buffer-substring (nth 1 tok) (nth 2 tok))) (setq p (nthcdr 2 p)))
((vm-imap-response-matches p (quote FLAGS) (quote list)) (setq pl (cdr
(nth 1 p)) flags nil) (while pl (setq tok (car pl)) (if (not ...)
(vm-imap-protocol-error "expected atom in FLAGS list in FETCH
response")) (setq flag (downcase ...) flags (cons flag flags) pl (cdr
pl))) (setq p (nthcdr 2 p))) (t (vm-imap-protocol-error "expected UID,
RFC822.SIZE and (FLAGS list) in FETCH response")))) (setq list (cons
(cons msg-num (cons uid (cons size flags))) list)))
((vm-imap-response-matches response (quote VM) (quote OK)) (setq need-ok
nil)))

(while need-ok (setq response (vm-imap-read-response-and-verify process
"FLAGS FETCH")) (cond ((vm-imap-response-matches response (quote *)
(quote atom) (quote FETCH) (quote list)) (setq p (cdr (nth 3 response)))
(setq tok (nth 1 response)) (goto-char (nth 1 tok)) (setq msg-num (read
imap-buffer)) (while p (cond ((vm-imap-response-matches p (quote UID)
(quote atom)) (setq tok (nth 1 p)) (setq uid (buffer-substring ... ...))
(setq p (nthcdr 2 p))) ((vm-imap-response-matches p (quote RFC822\.SIZE)
(quote atom)) (setq tok (nth 1 p)) (setq size (buffer-substring
... ...)) (setq p (nthcdr 2 p))) ((vm-imap-response-matches p (quote
FLAGS) (quote list)) (setq pl (cdr ...) flags nil) (while pl (setq tok
...) (if ... ...) (setq flag ... flags ... pl ...)) (setq p (nthcdr 2
p))) (t (vm-imap-protocol-error "expected UID, RFC822.SIZE and (FLAGS
list) in FETCH response")))) (setq list (cons (cons msg-num (cons uid
(cons size flags))) list))) ((vm-imap-response-matches response (quote
VM) (quote OK)) (setq need-ok nil))))

I can submit a bug but thought the extra visibility might cause others
to add suggestions.

Robert
-- 
La grenouille songe..dans son château d'eau
Links and things http://rmstar.blogspot.com/