[mel-base-devel] mel.mime:parts not working properly for rfc 2822 (reading from a file)

[Fred Gibson]

I had to rewrite a good portion of read-multipart-body-1 to get the
parts to parse correctly.  I've tested this with text/plain,
multipart/alternative and multipart/mixed, and all parsed correctly.
Here is the diff from my git commit:

commit 87842c16b7021a28f776fb952535c43426ba55d6
Author: Fred Gibson <fred at streamfocus.com>
Date:   Sat Jan 23 01:28:13 2010 -0800

    revised mel-base read-multipart-body-1 to work with alternative
and mixed multipart mime types

diff --git a/lib/mel-base_0.9-2/multiparts.lisp
b/lib/mel-base_0.9-2/multiparts.lisp
index 7c1e7f1..ee30f88 100644
--- a/lib/mel-base_0.9-2/multiparts.lisp
+++ b/lib/mel-base_0.9-2/multiparts.lisp
@@ -286,41 +286,58 @@
 (defun compute-bodystructure (message)
   (compute-bodystructure-using-folder (folder message) message))

-(defun read-multipart-body-1 (part stream)
-  (let ((boundary (boundary-tag part)))
-    (let (parts
-	  last-part)
-      (loop
-       (multiple-value-bind (octets lines endp)
-	   (scan-forward-boundary-tag stream boundary)
-	 (when last-part
-	   #+nil (incf (seventh last-part) octets)
-	   (setf (seventh last-part) octets)
-	   (setf (eighth last-part) lines)
-	   (setf last-part nil))
-	 (cond (endp
-		; (format t "End tag of boundary=~A~%" boundary)
-		(multiple-value-bind (super sub params)
-		    (content-type part)
-		  (declare (ignore super))
-		  (let ((result `(,@(nreverse parts) ,sub ,params nil nil)))
-		    ; (format t "Multipart-Structure: ~A~%" result)
-		    (return result))))
-	       (t
-		(multiple-value-bind (headers hoctets) (read-rfc2822-header stream)
-		 ; (format t "Headers read ~A" hoctets)
-		  (let ((content-type (or (cdr (assoc :content-type headers))
-					  "text/plain")))
-		    (multiple-value-bind (super sub params) (parse-content-type content-type)
-		      (declare (ignore params))
-		    (let ((next-part (make-instance (if (eq super :multipart)
-							(multipart-type-class sub)
-							'simple-part)
-						    :header-fields (or headers
-								       '((:content-type . "text/plain"))))))
-		    (if (eq super :multipart)
-			(push (read-multipart-body-1 next-part stream) parts)
-			(push (setf last-part (read-simple-body next-part)) parts)))))))))))))
+(defun read-multipart-body-1 (part stream &key recurse?)
+  (multiple-value-bind (p-super p-sub p-params)(content-type part)
+    (declare (ignore p-super))
+    (flet ((build-return (parts)
+             `(,@(nreverse parts) ,p-sub ,p-params nil nil)))
+      (let (parts
+            last-part
+            boundary)
+        (loop
+           (multiple-value-bind (headers hoctets) (read-rfc2822-header stream)
+             (declare (ignore hoctets))
+             (let ((content-type (or (cdr (assoc :content-type headers))
+                                     "text/plain"))
+                   (boundary-read
+                    (let ((assoc-hdr
+                           (assoc "--" headers
+                                  :test #'string=
+                                  :key (lambda (x) (let ((nm (symbol-name x)))
+                                                     (when (> (length nm) 2)
+                                                       (let ((a (char nm 0))
+                                                             (b (char nm 1)))
+                                                         (concatenate
'string (list a b)))))))))
+                      (when assoc-hdr
+                        (string-downcase (string-left-trim "-" (car
assoc-hdr)))))))
+               (setf boundary (or boundary-read boundary))
+               (multiple-value-bind (super sub params)
(parse-content-type content-type)
+                 (declare (ignore params))
+                 (when (and (eq p-sub :mixed) (not recurse?))
+                   (return (append (read-multipart-body-1 part stream
:recurse? t)
+                                   (build-return
(read-multipart-body-1 part stream :recurse? t)))))
+                 (let ((next-part (make-instance
+                                   (if (eq super :multipart)
+                                       (multipart-type-class sub)
+                                       'simple-part)
+                                   :header-fields (or headers
'((:content-type . "text/plain"))))))
+                   (if (eq super :multipart)
+                       (progn
+                         (setf last-part (read-simple-body next-part))
+                         (push (read-multipart-body-1 next-part stream) parts))
+                       (push (setf last-part (read-simple-body
next-part)) parts))
+                   (multiple-value-bind (octets lines endp)
+                       (scan-forward-boundary-tag stream boundary)
+                     (when last-part
+                       #+nil (incf (seventh last-part) octets)
+                       (setf (seventh last-part) octets)
+                       (setf (eighth last-part) lines)
+                       (setf last-part nil))
+                     (when endp ; (format t "End tag of
boundary=~A~%" boundary)
+                       (if recurse?
+                           (return (nreverse parts))
+                           (return (build-return parts))))
+                     ))))))))))

 (defun read-simple-body (part)
   (multiple-value-bind (super sub params)


On Thu, Jan 21, 2010 at 10:36 PM, Fred Gibson <fred at streamfocus.com> wrote:
> I've been working with reading in an rfc 2822 file, and the parts
> method returns only 1 large part for the whole message rather than
> breaking it into smaller parts.  It looks like the
> mel.mime:read-multipart-body-1 function starts off from
> mel.mime:compute-bodystructure-using-folder with the whole message and
> then is sent to scan-forward-boundary-tag with the boundary tag for
> the overall message, which then only matches at the end of the file
> and so only 1 big part is returned.  I'm troubleshooting this problem
> now.
>
> Fred Gibson
>
> Founder / Software Developer
> http://www.streamfocus.com
>
> (c)2010 Organon Technologies LLC
>

-- 
Fred Gibson

Founder / Software Developer
http://www.streamfocus.com

(c)2010 Organon Technologies LLC