diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2012 Vincent Hanquez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. 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. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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/Network/Connection.hs b/Network/Connection.hs new file mode 100644 --- /dev/null +++ b/Network/Connection.hs @@ -0,0 +1,190 @@ +-- | +-- Module : Network.Connection +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : portable +-- +-- Simple connection abstraction +-- +module Network.Connection + ( + -- * Type for a connection + Connection + , connectionID + , ConnectionParams(..) + , TLSSettings(..) + , SockSettings(..) + + -- * Library initialization + , initConnectionContext + , ConnectionContext + + -- * Connection operation + , connectFromHandle + , connectTo + , connectionClose + + -- * Sending and receiving data + , connectionGet + , connectionGetChunk + , connectionPut + + -- * TLS related operation + , connectionSetSecure + , connectionIsSecure + ) where + +import Control.Applicative +import Control.Concurrent.MVar + +import qualified Network.TLS as TLS +import qualified Network.TLS.Extra as TLS + +import System.Certificate.X509 (getSystemCertificateStore) + +import Network.Socks5 +import qualified Network as N + +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as L + +import qualified Crypto.Random.AESCtr as RNG + +import System.IO +import qualified Data.Map as M + +import Network.Connection.Types + +type Manager = MVar (M.Map TLS.SessionID TLS.SessionData) +data ConnectionSessionManager = ConnectionSessionManager Manager + +instance TLS.SessionManager ConnectionSessionManager where + sessionResume (ConnectionSessionManager mvar) sessionID = + withMVar mvar (return . M.lookup sessionID) + sessionEstablish (ConnectionSessionManager mvar) sessionID sessionData = + modifyMVar_ mvar (return . M.insert sessionID sessionData) + sessionInvalidate (ConnectionSessionManager mvar) sessionID = + modifyMVar_ mvar (return . M.delete sessionID) + +-- | Initialize the library with shared parameters between connection. +initConnectionContext :: IO ConnectionContext +initConnectionContext = ConnectionContext <$> getSystemCertificateStore + +makeTLSParams :: ConnectionContext -> TLSSettings -> TLS.Params +makeTLSParams cg ts@(TLSSettingsSimple {}) = + TLS.defaultParamsClient + { TLS.pConnectVersion = TLS.TLS11 + , TLS.pAllowedVersions = [TLS.TLS10,TLS.TLS11,TLS.TLS12] + , TLS.pCiphers = TLS.ciphersuite_all + , TLS.pCertificates = [] + , TLS.onCertificatesRecv = if settingDisableCertificateValidation ts + then const $ return TLS.CertificateUsageAccept + else TLS.certificateVerifyChain (globalCertificateStore cg) + } +makeTLSParams _ (TLSSettings p) = p + +withBackend :: (ConnectionBackend -> IO a) -> Connection -> IO a +withBackend f conn = modifyMVar (connectionBackend conn) (\b -> f b >>= \a -> return (b,a)) + +withBuffer :: (ByteString -> IO (ByteString, b)) -> Connection -> IO b +withBuffer f conn = modifyMVar (connectionBuffer conn) f + +connectionNew :: ConnectionParams -> ConnectionBackend -> IO Connection +connectionNew p backend = Connection <$> newMVar backend <*> newMVar B.empty <*> pure (connectionHostname p, connectionPort p) + +-- | Use an already established handle to create a connection object. +-- +-- if the TLS Settings is set, it will do the handshake with the server. +-- The SOCKS settings have no impact here, as the handle is already established +connectFromHandle :: ConnectionContext + -> Handle + -> ConnectionParams + -> IO Connection +connectFromHandle cg h p = withSecurity (connectionUseSecure p) + where withSecurity Nothing = connectionNew p $ ConnectionStream h + withSecurity (Just tlsSettings) = tlsEstablish h (makeTLSParams cg tlsSettings) >>= connectionNew p . ConnectionTLS + +-- | connect to a destination using the parameter +connectTo :: ConnectionContext -- ^ The global context of this connection. + -> ConnectionParams -- ^ The parameters for this connection (where to connect, and such). + -> IO Connection -- ^ The new established connection on success. +connectTo cg cParams = do + h <- conFct (connectionHostname cParams) (N.PortNumber $ connectionPort cParams) + connectFromHandle cg h cParams + where + conFct = case connectionUseSocks cParams of + Nothing -> N.connectTo + Just (SockSettingsSimple h p) -> socksConnectTo h (N.PortNumber p) + +-- | Put a block of data in the connection. +connectionPut :: Connection -> ByteString -> IO () +connectionPut connection content = withBackend doWrite connection + where doWrite (ConnectionStream h) = B.hPut h content >> hFlush h + doWrite (ConnectionTLS ctx) = TLS.sendData ctx $ L.fromChunks [content] + +-- | Get some bytes from a connection. +-- +-- The size argument is just the maximum that could be returned to the user, +-- however the call will returns as soon as there's data, even if there's less +-- data than expected. +connectionGet :: Connection -> Int -> IO ByteString +connectionGet con size = withBuffer getData con + where getData buf + | B.null buf = do chunk <- withBackend getMoreData con + let (ret, remain) = B.splitAt size chunk + return (remain, ret) + | B.length buf >= size = let (ret, remain) = B.splitAt size buf + in return (remain, ret) + | otherwise = return (B.empty, buf) + getMoreData (ConnectionTLS tlsctx) = TLS.recvData tlsctx + getMoreData (ConnectionStream h) = hWaitForInput h (-1) >> B.hGetNonBlocking h (16 * 1024) + +-- | Get the next block of data from the connection. +connectionGetChunk :: Connection -> IO ByteString +connectionGetChunk con = withBuffer getData con + where getData buf + | B.null buf = withBackend getMoreData con >>= \chunk -> return (B.empty, chunk) + | otherwise = return (B.empty, buf) + getMoreData (ConnectionTLS tlsctx) = TLS.recvData tlsctx + getMoreData (ConnectionStream h) = hWaitForInput h (-1) >> B.hGetNonBlocking h (16 * 1024) + +-- | Close a connection. +connectionClose :: Connection -> IO () +connectionClose = withBackend backendClose + where backendClose (ConnectionTLS ctx) = TLS.bye ctx >> TLS.contextClose ctx + backendClose (ConnectionStream h) = hClose h + +-- | Activate secure layer using the parameters specified. +-- +-- This is typically used to negociate a TLS channel on an already +-- establish channel, e.g. supporting a STARTTLS command. it also +-- flush the received buffer to prevent application confusing +-- received data before and after the setSecure call. +-- +-- If the connection is already using TLS, nothing else happens. +connectionSetSecure :: ConnectionContext + -> Connection + -> TLSSettings + -> IO () +connectionSetSecure cg connection params = + modifyMVar_ (connectionBuffer connection) $ \b -> + modifyMVar (connectionBackend connection) $ \backend -> + case backend of + (ConnectionStream h) -> do ctx <- tlsEstablish h (makeTLSParams cg params) + return (ConnectionTLS ctx, B.empty) + (ConnectionTLS _) -> return (backend, b) + +-- | Returns if the connection is establish securely or not. +connectionIsSecure :: Connection -> IO Bool +connectionIsSecure conn = withBackend isSecure conn + where isSecure (ConnectionStream _) = return False + isSecure (ConnectionTLS _) = return True + +tlsEstablish :: Handle -> TLS.TLSParams -> IO TLS.Context +tlsEstablish handle tlsParams = do + rng <- RNG.makeSystem + ctx <- TLS.contextNewOnHandle handle tlsParams rng + TLS.handshake ctx + return ctx diff --git a/Network/Connection/Types.hs b/Network/Connection/Types.hs new file mode 100644 --- /dev/null +++ b/Network/Connection/Types.hs @@ -0,0 +1,87 @@ +-- | +-- Module : Network.Connection.Types +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : portable +-- +-- connection types +-- +module Network.Connection.Types + where + +import Control.Concurrent.MVar (MVar) + +import Data.Default +import Data.CertificateStore +import Data.ByteString (ByteString) + +import Network.BSD (HostName) +import Network.Socket (PortNumber) +import qualified Network.TLS as TLS + +import System.IO (Handle) + +-- | Simple backend enumeration, either using a raw connection or a tls connection. +data ConnectionBackend = ConnectionStream Handle + | ConnectionTLS TLS.Context + +-- | Connection Parameters to establish a Connection. +-- +-- The strict minimum is an hostname and the port. +-- +-- If you need to establish a TLS connection, you should make sure +-- connectionUseSecure is correctly set. +-- +-- If you need to connect through a SOCKS, you should make sure +-- connectionUseSocks is correctly set. +data ConnectionParams = ConnectionParams + { connectionHostname :: HostName -- ^ host name to connect to. + , connectionPort :: PortNumber -- ^ port number to connect to. + , connectionUseSecure :: Maybe TLSSettings -- ^ optional TLS parameters. + , connectionUseSocks :: Maybe SockSettings -- ^ optional Socks configuration. + } + +-- | Socks settings for the connection. +-- +-- The simple settings is just the hostname and portnumber of the proxy server. +-- +-- That's for now the only settings in the SOCKS package, +-- socks password, or authentication is not yet implemented. +data SockSettings = SockSettingsSimple HostName PortNumber + +-- | TLS Settings that can be either expressed as simple settings, +-- or as full blown TLS.Params settings. +-- +-- Unless you need access to parameters that are not accessible through the +-- simple settings, you should use TLSSettingsSimple. +data TLSSettings + = TLSSettingsSimple + { settingDisableCertificateValidation :: Bool -- ^ Disable certificate verification completely, + -- this make TLS/SSL vulnerable to a MITM attack. + -- not recommended to use, but for testing. + , settingDisableSession :: Bool -- ^ Disable session management. TLS/SSL connections + -- will always re-established their context. + -- Not Implemented Yet. + , settingUseServerName :: Bool -- ^ Use server name extension. Not Implemented Yet. + } -- ^ Simple TLS settings. recommended to use. + | TLSSettings TLS.Params -- ^ full blown TLS Settings directly using TLS.Params. for power users. + deriving (Show) + +instance Default TLSSettings where + def = TLSSettingsSimple False False False + +-- | This opaque type represent a connection to a destination. +data Connection = Connection + { connectionBackend :: MVar ConnectionBackend + , connectionBuffer :: MVar ByteString + , connectionID :: (HostName, PortNumber) -- ^ return a simple tuple of the port and hostname that we're connected to. + } + +-- | Shared values (certificate store, sessions, ..) between connections +-- +-- At the moment, this is only strictly needed to shared sessions and certificates +-- when using a TLS enabled connection. +data ConnectionContext = ConnectionContext + { globalCertificateStore :: !CertificateStore + } diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,81 @@ +haskell Connection library +========================== + +Simple network library for all your connection need. + +Features: + +- Really simple to use +- SSL/TLS +- SOCKS + +Usage +----- + +Connect to www.example.com on port 4567 (without socks or tls), then send a +byte, receive a single byte, print it, and close the connection: + + import qualified Data.ByteString as B + import Network.Connection + import Data.Default + + main = do + ctx <- initConnectionContext + con <- connectTo ctx $ ConnectionParams + { connectionHostname = "www.example.com" + , connectionPort = fromIntegral 4567 + , connectionUseSecure = Nothing + , connectionUseSocks = Nothing + } + connectionPut con (B.singleton 0xa) + r <- connectionGet con 1 + putStrLn $ show r + connectionClose con + +Using a socks proxy is easy, we just need replacing the connectionSocks +parameter, for example connecting to the same host, but using a socks +proxy at localhost:1080: + + con <- connectTo ctx $ ConnectionParams + { connectionHostname = "www.example.com" + , connectionPort = fromIntegral 4567 + , connectionUseSecure = Nothing + , connectionUseSocks = Just $ SockSettingsSimple "localhost" (fromIntegral 1080) + } + +Connecting to a SSL style socket is equally easy, and need to set the UseSecure fields in ConnectionParams: + + con <- connectTo ctx $ ConnectionParams + { connectionHostname = "www.example.com" + , connectionPort = fromIntegral 4567 + , connectionUseSecure = Just def + , connectionUseSocks = Nothing + } + +And finally, you can start TLS in the middle of an insecure connection. This is great for +protocol using STARTTLS (e.g. IMAP, SMTP): + + {-# LANGUAGE OverloadedStrings #-} + import qualified Data.ByteString as B + import Data.ByteString.Char8 () + import Network.Connection + import Data.Default + + main = do + ctx <- initConnectionContext + con <- connectTo ctx $ ConnectionParams + { connectionHostname = "www.example.com" + , connectionPort = fromIntegral 4567 + , connectionUseSecure = Nothing + , connectionUseSocks = Nothing + } + -- talk to the other side with no TLS: says hello and starttls + connectionPut con "HELLO\n" + connectionPut con "STARTTLS\n" + + -- switch to TLS + connectionSetSecure ctx con def + + -- the connection is from now on using TLS, we can send secret for example + connectionPut con "PASSWORD 123\n" + connectionClose con diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/connection.cabal b/connection.cabal new file mode 100644 --- /dev/null +++ b/connection.cabal @@ -0,0 +1,44 @@ +Name: connection +Version: 0.1.0 +Description: + Simple network library for all your connection need. + . + Features: Really simple to use, SSL/TLS, SOCKS + . + This library provides a very simple api to create sockets + to a destination with the choice of SSL/TLS, and SOCKS. +License: BSD3 +License-file: LICENSE +Copyright: Vincent Hanquez +Author: Vincent Hanquez +Maintainer: Vincent Hanquez +Synopsis: Simple and easy network connections API +Build-Type: Simple +Category: Network +stability: experimental +Cabal-Version: >=1.6 +Homepage: http://github.com/vincenthz/hs-connection +data-files: README.md + +Flag test + Description: Build unit test + Default: False + +Library + Build-Depends: base >= 3 && < 5 + , bytestring + , containers + , data-default + , network >= 2.3 + , tls >= 1.0 + , tls-extra >= 0.5 + , cprng-aes + , socks >= 0.4 + , certificate >= 1.3.0 && < 1.4.0 + Exposed-modules: Network.Connection + Other-modules: Network.Connection.Types + ghc-options: -Wall + +source-repository head + type: git + location: git://github.com/vincenthz/hs-connection