From 24e8f1c7f9b5cd3458768db6a259cad6da626634 Mon Sep 17 00:00:00 2001 From: "Daniel P. Wright" Date: Mon, 26 Aug 2013 13:33:34 +0900 Subject: [PATCH] Initial commit --- HaskellNet-SSL.cabal | 34 ++++++++++++++++ LICENSE | 30 ++++++++++++++ README.md | 11 +++++ Setup.hs | 2 + src/Network/HaskellNet/IMAP/SSL.hs | 15 +++++++ src/Network/HaskellNet/POP3/SSL.hs | 15 +++++++ src/Network/HaskellNet/SMTP/SSL.hs | 64 ++++++++++++++++++++++++++++++ src/Network/HaskellNet/SSL.hs | 44 ++++++++++++++++++++ 8 files changed, 215 insertions(+) create mode 100644 HaskellNet-SSL.cabal create mode 100644 LICENSE create mode 100644 README.md create mode 100644 Setup.hs create mode 100644 src/Network/HaskellNet/IMAP/SSL.hs create mode 100644 src/Network/HaskellNet/POP3/SSL.hs create mode 100644 src/Network/HaskellNet/SMTP/SSL.hs create mode 100644 src/Network/HaskellNet/SSL.hs diff --git a/HaskellNet-SSL.cabal b/HaskellNet-SSL.cabal new file mode 100644 index 0000000..733b78a --- /dev/null +++ b/HaskellNet-SSL.cabal @@ -0,0 +1,34 @@ +name: HaskellNet-SSL +synopsis: Helpers to connect to SSL/TLS mail servers with HaskellNet +version: 0.1.0.0 +description: This package ties together the HaskellNet and connection + packages to make it easy to open IMAP and SMTP connections + over SSL. +homepage: https://github.com/dpwright/HaskellNet-SSL +license: BSD3 +license-file: LICENSE +author: Daniel P. Wright +maintainer: dani@dpwright.com +copyright: (c) 2013 Daniel P. Wright +category: Network +build-type: Simple +cabal-version: >=1.8 +data-files: README.md + +source-repository head + type: git + location: git://github.com/dpwright/HaskellNet-SSL.git + +library + hs-source-dirs: src + ghc-options: -Wall + exposed-modules: Network.HaskellNet.IMAP.SSL + Network.HaskellNet.POP3.SSL + Network.HaskellNet.SMTP.SSL + other-modules: Network.HaskellNet.SSL + build-depends: base ==4.5.*, + HaskellNet >= 0.3.1, + connection >= 0.1.3, + network >= 2.3, + bytestring, + data-default diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..10993d0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2013, Daniel P. Wright + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Daniel P. Wright nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 index 0000000..26711de --- /dev/null +++ b/README.md @@ -0,0 +1,11 @@ +HaskellNet-SSL +-------------- + +This package ties together the excellent [HaskellNet][HaskellNet] and +[connection][connection] packages to make it easy to open IMAP and SMTP +connections over SSL. This is a simple "glue" library; all credit for a) +connecting to IMAP/SMTP servers and b) making an SSL connection goes to the +aforementioned libraries. + +[HaskellNet]: https://github.com/jtdaugherty/HaskellNet +[connection]: https://github.com/vincenthz/hs-connection diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/Network/HaskellNet/IMAP/SSL.hs b/src/Network/HaskellNet/IMAP/SSL.hs new file mode 100644 index 0000000..5a6717e --- /dev/null +++ b/src/Network/HaskellNet/IMAP/SSL.hs @@ -0,0 +1,15 @@ +module Network.HaskellNet.IMAP.SSL + ( connectIMAPSSL + , connectIMAPSSLPort + ) where + +import Network.Socket.Internal (PortNumber) +import Network.HaskellNet.IMAP.Connection +import Network.HaskellNet.IMAP +import Network.HaskellNet.SSL + +connectIMAPSSL :: String -> IO IMAPConnection +connectIMAPSSL hostname = connectIMAPSSLPort hostname 993 + +connectIMAPSSLPort :: String -> PortNumber -> IO IMAPConnection +connectIMAPSSLPort hostname port = connectSSL hostname port >>= connectStream diff --git a/src/Network/HaskellNet/POP3/SSL.hs b/src/Network/HaskellNet/POP3/SSL.hs new file mode 100644 index 0000000..f57a1c1 --- /dev/null +++ b/src/Network/HaskellNet/POP3/SSL.hs @@ -0,0 +1,15 @@ +module Network.HaskellNet.POP3.SSL + ( connectPop3SSL + , connectPop3SSLPort + ) where + +import Network.Socket.Internal (PortNumber) +import Network.HaskellNet.POP3.Connection +import Network.HaskellNet.POP3 +import Network.HaskellNet.SSL + +connectPop3SSL :: String -> IO POP3Connection +connectPop3SSL hostname = connectPop3SSLPort hostname 995 + +connectPop3SSLPort :: String -> PortNumber -> IO POP3Connection +connectPop3SSLPort hostname port = connectSSL hostname port >>= connectStream diff --git a/src/Network/HaskellNet/SMTP/SSL.hs b/src/Network/HaskellNet/SMTP/SSL.hs new file mode 100644 index 0000000..f3197a6 --- /dev/null +++ b/src/Network/HaskellNet/SMTP/SSL.hs @@ -0,0 +1,64 @@ +module Network.HaskellNet.SMTP.SSL + ( connectSMTPSSL + , connectSMTPSSLPort + , connectSMTPSTARTTLS + , connectSMTPSTARTTLSPort + ) where + +import Network.Socket.Internal (PortNumber) +import Network.HaskellNet.SMTP +import Network.HaskellNet.SSL + +import Network.HaskellNet.BSStream + +import qualified Data.ByteString.Char8 as B + +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 + + bsPut bs $ B.pack "HELO\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 diff --git a/src/Network/HaskellNet/SSL.hs b/src/Network/HaskellNet/SSL.hs new file mode 100644 index 0000000..7a0092f --- /dev/null +++ b/src/Network/HaskellNet/SSL.hs @@ -0,0 +1,44 @@ +module Network.HaskellNet.SSL ( connectSSL + , connectPlain + ) where + +import Network.Connection +import Network.HaskellNet.BSStream +import Network.Socket.Internal (PortNumber) + +import qualified Data.ByteString.Char8 as B +import Data.Default + +type STARTTLS = IO () + +maxLineLength :: Int +maxLineLength = 10000 + +connectionGetBytes :: Connection -> Int -> IO B.ByteString +connectionGetBytes = loop B.empty where + loop buf _ 0 = return buf + loop buf c l = connectionGet c l >>= nextIteration + where nextIteration b = loop (buf `B.append` b) c $ l - B.length b + +connectionToStream :: Connection -> BSStream +connectionToStream c = BSStream + { bsGet = connectionGetBytes c + , bsPut = connectionPut c + , bsFlush = return () + , bsClose = connectionClose c + , bsIsOpen = return True + , bsGetLine = connectionGetLine maxLineLength c + } + +connectSSL :: String -> PortNumber -> IO BSStream +connectSSL hostname port = do + c <- initConnectionContext >>= flip connectTo params + return $ connectionToStream c + where params = ConnectionParams hostname port (Just def) Nothing + +connectPlain :: String -> PortNumber -> IO (BSStream, STARTTLS) +connectPlain hostname port = do + ctx <- initConnectionContext + c <- connectTo ctx params + return (connectionToStream c, connectionSetSecure ctx c def) + where params = ConnectionParams hostname port Nothing Nothing