Initial commit

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

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.

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

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

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

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

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

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