mime-string 0.3 → 0.4
raw patch · 4 files changed
+98/−86 lines, 4 filesdep +bytestringdep +old-time
Dependencies added: bytestring, old-time
Files
- Codec/MIME/String/Flatten.hs +72/−64
- Codec/MIME/String/Headers.hs +4/−5
- Codec/MIME/String/Parse.hs +18/−13
- mime-string.cabal +4/−4
Codec/MIME/String/Flatten.hs view
@@ -1,18 +1,14 @@ module Codec.MIME.String.Flatten- (flatten, flattenXXX, Attachments, Attachment)+ (flatten, Attachments, Attachment) where import qualified Codec.Binary.Base64.String as Base64 (encode)-import Codec.MIME.String.Date-import Codec.MIME.String.EncodedWord import qualified Codec.MIME.String.QuotedPrintable as QP (encode) import Codec.MIME.String.Headers import Codec.MIME.String.Internal.Utils-import Codec.MIME.String.Parse import Codec.MIME.String.Types -import Data.List (intersperse) {- XXX For message IDs: import Network.BSD (getHostName)@@ -24,34 +20,27 @@ type Attachments = [Attachment] type Attachment = (String, FilePath, Maybe ContentType) --- XXX This has the API of the old function. Should go at some point.--- Flatten {meta info, message body and list of attachments} to a raw message-flattenXXX :: String -> String -> String -> FullDate -> String -> Attachments- -> IO String-flattenXXX from_name from_email subject date body attachments- = let -- XXX This (\n) could be prettier - check llengths of bits- from_full = encode_name from_name ++ "\n <" ++ from_email ++ ">"- headers = [mk_header ["From " ++ from_email- ++ " " ++ show_mbox_full_date date],- mk_header ["Date: " ++ show_full_date date],- mk_header ["From: " ++ from_full],- mk_header ["Subject: " ++ mk_subject subject]]- in flatten headers body attachments---- XXX This should take a headers structure-flatten :: Headers -> String -> Attachments -> IO String-flatten headers body attachments+-- XXX This should be rewritten in a more compositional way!+flatten :: Headers -> String -> Maybe String -> Attachments -> IO String+flatten headers body maybeHtmlBody attachments = do -- XXX Could add one of one isn't already found? msgid <- mk_msgid let -- XXX This (\n) could be prettier - check llengths of bits- boundary = "=:"- part_start = "\n--" ++ boundary ++ "\n"- parts_end = "\n--" ++ boundary ++ "--\n"+ alternativeBoundary = "=:A"+ alternativePartStart = "\n--" ++ alternativeBoundary ++ "\n"+ alternativePartsEnd = "\n--" ++ alternativeBoundary ++ "--\n"+ mixedBoundary = "=:M"+ mixedPartStart = "\n--" ++ mixedBoundary ++ "\n"+ mixedPartsEnd = "\n--" ++ mixedBoundary ++ "--\n" common_headers = unlines (concatMap h_raw_header headers) ++ "MIME-Version: 1.0\n" text_content_headers = unlines [ "Content-type: text/plain; charset=utf-8", "Content-transfer-encoding: quoted-printable", "Content-Disposition: inline"]+ html_content_headers = unlines [+ "Content-type: text/html; charset=utf-8",+ "Content-transfer-encoding: quoted-printable",+ "Content-Disposition: inline"] -- This is overly paranoid safe_char c = isAsciiAlphaNum c || (c `elem` " .-_") mime_attachment (a, fn, mct)@@ -63,7 +52,7 @@ "Content-type: " ++ x ++ "/" ++ y ++ concatMap showParam ps ++ "\n" Nothing -> "Content-type: application/octet-stream\n"- in part_start+ in mixedPartStart ++ ct ++ "Content-transfer-encoding: base64\n" ++ "Content-Disposition: attachment; filename=\""@@ -76,21 +65,63 @@ ++ "\n" ++ Base64.encode a msg = if single_part- then common_headers- ++ text_content_headers- ++ "\n"- ++ QP.encode (my_lines body)- else common_headers- ++ "Content-type: multipart/mixed; boundary=\""- ++ boundary ++ "\"\n"- ++ "\n"- ++ "This is a multi-part message in MIME format.\n"- ++ part_start- ++ text_content_headers- ++ "\n"- ++ QP.encode (my_lines body)- ++ concatMap mime_attachment attachments- ++ parts_end+ then case maybeHtmlBody of+ Nothing ->+ common_headers+ ++ text_content_headers+ ++ "\n"+ ++ QP.encode (my_lines body)+ Just htmlBody ->+ common_headers+ ++ "Content-type: multipart/alternative; boundary=\""+ ++ alternativeBoundary ++ "\"\n"+ ++ "\n"+ ++ "This is a multi-part message in MIME format.\n"+ ++ alternativePartStart+ ++ text_content_headers+ ++ "\n"+ ++ QP.encode (my_lines body)+ ++ alternativePartStart+ ++ html_content_headers+ ++ "\n"+ ++ QP.encode (my_lines htmlBody)+ ++ alternativePartsEnd+ else case maybeHtmlBody of+ Nothing ->+ common_headers+ ++ "Content-type: multipart/mixed; boundary=\""+ ++ mixedBoundary ++ "\"\n"+ ++ "\n"+ ++ "This is a multi-part message in MIME format.\n"+ ++ mixedPartStart+ ++ text_content_headers+ ++ "\n"+ ++ QP.encode (my_lines body)+ ++ concatMap mime_attachment attachments+ ++ mixedPartsEnd+ Just htmlBody ->+ common_headers+ ++ "Content-type: multipart/mixed; boundary=\""+ ++ mixedBoundary ++ "\"\n"+ ++ "\n"+ ++ "This is a multi-part message in MIME format.\n"+ ++ mixedPartStart+ -- Start of the body+ ++ "Content-type: multipart/alternative; boundary=\""+ ++ alternativeBoundary ++ "\"\n"+ ++ "\n"+ ++ alternativePartStart+ ++ text_content_headers+ ++ "\n"+ ++ QP.encode (my_lines body)+ ++ alternativePartStart+ ++ html_content_headers+ ++ "\n"+ ++ QP.encode (my_lines htmlBody)+ ++ alternativePartsEnd+ -- End of the body+ ++ concatMap mime_attachment attachments+ ++ mixedPartsEnd return msg where single_part = null attachments @@ -110,27 +141,4 @@ [timestamp, show (r :: Int)] return (lhs ++ "@" ++ hostname) -}--mk_subject :: String -> String-mk_subject subject- = if can_send_clear subject &&- length_at_most (76 - length "Subject: ") subject- then subject- else encode_string (length "Subject: ") subject--can_send_clear :: String -> Bool-can_send_clear = all isAsciiPrint--length_at_most :: Int -> [a] -> Bool-length_at_most _ [] = True-length_at_most 0 _ = False-length_at_most i (_:xs) = length_at_most (i-1) xs--encode_name :: String -> String-encode_name rn = encode_string (length "From: ") rn--encode_string :: Int -> String -> String-encode_string n s- = concat $ intersperse "\n " $ map (base64_encode "utf-8") (splits n' s)- where n' = ((76 - n - length "=?utf-8?B??=") * 3) `div` 4
Codec/MIME/String/Headers.hs view
@@ -24,7 +24,6 @@ ) where -import Text.Iconv import Codec.MIME.String.Internal.ABNF ( Parser, parse, pSucceed, pFail,@@ -35,6 +34,8 @@ import qualified Codec.Binary.EncodingQ.String as EncodingQ (decode) import Codec.MIME.String.Internal.Utils +import Codec.Text.IConv+import qualified Data.ByteString.Lazy.Char8 as BS import Data.Char import Data.List @@ -100,11 +101,9 @@ <$> p_encoded_word <*> pMany (id <$ cws <*> p_encoded_word) +-- XXX What happens if iconv doesn't understand the charset "cs"? p_encoded_word :: Parser Char String-p_encoded_word = (\cs dec text -> case convert Fuzzy cs "utf8" (dec text) of- ConversionSuccess xs -> xs- ConversionFailed -> error "p_encoded_word: Can't happen XXX"- ConversionUnsupported -> error "p_encoded_word: Unknown charset XXX")+p_encoded_word = (\cs dec text -> BS.unpack $ convertFuzzy Transliterate cs "utf8" $ BS.pack $ dec text) <$ pString "=?" <*> p_charset <* pChar '?'
Codec/MIME/String/Parse.hs view
@@ -1,7 +1,6 @@ module Codec.MIME.String.Parse where -import Text.Iconv import qualified Codec.Binary.Base64.String as Base64 (decode) import Codec.MIME.String.ContentDisposition (@@ -37,8 +36,11 @@ ) import Codec.MIME.String.Internal.Utils +import Codec.Text.IConv import Control.Monad (liftM) import Control.Monad.State (evalState, get, put)+import qualified Data.ByteString.Lazy.Char8 as BS+import Data.ByteString.Lazy.Char8 (ByteString) import Data.Maybe (fromMaybe) mkMessage :: MessageInfo -> ParseM MessageContent -> ParseM Message@@ -83,12 +85,7 @@ convertAsciiToUtf8 :: String -> String convertAsciiToUtf8 xs- = case convert Fuzzy "US-ASCII" "utf8" xs of- ConversionSuccess xs' -> xs'- ConversionFailed ->- error "convertAsciiToUtf8: Can't happen XXX: Fuzzy conversion failed"- ConversionUnsupported ->- error "convertAsciiToUtf8: Can't happen XXX: Conversion unsupported"+ = BS.unpack $ convertFuzzy Transliterate "US-ASCII" "utf8" $ BS.pack xs parse_mime_message :: ContentType -> String -> ParseM Message parse_mime_message def_content_type msg@@ -138,13 +135,12 @@ ContentType "text" _ ps -> let charset = fromMaybe "US-ASCII" $ lookup_param "charset" ps- in case convert Fuzzy charset "utf8" decoded_body of- ConversionSuccess xs ->- mkBody content_type filename xs- ConversionUnsupported ->+ decoded_body' = BS.pack decoded_body+ in case tryConvertFuzzy Transliterate charset "utf8" decoded_body' of+ Just xs ->+ mkBody content_type filename $ BS.unpack xs+ Nothing -> mkData Nothing content_type filename decoded_body- ConversionFailed ->- error "make_mime_message_content: Fuzzy conversion failed: Can't happen XXX" ContentType "multipart" st ps | Just raw_b <- lookup_param "boundary" ps, Just b <- get_boundary raw_b@@ -187,6 +183,15 @@ -- Don't worry if 8-bit data is in 7-bit transfer-encoded data Just body else Nothing++-- XXX This is rather hacky. We really want convertFuzzy to tell us if+-- the conversion is supported itself+tryConvertFuzzy :: Fuzzy -> EncodingName -> EncodingName -> ByteString+ -> Maybe ByteString+tryConvertFuzzy fuzzy from_charset to_charset decoded_body =+ case convertStrictly from_charset to_charset decoded_body of+ Right (UnsuportedConversion {}) -> Nothing+ _ -> Just $ convertFuzzy fuzzy from_charset to_charset decoded_body get_filename :: ContentDisposition -> ContentType -> FilePath get_filename (ContentDisposition _ params) (ContentType _ _ params')
mime-string.cabal view
@@ -1,5 +1,5 @@ Name: mime-string-Version: 0.3+Version: 0.4 License: OtherLicense License-File: COPYING Copyright: Ian Lynagh, 2005, 2007@@ -7,12 +7,12 @@ Maintainer: igloo@earth.li Stability: experimental Synopsis: MIME implementation for String's.+Build-Type: Simple Description: Implementation of the MIME RFCs 2045-2049. Rather rough around the edges at the moment. Category: Codec-Tested-With: GHC==6.6-Build-Depends: base, mtl, network, iconv, base64-string+Build-Depends: base, mtl, network, iconv, base64-string, old-time, bytestring Extensions: PatternGuards Extra-source-files: "BSD3", "GPL-2" Exposed-modules:@@ -29,5 +29,5 @@ Other-Modules: Codec.MIME.String.Internal.ABNF Codec.MIME.String.Internal.Utils-GHC-Options: -O -Wall -Werror+GHC-Options: -Wall