@@ -1,3 +1,13 @@

+2009-09-30  Kevin Layer  <layer@gemini.franz.com>

+

+	* mime-api.cl: rfe9010: decode-header-text: remove "soft"

+	  newlines in the decoded text

+	* mime-transfer-encoding.cl: bug18636: underscore handling:

+	  refine previous fix to be more surgical and conditional on a

+	  keyword argument, because other routines use these functions

+	* t-imap.cl: the start of a test suite for the mime side of

+	  things

+

 2009-09-30  Kevin Layer  <layer@gemini.franz.com>

 	* mime-transfer-encoding.cl: bug18636: handle underscore

@@ -426,18 +426,22 @@ This is a multi-part message in MIME format.~%"))

   (declare (optimize (speed 3))

 	   (string text))

   (let ((pos 0)

-	(len (length text)))

+	(len (length text))

+	last-tail)

     (declare (fixnum pos len))

     (with-output-to-string (res)

       (while (< pos len)

-	(multiple-value-bind (matched whole charset encoding encoded)

-	    (match-re "=\\?([^?]+)\\?(q|b)\\?(.*?)\\?=" text 

+	(multiple-value-bind (matched whole charset encoding encoded tail)

+	    (match-re "=\\?([^?]+)\\?(q|b)\\?(.*?)\\?=(\\s+)?" text 

 		      :start pos

 		      :case-fold t

 		      :return :index)

-	  (if (null matched)

-	      (return))

+	  (when (null matched)

+	    (when last-tail

+	      (write-string text res

+			    :start (car last-tail) :end (cdr last-tail)))

+	    (return))

 	  ;; Write out the "before" stuff.

 	  (write-string text res :start pos :end (car whole))

@@ -451,7 +455,8 @@ This is a multi-part message in MIME format.~%"))

 		then (qp-decode-string text

 				       :start (car encoded)

 				       :end (cdr encoded)

-				       :external-format ef)

+				       :external-format ef

+				       :underscores-are-spaces t)

 		else ;; FIXME: Clean this up with/if rfe6174 is completed.

 		     (octets-to-string

 		      (base64-string-to-usb8-array 

@@ -459,7 +464,8 @@ This is a multi-part message in MIME format.~%"))

 		      :external-format ef))

 	     res))

-	  (setf pos (cdr whole))))

+	  (setf pos (cdr whole))

+	  (setf last-tail tail)))

       ;; Write out the remaining portion.

       (write-string text res :start pos))))

@@ -184,8 +184,6 @@

 					 then (return)

 					 else (out byte3))

 				 else (out value)))))

-	   elseif (eq byte #.(char-code #\_))

-	     then (out #.(char-code #\space))

 	     else (out byte)))

 	t))))

@@ -197,7 +195,8 @@

 ;;  1) the supplied or allocated array

 ;;  2) the just past the last byte populated in the array.

 (defun qp-decode-usb8 (in out &key (start1 0) (end1 (length in))

-				   (start2 0) end2)

+				   (start2 0) end2

+				   underscores-are-spaces)

   (declare (optimize (speed 3))

 	   ((simple-array (unsigned-byte 8) (*)) in out)

 	   (fixnum start1 end1 start2 end2))

@@ -262,20 +261,24 @@

 					 then (return)

 					 else (out byte3))

 				 else (out value)))))

-	   elseif (eq byte #.(char-code #\_))

-	     then (out #.(char-code #\space))

+	   elseif (and underscores-are-spaces (eq byte #.(char-code #\_)))

+	     then ;; See the discussion in bug18636 about why this is

+		  ;; done.

+		  (out #.(char-code #\space))

 	     else (out byte)))

 	(values out start2)))))

 (defun qp-decode-string (string &key (start 0) (end (length string))

 				     (return :string)

-				     (external-format :default))

+				     (external-format :default)

+				     underscores-are-spaces)

   (multiple-value-bind (vec len)

       (string-to-octets string :start start :end end :null-terminate nil

 			:external-format :latin1)

     (multiple-value-setq (vec len)

-      (qp-decode-usb8 vec vec :end1 len))

+      (qp-decode-usb8 vec vec :end1 len

+		      :underscores-are-spaces underscores-are-spaces))

     (ecase return

       (:string

        (octets-to-string vec :end len :external-format external-format))

@@ -316,5 +319,3 @@

    (t

     ;; defined in mime-parse.cl

     (stream-to-stream-copy outstream instream count))))

-    

-

@@ -20,6 +20,8 @@

 ;; requires smtp module too

 (eval-when (compile load eval)

+  (require :smtp)

+  (require :imap)

   (require :test))

@@ -227,30 +229,34 @@

     (net.post-office:close-connection pb)))

+

+(defun test-mime ()

+  (test-equal

+   "foobar baz"

+   (net.post-office:decode-header-text "=?utf-8?q?foo?=

+  =?utf-8?q?bar?= baz"))

+  (test-equal

+   "before brucejones hello"

+   (net.post-office:decode-header-text "before =?utf-8?q?bruce?=    =?utf-8?q?jones?= hello"))

+  (test-equal

+   "[Franz Wiki] Update of \"Office/EmployeeDirectory\" by SteveHaflich"

+   (net.post-office:decode-header-text "=?utf-8?q?=5BFranz_Wiki=5D_Update_of_=22Office/EmployeeDirectory=22_by_St?=

+ =?utf-8?q?eveHaflich?="))

+  )

 (defun test-imap ()

   (handler-bind ((net.post-office:po-condition 

 		  #'(lambda (con)

 		      (format t "Got imap condition: ~a~%" con))))

-				       

-    (test-connect)

-  

-    (test-sends)

-

-    (test-flags)

- 

-    (test-mailboxes)

-

-    (test-pop)

-  

-  

-    ))

+    (test-mime)

+;;;; Only jkf is setup to run the tests.

+    (when (string= "jkf" (sys:getenv "USER"))

+      (test-connect)

+      (test-sends)

+      (test-flags)

+      (test-mailboxes)

+      (test-pop))))

 (if* *do-test* then (do-test :imap #'test-imap))

-    

-    

-    

-    

-