smtp-mail 0.1.1.0 → 0.1.2.0
raw patch · 3 files changed
+63/−50 lines, 3 filesdep +base16-bytestringdep +base64-bytestringdep +cryptohashdep −Cryptodep −base64-stringdep ~arraydep ~basedep ~bytestring
Dependencies added: base16-bytestring, base64-bytestring, cryptohash
Dependencies removed: Crypto, base64-string
Dependency ranges changed: array, base, bytestring, mime-mail, network, text
Files
- Network/Mail/SMTP.hs +14/−10
- Network/Mail/SMTP/Auth.hs +37/−31
- smtp-mail.cabal +12/−9
Network/Mail/SMTP.hs view
@@ -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
Network/Mail/SMTP/Auth.hs view
@@ -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
smtp-mail.cabal view
@@ -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