[mel-base-devel] skip-rfc2822-header problem with html document

Wed Feb 17 15:48:15 UTC 2010

With email that has no parts and comprise and entire webpage beginning
after the main email header with:

<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">

The skip-rfc2822-header mistakenly skips this and quite a bit more of
the initial html tags of the document.  To solve this, I added a check
that, if the character #\< is the first character in the stream, then
the following cannot be a header and the function returns without
changing the stream position:

diff --git a/lib/mel-base/rfc2822.lisp b/lib/mel-base/rfc2822.lisp
index 29888fd..704ce36 100644
--- a/lib/mel-base/rfc2822.lisp
+++ b/lib/mel-base/rfc2822.lisp
@@ -188,20 +188,21 @@
 						    :courier)
 						   (t :mac)))
 				   (#\linefeed :unix))))))
-			
-    (loop with line-ending-style = :rfc
-	  for style = (skip-to-cr/lf)
-	  do
-	  (unless (eq line-ending-style style)
-	    (buggy "Switched lineending-style")
-	    (setf line-ending-style style))
-	  (case line-ending-style
-	    (:mac (when (accept-char #\return stream) (return (1+ file-position))))
-	    (:unix (when (accept-char #\linefeed stream) (return (1+ file-position))))
-	    (:rfc (when (accept-crlf stream) (return (+ 2 file-position))))
-	    (:courier (when (and (accept-char #\return stream)(accept-crlf stream))
-			(return (+ 3 file-position))))
-	    ))))
+    (let ((first-char (peek-char nil stream nil nil)))
+      (unless (char= #\< first-char);Start of html document
+        (loop with line-ending-style = :rfc
+           for style = (skip-to-cr/lf)
+           do
+             (unless (eq line-ending-style style)
+               (buggy "Switched lineending-style")
+               (setf line-ending-style style))
+             (case line-ending-style
+               (:mac (when (accept-char #\return stream) (return (1+
file-position))))
+               (:unix (when (accept-char #\linefeed stream) (return
(1+ file-position))))
+               (:rfc (when (accept-crlf stream) (return (+ 2 file-position))))
+               (:courier (when (and (accept-char #\return
stream)(accept-crlf stream))
+                           (return (+ 3 file-position))))
+               ))))))

 (defun read-rfc2822-header (stream)
   (let ((octets 0) fields

Does that make sense?

My best,

Fred Gibson

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

(c)2010 Organon Technologies LLC


