mime-string 0.1 → 0.2
raw patch · 3 files changed
+43/−27 lines, 3 files
Files
- Codec/MIME/String/Flatten.hs +31/−18
- Codec/MIME/String/Parse.hs +10/−6
- mime-string.cabal +2/−3
Codec/MIME/String/Flatten.hs view
@@ -1,41 +1,52 @@ -module Codec.MIME.String.Flatten (flatten) where+module Codec.MIME.String.Flatten (flatten, flattenXXX) where import qualified Codec.Binary.Base64.String as Base64 (encode)-import Codec.MIME.String.Date (FullDate, show_full_date, show_mbox_full_date)-import Codec.MIME.String.EncodedWord (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.Internal.Utils+import Codec.MIME.String.Parse+import Codec.MIME.String.Types import Data.List (intersperse)+{-+XXX For message IDs: import Network.BSD (getHostName) import System.Locale (defaultTimeLocale) import System.Random (randomIO) import System.Time (getClockTime, toCalendarTime, formatCalendarTime)+-} --- XXX This should take a headers structure+-- 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-flatten :: String -> String -> String -> FullDate+flattenXXX :: String -> String -> String -> FullDate -> String -> [(String, FilePath)] -> IO String-flatten from_name from_email subject date body attachments- = do msgid <- mk_msgid+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 -> [(String, FilePath)] -> IO String+flatten headers body 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- from_full = encode_name from_name ++ "\n <" ++ from_email ++ ">" boundary = "=:" part_start = "\n--" ++ boundary ++ "\n" parts_end = "\n--" ++ boundary ++ "--\n"- text_content = unlines [+ 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"]- common_headers = unlines [- "From " ++ from_email ++ " " ++ show_mbox_full_date date,- "Date: " ++ show_full_date date,- "Message-ID: " ++ msgid,- "From: " ++ from_full,- "Subject: " ++ mk_subject subject,- "MIME-Version: 1.0"] -- This is overly paranoid safe_char c = isAsciiAlphaNum c || (c `elem` " .-_") mime_attachment (a, fn)@@ -54,7 +65,7 @@ ++ Base64.encode a msg = if single_part then common_headers- ++ text_content+ ++ text_content_headers ++ "\n" ++ QP.encode (my_lines body) else common_headers@@ -63,7 +74,7 @@ ++ "\n" ++ "This is a multi-part message in MIME format.\n" ++ part_start- ++ text_content+ ++ text_content_headers ++ "\n" ++ QP.encode (my_lines body) ++ concatMap mime_attachment attachments@@ -74,6 +85,7 @@ -- XXX The IO calls used to use liftIOErr. We could use something similar -- but require we are called in a MonadError m? -- XXX We should possibly be including a program name+{- mk_msgid :: IO String mk_msgid = do hostname <- getHostName@@ -85,6 +97,7 @@ lhs = concat $ intersperse "." [timestamp, show (r :: Int)] return (lhs ++ "@" ++ hostname)+-} mk_subject :: String -> String mk_subject subject
Codec/MIME/String/Parse.hs view
@@ -274,14 +274,14 @@ [] -> skip_whitespace m_zs ys' -> gather [ys'] m_zs gather :: [String] -> Maybe String -> ([Header], Maybe String)- gather acc Nothing = ([mk_header acc], Nothing)+ gather acc Nothing = ([mk_rev_header acc], Nothing) gather acc (Just xs) = case get_line xs of- ([], m_zs) -> ([mk_header acc], m_zs)+ ([], m_zs) -> ([mk_rev_header acc], m_zs) (ys, m_zs) | starts_with_white ys -> gather (ys:acc) m_zs | otherwise -> let (hs, m_rest) = gather [ys] m_zs- in (mk_header acc:hs, m_rest)+ in (mk_rev_header acc:hs, m_rest) starts_with_white (c:_) = isWhite c starts_with_white [] = False isWhite ' ' = True@@ -290,13 +290,18 @@ -- Takes the lines comprising a header (in reverse order) and constructs -- the corresponding Header+mk_rev_header :: [String] -> Header+mk_rev_header = mk_header . reverse++-- Takes the lines comprising a header and constructs+-- the corresponding Header mk_header :: [String] -> Header-mk_header xs = let unfolded = concat xs'+mk_header xs = let unfolded = concat xs (raw_name, body) = case break ends_header unfolded of (name, ':':val) -> (name ++ ":", val) (name, val) -> (name, val) in Header {- h_raw_header = xs',+ h_raw_header = xs, h_raw_name = raw_name, h_name = map asciiToLower raw_name, h_body = body@@ -305,5 +310,4 @@ ends_header ' ' = True ends_header '\t' = True ends_header _ = False- xs' = reverse xs
mime-string.cabal view
@@ -1,16 +1,15 @@ Name: mime-string-Version: 0.1+Version: 0.2 License: OtherLicense License-File: COPYING Copyright: Ian Lynagh, 2005, 2007 Author: Ian Lynagh Maintainer: igloo@earth.li Stability: experimental-Homepage: http://urchin.earth.li/~ian/cabal/mime-string/ Synopsis: MIME implementation for String's. Description: Implementation of the MIME RFCs 2045-2049.- A bit rough around the edges.+ Rather rough around the edges at the moment. Category: Codec Tested-With: GHC==6.6 Build-Depends: base, mtl, network, iconv, base64-string