diff --git a/Codec/MIME/Base64.hs b/Codec/MIME/Base64.hs --- a/Codec/MIME/Base64.hs +++ b/Codec/MIME/Base64.hs @@ -1,9 +1,9 @@ {- | Module : Codec.MIME.Parse - Copyright : (c) 2006-2007 + Copyright : (c) 2006-2008 - Maintainer : + Maintainer : Sigbjorn Finne Stability : unstable Portability : GHC diff --git a/Codec/MIME/Decode.hs b/Codec/MIME/Decode.hs --- a/Codec/MIME/Decode.hs +++ b/Codec/MIME/Decode.hs @@ -1,10 +1,10 @@ -------------------------------------------------------------------- -- | -- Module : Codec.MIME.Decode --- Copyright : (c) Galois, Inc. 2006..2008 +-- Copyright : (c) 2006-2008, Galois, Inc. -- License : BSD3 -- --- Maintainer: Don Stewart +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- @@ -24,7 +24,7 @@ "quoted-printable" -> QP.decode body _ -> body --- Decoding of RFC 2047's "encoded-words' production +-- Decoding of RFC 2047's "encoded-words" production -- (as used in email-headers and some HTTP header cases -- (AtomPub's Slug: header)) decodeWord :: String -> Maybe (String, String) diff --git a/Codec/MIME/Parse.hs b/Codec/MIME/Parse.hs --- a/Codec/MIME/Parse.hs +++ b/Codec/MIME/Parse.hs @@ -1,8 +1,8 @@ {- | - Module : MIME.Parse - Copyright : (c) 2006-2007 Galois Inc. + Module : Codec.MIME.Parse + Copyright : (c) 2006-2008 Galois Inc. - Maintainer : tse-dev-team@galois.com + Maintainer : Sigbjorn Finne Stability : unstable Portability : GHC @@ -26,8 +26,11 @@ case mimeType mty of Multipart{} -> fst (parseMultipart mty body) Message{} -> fst (parseMultipart mty body) - _ -> MIMEValue mty (parseContentDisp headers) - (Single (processBody headers 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 @@ -102,8 +105,14 @@ case lookupField "boundary" (mimeParams mty) of Nothing -> trace ("Multipart mime type, " ++ showType mty ++ ", has no required boundary parameter. Defaulting to text/plain") $ - (MIMEValue defaultType Nothing (Single body), "") - Just bnd -> (MIMEValue mty Nothing (Multi vals), rs) + (nullMIMEValue{ mime_val_type = defaultType + , mime_val_disp = Nothing + , mime_val_content = Single body + }, "") + Just bnd -> (nullMIMEValue { mime_val_type = mty + , mime_val_disp = Nothing + , mime_val_content = Multi vals + }, rs) where (vals,rs) = splitMulti bnd body splitMulti :: String -> String -> ([MIMEValue], String) diff --git a/Codec/MIME/QuotedPrintable.hs b/Codec/MIME/QuotedPrintable.hs --- a/Codec/MIME/QuotedPrintable.hs +++ b/Codec/MIME/QuotedPrintable.hs @@ -4,22 +4,57 @@ -- Copyright : (c) Galois, Inc. 2008 -- License : BSD3 -- --- Maintainer: +-- Maintainer: Sigbjorn Finne -- Stability : provisional -- Portability: -- -------------------------------------------------------------------- -module Codec.MIME.QuotedPrintable where +module Codec.MIME.QuotedPrintable + ( decode -- :: String -> String + , encode -- :: String -> String + ) where import Data.Char +-- | 'decode' incoming quoted-printable content, stripping +-- out soft line breaks and decode :: String -> String decode "" = "" +decode ('=':'\r':'\n':xs) = decode xs -- soft line break. decode ('=':x1:x2:xs) | isHexDigit x1 && isHexDigit x2 = chr (digitToInt x1 * 16 + digitToInt x2) : decode xs decode ('=':xs) = '=':decode xs -- make it explicit that we propagate other '=' occurrences. decode (x1:xs) = x1:decode xs + +-- | 'encode' converts a sequence of characeter _octets_ into +-- quoted-printable form; suitable for transmission in MIME +-- payloads. Note the stress on _octets_; it is assumed that +-- you have already converted Unicode into a <=8-bit encoding +-- (UTF-8, most likely.) +encode :: String -> String +encode xs = encodeLength 0 xs + +encodeLength :: Int -> String -> String +encodeLength _ "" = "" +encodeLength n (x:xs) + | n >= 72 = '=':'\r':'\n':encodeLength 0 (x:xs) +encodeLength _ ('=':xs) + = '=':'3':'D':encodeLength 0 xs +encodeLength n (x:xs) + | ox >= 0x100 = error ("QuotedPrintable.encode: encountered > 8 bit character: " ++ show (x,ox)) + | n >= 72 = '=':'\r':'\n':encodeLength 0 (x:xs) + | ox >= 0x21 && ox <= 0x7e = x : encodeLength (n+1) xs + | ox == 0x09 || ox == 0x20 = x : encodeLength (n+1) xs + | otherwise = '=':showH (ox `div` 0x10): showH (ox `mod` 0x10):encodeLength (n+3) xs + where + ox = ord x + showH v + | v < 10 = chr (ord_0 + v) + | otherwise = chr (ord_A + (v-10)) + + ord_0 = ord '0' + ord_A = ord 'A' diff --git a/Codec/MIME/Type.hs b/Codec/MIME/Type.hs --- a/Codec/MIME/Type.hs +++ b/Codec/MIME/Type.hs @@ -1,9 +1,10 @@ {- | - Module : MIME.Type - Copyright : (c) 2006-2007 Galois Inc. + Module : Codec.MIME.Type + Copyright : (c) 2006-2008, Galois Inc. +- License : BSD3 - Maintainer : tse-dev-team@galois.com + Maintainer : Sigbjorn Finne Stability : unstable Portability : GHC @@ -20,13 +21,19 @@ , mimeParams :: [(String,String)] } deriving ( Show, Ord, Eq ) +nullType :: Type +nullType = Type + { mimeType = Text "plain" + , mimeParams = [] + } + showType :: Type -> String showType t = showMIMEType (mimeType t) ++ showMIMEParams (mimeParams t) showMIMEParams :: [(String,String)] -> String showMIMEParams ps = concatMap showP ps where - showP (a,b) = ';':a ++ '=':'"':b ++ "\"" + showP (a,b) = ';':' ':a ++ '=':'"':b ++ "\"" data MIMEType @@ -132,11 +139,22 @@ type Content = String -data MIMEValue = MIMEValue { - mime_val_type :: Type, - mime_val_disp :: Maybe Disposition, - mime_val_content :: MIMEContent } - deriving ( Show, Eq ) +data MIMEValue = MIMEValue + { mime_val_type :: Type + , mime_val_disp :: Maybe Disposition + , mime_val_content :: MIMEContent + , mime_val_headers :: [(String,String)] + , mime_val_inc_type :: Bool + } deriving ( Show, Eq ) + +nullMIMEValue :: MIMEValue +nullMIMEValue = MIMEValue + { mime_val_type = nullType + , mime_val_disp = Nothing + , mime_val_content = Multi [] + , mime_val_headers = [] + , mime_val_inc_type = True + } data MIMEContent = Single Content diff --git a/Codec/MIME/Utils.hs b/Codec/MIME/Utils.hs --- a/Codec/MIME/Utils.hs +++ b/Codec/MIME/Utils.hs @@ -1,8 +1,9 @@ {- | - Module : MIME.Utils - Copyright : (c) 2007 + Module : Codec.MIME.Utils + Copyright : (c) 2007-2008, Galois, Inc. + License : BSD3 - Maintainer : tse-dev-team@galois.com + Maintainer : Sigbjorn Finne Stability : unstable Portability : GHC diff --git a/mime.cabal b/mime.cabal --- a/mime.cabal +++ b/mime.cabal @@ -1,12 +1,12 @@ name: mime -version: 0.2.1 +version: 0.3.0 synopsis: Working with MIME types. description: Working with MIME types. category: Codec license: BSD3 license-file: LICENSE author: Galois Inc. -maintainer: diatchki@galois.com +maintainer: sof@galois.com Copyright: (c) 2006-2008 Galois Inc. cabal-version: >= 1.2.0 build-type: Simple @@ -22,7 +22,7 @@ exposed-modules: Codec.MIME.Type Codec.MIME.Parse Codec.MIME.Utils - other-modules: Codec.MIME.Base64 + Codec.MIME.Base64 Codec.MIME.Decode Codec.MIME.QuotedPrintable ghc-options: -Wall -O2