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

Fred Gibson fred at streamfocus.com
Sun Jan 24 13:03:51 UTC 2010


Hi Jochen,

Yes, that is a beautiful thing - works great now.  (I had to change
the peek flet to: ((peek ()   (peek-char nil in-stream nil :eof))  to
cure the eof problem.  All is well now.

I made the mistake in my version of thinking the result should give
just the low level parts (so 3 parts in the example case instead of a
new smaller message + 1 part), so that was part of my misunderstanding
about it.

Thanks :)

Fred

On Sat, Jan 23, 2010 at 6:04 PM, Jochen Schmidt <js at crispylogics.com> wrote:
>
> 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
>
>



-- 
Fred Gibson

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

(c)2010 Organon Technologies LLC




More information about the mel-base-devel mailing list