From d2d1d5dcee101bfbc96a6240f5f9af1df9ee652f Mon Sep 17 00:00:00 2001
Message-Id: <d2d1d5dcee101bfbc96a6240f5f9af1df9ee652f.1717258127.git.mdw@distorted.org.uk>
From: Mark Wooding <mdw@chiark.greenend.org.uk>
Date: Wed, 22 Nov 2017 18:57:45 +0000
Subject: [PATCH] el/dot-emacs.el: Hack Gnus to cope with IMAP literals
 properly.
Organization: Straylight/Edgeware

From: Mark Wooding <mdw@distorted.org.uk>

The bug manifests when Dovecot encounters a MIME-part header of the form

	Content-Description:
		BLAH...

Gnus requests `BODYSTRUCTURE' as part of its `FETCH' command.  In the
specific case shown above, Dovecot encodes the description using IMAP
`literal' quoting, as

	{LEN}

		BLAH...

(The first newline is part of the literal syntax; and the second is part
of the header data.  Actually, the first newline is an IETF-style
carriage-return/line-feed pair, and the second is a bare linefeed, but
that doesn't matter here.)

Gnus has a loop which converts such strings into plain double-quoted
strings, but it can't cope with two consecutive such strings.
Specifically, it ends up with

	... " BLAH"| {LEN} ...

with point at the `|', but expects to find at least two characters
before the next `{LEN}'.  Hacky fix: move back by one place before
resuming the search.

Much worse is the need to include the entire function here so that I can
patch it just a little.
---
 el/dot-emacs.el | 72 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 72 insertions(+)

diff --git a/el/dot-emacs.el b/el/dot-emacs.el
index 17ca3bb..d99134d 100644
--- a/el/dot-emacs.el
+++ b/el/dot-emacs.el
@@ -752,6 +752,78 @@ (defun nntp-open-authinfo-kludge (buffer)
 (eval-after-load "erc"
   '(load "~/.ercrc.el"))
 
+;; Heavy-duty Gnus patching.
+
+(defun mdw-nnimap-transform-headers ()
+  (goto-char (point-min))
+  (let (article lines size string)
+    (block nil
+      (while (not (eobp))
+	(while (not (looking-at "\\* [0-9]+ FETCH"))
+	  (delete-region (point) (progn (forward-line 1) (point)))
+	  (when (eobp)
+	    (return)))
+	(goto-char (match-end 0))
+	;; Unfold quoted {number} strings.
+	(while (re-search-forward
+		"[^]][ (]{\\([0-9]+\\)}\r?\n"
+		(save-excursion
+		  ;; Start of the header section.
+		  (or (re-search-forward "] {[0-9]+}\r?\n" nil t)
+		      ;; Start of the next FETCH.
+		      (re-search-forward "\\* [0-9]+ FETCH" nil t)
+		      (point-max)))
+		t)
+	  (setq size (string-to-number (match-string 1)))
+	  (delete-region (+ (match-beginning 0) 2) (point))
+	  (setq string (buffer-substring (point) (+ (point) size)))
+	  (delete-region (point) (+ (point) size))
+	  (insert (format "%S" (mm-subst-char-in-string ?\n ?\s string)))
+	  ;; [mdw] missing from upstream
+	  (backward-char 1))
+	(beginning-of-line)
+	(setq article
+	      (and (re-search-forward "UID \\([0-9]+\\)" (line-end-position)
+				      t)
+		   (match-string 1)))
+	(setq lines nil)
+	(setq size
+	      (and (re-search-forward "RFC822.SIZE \\([0-9]+\\)"
+				      (line-end-position)
+				      t)
+		   (match-string 1)))
+	(beginning-of-line)
+	(when (search-forward "BODYSTRUCTURE" (line-end-position) t)
+	  (let ((structure (ignore-errors
+			     (read (current-buffer)))))
+	    (while (and (consp structure)
+			(not (atom (car structure))))
+	      (setq structure (car structure)))
+	    (setq lines (if (and
+			     (stringp (car structure))
+			     (equal (upcase (nth 0 structure)) "MESSAGE")
+			     (equal (upcase (nth 1 structure)) "RFC822"))
+			    (nth 9 structure)
+			  (nth 7 structure)))))
+	(delete-region (line-beginning-position) (line-end-position))
+	(insert (format "211 %s Article retrieved." article))
+	(forward-line 1)
+	(when size
+	  (insert (format "Chars: %s\n" size)))
+	(when lines
+	  (insert (format "Lines: %s\n" lines)))
+	;; Most servers have a blank line after the headers, but
+	;; Davmail doesn't.
+	(unless (re-search-forward "^\r$\\|^)\r?$" nil t)
+	  (goto-char (point-max)))
+	(delete-region (line-beginning-position) (line-end-position))
+	(insert ".")
+	(forward-line 1)))))
+
+(eval-after-load 'nnimap
+  '(defalias 'nnimap-transform-headers
+     (symbol-function 'mdw-nnimap-transform-headers)))
+
 ;;;--------------------------------------------------------------------------
 ;;; Utility functions.
 
-- 
[mdw]