diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,4 +1,41 @@ +0.3 -> 0.4 +---------- + + - Merge pull request #22 from dpwright/parse-fix: + Fix parser error when passing parameters to FETCH + (See http://stackoverflow.com/questions/26183675/error-when-fetching-subject-from-email-using-haskellnets-imap) + - Merge pull request #20 from vincenthz/master: + Replace Crypto by the much faster cryptohash + - Merge pull request #19 from fegu/patch-1 + remove closeSMTP at end of sendMimeMail + (sendMail and sendMimeMail should have the same behaviour towards the + connection given to the function. In addition, Office365 causes the + closeSMTP of sendMimeMail to raise an exception of already closed. Thus, + removed.) + - Merge pull request #18 from michaelbeaumont/issue17 + Stopped the POP3 module from removing whitespace before response lines + except for the initial line with the POP3 status. Retrieved messages can now + be correctly parsed. + - Merge pull request #16 from fegu/master + Fix store command to enable Office365 support (Adding a space between UID + and flags in STORE command. This should have been there all the time, but + while some IMAP servers (notably Gmail) accepts that it is missing, others + (notably Office365) requires it.) + - Merge pull request #10 from ppetr/master + Improve `tryCommand` so that it includes the failed server response. + - Improve a bad piece of code in `sendMail`. + It used pattern matching and then catching the exception using `handle`, + which is very non-idiomatic and error prone. Also the code seemed to catch + the failure only to rethrow it. + - Merge pull request #8 from ppetr/master + Upgrade to mime-mail >= 0.4. + - Merge pull request #5 from sordina/master + Adding show constraint to show6 in Network/HaskellNet/IMAP.hs for + compatibility with GHC 7.4.1 + - Merge pull request #4 from nh2/ghc-7.2 + Fix compilation with GHC 7.0 and 7.2 (fixes Char and List imports) + 0.2.5 -> 0.3 ------------ @@ -38,4 +75,4 @@ Network.HaskellNet.Connection (POP connection functions) * IMAP.Parsers: - removed unused Either handling functions - - constraind exports (originally exported everything) + - constraind exports (originally exported everything)commit 682edece1bf5fb5923ea5bd04309819c630ff33d diff --git a/HaskellNet.cabal b/HaskellNet.cabal --- a/HaskellNet.cabal +++ b/HaskellNet.cabal @@ -4,10 +4,10 @@ SMTP, and IMAP protocols. NOTE: this package will be split into smaller, protocol-specific packages in the future. -Version: 0.3.1 +Version: 0.4 Copyright: (c) 2006 Jun Mukai Author: Jun Mukai -Maintainer: Jonathan Daugherty +Maintainer: Jonathan Daugherty License: BSD3 License-file: LICENSE Category: Network @@ -24,12 +24,6 @@ type: git location: git://github.com/jtdaugherty/HaskellNet.git -Source-Repository this - type: git - location: git://github.com/shapr/HaskellNet.git - tag: nonmaintainerupload - - Library Hs-Source-Dirs: src GHC-Options: -Wall -fno-warn-unused-do-bind @@ -58,8 +52,8 @@ bytestring, pretty, array, - Crypto > 4.2.1, + cryptohash, base64-string, old-time, - mime-mail >= 0.4, + mime-mail >= 0.4.0 && < 0.5, text diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -17,6 +17,3 @@ :set -fbreak-on-exception :trace main - - -(The source for the 0.3.1 non-maintainer upload can be found at https://github.com/shapr/HaskellNet) diff --git a/src/Network/HaskellNet/Auth.hs b/src/Network/HaskellNet/Auth.hs --- a/src/Network/HaskellNet/Auth.hs +++ b/src/Network/HaskellNet/Auth.hs @@ -1,13 +1,14 @@ module Network.HaskellNet.Auth where -import Data.Digest.MD5 -import Codec.Utils +import Crypto.Hash.MD5 import qualified Codec.Binary.Base64.String as B64 (encode, decode) +import Data.Word import Data.List import Data.Bits import Data.Array +import qualified Data.ByteString as B type UserName = String type Password = String @@ -30,16 +31,19 @@ b64Decode :: String -> String b64Decode = map (toEnum.fromEnum) . B64.decode . map (toEnum.fromEnum) -showOctet :: [Octet] -> String +showOctet :: [Word8] -> String showOctet = concat . map hexChars where hexChars c = [arr ! (c `div` 16), arr ! (c `mod` 16)] arr = listArray (0, 15) "0123456789abcdef" -hmacMD5 :: String -> String -> [Octet] -hmacMD5 text key = hash $ okey ++ hash (ikey ++ map (toEnum.fromEnum) text) +hashMD5 :: [Word8] -> [Word8] +hashMD5 = B.unpack . hash . B.pack + +hmacMD5 :: String -> String -> [Word8] +hmacMD5 text key = hashMD5 $ okey ++ hashMD5 (ikey ++ map (toEnum.fromEnum) text) where koc = map (toEnum.fromEnum) key key' = if length koc > 64 - then hash koc ++ replicate 48 0 + then hashMD5 $ koc ++ replicate 48 0 else koc ++ replicate (64-length koc) 0 ipad = replicate 64 0x36 opad = replicate 64 0x5c diff --git a/src/Network/HaskellNet/IMAP.hs b/src/Network/HaskellNet/IMAP.hs --- a/src/Network/HaskellNet/IMAP.hs +++ b/src/Network/HaskellNet/IMAP.hs @@ -398,7 +398,7 @@ storeFull :: IMAPConnection -> String -> FlagsQuery -> Bool -> IO [(UID, [Flag])] storeFull conn uidstr query isSilent = - fetchCommand conn ("UID STORE " ++ uidstr ++ flgs query) procStore + fetchCommand conn ("UID STORE " ++ uidstr ++ " " ++ flgs query) procStore where fstrs fs = "(" ++ (concat $ intersperse " " $ map show fs) ++ ")" toFStr s fstrs' = s ++ (if isSilent then ".SILENT" else "") ++ " " ++ fstrs' diff --git a/src/Network/HaskellNet/IMAP/Parsers.hs b/src/Network/HaskellNet/IMAP/Parsers.hs --- a/src/Network/HaskellNet/IMAP/Parsers.hs +++ b/src/Network/HaskellNet/IMAP/Parsers.hs @@ -321,7 +321,11 @@ char ')' crlfP return $ Right $ (read num, pairs) - where pPair = do key <- anyChar `manyTill` space + where pPair = do key <- (do k <- anyChar `manyTill` char '[' + ps <- anyChar `manyTill` char ']' + space + return (k++"["++ps++"]")) + <|> anyChar `manyTill` space value <- (do char '(' v <- pParen `sepBy` space char ')' diff --git a/src/Network/HaskellNet/POP3.hs b/src/Network/HaskellNet/POP3.hs --- a/src/Network/HaskellNet/POP3.hs +++ b/src/Network/HaskellNet/POP3.hs @@ -33,8 +33,9 @@ import qualified Network.HaskellNet.Auth as A import Data.ByteString (ByteString) +import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BS -import Data.Digest.MD5 +import Crypto.Hash.MD5 import Numeric (showHex) import Control.Applicative ((<$>)) @@ -52,16 +53,20 @@ import Network.HaskellNet.POP3.Connection hexDigest :: [Char] -> [Char] -hexDigest = concatMap (flip showHex "") . hash . map (toEnum.fromEnum) +hexDigest = concatMap (flip showHex "") . B.unpack . hash . B.pack . map (toEnum.fromEnum) +blank :: Char -> Bool +blank a = isSpace a || isControl a + +trimR :: ByteString -> ByteString +trimR s = let rs = BS.reverse s in + BS.dropWhile blank rs + strip :: ByteString -> ByteString strip = trimR . trimR - where - trimR s = let rs = BS.reverse s in - BS.dropWhile blank rs -blank :: Char -> Bool -blank a = isSpace a || isControl a +stripEnd :: ByteString -> ByteString +stripEnd = BS.reverse . trimR -- | connecting to the pop3 server specified by the hostname and port -- number @@ -101,7 +106,7 @@ return (Ok, BS.unlines (BS.drop 4 reply : rest)) else return (Err, BS.drop 5 reply) where st = stream conn - getRest = do l <- strip <$> bsGetLine st + getRest = do l <- stripEnd <$> bsGetLine st if l == BS.singleton '.' then return [] else (l:) <$> getRest diff --git a/src/Network/HaskellNet/SMTP.hs b/src/Network/HaskellNet/SMTP.hs --- a/src/Network/HaskellNet/SMTP.hs +++ b/src/Network/HaskellNet/SMTP.hs @@ -45,7 +45,9 @@ import Prelude hiding (catch) -data SMTPConnection = SMTPC !BSStream ![ByteString] +-- The response field seems to be unused. It's saved at one place, but never +-- retrieved. +data SMTPConnection = SMTPC { bsstream :: !BSStream, _response :: ![ByteString] } data Command = HELO String | EHLO String @@ -100,17 +102,19 @@ -> IO SMTPConnection connectSMTP = flip connectSMTPPort 25 -tryCommand :: BSStream -> Command -> Int -> ReplyCode +tryCommand :: SMTPConnection -> Command -> Int -> ReplyCode -> IO ByteString -tryCommand st cmd tries expectedReply | tries <= 0 = do - bsClose st - fail $ "cannot execute command " ++ show cmd ++ - ", expected reply code " ++ show expectedReply -tryCommand st cmd tries expectedReply = do - (code, msg) <- sendCommand (SMTPC st []) cmd - if code == expectedReply then - return msg else - tryCommand st cmd (tries - 1) expectedReply +tryCommand conn cmd tries expectedReply = do + (code, msg) <- sendCommand conn cmd + case () of + _ | code == expectedReply -> return msg + _ | tries > 1 -> + tryCommand conn cmd (tries - 1) expectedReply + _ | otherwise -> do + bsClose (bsstream conn) + fail $ "cannot execute command " ++ show cmd ++ + ", expected reply code " ++ show expectedReply ++ + ", but received " ++ show code ++ " " ++ BS.unpack msg -- | create SMTPConnection from already connected Stream connectStream :: BSStream -> IO SMTPConnection @@ -120,7 +124,7 @@ do bsClose st fail "cannot connect to the server" senderHost <- getHostName - msg <- tryCommand st (EHLO senderHost) 3 250 + msg <- tryCommand (SMTPC st []) (EHLO senderHost) 3 250 return (SMTPC st (tail $ BS.lines msg)) parseResponse :: BSStream -> IO (ReplyCode, ByteString) @@ -207,15 +211,14 @@ -> ByteString -- ^ data -> SMTPConnection -> IO () -sendMail sender receivers dat conn = - catcher `handle` mainProc - where mainProc = - do (250, _) <- sendCommand conn (MAIL sender) - vals <- mapM (sendCommand conn . RCPT) receivers - unless (all ((==250) . fst) vals) $ fail "sendMail error" - (250, _) <- sendCommand conn (DATA dat) +sendMail sender receivers dat conn = do + sendAndCheck (MAIL sender) + mapM_ (sendAndCheck . RCPT) receivers + sendAndCheck (DATA dat) return () - catcher e@(PatternMatchFail _) = throwIO e + where + -- Try the command once and @fail@ if the response isn't 250. + sendAndCheck cmd = tryCommand conn cmd 1 250 -- | doSMTPPort open a connection, and do an IO action with the -- connection, and then close it. @@ -236,12 +239,12 @@ sendMimeMail :: String -> String -> String -> LT.Text -> LT.Text -> [(T.Text, FilePath)] -> SMTPConnection -> IO () sendMimeMail to from subject plainBody htmlBody attachments con = do - myMail <- simpleMail (Address Nothing $ T.pack to) (Address Nothing - $ T.pack from) - (T.pack subject) plainBody htmlBody attachments + myMail <- simpleMail (address to) (address from) (T.pack subject) + plainBody htmlBody attachments renderedMail <- renderMail' myMail sendMail from [to] (lazyToStrict renderedMail) con - closeSMTP con + where + address = Address Nothing . T.pack -- haskellNet uses strict bytestrings -- TODO: look at making haskellnet lazy