diff options
Diffstat (limited to 'Codec')
| -rw-r--r-- | Codec/MIME/Decode.hs | 2 | ||||
| -rw-r--r-- | Codec/MIME/Parse.hs | 36 | ||||
| -rw-r--r-- | Codec/MIME/Type.hs | 2 | ||||
| -rw-r--r-- | Codec/MIME/Utils.hs | 2 |
4 files changed, 24 insertions, 18 deletions
diff --git a/Codec/MIME/Decode.hs b/Codec/MIME/Decode.hs index 364e0fb..278d6f6 100644 --- a/Codec/MIME/Decode.hs +++ b/Codec/MIME/Decode.hs @@ -27,7 +27,7 @@ import Codec.MIME.Base64 as Base64 decodeBody :: String -> String -> String decodeBody enc body = case map toLower enc of - "base64" -> map (chr.fromIntegral) $ Base64.decode body + "base64" -> Base64.decodeToString body "quoted-printable" -> QP.decode body _ -> body diff --git a/Codec/MIME/Parse.hs b/Codec/MIME/Parse.hs index df3549f..6108441 100644 --- a/Codec/MIME/Parse.hs +++ b/Codec/MIME/Parse.hs @@ -31,18 +31,17 @@ import Data.List import Debug.Trace ( trace ) parseMIMEBody :: [(String,String)] -> String -> MIMEValue -parseMIMEBody headers_in body = - case mimeType mty of +parseMIMEBody headers_in body = result { mime_val_headers = headers } + where + result = case mimeType mty of Multipart{} -> fst (parseMultipart mty body) Message{} -> fst (parseMultipart mty body) - _ -> nullMIMEValue - { mime_val_type = mty - , mime_val_disp = parseContentDisp headers - , mime_val_content = Single (processBody headers body) - } - - where headers = [ (map toLower k,v) | (k,v) <- headers_in ] - mty = fromMaybe defaultType + _ -> nullMIMEValue { mime_val_type = mty + , mime_val_disp = parseContentDisp headers + , mime_val_content = Single (processBody headers body) + } + headers = [ (map toLower k,v) | (k,v) <- headers_in ] + mty = fromMaybe defaultType (parseContentType =<< lookupField "content-type" headers) defaultType :: Type defaultType = Type { mimeType = Text "plain" @@ -87,9 +86,16 @@ processBody headers body = Nothing -> body Just v -> decodeBody v body +normalizeCRLF :: String -> String +normalizeCRLF ('\r':'\n':xs) = '\r':'\n':normalizeCRLF xs +normalizeCRLF ('\r':xs) = '\r':'\n':normalizeCRLF xs +normalizeCRLF ('\n':xs) = '\r':'\n':normalizeCRLF xs +normalizeCRLF (x:xs) = x:normalizeCRLF xs +normalizeCRLF [] = [] + parseMIMEMessage :: String -> MIMEValue parseMIMEMessage entity = - case parseHeaders entity of + case parseHeaders (normalizeCRLF entity) of (as,bs) -> parseMIMEBody as bs parseHeaders :: String -> ([(String,String)], String) @@ -217,10 +223,10 @@ multipartTypes = ] untilMatch :: String -> String -> Maybe String -untilMatch str xs = go str xs - where go "" rs = Just rs - go _ "" = Nothing - go (a:as) (b:bs) = if a == b then go as bs else go str bs +untilMatch "" a = Just a +untilMatch _ "" = Nothing +untilMatch a b | a `isPrefixOf` b = Just $ drop (length a) b +untilMatch a (_:bs) = untilMatch a bs matchUntil :: String -> String -> (String, String) matchUntil _ "" = ("", "") diff --git a/Codec/MIME/Type.hs b/Codec/MIME/Type.hs index 5b91b14..675d29e 100644 --- a/Codec/MIME/Type.hs +++ b/Codec/MIME/Type.hs @@ -14,7 +14,7 @@ -------------------------------------------------------------------- module Codec.MIME.Type where -import Data.List ( concatMap, isSuffixOf ) +import Data.List ( isSuffixOf ) data Type = Type diff --git a/Codec/MIME/Utils.hs b/Codec/MIME/Utils.hs index 624d433..8606342 100644 --- a/Codec/MIME/Utils.hs +++ b/Codec/MIME/Utils.hs @@ -26,7 +26,7 @@ findMultipartNamed nm mv = case mime_val_content mv of Multi ms -> msum (map (findMultipartNamed nm) ms) Single {} -> do cd <- mime_val_disp mv - find (withDispName nm) (dispParams cd) + _ <- find (withDispName nm) (dispParams cd) return mv where withDispName a (Name b) = a == b withDispName _ _ = False |