@@ -1,3 +1,16 @@

+2007-08-02  Ahmon Dancy  <dancy@dancy>

+

+	* mime-parse.cl:

+

+	Don't include the stuff between the end of a multipart part and

+	the beginning of the next part in the mime-part-body-size.

+

+	* mime-transfer-encoding.cl:

+

+	with-decoded-part-body-stream.  Set the stream's external-format

+	based on the charset specified in the part (if any (defaults to

+	:latin1)).

+

 2007-06-05  Ahmon Dancy  <dancy@dancy>

 	* rfe7210: rfc2822.cl: new extract-email-addresses function.

@@ -1,3 +1,9 @@

+#+(version= 8 1)

+(sys:defpatch "mime" 1

+  "v1: changes to internal/undocumented portions of module."

+  :type :system

+  :post-loadable t)

+

 #+(version= 8 0)

 (sys:defpatch "mime" 3

   "v0: New module.  See documentation.;

@@ -34,7 +40,7 @@ v2: make-mime-part: Default external-format is :utf8."

 ;; merchantability or fitness for a particular purpose.  See the GNU

 ;; Lesser General Public License for more details.

 ;;

-;; $Id: mime-api.cl,v 1.7 2007/05/31 23:13:08 dancy Exp $

+;; $Id: mime-api.cl,v 1.8 2007/08/02 18:14:31 layer Exp $

 (defpackage :net.post-office

   (:use #:lisp #:excl)

@@ -14,7 +14,7 @@

 ;; merchantability or fitness for a particular purpose.  See the GNU

 ;; Lesser General Public License for more details.

 ;;

-;; $Id: mime-parse.cl,v 1.6 2007/05/31 23:13:08 dancy Exp $

+;; $Id: mime-parse.cl,v 1.7 2007/08/02 18:14:31 layer Exp $

 (defpackage :net.post-office

   (:use #:lisp #:excl)

@@ -347,10 +347,10 @@

     ;; If boundary isn't specified.. try to compensate by using our

     ;; parent's boundary.

-    (if (null boundary)

-	(setf boundary parent-boundary)

-      (setf boundary (mime-dequote boundary)))

-    

+    (if* (null boundary)

+       then (setf boundary parent-boundary)

+       else (setf boundary (mime-dequote boundary)))

+

     ;; Locate the first boundary.

     (multiple-value-bind (ignore1 ignore2 ignore3 newpos)

 	(read-until-boundary stream boundary pos mbox)

@@ -366,13 +366,12 @@

     (setf (mime-part-parts part) (nreverse parts))

+    (setf (mime-part-body-size part) (- pos startpos))

+    

     ;; Discard everything that follows until we reach the parent-boundary.

     (multiple-value-bind (ignore1 ignore2 eof pos)

 	(read-until-boundary stream parent-boundary pos mbox)

       (declare (ignore ignore1 ignore2))

-      

-      (setf (mime-part-body-size part) (- pos startpos))

-      

       (values part eof pos))))

@@ -14,7 +14,7 @@

 ;; merchantability or fitness for a particular purpose.  See the GNU

 ;; Lesser General Public License for more details.

 ;;

-;; $Id: mime-transfer-encoding.cl,v 1.13 2007/06/19 22:01:14 dancy Exp $

+;; $Id: mime-transfer-encoding.cl,v 1.14 2007/08/02 18:14:31 layer Exp $

 (defpackage :net.post-office

   (:use #:lisp #:excl)

@@ -283,7 +283,9 @@

 (defmacro with-decoded-part-body-stream ((sym part instream) &body body)

   (let ((p (gensym))

 	(encoding (gensym))

-	(count (gensym)))

+	(count (gensym))

+	(charset (gensym))

+	(ef (gensym)))

     `(let* ((,p ,part)

 	    (,encoding (mime-part-encoding ,p))

 	    (,count (mime-part-body-size ,p)))

@@ -291,6 +293,11 @@

 					      ,instream

 					      ,encoding

 					      ,count)

+	 (let* ((,charset (or (cdr (assoc "charset" (mime-part-parameters ,p)

+					  :test #'equalp))

+			      "us-ascii"))

+		(,ef (or (charset-to-external-format ,charset) :latin1)))

+	   (setf (stream-external-format ,sym) ,ef))

 	 ,@body))))

 (defun mime-decode-transfer-encoding (outstream instream encoding count)