module Network.SMTP.Client (
sendSMTP,
sendSMTP_,
SMTPException(..)
) where
import Network.SMTP.ClientSession
import Control.Exception
import Text.ParserCombinators.Parsec.Rfc2822 (
Message(..),
Field(..),
NameAddr(..)
)
import Network.Socket
import Control.Applicative
import System.IO
import Control.Monad
import Data.Typeable
import Data.IORef
sendSMTP :: String
-> SockAddr
-> [Message]
-> IO ()
sendSMTP = sendSMTP_ (\_ -> return ()) Nothing
sendSMTP_ :: (String -> IO ())
-> Maybe (IORef Int)
-> String
-> SockAddr
-> [Message]
-> IO ()
sendSMTP_ log mSentSoFar domain sockAddr messages = do
sock <- socket AF_INET Stream defaultProtocol
connect sock sockAddr
handle <- socketToHandle sock ReadWriteMode
(do
let smtp = smtpClientSession domain messages
process handle smtp
) `finally` hClose handle
where
process :: Handle -> SMTPState -> IO ()
process h state = do
case mSentSoFar of
Just sentSoFar -> writeIORef sentSoFar (smtpSent state)
Nothing -> return ()
forM_ (reverse $ smtpOutQueue state) $ \ line -> do
log $ "-> "++line
hPutStr h line
hPutStr h "\r\n"
hFlush h
case (smtpSuccess state, smtpFailure state) of
(True, _) -> do
log "SUCCEEDED"
(False, Just err) ->
throwIO $ SMTPException err
otherwise -> do
reply <- reverse . dropWhile (=='\r') . reverse <$> hGetLine h
putStrLn $ "<- "++reply
let state' = smtpReceive state reply $ state {smtpOutQueue = []}
process h state'
data SMTPException = SMTPException String
deriving (Eq, Show, Typeable)
instance Exception SMTPException where