BODY.PEEK change breaks mail-source-fetch-imap

BODY.PEEK change breaks mail-source-fetch-imap

[mi-gnus]

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


After running an older snapshot for a few weeks today i finally
updated to the latest CVS and was in for an unpleasant surprise: IMAP
fetching blew up in a spectacular way. See the attached backtrace. I
narrowed it down to the following change:

2001-10-01  Simon Josefsson  <jas@extundo.com>

        * mail-source.el (mail-source-fetch-imap): Use BODY.PEEK if server
        is IMAP4rev1.

% cvs diff -D 2001/10/01 -D 2001/10/02 mail-source.el
Index: mail-source.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/mail-source.el,v
retrieving revision 6.9
retrieving revision 6.10
diff -u -b -B -r6.9 -r6.10
--- mail-source.el      2001/08/30 18:40:37     6.9
+++ mail-source.el      2001/10/01 20:18:38     6.10
@@ -901,7 +901,10 @@
                  (push (cons from imap-password) mail-source-password-cache)))
              ;; if predicate is nil, use all uids
              (dolist (uid (imap-search (or predicate "1:*") buf))
-               (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))
+               (when (setq str (if (imap-capability 'IMAP4rev1 buf)
+                                   (imap-fetch uid "BODY.PEEK[]" 'BODYDETAIL
+                                               nil buf)
+                           (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
                  (push uid remove)
                  (insert "From imap " (current-time-string) "\n")
                  (save-excursion


Disabling the BODY.PEEK code fixes my problems:

-               (when (setq str (if (imap-capability 'IMAP4rev1 buf)
+               (when (setq str (if nil ;(imap-capability 'IMAP4rev1 buf)


The local imap server is imap-uw 4.7c6:

* OK popserv2.redback.com IMAP4rev1 2000.279 at Wed, 7 Nov 2001 18:27:00 -0800 (PST)

Please let me know if there is any more data you would like.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gnus backtrace --]
[-- Type: text/plain; charset=utf-8, Size: 7334 bytes --]

Debugger entered--Lisp error: (wrong-type-argument char-or-string-p (("" nil "Return-Path: <root@redback.com>
Delivered-To: istvan+foo@redback.com
Received: from elvis.redback.com (elvis.redback.com [155.53.12.7])
	by prattle.redback.com (Postfix) with ESMTP id AA8B7F2C4C
	for <istvan+foo@redback.com>; Wed,  7 Nov 2001 18:15:35 -0800 (PST)
Received: (from root@localhost)
	by elvis.redback.com (8.8.8/8.8.8/null redback bsdclient) id SAA01504
	for istvan; Wed, 7 Nov 2001 18:15:35 -0800 (PST)
Date: Wed, 7 Nov 2001 18:15:35 -0800 (PST)
From: <root@redback.com>
Message-Id: <200111080215.SAA01504@elvis.redback.com>
To: istvan+foo@redback.com
Subject: foo

")))
  insert((("" nil "Return-Path: <root@redback.com>\r\nDelivered-To: istvan+foo@redback.com\r\nReceived: from elvis.redback.com (elvis.redback.com [155.53.12.7])\r\n	by prattle.redback.com (Postfix) with ESMTP id AA8B7F2C4C\r\n	for <istvan+foo@redback.com>; Wed,  7 Nov 2001 18:15:35 -0800 (PST)\r\nReceived: (from root@localhost)\r\n	by elvis.redback.com (8.8.8/8.8.8/null redback bsdclient) id SAA01504\r\n	for istvan; Wed, 7 Nov 2001 18:15:35 -0800 (PST)\r\nDate: Wed, 7 Nov 2001 18:15:35 -0800 (PST)\r\nFrom: <root@redback.com>\r\nMessage-Id: <200111080215.SAA01504@elvis.redback.com>\r\nTo: istvan+foo@redback.com\r\nSubject: foo\r\n\r\n")) "\n\n")
  (save-excursion (insert str "\n\n"))
  (progn (push uid remove) (insert "From imap " (current-time-string) "\n") (save-excursion (insert str "\n\n")) (while (re-search-forward "^From " nil t) (replace-match ">From ")) (goto-char (point-max)))
  (if (setq str (if ... ... ...)) (progn (push uid remove) (insert "From imap " ... "\n") (save-excursion ...) (while ... ...) (goto-char ...)))
  (when (setq str (if ... ... ...)) (push uid remove) (insert "From imap " (current-time-string) "\n") (save-excursion (insert str "\n\n")) (while (re-search-forward "^From " nil t) (replace-match ">From ")) (goto-char (point-max)))
  (while --dolist-temp--19610 (setq uid (car --dolist-temp--19610)) (when (setq str ...) (push uid remove) (insert "From imap " ... "\n") (save-excursion ...) (while ... ...) (goto-char ...)) (setq --dolist-temp--19610 (cdr --dolist-temp--19610)))
  (let ((--dolist-temp--19610 ...) uid) (while --dolist-temp--19610 (setq uid ...) (when ... ... ... ... ... ...) (setq --dolist-temp--19610 ...)) nil)
  (catch (quote --cl-block-nil--) (let (... uid) (while --dolist-temp--19610 ... ... ...) nil))
  (cl-block-wrapper (catch (quote --cl-block-nil--) (let ... ... nil)))
  (block nil (let (... uid) (while --dolist-temp--19610 ... ... ...) nil))
  (dolist (uid (imap-search ... buf)) (when (setq str ...) (push uid remove) (insert "From imap " ... "\n") (save-excursion ...) (while ... ...) (goto-char ...)))
  (save-current-buffer (set-buffer temp-buffer) (mm-disable-multibyte) (with-current-buffer buf (when ... ...)) (dolist (uid ...) (when ... ... ... ... ... ...)) (nnheader-ms-strip-cr))
  (with-current-buffer temp-buffer (mm-disable-multibyte) (with-current-buffer buf (when ... ...)) (dolist (uid ...) (when ... ... ... ... ... ...)) (nnheader-ms-strip-cr))
  (prog1 (with-current-buffer temp-buffer (mm-disable-multibyte) (with-current-buffer buf ...) (dolist ... ...) (nnheader-ms-strip-cr)) (with-current-buffer temp-buffer (widen) (write-region ... ... temp-file nil 0)))
  (unwind-protect (prog1 (with-current-buffer temp-buffer ... ... ... ...) (with-current-buffer temp-buffer ... ...)) (and (buffer-name temp-buffer) (kill-buffer temp-buffer)))
  (let ((temp-file mail-source-crash-box) (temp-buffer ...)) (unwind-protect (prog1 ... ...) (and ... ...)))
  (with-temp-file mail-source-crash-box (mm-disable-multibyte) (with-current-buffer buf (when ... ...)) (dolist (uid ...) (when ... ... ... ... ... ...)) (nnheader-ms-strip-cr))
  (let ((coding-system-for-write mail-source-imap-file-coding-system) str) (with-temp-file mail-source-crash-box (mm-disable-multibyte) (with-current-buffer buf ...) (dolist ... ...) (nnheader-ms-strip-cr)) (incf found (mail-source-callback callback server)) (when (and remove fetchflag) (imap-message-flags-add ... fetchflag nil buf)) (if dontexpunge (imap-mailbox-unselect buf) (imap-mailbox-close nil buf)) (imap-close buf))
  (if (and (imap-open server port stream authentication buf) (imap-authenticate user ... buf) (imap-mailbox-select mailbox nil buf)) (let (... str) (with-temp-file mail-source-crash-box ... ... ... ...) (incf found ...) (when ... ...) (if dontexpunge ... ...) (imap-close buf)) (imap-close buf) (setq mail-source-password-cache (delq ... mail-source-password-cache)) (error (imap-error-text buf)))
  (let ((from ...) (found 0) (buf ...) (mail-source-string ...) (imap-shell-program ...) remove) (if (and ... ... ...) (let ... ... ... ... ... ...) (imap-close buf) (setq mail-source-password-cache ...) (error ...)) (kill-buffer buf) found)
  (let ((dontexpunge nil) (fetchflag nil) (predicate nil) (mailbox nil) (password nil) (user nil) (authentication nil) (program nil) (stream nil) (port nil) (server nil)) (mail-source-set-1 source) (let (... ... ... ... ... remove) (if ... ... ... ... ...) (kill-buffer buf) found))
  (mail-source-bind (imap source) (let (... ... ... ... ... remove) (if ... ... ... ... ...) (kill-buffer buf) found))
  mail-source-fetch-imap((imap :server "imap.redback.com") #[(file orig-file) "‚Â\b‚ÂÄ\b	š?ÂÂ…\x0f\0‚Å	‚Æ\"‚Ç%‡" [file orig-file nnmail-split-incoming nnml-save-mail nil nnmail-get-split-group (imap :server "imap.redback.com") nnml-active-number] 7])
  funcall(mail-source-fetch-imap (imap :server "imap.redback.com") #[(file orig-file) "‚Â\b‚ÂÄ\b	š?ÂÂ…\x0f\0‚Å	‚Æ\"‚Ç%‡" [file orig-file nnmail-split-incoming nnml-save-mail nil nnmail-get-split-group (imap :server "imap.redback.com") nnml-active-number] 7])
  (if (or debug-on-quit debug-on-error) (funcall function source callback) (condition-case err (funcall function source callback) (error ... 0)))
  (+ found (if (or debug-on-quit debug-on-error) (funcall function source callback) (condition-case err ... ...)))
  (let ((function ...) (found 0)) (unless function (error "%S is an invalid mail source specification" source)) (when (file-exists-p mail-source-crash-box) (message "Processing mail from %s..." mail-source-crash-box) (setq found ...)) (+ found (if ... ... ...)))
  (save-excursion (let (... ...) (unless function ...) (when ... ... ...) (+ found ...)))
  (if (or mail-source-plugged plugged) (save-excursion (let ... ... ... ...)))
  (let ((plugged nil)) (mail-source-set-common-1 source) (if (or mail-source-plugged plugged) (save-excursion ...)))
  (mail-source-bind-common source (if (or mail-source-plugged plugged) (save-excursion ...)))
  mail-source-fetch((imap :server "imap.redback.com") #[(file orig-file) "‚Â\b‚ÂÄ\b	š?ÂÂ…\x0f\0‚Å	‚Æ\"‚Ç%‡" [file orig-file nnmail-split-incoming nnml-save-mail nil nnmail-get-split-group (imap :server "imap.redback.com") nnml-active-number] 7])
  nnmail-get-new-mail(nnml nnml-save-nov "~/Mail/" "mail.personal")
  nnml-request-scan("mail.personal" "private")
  gnus-request-scan("nnml+private:mail.personal" (nnml "private"))
  gnus-activate-group("nnml+private:mail.personal" scan)
  gnus-get-unread-articles(2)
  gnus-group-get-new-news(2)
  my-get-mail()
  call-interactively(my-get-mail)

[-- Attachment #3: Type: text/plain, Size: 13 bytes --]


-- 
	Istvan

Re: BODY.PEEK change breaks mail-source-fetch-imap

[Simon Josefsson]

On Wed, 7 Nov 2001 mi-gnus@imarko.dhs.org wrote:

> -               (when (setq str (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf))
> +               (when (setq str (if (imap-capability 'IMAP4rev1 buf)
> +                                   (imap-fetch uid "BODY.PEEK[]" 'BODYDETAIL
> +                                               nil buf)
> +                           (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
> 
> The local imap server is imap-uw 4.7c6:
> 
> * OK popserv2.redback.com IMAP4rev1 2000.279 at Wed, 7 Nov 2001 18:27:00 -0800 (PST)
> 
> Please let me know if there is any more data you would like.

I believe the code is correct -- RFC822.PEEK is obsoleted by IMAP4rev1, in
favor of BODY.PEEK[].  However it seems as if at least Exchange is buggy
in this regard, but your server is UoW so maybe it is more worthwile to
track this down.  Maybe there is a imap.el parser bug in there somewhere.

Can you frob `imap-log' to get the complete IMAP trace (modulo passwords 
but including the server logon)?

Re: BODY.PEEK change breaks mail-source-fetch-imap

[Simon Josefsson]

mi-gnus@imarko.dhs.org writes:

> After running an older snapshot for a few weeks today i finally
> updated to the latest CVS and was in for an unpleasant surprise: IMAP
> fetching blew up in a spectacular way. See the attached backtrace.

Should be fixed, please test again.

Re: BODY.PEEK change breaks mail-source-fetch-imap

[Istvan Marko]

Simon Josefsson <jas@extundo.com> writes:

> mi-gnus@imarko.dhs.org writes:
>
>> After running an older snapshot for a few weeks today i finally
>> updated to the latest CVS and was in for an unpleasant surprise: IMAP
>> fetching blew up in a spectacular way. See the attached backtrace.
>
> Should be fixed, please test again.

It works! Thanks a lot Simon!

-- 
	Istvan