From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 11 Apr 2001 01:09:45 +0000 (+0000)
Subject: Fix bug: must preserve MIME headers in forwarded messages, otherwise
X-Git-Tag: 20090517-FFI~2864
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=22c864db1bb6d5f16f56e5c1ad172d3c668d2996;p=mit-scheme.git

Fix bug: must preserve MIME headers in forwarded messages, otherwise
the encapsulated message won't be interpreted correctly by the
receiver.
---

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 6426d9140..a4ef1bc85 100644
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.234 2001/03/19 19:31:12 cph Exp $
+;;; $Id: imail-top.scm,v 1.235 2001/04/11 01:09:16 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2001 Massachusetts Institute of Technology
 ;;;
@@ -1154,7 +1154,11 @@ With negative argument, forward the message with all headers;
 		   (let ((headers (message-header-fields message)))
 		     (if raw?
 			 headers
-			 (maybe-reformat-headers headers mail-buffer))))
+			 (maybe-reformat-headers
+			  headers
+			  (or (imail-message->buffer message #f)
+			      mail-buffer)
+			  #t))))
 	      (lambda (port) (write-message-body message port)))
 	     (let ((mark (mark-left-inserting-copy (buffer-end mail-buffer))))
 	       (with-buffer-point-preserved mail-buffer
@@ -2071,38 +2075,55 @@ Negative argument means search in reverse."
 	       (write-message-body message port)))))))
 
 (define (insert-header-fields headers raw? mark)
-  (encode-header-fields (let ((headers (->header-fields headers)))
+  (encode-header-fields (let ((headers* (->header-fields headers)))
 			  (if raw?
-			      headers
+			      headers*
 			      (maybe-reformat-headers
-			       headers
+			       headers*
 			       (or (and (message? headers)
 					(imail-message->buffer headers #f))
-				   mark))))
+				   mark)
+			       #f)))
 			(lambda (string start end)
 			  (insert-substring string start end mark))))
 
-(define (maybe-reformat-headers headers buffer)
+(define (maybe-reformat-headers headers context keep-mime?)
   (let ((headers
-	 (cond ((ref-variable imail-kept-headers buffer)
-		=> (lambda (regexps)
-		     (append-map!
-		      (lambda (regexp)
-			(list-transform-positive headers
-			  (lambda (header)
-			    (re-string-match regexp
-					     (header-field-name header)
-					     #t))))
-		      regexps)))
-	       ((ref-variable imail-ignored-headers buffer)
-		=> (lambda (regexp)
-		     (list-transform-negative headers
-		       (lambda (header)
-			 (re-string-match regexp
-					  (header-field-name header)
-					  #t)))))
-	       (else headers)))
-	(filter (ref-variable imail-message-filter buffer)))
+	 (let ((mime-headers
+		(lambda ()
+		  (if keep-mime?
+		      (list-transform-positive headers
+			(lambda (header)
+			  (re-string-match "^\\(mime-version$\\|content-\\)"
+					   (header-field-name header)
+					   #t)))
+		      '()))))
+	   (cond ((ref-variable imail-kept-headers context)
+		  => (lambda (regexps)
+		       (remove-duplicates!
+			(append-map*!
+			 (mime-headers)
+			 (lambda (regexp)
+			   (list-transform-positive headers
+			     (lambda (header)
+			       (re-string-match regexp
+						(header-field-name header)
+						#t))))
+			 regexps)
+			(lambda (a b) (eq? a b)))))
+		 ((ref-variable imail-ignored-headers context)
+		  => (lambda (regexp)
+		       (remove-duplicates!
+			(append!
+			 (list-transform-negative headers
+			   (lambda (header)
+			     (re-string-match regexp
+					      (header-field-name header)
+					      #t)))
+			 (mime-headers))
+			(lambda (a b) (eq? a b)))))
+		 (else headers))))
+	(filter (ref-variable imail-message-filter context)))
     (if filter
 	(map (lambda (n.v)
 	       (make-header-field (car n.v) (cdr n.v)))
diff --git a/v7/src/imail/todo.txt b/v7/src/imail/todo.txt
index 97f4e8941..69bd0d5e6 100644
--- a/v7/src/imail/todo.txt
+++ b/v7/src/imail/todo.txt
@@ -1,15 +1,9 @@
 IMAIL To-Do List
-$Id: todo.txt,v 1.114 2001/04/10 20:37:17 cph Exp $
+$Id: todo.txt,v 1.115 2001/04/11 01:09:45 cph Exp $
 
 Bug fixes
 ---------
 
-* When forwarding a message using MIME, the code that strips off the
-  extra headers is causing problems -- in particular, it strips off
-  the MIME headers of the encapsulated message, which means that the
-  reader can't properly interpret the contents.  The MIME headers must
-  be left intact.
-
 * When network connection gets wedged, Edwin locks up and can't be
   interrupted with C-g.  This is fundamentally an Edwin problem, but
   it occurs much more frequently with IMAIL.  See if there's a better