Permalink
Browse files

bug18636 (handle underscore) and rfe9010 (soft newlines)

  • Loading branch information...
1 parent ade4ba4 commit 25a9bbcd77529fbdac213a7a467af8d24b627ac7 @dklayer dklayer committed Sep 30, 2009
Showing with 57 additions and 34 deletions.
  1. +10 −0 ChangeLog
  2. +13 −7 mime-api.cl
  3. +10 −9 mime-transfer-encoding.cl
  4. +24 −18 t-imap.cl
View
@@ -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
View
@@ -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,15 +455,17 @@ 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
(subseq text (car encoded) (cdr encoded)))
: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))))
-
-
View
@@ -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))
-
-
-
-
-

0 comments on commit 25a9bbc

Please sign in to comment.