@@ -1,5 +1,15 @@ 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 character in quoted printable encoding ChangeLog @@ -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)))) mime-api.cl @@ -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)))) - - mime-transfer-encoding.cl @@ -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)) - - - - - t-imap.cl ade4ba4ac38fbc6b984ab5acc90393570fa7ab20 Kevin Layer layer@franz.com http://github.com/franzinc/imap/commit/25a9bbcd77529fbdac213a7a467af8d24b627ac7 25a9bbcd77529fbdac213a7a467af8d24b627ac7 2009-09-30T13:31:11-07:00 2009-09-30T13:31:11-07:00 bug18636 (handle underscore) and rfe9010 (soft newlines) ad829c0c62f2cb0d97934e67fa9935f43464f04b Kevin Layer layer@franz.com