mime-string (empty) → 0.1
raw patch · 17 files changed
+2276/−0 lines, 17 filesdep +basedep +base64-stringdep +iconvbuild-type:Customsetup-changed
Dependencies added: base, base64-string, iconv, mtl, network
Files
- BSD3 +26/−0
- COPYING +6/−0
- Codec/Binary/EncodingQ/String.hs +49/−0
- Codec/MIME/String.hs +21/−0
- Codec/MIME/String/ContentDisposition.hs +115/−0
- Codec/MIME/String/Date.hs +241/−0
- Codec/MIME/String/EncodedWord.hs +8/−0
- Codec/MIME/String/Flatten.hs +111/−0
- Codec/MIME/String/Headers.hs +635/−0
- Codec/MIME/String/Internal/ABNF.hs +173/−0
- Codec/MIME/String/Internal/Utils.hs +58/−0
- Codec/MIME/String/Parse.hs +309/−0
- Codec/MIME/String/QuotedPrintable.hs +60/−0
- Codec/MIME/String/Types.hs +82/−0
- GPL-2 +340/−0
- Setup.hs +8/−0
- mime-string.cabal +34/−0
+ BSD3 view
@@ -0,0 +1,26 @@+Copyright (c) Ian Lynagh.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. The names of the author may not be used to endorse or promote+ products derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ COPYING view
@@ -0,0 +1,6 @@++Copyright (c) Ian Lynagh, 2005, 2007.++This package can be used under either the GPL v2, as in ./GPL-2, or the+3-clause BSD, as in ./BSD3, license.+
+ Codec/Binary/EncodingQ/String.hs view
@@ -0,0 +1,49 @@++-- XXX Write tests++-- Defined in RFC 2047+-- We assume we have US-ASCII characters.++module Codec.Binary.EncodingQ.String ( encode, decode) where++import Codec.MIME.String.Internal.Utils+import Data.Bits+import Data.Char++-- len is the maximum length the encoded text in a single block is+-- allowed to be+encode :: Int -> String -> [String]+encode _ "" = []+encode len xs = enc len 0 id id xs++-- The Int is the number of characters on this line so far+-- 76 is the maximum we can have no one line, and 3 is the most+-- generated for 1 input char (but we also need space for a trailing+-- '=' for a soft line break).++enc :: Int -> Int -- Length stuff+ -> ([String] -> [String]) -> (String -> String) -- accumulators+ -> String -- input+ -> [String]+enc _ _ acc_list acc_string "" = acc_list [acc_string ""]+enc len so_far acc_list acc_string (c:cs)+ = if so_far' > len+ then enc len new_len (acc_list . (acc_string "" :)) id cs+ else enc len new_len acc_list (acc_string . (encoded ++)) cs+ where encoded = if isAsciiPrint c && (c /= ' ') && (c /= '?')+ then [c]+ else ['=', x1, x2]+ new_len = length encoded+ so_far' = so_far + new_len+ o = ord c+ x1 = toUpper $ intToDigit (o `shiftR` 4)+ x2 = toUpper $ intToDigit (o .&. 0xF)++decode :: String -> String+decode ('=':c1:c2:cs)+ | isAsciiHexDigit c1 && isAsciiHexDigit c2+ = chr ((digitToInt c1 `shiftL` 4) + digitToInt c2):decode cs+decode ('_':cs) = ' ':decode cs+decode (c:cs) = c:decode cs+decode "" = ""+
+ Codec/MIME/String.hs view
@@ -0,0 +1,21 @@++module Codec.MIME.String (+ module Codec.MIME.String.ContentDisposition,+ module Codec.MIME.String.Date,+ module Codec.MIME.String.EncodedWord,+ module Codec.MIME.String.Flatten,+ module Codec.MIME.String.Headers,+ module Codec.MIME.String.Parse,+ module Codec.MIME.String.QuotedPrintable,+ module Codec.MIME.String.Types,+ ) where++import Codec.MIME.String.ContentDisposition+import Codec.MIME.String.Date+import Codec.MIME.String.EncodedWord+import Codec.MIME.String.Flatten+import Codec.MIME.String.Headers+import Codec.MIME.String.Parse+import Codec.MIME.String.QuotedPrintable+import Codec.MIME.String.Types+
+ Codec/MIME/String/ContentDisposition.hs view
@@ -0,0 +1,115 @@++-- We assume we have US-ASCII characters++module Codec.MIME.String.ContentDisposition+ (+ ContentDisposition(ContentDisposition),+ DispositionType(Inline, Attachment),+ DispositionParameter(..),+ get_content_disposition,+ ) where++import Codec.MIME.String.Internal.Utils+import Codec.MIME.String.Internal.ABNF+ (+ Parser, parse, nested_parse,+ (<$>), (<$), (<*>), (<*), (<|>),+ pEOI, pPred, pChar, pMany, pAtLeast,+ )+import Codec.MIME.String.Date (FullDate, p_date_time)+import Codec.MIME.String.Headers+ (+ Parameter, p_parameter,+ cws, p_ci_string, p_extension_token, p_value, p_quoted_string,+ )++data ContentDisposition = ContentDisposition DispositionType+ [DispositionParameter]+ deriving (Show, Read)++data DispositionType = Inline | Attachment+ deriving (Show, Read)++data DispositionParameter = Filename String+ | CreationDate FullDate+ | ModificationDate FullDate+ | ReadDate FullDate+ | Size Integer+ | DispositionParameter Parameter+ deriving (Show, Read)++get_content_disposition :: String -> Maybe ContentDisposition+get_content_disposition xs+ = case parse ph_content_disposition xs of+ Left cd -> Just cd+ Right _ -> Nothing++ph_content_disposition :: Parser Char ContentDisposition+ph_content_disposition = ContentDisposition+ <$ cws+ <*> p_disposition_type+ <*> pMany ( id+ <$ cws+ <* pChar ';'+ <* cws+ <*> p_disposition_parm)+ <* cws+ <* pEOI++p_disposition_type :: Parser Char DispositionType+p_disposition_type = Inline <$ p_ci_string "inline"+ <|> Attachment <$ p_ci_string "attachment"+ <|> Attachment <$ p_extension_token++p_disposition_parm :: Parser Char DispositionParameter+p_disposition_parm = p_filename_parm+ <|> p_creation_date_parm+ <|> p_modification_date_parm+ <|> p_read_date_parm+ <|> p_size_parm+ <|> DispositionParameter <$> p_parameter++p_filename_parm :: Parser Char DispositionParameter+p_filename_parm = Filename+ <$ p_ci_string "filename"+ <* cws+ <* pChar '='+ <* cws+ <*> p_value++p_creation_date_parm :: Parser Char DispositionParameter+p_creation_date_parm = CreationDate+ <$ p_ci_string "creation-date"+ <* cws+ <* pChar '='+ <* cws+ <*> p_quoted_date_time++p_modification_date_parm :: Parser Char DispositionParameter+p_modification_date_parm = ModificationDate+ <$ p_ci_string "modification-date"+ <* cws+ <* pChar '='+ <* cws+ <*> p_quoted_date_time++p_read_date_parm :: Parser Char DispositionParameter+p_read_date_parm = ReadDate+ <$ p_ci_string "read-date"+ <* cws+ <* pChar '='+ <* cws+ <*> p_quoted_date_time++p_size_parm :: Parser Char DispositionParameter+p_size_parm = (Size . read)+ <$ p_ci_string "size"+ <* cws+ <* pChar '='+ <* cws+ <*> pAtLeast 1 (pPred isAsciiDigit)++p_quoted_date_time :: Parser Char FullDate+p_quoted_date_time = nested_parse p_quoted_string+ (id <$> p_date_time <* pEOI)+
+ Codec/MIME/String/Date.hs view
@@ -0,0 +1,241 @@++module Codec.MIME.String.Date+ (FullDate(FullDate), DOW(..), Date(Date), Day, Month(..), Year,+ Time(Time), Zone, TimeOfDay(TimeOfDay), Hour, Minute, Second,+ show_full_date, show_mbox_full_date, get_date, p_date_time,+ get_current_date, epochDate,+ )+ where++import Codec.MIME.String.Internal.ABNF+ (+ Parser, parse,+ (<$>), (<$), (<*>), (<*), (<|>),+ pEOI, pPred, pChar, pAtLeast, pFromTo, pExactly, pMaybe,+ )+import Codec.MIME.String.Headers (cws, p_ci_string)+import Codec.MIME.String.Internal.Utils++import Control.Monad.Trans (MonadIO, liftIO)+import System.Time hiding (Month(May), Day)+import qualified System.Time as Time (Month(May))++data FullDate = FullDate (Maybe DOW) Date Time+ deriving (Show, Read)++data DOW = Mon | Tue | Wed | Thu | Fri | Sat | Sun+ deriving (Show, Read)++data Date = Date Day Month Year+ deriving (Show, Read)+type Day = Int+data Month = Jan | Feb | Mar | Apr | May | Jun+ | Jul | Aug | Sep | Oct | Nov | Dec+ deriving (Show, Read)+type Year = Int++data Time = Time TimeOfDay Zone+ deriving (Show, Read)+type Zone = Int+data TimeOfDay = TimeOfDay Hour Minute (Maybe Second)+ deriving (Show, Read)+type Hour = Int+type Minute = Int+type Second = Int++epochDate :: FullDate+epochDate = FullDate (Just Thu) (Date 01 Jan 1970)+ (Time (TimeOfDay 0 0 (Just 0)) 0)++------------------------ Showing++show_full_date :: FullDate -> String+show_full_date (FullDate m_dow date time)+ = shown_dow ++ show_date date ++ " " ++ show_time time+ where shown_dow = case m_dow of+ Nothing -> ""+ Just dow -> show dow ++ ", "++show_date :: Date -> String+show_date (Date day month year)+ = show_int 2 day ++ " " ++ show month ++ " " ++ show year++show_time :: Time -> String+show_time (Time tod zone) = show_tod tod ++ " " ++ show_zone zone++show_tod :: TimeOfDay -> String+show_tod (TimeOfDay h m m_s)+ = show_int 2 h ++ ":" ++ show_int 2 m ++ shown_s+ where shown_s = case m_s of+ Nothing -> ""+ Just s -> ":" ++ show_int 2 s++show_zone :: Zone -> String+show_zone z = (if z < 0 then '-' else '+'):show_int 4 (abs z)++show_int :: Int -> Int -> String+show_int digits int = let s = show int+ in replicate (digits - length s) '0' ++ s++-- Showing for the "From " line in mboxes is sadly a slightly different format++show_mbox_full_date :: FullDate -> String+show_mbox_full_date (FullDate m_dow (Date day month year) (Time tod _))+ = shown_dow ++ show month ++ " " ++ show_int 2 day ++ " " +++ show_tod tod ++ " " ++ show year+ where shown_dow = case m_dow of+ Nothing -> ""+ Just dow -> show dow ++ " "++------------------------ Parsing++get_date :: String -> Maybe FullDate+get_date xs+ = case parse ph_date xs of+ Left f -> Just f+ Right _ -> Nothing++ph_date :: Parser Char FullDate+ph_date = id+ <$ cws+ <*> p_date_time+ <* cws+ <* pEOI++p_date_time :: Parser Char FullDate+p_date_time = FullDate+ <$> pMaybe ( id+ <$> p_dow+ <* cws+ <* pChar ','+ <* cws)+ <*> p_date+ <* cws+ <*> p_time++p_dow :: Parser Char DOW+p_dow = Mon <$ p_ci_string "Mon"+ <|> Tue <$ p_ci_string "Tue"+ <|> Wed <$ p_ci_string "Wed"+ <|> Thu <$ p_ci_string "Thu"+ <|> Fri <$ p_ci_string "Fri"+ <|> Sat <$ p_ci_string "Sat"+ <|> Sun <$ p_ci_string "Sun"++p_date :: Parser Char Date+p_date = Date+ <$> p_day+ <* cws+ <*> p_month+ <* cws+ <*> p_year++-- obs-year merged in+p_year :: Parser Char Year+p_year = (\ds -> let y = read ds+ in case ds of+ [_, _, _] -> 2000 + y+ [_, _]+ | y < 50 -> 1900 + y+ | otherwise -> 2000 + y+ _ -> y)+ <$> pAtLeast 2 (pPred isAsciiDigit)++p_month :: Parser Char Month+p_month = Jan <$ p_ci_string "Jan"+ <|> Feb <$ p_ci_string "Feb"+ <|> Mar <$ p_ci_string "Mar"+ <|> Apr <$ p_ci_string "Apr"+ <|> May <$ p_ci_string "May"+ <|> Jun <$ p_ci_string "Jun"+ <|> Jul <$ p_ci_string "Jul"+ <|> Aug <$ p_ci_string "Aug"+ <|> Sep <$ p_ci_string "Sep"+ <|> Oct <$ p_ci_string "Oct"+ <|> Nov <$ p_ci_string "Nov"+ <|> Dec <$ p_ci_string "Dec"++p_day :: Parser Char Day+p_day = read <$> pFromTo 1 2 (pPred isAsciiDigit)++p_time :: Parser Char Time+p_time = Time+ <$> p_time_of_day+ <* cws+ <*> p_zone++p_time_of_day :: Parser Char TimeOfDay+p_time_of_day = TimeOfDay+ <$> p_hour+ <* cws+ <* pChar ':'+ <* cws+ <*> p_minute+ <*> pMaybe ( id+ <$ cws+ <* pChar ':'+ <* cws+ <*> p_second)++p_hour :: Parser Char Hour+p_hour = read <$> pExactly 2 (pPred isAsciiDigit)++p_minute :: Parser Char Minute+p_minute = read <$> pExactly 2 (pPred isAsciiDigit)++p_second :: Parser Char Second+p_second = read <$> pExactly 2 (pPred isAsciiDigit)++p_zone :: Parser Char Zone+p_zone = (\f n -> f $ read n)+ <$> (id <$ pChar '+' <|> negate <$ pChar '-')+ <*> pExactly 4 (pPred isAsciiDigit)+ <|> p_obs_zone++p_obs_zone :: Parser Char Zone+p_obs_zone = 0 <$ p_ci_string "UT"+ <|> 0 <$ p_ci_string "GMT"+ <|> -500 <$ p_ci_string "EST"+ <|> -400 <$ p_ci_string "EDT"+ <|> -600 <$ p_ci_string "CST"+ <|> -500 <$ p_ci_string "CDT"+ <|> -700 <$ p_ci_string "MST"+ <|> -600 <$ p_ci_string "MDT"+ <|> -800 <$ p_ci_string "PST"+ <|> -700 <$ p_ci_string "PDT"+ -- Military time zones. Strictly we shouldn't accept [jJ]+ -- but no harm done.+ -- 'they SHOULD all be considered equivalent to "-0000"' as+ -- RFC 822 defined them incorrectly.+ <|> 0 <$ pPred isAsciiAlpha++get_current_date :: MonadIO m => m FullDate+get_current_date+ = do clt <- liftIO getClockTime+ cat <- liftIO $ toCalendarTime clt+ let fd = FullDate (Just dow) date time+ get_dow Sunday = Sun+ get_dow Monday = Mon+ get_dow Tuesday = Tue+ get_dow Wednesday = Wed+ get_dow Thursday = Thu+ get_dow Friday = Fri+ get_dow Saturday = Sat+ get_month January = Jan+ get_month February = Feb+ get_month March = Mar+ get_month April = Apr+ get_month Time.May = May+ get_month June = Jun+ get_month July = Jul+ get_month August = Aug+ get_month September = Sep+ get_month October = Oct+ get_month November = Nov+ get_month December = Dec+ dow = get_dow (ctWDay cat)+ date = Date (ctDay cat) (get_month (ctMonth cat)) (ctYear cat)+ time = Time tod (ctTZ cat `div` 36)+ tod = TimeOfDay (ctHour cat) (ctMin cat) (Just (ctSec cat))+ return fd+
+ Codec/MIME/String/EncodedWord.hs view
@@ -0,0 +1,8 @@++module Codec.MIME.String.EncodedWord (base64_encode) where++import Codec.Binary.Base64.String (encode)++base64_encode :: String -> String -> String+base64_encode charset xs = "=?" ++ charset ++ "?B?" ++ encode xs ++ "?="+
+ Codec/MIME/String/Flatten.hs view
@@ -0,0 +1,111 @@++module Codec.MIME.String.Flatten (flatten) 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 qualified Codec.MIME.String.QuotedPrintable as QP (encode)+import Codec.MIME.String.Internal.Utils++import Data.List (intersperse)+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+-- Flatten {meta info, message body and list of attachments} to a raw message+flatten :: String -> String -> String -> FullDate+ -> String -> [(String, FilePath)]+ -> IO String+flatten from_name from_email subject date body attachments+ = do 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 [+ "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)+ = part_start+ -- XXX Can we give a better MIME type than this?+ ++ "Content-type: application/octet-stream\n"+ ++ "Content-transfer-encoding: base64\n"+ ++ "Content-Disposition: attachment; filename=\""+ ++ (case reverse $ filter safe_char+ $ takeWhile ('/' /=)+ $ reverse fn of+ [] -> "unknown"+ fn' -> fn')+ ++ "\"\n"+ ++ "\n"+ ++ Base64.encode a+ msg = if single_part+ then common_headers+ ++ text_content+ ++ "\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+ ++ "\n"+ ++ QP.encode (my_lines body)+ ++ concatMap mime_attachment attachments+ ++ parts_end+ return msg+ where single_part = null attachments++-- 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+ clock_time <- getClockTime+ calendar_time <- toCalendarTime clock_time+ r <- randomIO+ let timestamp = formatCalendarTime defaultTimeLocale+ "%Y%m%d%H%M%S" calendar_time+ lhs = concat $ intersperse "."+ [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
@@ -0,0 +1,635 @@++-- We assume we have US-ASCII characters++module Codec.MIME.String.Headers+ (+ Domain(Domain, LiteralDomain),+ Mailbox(Mailbox),+ RoutedEmailAddress(RoutedEmailAddress, NormalEmailAddress),+ EmailAddress(EmailAddress), get_addr_spec,+ Address(Address, Group),+ ContentType(ContentType), get_content_type,+ ContentDescription(ContentDescription),+ get_content_description,+ ContentTransferEncoding(ContentTransferEncoding),+ get_content_transfer_encoding,+ ContentID(ContentID), get_content_id,+ MessageID(MessageID),+ MIMEVersion(MIMEVersion), get_mime_version,+ Parameter(Parameter), p_parameter,+ From(From), To(To), Subject(Subject),+ get_from, get_to, get_subject,+ get_boundary, p_extension_token, p_value, p_quoted_string,+ cws, p_ci_string,+ )+ where++import Text.Iconv+import Codec.MIME.String.Internal.ABNF+ (+ Parser, parse, pSucceed, pFail,+ (<$>), (<$), (<*>), (<*), (<|>), (<|), (<!>),+ pEOI, pPred, pChar, pMany, pAtLeast, pMaybe, pOptDef, pString,+ )+import qualified Codec.Binary.Base64.String as Base64 (decode)+import qualified Codec.Binary.EncodingQ.String as EncodingQ (decode)+import Codec.MIME.String.Internal.Utils++import Data.Char+import Data.List++-----------------------+-- Utils++ignore :: Parser inp a -> Parser inp ()+ignore p = () <$ p++boxp :: Parser inp a -> Parser inp [a]+boxp p = box <$> p++-----------------------+-- RFC 2234++p_CTL :: Parser Char Char+p_CTL = pPred (\c -> ord c < 32 || ord c == 127)++p_SP :: Parser Char Char+p_SP = pChar ' '++p_HTAB :: Parser Char Char+p_HTAB = pChar '\t'++p_WSP :: Parser Char Char+p_WSP = p_SP <|> p_HTAB++-----------------------+-- RFC 2822++-- Case insensitive strings, written "Foo"+p_ci_string :: String -> Parser Char String+p_ci_string s = s <$ f s+ where f "" = pSucceed ()+ f (c:cs) = let p = if isAsciiAlpha c+ then pChar (toLower c) <| pChar (toUpper c)+ else pChar c+ in () <$ p <* f cs++p_NO_WS_CTL :: Parser Char Char+p_NO_WS_CTL = pPred (\c -> let o = ord c in 1 <= o && o <= 8+ || o == 11+ || o == 12+ || 14 <= o && o <= 31+ || o == 127)++-- If we follow the spec precisely then we get pMany (pMany), and hence+-- non-termination, so we merge the definition of p_obs_text in.+p_text :: Parser Char String+p_text = concat+ <$> pMany (+ p_encoded_words+ <| boxp (pPred (\c -> let o = ord c in 0 <= o && o <= 9+ || o == 11+ || o == 12+ || 14 <= o && o <= 127))+ )++-- We are lax about checking they have any necessary surrounding+-- whitespace+p_encoded_words :: Parser Char String+p_encoded_words = (\x xs -> x ++ concat xs)+ <$> p_encoded_word+ <*> pMany (id <$ cws <*> p_encoded_word)++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")+ <$ pString "=?"+ <*> p_charset+ <* pChar '?'+ <*> p_encoding+ <* pChar '?'+ <*> p_encoded_text+ <* pString "?="++-- token definition inlined as they use a different one to p_token.+p_charset :: Parser Char String+p_charset = pAtLeast 1 (pPred isAscii <!> (p_SP <|> p_CTL <|> p_especials))++p_especials :: Parser Char Char+p_especials = pPred (`elem` "()<>@,;:\\\"/[]?.=")++-- This is much stricter than specified, but if it's not [qQbB] then+-- we'd want to fall back to showing it as a string anyway.+p_encoding :: Parser Char (String -> String)+p_encoding = EncodingQ.decode <$ (pChar 'Q' <|> pChar 'q')+ <|> Base64.decode <$ (pChar 'B' <|> pChar 'b')++p_encoded_text :: Parser Char String+p_encoded_text = pMany (pPred (\c -> isAsciiPrint c && c /= '?' && c /= ' '))++p_quoted_pair :: Parser Char String+p_quoted_pair = id <$ pChar '\\' <*> p_text <|> (boxp p_obs_qp)++p_obs_qp :: Parser Char Char+p_obs_qp = id <$ pChar '\\' <*> pPred isAscii++-- Done differently as the newlines are already gone+p_FWS :: Parser Char String+p_FWS = pMany p_WSP++p_ctext :: Parser Char Char+p_ctext = p_NO_WS_CTL+ <|> pPred (\c -> let o = ord c in 33 <= o && o <= 39+ || 42 <= o && o <= 91+ || 93 <= o && o <= 126)++p_ccontent :: Parser Char ()+p_ccontent = ignore p_ctext <|> ignore p_quoted_pair <|> p_comment++p_comment :: Parser Char ()+p_comment = ()+ <$ pChar '('+ <* pMany (() <$ pMany p_NO_WS_CTL <* p_ccontent)+ <* pMany p_NO_WS_CTL+ <* pChar ')'++-- We might want to keep the result. If we do then we also need to+-- handle encoded words properly.+-- This isn't quite CFWS as we need to be able to accept "1.0"+-- as a MIME version with cws between all the characters.+-- Also, we've already removed all the newlines in the headers.+cws :: Parser Char ()+cws = ignore $ pMany (ignore (pAtLeast 1 p_WSP) <|> p_comment)++p_qtext :: Parser Char Char+p_qtext = p_NO_WS_CTL+ <|> pPred (\c -> let o = ord c in o == 33+ || 35 <= o && o <= 91+ || 93 <= o && o <= 126)++p_qcontent :: Parser Char String+p_qcontent = boxp p_qtext+ <|> p_quoted_pair++p_quoted_string :: Parser Char String+p_quoted_string = (++)+ <$ cws+ <* pChar '"'+ <*> (concat <$> pMany ((++) <$> pOptDef "" p_FWS <*> p_qcontent))+ <*> pOptDef "" p_FWS+ <* pChar '"'++p_dcontent :: Parser Char String+p_dcontent = boxp p_dtext <|> p_quoted_pair++p_dtext :: Parser Char Char+p_dtext = p_NO_WS_CTL+ <|> pPred (\c -> let o = ord c in 33 <= o && o <= 90+ || 94 <= o && o <= 126)++data MessageID = MessageID String Domain+ deriving (Show, Read)++p_msg_id :: Parser Char MessageID+p_msg_id = MessageID+ <$ cws+ <* pChar '<'+ <*> p_id_left+ <* pChar '@'+ <*> p_id_right+ <* pChar '>'+ <* cws++p_atom :: Parser Char String+p_atom = id+ <$ cws+ <*> pAtLeast 1 p_atext+ <* cws++p_atext :: Parser Char Char+p_atext = pPred (\c -> isAsciiAlphaNum c || c `elem` "!#$%&'+-/=?^_`{|}~")++p_dot_atom :: Parser Char String+p_dot_atom = id + <$ cws+ <*> p_dot_atom_text+ <* cws++p_word :: Parser Char String+p_word = p_atom <|> p_quoted_string++-- This incorporates obs-phrase+p_phrase :: Parser Char [String]+p_phrase = (:)+ <$> (p_encoded_words <| p_word)+ <*> pMany (id <$ cws <*> (p_encoded_words <| p_word <| pString "."))+ <|> boxp p_quoted_string++p_dot_atom_text :: Parser Char String+p_dot_atom_text = (\x xs -> x ++ concat xs)+ <$> pAtLeast 1 p_atext+ <*> pMany ((:) <$> pChar '.' <*> pAtLeast 1 p_atext)++p_id_left :: Parser Char String+p_id_left = p_dot_atom_text <|> p_no_fold_quote <|> p_obs_id_left++p_id_right :: Parser Char Domain+p_id_right = Domain <$> p_dot_atom_text+ <|> p_no_fold_literal+ <|> p_obs_id_right++p_obs_id_left :: Parser Char String+p_obs_id_left = p_local_part++p_local_part :: Parser Char String+p_local_part = p_dot_atom <|> p_quoted_string <|> p_obs_local_part++p_obs_local_part :: Parser Char String+p_obs_local_part = (\x xs -> x ++ concat xs)+ <$> p_word+ <*> pMany ((:) <$> pChar '.' <*> p_word)++p_domain :: Parser Char Domain+p_domain = Domain <$> p_dot_atom <|> p_domain_literal <|> p_obs_domain++p_domain_literal :: Parser Char Domain+p_domain_literal = (LiteralDomain . concat)+ <$ cws+ <* pChar '['+ <*> pMany ( id+ <$ p_FWS+ <*> p_dcontent)+ <* p_FWS+ <* pChar ']'+ <* cws++p_obs_domain :: Parser Char Domain+p_obs_domain = (\x xs -> Domain (x ++ concat xs))+ <$> p_atom+ <*> pMany ((:) <$> pChar '.' <*> p_atom)++p_obs_id_right :: Parser Char Domain+p_obs_id_right = p_domain++p_no_fold_quote :: Parser Char String+p_no_fold_quote = concat+ <$ pChar '"'+ <*> pMany (boxp p_qtext <|> p_quoted_pair)+ <* pChar '"'++data Domain = Domain String | LiteralDomain String+ deriving (Show, Read, Eq)++p_no_fold_literal :: Parser Char Domain+p_no_fold_literal = LiteralDomain . concat+ <$ pChar '['+ <*> pMany (boxp p_dtext <|> p_quoted_pair)+ <* pChar ']'++data Subject = Subject String+ deriving (Show, Read)++get_subject :: String -> Maybe Subject+get_subject xs+ = case parse ph_subject xs of+ Left cd -> Just cd+ Right _ -> Nothing++-- This is actually the RFC822 definition, as otherwise things get very+-- confusing.+-- Would be pMany, but p_text already does that for us+ph_subject :: Parser Char Subject+ph_subject = Subject <$> p_text <* pEOI++data From = From [Mailbox]+ deriving (Show, Read, Eq)++get_from :: String -> Maybe From+get_from xs+ = case parse ph_from xs of+ Left f -> Just f+ Right _ -> Nothing++ph_from :: Parser Char From+ph_from = From <$ cws <*> p_mailbox_list <* cws <* pEOI++data To = To [Address]+ deriving (Show, Read)++data Address = Address Mailbox+ | Group String [Mailbox]+ deriving (Show, Read)++get_to :: String -> Maybe To+get_to xs+ = case parse ph_to xs of+ Left t -> Just t+ Right _ -> Nothing++ph_to :: Parser Char To+ph_to = To <$ cws <*> p_address_list <* cws <* pEOI++-- obs-addr-list merged in+p_address_list :: Parser Char [Address]+p_address_list = (:)+ <$ pMany (() <$ pChar ',' <* cws)+ <*> p_address+ <*> pMany ( id+ <$ pAtLeast 1 (() <$ cws <* pChar ',')+ <* cws+ <*> p_address)+ <* pMany (() <$ cws <* pChar ',')++p_address :: Parser Char Address+p_address = Address <$> p_mailbox+ <|> p_group++p_group :: Parser Char Address+p_group = Group+ <$> p_display_name + <* cws+ <* pChar ':'+ <* cws+ <*> pOptDef [] p_mailbox_list+ <* cws+ <* pChar ';'++-- obs-mbox-list merged in+p_mailbox_list :: Parser Char [Mailbox]+p_mailbox_list = (:)+ <$ pMany (() <$ pChar ',' <* cws)+ <*> p_mailbox+ <*> pMany ( id+ <$ pAtLeast 1 (() <$ cws <* pChar ',')+ <* cws+ <*> p_mailbox)+ <* pMany (() <$ cws <* pChar ',')++data Mailbox = Mailbox (Maybe String) RoutedEmailAddress+ deriving (Show, Read, Eq)++p_mailbox :: Parser Char Mailbox+p_mailbox = p_name_addr+ <|> (Mailbox Nothing . NormalEmailAddress) <$> p_addr_spec++p_name_addr :: Parser Char Mailbox+p_name_addr = Mailbox+ <$> pMaybe p_display_name+ <* cws+ <*> p_angle_addr++data EmailAddress = EmailAddress String Domain+ deriving (Show, Read, Eq)++data RoutedEmailAddress = NormalEmailAddress EmailAddress+ | RoutedEmailAddress [Domain] EmailAddress+ deriving (Show, Read, Eq)++p_angle_addr :: Parser Char RoutedEmailAddress+p_angle_addr = ($)+ <$ pChar '<'+ <* cws+ -- This next makes us also satisfy obs-angle-addr+ <*> pOptDef NormalEmailAddress+ (RoutedEmailAddress <$> p_obs_route <* cws)+ <*> p_addr_spec+ <* cws+ <* pChar '>'++get_addr_spec :: String -> Maybe EmailAddress+get_addr_spec xs+ = case parse p_addr_spec xs of+ Left e -> Just e+ Right _ -> Nothing++p_addr_spec :: Parser Char EmailAddress+p_addr_spec = EmailAddress+ <$> p_local_part+ <* cws+ <* pChar '@'+ <* cws+ <*> p_domain++p_display_name :: Parser Char String+p_display_name = (concat . intersperse " ") <$> p_phrase++p_obs_route :: Parser Char [Domain]+p_obs_route = id <$> p_obs_domain_list <* pChar ':'++p_obs_domain_list :: Parser Char [Domain]+p_obs_domain_list = (:)+ <$ pChar '@'+ <* cws+ <*> p_domain+ <*> pMany ( id+ <$ pMaybe (() <$ cws <* pChar ',')+ <* cws+ <* pChar '@'+ <* cws+ <*> p_domain)++-----------------------+-- RFC 2045++data MIMEVersion = MIMEVersion Integer Integer+ deriving (Show, Read)++get_mime_version :: String -> Maybe MIMEVersion+get_mime_version xs = case parse ph_mime_version xs of+ Left ct -> Just ct+ Right _ -> Nothing++ph_mime_version :: Parser Char MIMEVersion+ph_mime_version = MIMEVersion+ <$ cws+ <*> (read <$> pMany (pPred isAsciiDigit))+ <* cws+ <* pChar '.'+ <* cws+ <*> (read <$> pMany (pPred isAsciiDigit))+ <* cws+ <* pEOI++data ContentType = ContentType String -- Case insensitive: lower-cased+ String -- Case insensitive: lower-cased+ [Parameter]+ deriving (Show, Read)+data Parameter = Parameter String -- Case insensitive: lower-cased+ String+ deriving (Show, Read)++get_content_type :: String -> Maybe ContentType+get_content_type xs = case parse ph_content_type xs of+ Left ct -> Just ct+ Right _ -> Nothing++ph_content_type :: Parser Char ContentType+ph_content_type = ContentType+ <$ cws+ <*> p_type+ <* cws+ <* pChar '/'+ <* cws+ <*> p_subtype+ <*> pMany (id+ <$ cws+ <* pChar ';'+ <* cws+ <*> p_parameter)+ <* cws+ <* pEOI+++-- For type and subtypes, allow anything that matches a regexp that+-- subsumes the currently allowed values+p_type :: Parser Char String+p_type = pAtLeast 1 (pPred (\c -> isAsciiAlphaNum c || c `elem` "-.+"))++p_subtype :: Parser Char String+p_subtype = pAtLeast 1 (pPred (\c -> isAsciiAlphaNum c || c `elem` "-.+"))++{-+p_type :: Parser Char String+p_type = p_discrete_type <|> p_composite_type++p_subtype :: Parser Char String+p_subtype = map asciiToLower <$> (p_extension_token <|> p_iana_token)++p_discrete_type :: Parser Char String+p_discrete_type = p_ci_string "text"+ <|> p_ci_string "image"+ <|> p_ci_string "audio"+ <|> p_ci_string "video"+ <|> p_ci_string "application"+ <|> map asciiToLower <$> p_extension_token++p_composite_type :: Parser Char String+p_composite_type = p_ci_string "message"+ <|> p_ci_string "multipart"+ <|> map asciiToLower <$> p_extension_token++p_iana_token :: Parser Char String+p_iana_token = pFail+-}++p_extension_token :: Parser Char String+p_extension_token = p_ietf_token <|> p_x_token++p_ietf_token :: Parser Char String+p_ietf_token = pFail++p_x_token :: Parser Char String+p_x_token = (\x t -> x:'-':t)+ <$> (pChar 'X' <|> pChar 'x')+ <* pChar '-'+ <*> p_token++p_parameter :: Parser Char Parameter+p_parameter = Parameter+ <$> p_attribute+ <* cws+ <* pChar '='+ <* cws+ <*> p_value++p_attribute :: Parser Char String+p_attribute = map asciiToLower <$> p_token++p_value :: Parser Char String+p_value = p_token <|> p_quoted_string++p_token :: Parser Char String+p_token = pAtLeast 1 (pPred isAscii <!> (p_SP <|> p_CTL <|> p_tspecials))++p_tspecials :: Parser Char Char+p_tspecials = pPred (`elem` "()<>@,;:\\\"/[]?=")++-----++data ContentTransferEncoding+ = ContentTransferEncoding String -- Case insensitive: lower-cased+ deriving (Show, Read)++get_content_transfer_encoding :: String -> Maybe ContentTransferEncoding+get_content_transfer_encoding xs+ = case parse ph_content_transfer_encoding xs of+ Left cte -> Just cte+ Right _ -> Nothing++ph_content_transfer_encoding :: Parser Char ContentTransferEncoding+ph_content_transfer_encoding+ = ContentTransferEncoding+ <$ cws+ <*> p_mechanism+ <* cws+ <* pEOI++p_mechanism :: Parser Char String+p_mechanism = p_ci_string "7bit"+ <|> p_ci_string "8bit"+ <|> p_ci_string "binary"+ <|> p_ci_string "quoted-printable"+ <|> p_ci_string "base64"+ <|> map asciiToLower <$> p_ietf_token+ <|> map asciiToLower <$> p_x_token++data ContentID = ContentID MessageID+ deriving (Show, Read)++get_content_id :: String -> Maybe ContentID+get_content_id xs+ = case parse ph_content_id xs of+ Left ci -> Just ci+ Right _ -> Nothing++ph_content_id :: Parser Char ContentID+ph_content_id+ = ContentID+ <$ cws+ <*> p_msg_id+ <* cws+ <* pEOI++data ContentDescription = ContentDescription String+ deriving (Show, Read)++get_content_description :: String -> Maybe ContentDescription+get_content_description xs+ = case parse ph_content_description xs of+ Left cd -> Just cd+ Right _ -> Nothing++ph_content_description :: Parser Char ContentDescription+ph_content_description+ = ContentDescription+ <$ cws+ <*> p_text -- would be pMany, but p_text already does that for us+ <* cws+ <* pEOI++-----------------------+-- RFC 2046++-- Not really a header as such++get_boundary :: String -> Maybe String+get_boundary xs+ = case parse p_boundary xs of+ Left b -> Just b+ Right _ -> Nothing++-- We are very flexible here+p_boundary :: Parser Char String+p_boundary = (\ss b bs -> dropFromEndWhile (' ' ==) (ss ++ [b] ++ bs))+ <$> pMany (pChar ' ')+ <*> p_bchars+ <*> pMany p_bchars++p_bchars :: Parser Char Char+p_bchars = p_bcharsnospace <|> pChar ' '++p_bcharsnospace :: Parser Char Char+p_bcharsnospace = pPred (\c -> isAsciiAlphaNum c || c `elem` "'()+_,-./:=?")+
+ Codec/MIME/String/Internal/ABNF.hs view
@@ -0,0 +1,173 @@++module Codec.MIME.String.Internal.ABNF+ (Parser, apply, parse,+ pPred, pSucceed, pFail, pEOI, (<*>), (<|>), (<| ), (<!>), nested_parse,+ pChar, pString, (<$>), (<$ ), (<* ), ( |>),+ pMany, pAtLeast, pAtMost, pExactly, pFromTo, pOptDef, pMaybe+ ) where++import Data.Word++newtype Parser inp res = Parser ([(inp, Pos)] -> ParseResult inp res)++data ParseResult inp res = Success res [(inp, Pos)] !Pos+ | Fail !Pos++type Line = Integer+type Column = Integer+data Pos = Pos !Line !Column+ | EOI+ deriving (Eq, Ord)++get_pos :: [(a, Pos)] -> Pos+get_pos [] = EOI+get_pos ((_, p):_) = p++show_pos :: Pos -> String+show_pos EOI = "End of input"+show_pos (Pos l c) = "Line " ++ show l ++ ", column " ++ show c++infixl 6 <$>, <$, <*>, <*+infixr 3 <|>, <|, |>++posify :: String -> [(Char, Pos)]+posify = f 1 1+ where f _ _ [] = []+ f l c ('\n':xs) = ('\n', Pos l c):f (l+1) 1 xs+ f l c (x :xs) = (x, Pos l c):f l (c+1) xs++apply :: Parser Char a -> String -> Either (a, String) String+apply (Parser p) xs+ = case p $ posify xs of+ Success res ys _ -> Left (res, map fst ys)+ Fail pos -> Right ("Error: Failed at " ++ show_pos pos)++parse :: Parser Char a -> String -> Either a String+parse (Parser p) xs+ = case p $ posify xs of+ Success res [] _ -> Left res+ Success _ ((_, pos):_) _ ->+ Right ("Error: Only consumed up to " ++ show_pos pos)+ Fail pos ->+ Right ("Error: Failed at " ++ show_pos pos)++-- Primitive combinators++pPred :: (inp -> Bool) -> Parser inp inp+pPred p = Parser+ $ \inp -> case inp of+ ((x, pos):inp')+ | p x -> Success x inp' pos+ _ -> Fail (get_pos inp)++pSucceed :: res -> Parser a res+pSucceed x = Parser $ \inp -> Success x inp (get_pos inp)++pFail :: Parser a res+pFail = Parser $ \inp -> Fail (get_pos inp)++pEOI :: Parser a ()+pEOI = Parser $ \inp -> case inp of+ [] -> Success () [] EOI+ _ -> Fail (get_pos inp)++(<*>) :: Parser inp (a -> b) -> Parser inp a -> Parser inp b+Parser p <*> Parser q = Parser $ \inp ->+ case p inp of+ Fail pos -> Fail pos+ Success f inp' pos ->+ case q inp' of+ Fail pos' -> Fail (pos `max` pos')+ Success x inp'' pos' ->+ Success (f x) inp'' (pos `max` pos')++(<|>) :: Parser inp a -> Parser inp a -> Parser inp a+Parser p <|> Parser q = Parser $ \inp ->+ case (p inp, q inp) of+ (Fail posp, Fail posq) -> Fail (posp `max` posq)+ (Fail posp, Success x inp' posq) ->+ Success x inp' (posp `max` posq)+ (Success x inp' posp, Fail posq) ->+ Success x inp' (posp `max` posq)+ (rp@(Success _ _ posp), rq@(Success _ _ posq))+ -> if posp >= posq then rp else rq++(<| ) :: Parser inp a -> Parser inp a -> Parser inp a+Parser p <| Parser q = Parser $ \inp ->+ case p inp of+ Fail posp ->+ case q inp of+ Fail posq -> Fail (posp `max` posq)+ Success x inp' posq ->+ Success x inp' (posp `max` posq)+ s -> s++(<!>) :: Parser inp a -> Parser inp b -> Parser inp a+Parser p <!> Parser q = Parser $ \inp -> case q inp of+ Fail _ ->+ p inp+ Success _ _ pos -> Fail pos++check_fails_empty :: Parser inp a -> ()+check_fails_empty (Parser p) = case p [] of+ Fail _ -> ()+ _ -> error "check_fails_empty failed"++nested_parse :: Parser Char String -> Parser Char a -> Parser Char a+nested_parse (Parser p1) (Parser p2)+ = Parser+ $ \inp -> case p1 inp of+ Fail pos -> Fail pos+ Success inp' rem_inp pos ->+ case p2 $ posify inp' of+ Fail pos' -> Fail (pos `max` pos')+ Success x [] pos' -> Success x rem_inp (pos `max` pos')+ Success _ _ pos' -> Fail (pos `max` pos')++-- Derived combinators++pChar :: Char -> Parser Char Char+pChar c = pPred (c ==)++pString :: String -> Parser Char String+pString "" = pSucceed ""+pString (c:cs) = (:) <$> pChar c <*> pString cs++(<$>) :: (a -> b) -> Parser inp a -> Parser inp b+x <$> q = pSucceed x <*> q++(<$ ) :: a -> Parser inp b -> Parser inp a+x <$ q = pSucceed x <* q++(<* ) :: Parser inp a -> Parser inp b -> Parser inp a+p <* q = (\x _ -> x) <$> p <*> q++( |>) :: Parser inp a -> Parser inp a -> Parser inp a+p |> q = q <| p++pMany :: Parser inp a -> Parser inp [a]+pMany p = check_fails_empty p `seq` ((:) <$> p <*> pMany p) <| pSucceed []++pAtLeast :: Word -> Parser inp a -> Parser inp [a]+pAtLeast 0 p = pMany p+pAtLeast n p = ((:) <$> p <*> pAtLeast (n-1) p)++pAtMost :: Word -> Parser inp a -> Parser inp [a]+pAtMost 0 _ = pSucceed []+pAtMost n p = ((:) <$> p <*> pAtMost (n-1) p) <| pSucceed []++pExactly :: Word -> Parser inp a -> Parser inp [a]+pExactly 0 _ = pSucceed []+pExactly n p = ((:) <$> p <*> pExactly (n-1) p)++pFromTo :: Word -> Word -> Parser inp a -> Parser inp [a]+pFromTo 0 t p = pAtMost t p+pFromTo _ 0 _ = error "Codec.MIME.String.Internal.ABNF.pFromTo: Bad arguments"+pFromTo f t p = ((:) <$> p <*> pFromTo (f-1) (t-1) p)++pOptDef :: a -> Parser inp a -> Parser inp a+pOptDef x p = p <| pSucceed x++pMaybe :: Parser inp a -> Parser inp (Maybe a)+pMaybe p = Just <$> p <| pSucceed Nothing+
+ Codec/MIME/String/Internal/Utils.hs view
@@ -0,0 +1,58 @@++module Codec.MIME.String.Internal.Utils where++import Data.Char++isAsciiDigit :: Char -> Bool+isAsciiDigit c = isAscii c && isDigit c++isAsciiHexDigit :: Char -> Bool+isAsciiHexDigit c = isAscii c && isHexDigit c++isAsciiPrint :: Char -> Bool+isAsciiPrint c = isAscii c && isPrint c++isAsciiAlpha :: Char -> Bool+isAsciiAlpha c = isAscii c && isAlpha c++isAsciiAlphaNum :: Char -> Bool+isAsciiAlphaNum c = isAscii c && isAlphaNum c++asciiToLower :: Char -> Char+asciiToLower c | isAscii c = toLower c+ | otherwise = c++asciiToUpper :: Char -> Char+asciiToUpper c | isAscii c = toUpper c+ | otherwise = c++splits :: Int -> [a] -> [[a]]+splits _ [] = []+splits n xs = case splitAt n xs of+ (ys, zs) -> ys:splits n zs++box :: a -> [a]+box x = [x]++dropFromEndWhile :: (a -> Bool) -> [a] -> [a]+dropFromEndWhile p = foldr (\x xs -> if null xs && p x then [] else x:xs) []++-- We are generous about what we allow as line terminators. Any of+-- \r \n \r\n \n\r will satisfy us.+my_lines :: String -> [String]+my_lines xs = case get_line xs of+ (ys, Nothing) -> [ys]+ (ys, Just zs) -> ys:my_lines zs++get_line :: String -> (String, Maybe String)+get_line xs = case break is_cr_or_lf xs of+ (ys, z1:z2:zs)+ | is_cr_or_lf z2 && z1 /= z2 -> (ys, Just zs)+ (ys, _:zs) -> (ys, Just zs)+ (ys, "") -> (ys, Nothing)++is_cr_or_lf :: Char -> Bool+is_cr_or_lf '\r' = True+is_cr_or_lf '\n' = True+is_cr_or_lf _ = False+
+ Codec/MIME/String/Parse.hs view
@@ -0,0 +1,309 @@++module Codec.MIME.String.Parse where++import Text.Iconv+import qualified Codec.Binary.Base64.String as Base64 (decode)+import Codec.MIME.String.ContentDisposition+ (+ ContentDisposition(ContentDisposition), get_content_disposition,+ DispositionType(Inline, Attachment),+ DispositionParameter(..),+ )+import Codec.MIME.String.Date (get_date)+import Codec.MIME.String.Headers+ (+ ContentTransferEncoding(ContentTransferEncoding),+ get_content_transfer_encoding,+ ContentType(ContentType), get_content_type,+ get_content_description, get_boundary,+ Parameter(Parameter),+ MIMEVersion(MIMEVersion), get_mime_version,+ Subject(Subject),+ get_subject, get_from, get_to,+ )+import qualified Codec.MIME.String.QuotedPrintable as QuotedPrintable (decode)+import Codec.MIME.String.Types+ (+ ParseM,+ Header(Header, h_raw_header, h_raw_name, h_name, h_body),+ Headers,+ Message(Message),+ MessageInfo(..),+ Multipart(Multipart),+ MessageContent(NoContent, Mixed, Alternative,+ Parallel, Digest, RFC822),+ mkData, mkBody,+ digest_content_type, ascii_text_content_type,+ )+import Codec.MIME.String.Internal.Utils++import Control.Monad (liftM)+import Control.Monad.State (evalState, get, put)+import Data.Maybe (fromMaybe)++mkMessage :: MessageInfo -> ParseM MessageContent -> ParseM Message+mkMessage mi f_mc+ = do pn <- get+ put (pn + 1)+ -- This is done slightly oddly so we get numbering in the natural+ -- order, which in turn is important when looking for a part number+ mc <- f_mc+ return $ Message pn mi mc++parse :: String -> Message+parse msg = evalState (parse_message msg) 1++parse_message :: String -> ParseM Message+parse_message msg+ = let (headers, m_body) = parse_headers msg+ in case get_header headers "mime-version:" get_mime_version of+ -- We only try and be clever if the MIME version is 1.0+ Just (MIMEVersion 1 0) ->+ parse_mime_message ascii_text_content_type msg+ _ ->+ do let m_from = get_header headers "from:" get_from+ m_subject = get_header headers "subject:" (Just . Subject)+ m_to = get_header headers "to:" get_to+ m_date = get_header headers "date:" get_date+ mi = MessageInfo {+ mi_headers = headers,+ mi_from = m_from,+ mi_subject = m_subject,+ mi_to = m_to,+ mi_date = m_date,+ mi_content_description = Nothing+ }+ mc = case m_body of+ Just body ->+ mkBody ascii_text_content_type "unknown"+ (convertAsciiToUtf8 body)+ Nothing ->+ return $ NoContent ascii_text_content_type+ mkMessage mi mc++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"++parse_mime_message :: ContentType -> String -> ParseM Message+parse_mime_message def_content_type msg+ = let (headers, m_body) = parse_headers msg+ mi = make_mime_message_info headers+ mc = case m_body of+ Nothing ->+ do let m_ct = get_header headers "content-type:"+ get_content_type+ content_type = fromMaybe def_content_type m_ct+ return $ NoContent content_type+ Just body ->+ make_mime_message_content def_content_type headers body+ in mkMessage mi mc++make_mime_message_info :: Headers -> MessageInfo+make_mime_message_info headers+ = let m_content_description = get_header headers "content-description:"+ get_content_description+ m_from = get_header headers "from:" get_from+ m_subject = get_header headers "subject:" get_subject+ m_to = get_header headers "to:" get_to+ m_date = get_header headers "date:" get_date+ in MessageInfo {+ mi_headers = headers,+ mi_from = m_from,+ mi_subject = m_subject,+ mi_to = m_to,+ mi_date = m_date,+ mi_content_description = m_content_description+ }++make_mime_message_content :: ContentType -> Headers -> String+ -> ParseM MessageContent+make_mime_message_content def_content_type headers body+ = -- We accept illegal combinations of content type and+ -- encoding, so just decode whatever it says+ case m_decoded_body of+ Nothing ->+ mkData (Just cte) content_type filename body+ Just decoded_body ->+ case content_disposition of+ ContentDisposition Attachment _ ->+ mkData Nothing content_type filename decoded_body+ ContentDisposition Inline _ ->+ case content_type of+ 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 ->+ 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+ -> do let (preamble, parts, epilogue)+ = get_parts b decoded_body+ ct = case st of+ "digest" -> digest_content_type+ _ -> ascii_text_content_type+ constr = case st of+ "alternative" -> Alternative+ "parallel" -> Parallel+ "digest" -> Digest+ _ -> Mixed+ ms <- mapM (parse_mime_message ct) parts+ return $ constr (Multipart preamble ms epilogue)+ ContentType "message" "rfc822" _ ->+ liftM (RFC822 decoded_body filename)+ (parse_message decoded_body)+ -- Anything else is treated like an+ -- application/octet-stream+ _ -> mkData Nothing content_type filename decoded_body+ where m_cd = get_header headers "content-disposition:"+ get_content_disposition+ content_disposition = fromMaybe (ContentDisposition Inline []) m_cd+ m_ct = get_header headers "content-type:"+ get_content_type+ content_type = fromMaybe def_content_type m_ct+ filename = get_filename content_disposition content_type+ m_ce = get_header headers "content-transfer-encoding:"+ get_content_transfer_encoding+ cte@(ContentTransferEncoding content_transfer_encoding)+ = fromMaybe (ContentTransferEncoding "7bit") m_ce+ m_decoded_body+ = if content_transfer_encoding == "base64" then+ Just (Base64.decode body)+ else if content_transfer_encoding == "quoted-printable" then+ Just (QuotedPrintable.decode $ my_lines body)+ else if content_transfer_encoding `elem`+ ["7bit", "8bit", "binary"] then+ -- Don't worry if 8-bit data is in 7-bit transfer-encoded data+ Just body+ else Nothing++get_filename :: ContentDisposition -> ContentType -> FilePath+get_filename (ContentDisposition _ params) (ContentType _ _ params')+ = loop params+ where loop [] = -- Look up legacy name parameter in content type+ case lookup_param "name" params' of+ Nothing -> default_filename+ Just f -> sanitise f+ loop (Filename f:_) = sanitise f+ loop (_:ps) = loop ps+ sanitise f = case reverse $ takeWhile ('/' /=) $ reverse f of+ "" -> default_filename+ f' -> f'+ default_filename = "unknown"++get_parts :: String -> String -> (String, [String], String)+get_parts boundary body+ = case gps [] body of+ (pre:parts, epi) -> (pre, parts, epi)+ _ -> error "Parse.get_parts: Can't happen XXX"+ where gps acc "" = ([from_acc acc], "")+ gps acc xs+ = case fmap (dropWhile isWSP) $ after dd_boundary+ $ snd $ read_line_ending xs of+ Just "--" -> ([from_acc acc], "")+ Just ('-':'-':cs@(c:_))+ | is_cr_or_lf c -> ([from_acc acc], cs)+ Just "" -> ([from_acc acc], "")+ Just (c1:cs)+ | is_cr_or_lf c1+ -> let cs' = case cs of+ c2:cs''+ | is_cr_or_lf c2 && c1 /= c2+ -> cs''+ _ -> cs+ in case gps [] cs' of+ (ps, ep) -> (from_acc acc:ps, ep)+ _ -> case read_line_ending xs of+ (le, xs') ->+ case break is_cr_or_lf xs' of+ (ys, zs) -> gps (ys:le:acc) zs+ from_acc acc = concat $ reverse acc+ read_line_ending cs = case cs of+ (c1:cs1)+ | is_cr_or_lf c1 ->+ case cs1 of+ (c2:cs2)+ | is_cr_or_lf c2 && c1 /= c2 ->+ ([c1, c2], cs2)+ _ -> ([c1], cs1)+ _ -> ("", cs)+ after "" ys = Just ys+ after (x:xs) (y:ys)+ | x == y = after xs ys+ | otherwise = Nothing+ after (_:_) "" = Nothing+ dd_boundary = "--" ++ boundary+ isWSP ' ' = True+ isWSP '\t' = True+ isWSP _ = False++-- Returns the value of the first parameter of the name (must be lower cased)+lookup_param :: String -> [Parameter] -> Maybe String+lookup_param _ [] = Nothing+lookup_param name (Parameter n v:ps)+ | name == n = Just v+ | otherwise = lookup_param name ps++get_header :: Headers -> String -> (String -> Maybe a) -> Maybe a+get_header hs name getter+ = case filter ((name ==) . h_name) hs of+ [h] -> getter (h_body h)+ _ -> Nothing++-- We skip over leading white space lines, both for resilience and+-- because this is allowed for MIME part headers.+parse_headers :: String -> (Headers, Maybe String)+parse_headers msg = skip_whitespace (Just msg)+ where skip_whitespace :: Maybe String -> ([Header], Maybe String)+ skip_whitespace Nothing = ([], Nothing)+ skip_whitespace (Just xs) = case get_line xs of+ ([], m_zs) -> ([], m_zs)+ (ys, m_zs) ->+ case dropWhile isWhite ys of+ [] -> 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 (Just xs)+ = case get_line xs of+ ([], m_zs) -> ([mk_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)+ starts_with_white (c:_) = isWhite c+ starts_with_white [] = False+ isWhite ' ' = True+ isWhite '\t' = True+ isWhite _ = False++-- Takes the lines comprising a header (in reverse order) and constructs+-- the corresponding Header+mk_header :: [String] -> Header+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_name = raw_name,+ h_name = map asciiToLower raw_name,+ h_body = body+ }+ where ends_header ':' = True+ ends_header ' ' = True+ ends_header '\t' = True+ ends_header _ = False+ xs' = reverse xs+
+ Codec/MIME/String/QuotedPrintable.hs view
@@ -0,0 +1,60 @@++-- Defined in RFC 2045.+-- We assume we have US-ASCII characters.+-- We return a string with native '\n' line endings.++module Codec.MIME.String.QuotedPrintable (encode, decode) where++import Codec.MIME.String.Internal.Utils+import Data.Bits+import Data.Char+import Data.List++encode :: [String] -> String+encode = enc 0++-- The Int is the number of characters on this line so far+-- 76 is the maximum we can have no one line, and 3 is the most+-- generated for 1 input char (but we also need space for a trailing+-- '=' for a soft line break).+enc :: Int -> [String] -> String+enc _ [] = ""+enc _ [[]] = ""+enc _ ([]:ls) = '\n':enc 0 ls+enc n ls | n > 72 = '=':'\n':enc 0 ls+enc n ((c:cs):ls)+ | (33 <= o && o <= 126 && o /= 61) ||+ (not (null cs) && (o == 9 || o == 32)) = c:enc (n+1) (cs:ls)+ | otherwise = '=':x1:x2:enc (n+3) (cs:ls)+ where o = ord c+ x1 = toUpper $ intToDigit (o `shiftR` 4)+ x2 = toUpper $ intToDigit (o .&. 0xF)++-- decode is very forgiving, and makes some best guesses+decode :: [String] -> String+decode = dec . concat . intersperse "\n"+ . removeSoftLinebreaks+ . map (dropFromEndWhile is_tab_space)+ where is_tab_space ' ' = True+ is_tab_space '\t' = True+ is_tab_space _ = False+ breakLast "" = ("", "")+ breakLast [x] = ("", [x])+ breakLast (x:xs) = case breakLast xs of+ (ys, zs) -> (x:ys, zs)+ removeSoftLinebreaks [] = []+ removeSoftLinebreaks (x:xs)+ = case breakLast x of+ (x', "=") ->+ case removeSoftLinebreaks xs of+ [] -> [x']+ (y:ys) -> (x' ++ y):ys+ _ -> x:removeSoftLinebreaks xs++dec :: String -> String+dec ('=':c1:c2:cs)+ | isAsciiHexDigit c1 && isAsciiHexDigit c2+ = chr ((digitToInt c1 `shiftL` 4) + digitToInt c2):dec cs+dec (c:cs) = c:dec cs+dec "" = ""+
+ Codec/MIME/String/Types.hs view
@@ -0,0 +1,82 @@++module Codec.MIME.String.Types+ (+ ParseM, PartNumber, Headers,+ Header(Header, h_raw_header, h_raw_name, h_name, h_body),+ Message(..), MessageInfo(..), Multipart(Multipart),+ MessageContent(NoContent, Body, Data, Mixed, Alternative,+ Parallel, Digest, RFC822),+ mkData, mkBody,+ digest_content_type, ascii_text_content_type,+ )+ where++import Codec.MIME.String.Date (FullDate)+import Codec.MIME.String.Headers+ (+ ContentType(ContentType), ContentDescription, ContentTransferEncoding,+ Parameter(Parameter), From, To, Subject,+ )+import Codec.MIME.String.Internal.Utils (my_lines)++import Control.Monad.State (State)++type Headers = [Header]+data Header = Header {+ h_raw_header :: [String],+ h_raw_name :: String,+ h_name :: String,+ h_body :: String+ }+ deriving (Show, Read)++data MessageInfo = MessageInfo {+ mi_headers :: Headers,+ mi_from :: Maybe From,+ mi_to :: Maybe To,+ mi_subject :: Maybe Subject,+ mi_date :: Maybe FullDate,+ mi_content_description :: Maybe ContentDescription+ }+ deriving (Show, Read)+data MessageContent = NoContent ContentType+ | Body ContentType FilePath String -- UTF-8 text+ | Data (Maybe ContentTransferEncoding)+ ContentType FilePath String -- 8-bit data+ | Mixed Multipart+ | Alternative Multipart+ | Parallel Multipart+ | Digest Multipart+ | RFC822 String{- unparsed message-} FilePath Message+ deriving (Show, Read)++type ParseM a = State PartNumber a++mkBody :: ContentType -> FilePath -> String -> ParseM MessageContent+mkBody ct fp s = return $ Body ct fp $ unlines $ my_lines s++mkData :: Maybe ContentTransferEncoding -> ContentType -> FilePath+ -> String -> ParseM MessageContent+mkData m_cte ct fp s = return $ Data m_cte ct fp s++data Multipart = Multipart String -- Preamble+ [Message] -- The messages themselves+ String -- Epilogue+ deriving (Show, Read)++type PartNumber = Integer++data Message = Message {+ m_part_number :: PartNumber,+ m_message_info :: MessageInfo,+ m_message_content :: MessageContent+ }+ deriving (Show, Read)++ascii_text_content_type :: ContentType+ascii_text_content_type+ = ContentType "text" "plain" [Parameter "charset" "US-ASCII"]++digest_content_type :: ContentType+digest_content_type = ContentType "message" "rfc822" []+
+ GPL-2 view
@@ -0,0 +1,340 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+ 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++ Preamble++ The licenses for most software are designed to take away your+freedom to share and change it. By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users. This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it. (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.) You can apply it to+your programs, too.++ When we speak of free software, we are referring to freedom, not+price. Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++ To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++ For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have. You must make sure that they, too, receive or can get the+source code. And you must show them these terms so they know their+rights.++ We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++ Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software. If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++ Finally, any free program is threatened constantly by software+patents. We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary. To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++ The precise terms and conditions for copying, distribution and+modification follow.++ GNU GENERAL PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License. The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language. (Hereinafter, translation is included without limitation in+the term "modification".) Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope. The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++ 1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++ 2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++ a) You must cause the modified files to carry prominent notices+ stating that you changed the files and the date of any change.++ b) You must cause any work that you distribute or publish, that in+ whole or in part contains or is derived from the Program or any+ part thereof, to be licensed as a whole at no charge to all third+ parties under the terms of this License.++ c) If the modified program normally reads commands interactively+ when run, you must cause it, when started running for such+ interactive use in the most ordinary way, to print or display an+ announcement including an appropriate copyright notice and a+ notice that there is no warranty (or else, saying that you provide+ a warranty) and that users may redistribute the program under+ these conditions, and telling the user how to view a copy of this+ License. (Exception: if the Program itself is interactive but+ does not normally print such an announcement, your work based on+ the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole. If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works. But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++ 3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++ a) Accompany it with the complete corresponding machine-readable+ source code, which must be distributed under the terms of Sections+ 1 and 2 above on a medium customarily used for software interchange; or,++ b) Accompany it with a written offer, valid for at least three+ years, to give any third party, for a charge no more than your+ cost of physically performing source distribution, a complete+ machine-readable copy of the corresponding source code, to be+ distributed under the terms of Sections 1 and 2 above on a medium+ customarily used for software interchange; or,++ c) Accompany it with the information you received as to the offer+ to distribute corresponding source code. (This alternative is+ allowed only for noncommercial distribution and only if you+ received the program in object code or executable form with such+ an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it. For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable. However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++ 4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License. Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++ 5. You are not required to accept this License, since you have not+signed it. However, nothing else grants you permission to modify or+distribute the Program or its derivative works. These actions are+prohibited by law if you do not accept this License. Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++ 6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions. You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++ 7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License. If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all. For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices. Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++ 8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded. In such case, this License incorporates+the limitation as if written in the body of this License.++ 9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time. Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number. If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation. If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++ 10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission. For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this. Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++ NO WARRANTY++ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++ END OF TERMS AND CONDITIONS++ How to Apply These Terms to Your New Programs++ If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++ To do so, attach the following notices to the program. It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ This program is free software; you can redistribute it and/or modify+ it under the terms of the GNU General Public License as published by+ the Free Software Foundation; either version 2 of the License, or+ (at your option) any later version.++ This program is distributed in the hope that it will be useful,+ but WITHOUT ANY WARRANTY; without even the implied warranty of+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+ GNU General Public License for more details.++ You should have received a copy of the GNU General Public License+ along with this program; if not, write to the Free Software+ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++ Gnomovision version 69, Copyright (C) year name of author+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+ This is free software, and you are welcome to redistribute it+ under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License. Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary. Here is a sample; alter the names:++ Yoyodyne, Inc., hereby disclaims all copyright interest in the program+ `Gnomovision' (which makes passes at compilers) written by James Hacker.++ <signature of Ty Coon>, 1 April 1989+ Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs. If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library. If this is what you want to do, use the GNU Library General+Public License instead of this License.
+ Setup.hs view
@@ -0,0 +1,8 @@++module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain+
+ mime-string.cabal view
@@ -0,0 +1,34 @@+Name: mime-string+Version: 0.1+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.+Category: Codec+Tested-With: GHC==6.6+Build-Depends: base, mtl, network, iconv, base64-string+Extensions: PatternGuards+Extra-source-files: "BSD3", "GPL-2"+Exposed-modules:+ Codec.Binary.EncodingQ.String+ Codec.MIME.String+ Codec.MIME.String.ContentDisposition+ Codec.MIME.String.Date+ Codec.MIME.String.EncodedWord+ Codec.MIME.String.Flatten+ Codec.MIME.String.Headers+ Codec.MIME.String.Parse+ Codec.MIME.String.Types+ Codec.MIME.String.QuotedPrintable+Other-Modules:+ Codec.MIME.String.Internal.ABNF+ Codec.MIME.String.Internal.Utils+GHC-Options: -O -Wall -Werror+