tags 608279 + patch fixed-upstream
thanks

Please find attached a patch for this bug. It has been created out of
upstream commits on the development branch (see the upstream bug report
for more details).

Thanks,
Description: [Gnus] Prevent MIME boundary collisons with MML syntax
Origin: upstream, commit: 1ed54fa, e35032b, 52ea2bb
Bug: http://debbugs.gnu.org/9862
Bug-Debian: http://bugs.debian.org/608279
Last-Update: 2011-11-05
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -445,6 +445,7 @@
 (defvar mml-boundary nil)
 (defvar mml-base-boundary "-=-=")
 (defvar mml-multipart-number 0)
+(defvar mml-inhibit-compute-boundary nil)
 
 (defun mml-generate-mime ()
   "Generate a MIME message based on the current MML document."
@@ -520,7 +521,11 @@
 			  ;; `m-g-d-t' will be bound to "message/rfc822"
 			  ;; when encoding an article to be forwarded.
 			  (mml-generate-default-type "text/plain"))
-		      (mml-to-mime))
+		      (mml-to-mime)
+		      ;; Update handle so mml-compute-boundary can
+		      ;; detect collisions with the nested parts.
+		      (unless mml-inhibit-compute-boundary
+			(setcdr (assoc 'contents cont) (buffer-string))))
 		    (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
 		      ;; ignore 0x1b, it is part of iso-2022-jp
 		      (setq encoding (mm-body-7-or-8))))
@@ -690,34 +695,30 @@
   "Return a unique boundary that does not exist in CONT."
   (let ((mml-boundary (funcall mml-boundary-function
 			       (incf mml-multipart-number))))
-    ;; This function tries again and again until it has found
-    ;; a unique boundary.
-    (while (not (catch 'not-unique
-		  (mml-compute-boundary-1 cont))))
+    (unless mml-inhibit-compute-boundary
+      ;; This function tries again and again until it has found
+      ;; a unique boundary.
+      (while (not (catch 'not-unique
+		    (mml-compute-boundary-1 cont)))))
     mml-boundary))
 
 (defun mml-compute-boundary-1 (cont)
-  (let (filename)
-    (cond
-     ((eq (car cont) 'part)
-      (with-temp-buffer
-	(cond
-	 ((cdr (assq 'buffer cont))
-	  (insert-buffer-substring (cdr (assq 'buffer cont))))
-	 ((and (setq filename (cdr (assq 'filename cont)))
-	       (not (equal (cdr (assq 'nofile cont)) "yes")))
-	  (mm-insert-file-contents filename nil nil nil nil t))
-	 (t
-	  (insert (cdr (assq 'contents cont)))))
-	(goto-char (point-min))
-	(when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
-				 nil t)
-	  (setq mml-boundary (funcall mml-boundary-function
-				      (incf mml-multipart-number)))
-	  (throw 'not-unique nil))))
-     ((eq (car cont) 'multipart)
-      (mapc 'mml-compute-boundary-1 (cddr cont))))
-    t))
+  (cond
+   ((member (car cont) '(part mml))
+    (mm-with-multibyte-buffer
+      (let ((mml-inhibit-compute-boundary t)
+	    (mml-multipart-number 0)
+	    mml-sign-alist mml-encrypt-alist)
+	(mml-generate-mime-1 cont))
+      (goto-char (point-min))
+      (when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
+			       nil t)
+	(setq mml-boundary (funcall mml-boundary-function
+				    (incf mml-multipart-number)))
+	(throw 'not-unique nil))))
+   ((eq (car cont) 'multipart)
+    (mapc 'mml-compute-boundary-1 (cddr cont))))
+  t)
 
 (defun mml-make-boundary (number)
   (concat (make-string (% number 60) ?=)
-- 
Sébastien Villemot
Researcher in Economics at CEPREMAP & Debian Maintainer
http://www.dynare.org/sebastien
Phone: +33-1-40-77-49-90 - GPG Key: 4096R/381A7594

Attachment: pgpi71T9knRw8.pgp
Description: PGP signature

Reply via email to