diff --git a/Network/Mail/SMTP.hs b/Network/Mail/SMTP.hs --- a/Network/Mail/SMTP.hs +++ b/Network/Mail/SMTP.hs @@ -7,6 +7,7 @@ -- * Types , Command(..) , Response(..) + , ReplyCode , SMTPConnection -- * Auth Types (reexports) , UserName @@ -14,6 +15,11 @@ , AuthType(..) -- * Network.Mail.Mime types (reexports) , Address (..) + -- * Network.Mail.Mime's sendmail interface (reexports) + , sendmail + , sendmailCustom + , renderSendMail + , renderSendMailCustom -- * Establishing Connection , connectSMTPPort , connectSMTP @@ -44,8 +50,6 @@ import qualified Data.Text.Lazy.Encoding as TL import Data.Text.Encoding -import Prelude hiding (catch) - data SMTPConnection = SMTPC !Handle ![ByteString] data Command = HELO ByteString @@ -152,10 +156,10 @@ where sendLine = bsPutCrLf conn sendCommand (SMTPC conn _) (AUTH LOGIN username password) = do bsPutCrLf conn command - parseResponse conn - bsPutCrLf conn $ BS.pack userB64 - parseResponse conn - bsPutCrLf conn $ BS.pack passB64 + _ <- parseResponse conn + bsPutCrLf conn userB64 + _ <- parseResponse conn + bsPutCrLf conn passB64 (code, msg) <- parseResponse conn unless (code == 235) $ fail "authentication failed." return (code, msg) @@ -165,7 +169,7 @@ do bsPutCrLf conn command (code, msg) <- parseResponse conn unless (code == 334) $ fail "authentication failed." - bsPutCrLf conn $ BS.pack $ auth at (BS.unpack msg) username password + bsPutCrLf conn $ auth at (BS.unpack msg) username password parseResponse conn where command = BS.pack $ unwords ["AUTH", show at] sendCommand (SMTPC conn _) meth = @@ -200,9 +204,9 @@ -> SMTPConnection -> IO () sendRenderedMail sender receivers dat conn = do - tryOnce conn (MAIL sender) 250 + _ <- tryOnce conn (MAIL sender) 250 mapM_ (\r -> tryOnce conn (RCPT r) 250) receivers - tryOnce conn (DATA dat) 250 + _ <- tryOnce conn (DATA dat) 250 return () -- | Render a 'Mail' to a 'ByteString' then send it over the specified @@ -226,7 +230,7 @@ sendMailWithLogin :: String -> PortNumber -> UserName -> Password -> Mail -> IO () sendMailWithLogin host port user pass mail = do con <- connectSMTPPort host port - sendCommand con (AUTH LOGIN user pass) + _ <- sendCommand con (AUTH LOGIN user pass) renderAndSend con mail closeSMTP con diff --git a/Network/Mail/SMTP/Auth.hs b/Network/Mail/SMTP/Auth.hs --- a/Network/Mail/SMTP/Auth.hs +++ b/Network/Mail/SMTP/Auth.hs @@ -1,13 +1,21 @@ -module Network.Mail.SMTP.Auth -where +module Network.Mail.SMTP.Auth ( + UserName, + Password, + AuthType(..), + login, + auth, +) where -import Data.Digest.MD5 -import Codec.Utils -import qualified Codec.Binary.Base64.String as B64 (encode, decode) +import Crypto.Hash.MD5 (hash) +import qualified Data.ByteString.Base16 as B16 (encode) +import qualified Data.ByteString.Base64 as B64 (encode) +import Data.ByteString (ByteString) import Data.List import Data.Bits -import Data.Array +import Data.Monoid +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 (unwords) type UserName = String type Password = String @@ -24,39 +32,37 @@ showMain LOGIN = "LOGIN" showMain CRAM_MD5 = "CRAM-MD5" -b64Encode :: String -> String -b64Encode = map (toEnum.fromEnum) . B64.encode . map (toEnum.fromEnum) - -b64Decode :: String -> String -b64Decode = map (toEnum.fromEnum) . B64.decode . map (toEnum.fromEnum) +toAscii :: String -> ByteString +toAscii = B.pack . map (toEnum.fromEnum) -showOctet :: [Octet] -> String -showOctet = concatMap hexChars - where hexChars c = [arr ! (c `div` 16), arr ! (c `mod` 16)] - arr = listArray (0, 15) "0123456789abcdef" +b64Encode :: String -> ByteString +b64Encode = B64.encode . toAscii -hmacMD5 :: String -> String -> [Octet] -hmacMD5 text key = hash $ okey ++ hash (ikey ++ map (toEnum.fromEnum) text) - where koc = map (toEnum.fromEnum) key - key' = if length koc > 64 - then hash koc ++ replicate 48 0 - else koc ++ replicate (64-length koc) 0 - ipad = replicate 64 0x36 - opad = replicate 64 0x5c - ikey = zipWith xor key' ipad - okey = zipWith xor key' opad +hmacMD5 :: ByteString -> ByteString -> ByteString +hmacMD5 text key = hash (okey <> hash (ikey <> text)) + where key' = if B.length key > 64 + then hash key <> B.replicate 48 0 + else key <> B.replicate (64-B.length key) 0 + ipad = B.replicate 64 0x36 + opad = B.replicate 64 0x5c + ikey = B.pack $ B.zipWith xor key' ipad + okey = B.pack $ B.zipWith xor key' opad -plain :: UserName -> Password -> String +plain :: UserName -> Password -> ByteString plain user pass = b64Encode $ intercalate "\0" [user, user, pass] -login :: UserName -> Password -> (String, String) +login :: UserName -> Password -> (ByteString, ByteString) login user pass = (b64Encode user, b64Encode pass) -cramMD5 :: String -> UserName -> Password -> String +cramMD5 :: String -> UserName -> Password -> ByteString cramMD5 challenge user pass = - b64Encode (user ++ " " ++ showOctet (hmacMD5 challenge pass)) + B64.encode $ B8.unwords [user', B16.encode (hmacMD5 challenge' pass')] + where + challenge' = toAscii challenge + user' = toAscii user + pass' = toAscii pass -auth :: AuthType -> String -> UserName -> Password -> String +auth :: AuthType -> String -> UserName -> Password -> ByteString auth PLAIN _ u p = plain u p -auth LOGIN _ u p = let (u', p') = login u p in unwords [u', p'] +auth LOGIN _ u p = let (u', p') = login u p in B8.unwords [u', p'] auth CRAM_MD5 c u p = cramMD5 c u p diff --git a/smtp-mail.cabal b/smtp-mail.cabal --- a/smtp-mail.cabal +++ b/smtp-mail.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: smtp-mail -version: 0.1.1.0 +version: 0.1.2.0 synopsis: Simple email sending via SMTP -- description: homepage: http://github.com/jhickner/smtp-mail @@ -23,11 +23,14 @@ exposed-modules: Network.Mail.SMTP, Network.Mail.SMTP.Auth -- other-modules: build-depends: - base ==4.5.*, - network ==2.3.*, - mime-mail ==0.4.*, - bytestring ==0.9.*, - text ==0.11.*, - Crypto ==4.2.*, - base64-string ==0.2.*, - array ==0.4.* + base >= 4.5 && < 5, + network, + mime-mail, + bytestring, + text, + cryptohash, + base16-bytestring, + base64-bytestring, + array + + ghc-options: -Wall -fwarn-tabs