a5e240859c
These are quite useful helpers to stop you from forgetting to close the connection (like I did).
87 lines
3.1 KiB
Haskell
87 lines
3.1 KiB
Haskell
module Network.HaskellNet.SMTP.SSL
|
|
( connectSMTPSSL
|
|
, connectSMTPSSLPort
|
|
, connectSMTPSTARTTLS
|
|
, connectSMTPSTARTTLSPort
|
|
, doSMTPSSL
|
|
, doSMTPSSLPort
|
|
, doSMTPSTARTTLS
|
|
, doSMTPSTARTTLSPort
|
|
) where
|
|
|
|
import Network.Socket.Internal (PortNumber)
|
|
import Network.HaskellNet.SMTP
|
|
import Network.HaskellNet.SSL
|
|
|
|
import Network.HaskellNet.BSStream
|
|
import Network.BSD (getHostName)
|
|
|
|
import qualified Data.ByteString.Char8 as B
|
|
|
|
import Control.Exception
|
|
import Control.Monad
|
|
import Data.IORef
|
|
|
|
connectSMTPSSL :: String -> IO SMTPConnection
|
|
connectSMTPSSL hostname = connectSMTPSSLPort hostname 465
|
|
|
|
connectSMTPSSLPort :: String -> PortNumber -> IO SMTPConnection
|
|
connectSMTPSSLPort hostname port = connectSSL hostname port >>= connectStream
|
|
|
|
connectSMTPSTARTTLS :: String -> IO SMTPConnection
|
|
connectSMTPSTARTTLS hostname = connectSMTPSTARTTLSPort hostname 587
|
|
|
|
connectSMTPSTARTTLSPort :: String -> PortNumber -> IO SMTPConnection
|
|
connectSMTPSTARTTLSPort hostname port = connectSTARTTLS hostname port >>= connectStream
|
|
|
|
connectSTARTTLS :: String -> PortNumber -> IO BSStream
|
|
connectSTARTTLS hostname port = do
|
|
(bs, startTLS) <- connectPlain hostname port
|
|
|
|
greeting <- bsGetLine bs
|
|
failIfNot bs 220 $ parseResponse greeting
|
|
|
|
hn <- getHostName
|
|
bsPut bs $ B.pack ("HELO " ++ hn ++ "\r\n")
|
|
getResponse bs >>= failIfNot bs 250
|
|
bsPut bs $ B.pack "STARTTLS\r\n"
|
|
getResponse bs >>= failIfNot bs 220
|
|
|
|
startTLS
|
|
|
|
prefixRef <- newIORef [greeting]
|
|
return $ bs {bsGetLine = prefixedGetLine prefixRef (bsGetLine bs)}
|
|
where parseResponse = parse . B.unpack
|
|
parse s = (getCode s, s)
|
|
getCode = read . head . words
|
|
getResponse bs = liftM parseResponse $ bsGetLine bs
|
|
|
|
failIfNot :: BSStream -> Integer -> (Integer, String) -> IO ()
|
|
failIfNot bs code (rc, rs) = when (code /= rc) closeAndFail
|
|
where closeAndFail = bsClose bs >> fail ("cannot connect to server: " ++ rs)
|
|
|
|
-- This is a bit of a nasty hack. Network.HaskellNet.SMTP.connectStream
|
|
-- expects to receive a status 220 from the server as soon as it connects,
|
|
-- but we've intercepted it in order to establish a STARTTLS connection.
|
|
-- This allows us to keep hold of the original greeting and pass it back to
|
|
-- HaskellNet.
|
|
prefixedGetLine :: IORef [B.ByteString] -> IO B.ByteString -> IO B.ByteString
|
|
prefixedGetLine prefix rawGetLine = readIORef prefix >>= deliverLine
|
|
where deliverLine [] = rawGetLine
|
|
deliverLine (l:ls) = writeIORef prefix ls >> return l
|
|
|
|
bracketSMTP :: IO SMTPConnection -> (SMTPConnection -> IO a) -> IO a
|
|
bracketSMTP = flip bracket closeSMTP
|
|
|
|
doSMTPSSL :: String -> (SMTPConnection -> IO a) -> IO a
|
|
doSMTPSSL host = bracketSMTP $ connectSMTPSSL host
|
|
|
|
doSMTPSSLPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
|
|
doSMTPSSLPort host port = bracketSMTP $ connectSMTPSSLPort host port
|
|
|
|
doSMTPSTARTTLS :: String -> (SMTPConnection -> IO a) -> IO a
|
|
doSMTPSTARTTLS host = bracketSMTP $ connectSMTPSTARTTLS host
|
|
|
|
doSMTPSTARTTLSPort :: String -> PortNumber -> (SMTPConnection -> IO a) -> IO a
|
|
doSMTPSTARTTLSPort host port = bracketSMTP $ connectSMTPSTARTTLSPort host port
|