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

[Jochen Schmidt]

Am 24.01.2010 um 01:00 schrieb Fred Gibson:

> Hi Jochen,
> 
> Your fix works great for text/plain and multipart/alternative where
> the same body tag is used throughout the message.  The problem happens
> when you have a multipart/mixed structure where there is more than one
> boundary in the message.  So what I did in the rewrite of
> read-multipart-body-1 (RMB1) is in the case of a mixed type, read just
> beyond the first boundary which can be ignored, then recurse on RMB1
> again to deal with only the boundaries that matter by reading each one
> in at the top of a message section and then sending it to scan rather
> than trying to use the boundary identified in the message header, thus
> allowing for many boundaries.   I realize it is pretty brute force,
> but it works flawlessly so far.  It made more sense to me to deal with
> the multiple tag issue in RMB1.  Is there a more elegant solution to
> this?  (I've included a sample shortened version of the mixed
> structure below so you can see the varying boundary issue. This is the
> case for any mail with an attachment I think.)


I've checked the example - it is not an issue with RMB1 but with SFBT; believe me :-). Your example exposed another bug in that the content-type header wasn't recognized because SFBT left a newline in the stream.

after a boundary is matched one still has to scan to the end of the line:

(loop while (case (peek) ((#\return #\linefeed) t)
                                (otherwise nil))
                        do (skip))

After this change and still the original RMB1 I get this bodystructure:

(((:TEXT :PLAIN (:CHARSET "ISO-8859-1") NIL NIL NIL 173 8 NIL NIL NIL)
  (:TEXT :HTML (:CHARSET "ISO-8859-1") NIL NIL :QUOTED-PRINTABLE 155 5 NIL NIL NIL)
  :ALTERNATIVE
  (:BOUNDARY "000e0cd1465866ab51047b429ec8")
  NIL
  NIL)
 (:APPLICATION :PDF (:CHARSET "us-ascii" :NAME "Invoice-2290.pdf") NIL NIL :BASE64 125 2 NIL NIL NIL)
 :MIXED
 (:BOUNDARY "000e0cd1465866ab58047b429eca")
 NIL
 NIL)

Here is the final SFBT:

(defun scan-forward-boundary-tag (in-stream boundary)
  (let ((tag (concatenate 'string "--" boundary))
        (match 0)
        (octets 0)
        (lines 0)
        (line-ending-octets 0))
    (flet ((peek ()
	     (peek-char nil in-stream))
           (skip () (read-char in-stream))
	   (consume ()
	     (prog1
		 (read-char in-stream)
	       (incf octets))))
	     (tagbody
              init (let ((c (peek)))
                     (if (char= c #\-)
                       (go possible-boundary)
                       (go start)))
	      start (let ((c (peek)))
		      (case c
			(#\return (skip) (go cr))
			(#\linefeed (skip) (go lf))
			(otherwise (consume) (go start))))
		
	      lf (setf line-ending-octets 1) (go newline)
		
	      cr 
		(let ((c (peek)))
		  (case c
		    (#\linefeed (setf line-ending-octets 2)
                                (skip) (go newline))
		    (otherwise
                     (setf line-ending-octets 1)
                     (go newline))))
		
	      newline 
                (let ((c (peek)))
                  (case c
                    (#\- (go possible-boundary))
                    (otherwise (incf octets line-ending-octets)
                               (incf lines)
                               (setf line-ending-octets 0)
                               (go start))))

              possible-boundary
                  (if (= match (length tag))
                    (go boundary-matched)
                    (let ((c (peek)))
                      (cond ((char= c (char tag match))
                             (skip) (incf match)(go possible-boundary))
                            (t (incf octets (+ line-ending-octets match))
                               (setf match 0 line-ending-octets 0)
                               (incf lines)
                               (go start)))))
              boundary-matched
                  (let ((c (peek)))
                    (case c
                      (#\- (skip)
                           (case c
                             (#\- (go end-boundary))
                             (otherwise (go boundary))))
                      (otherwise (go boundary))))
             
              boundary
                  (loop until (case (peek) ((#\return #\linefeed :eof) t)
                                (otherwise nil))
                        do (skip))
                  (loop while (case (peek) ((#\return #\linefeed) t)
                                (otherwise nil))
                        do (skip))
                  (return-from scan-forward-boundary-tag
                    (values octets lines nil))
                  
              end-boundary
                   (loop until (case (peek) ((#\return #\linefeed #\newline :eof) t)
                                 (otherwise nil))
                         do (skip))
                  (return-from scan-forward-boundary-tag
                    (values octets lines t))
                   ))))

Does that work for you?

(The EOF handling is still borked, but it should work - I'll fix that tomorrow)


ciao,
Jochen

-- 
Jochen Schmidt 
CRISPYLOGICS
Uhlandstr. 9, 90408 Nuremberg

Fon +49 (0)911 517 999 82
Fax +49 (0)911 517 999 83

mailto:(format nil "~(~36r@~36r.~36r~)" 870180 1680085828711918828 16438) http://www.crispylogics.com