diff --git a/Network/Connection.hs b/Network/Connection.hs --- a/Network/Connection.hs +++ b/Network/Connection.hs @@ -51,14 +51,16 @@ import qualified Network.TLS as TLS import qualified Network.TLS.Extra as TLS -import System.Certificate.X509 (getSystemCertificateStore) +import System.X509 (getSystemCertificateStore) import Network.Socks5 import qualified Network as N +import Data.Default.Class import Data.Data import Data.ByteString (ByteString) import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as L import qualified Crypto.Random.AESCtr as RNG @@ -69,7 +71,6 @@ import Network.Connection.Types type Manager = MVar (M.Map TLS.SessionID TLS.SessionData) -data ConnectionSessionManager = ConnectionSessionManager Manager -- | This is the exception raised if we reached the user specified limit for -- the line in ConnectionGetLine. @@ -77,39 +78,47 @@ instance E.Exception LineTooLong -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) +connectionSessionManager :: Manager -> TLS.SessionManager +connectionSessionManager mvar = TLS.SessionManager + { TLS.sessionResume = \sessionID -> withMVar mvar (return . M.lookup sessionID) + , TLS.sessionEstablish = \sessionID sessionData -> + modifyMVar_ mvar (return . M.insert sessionID sessionData) + , TLS.sessionInvalidate = \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.TLS10 - , TLS.pAllowedVersions = [TLS.TLS10] - , TLS.pCiphers = TLS.ciphersuite_all - , TLS.pCertificates = [] - , TLS.onCertificatesRecv = if settingDisableCertificateValidation ts - then const $ return TLS.CertificateUsageAccept - else TLS.certificateVerifyChain (globalCertificateStore cg) +makeTLSParams :: ConnectionContext -> ConnectionID -> TLSSettings -> TLS.ClientParams +makeTLSParams cg cid ts@(TLSSettingsSimple {}) = + (TLS.defaultParamsClient (fst cid) portString) + { TLS.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_all } + , TLS.clientShared = def + { TLS.sharedCAStore = globalCertificateStore cg + , TLS.sharedValidationCache = validationCache + -- , TLS.sharedSessionManager = connectionSessionManager + } } -makeTLSParams _ (TLSSettings p) = p + where validationCache + | settingDisableCertificateValidation ts = + TLS.ValidationCache (\_ _ _ -> return TLS.ValidationCachePass) + (\_ _ _ -> return ()) + | otherwise = def + portString = BC.pack $ show $ snd cid +makeTLSParams _ cid (TLSSettings p) + | fst cid /= fst (TLS.clientServerIdentification p) = + error "mismatch between given server identification and connection hostname" + | otherwise = p withBackend :: (ConnectionBackend -> IO a) -> Connection -> IO a -withBackend f conn = modifyMVar (connectionBackend conn) (\b -> f b >>= \a -> return (b,a)) +withBackend f conn = readMVar (connectionBackend conn) >>= f -connectionNew :: ConnectionParams -> ConnectionBackend -> IO Connection -connectionNew p backend = +connectionNew :: ConnectionID -> ConnectionBackend -> IO Connection +connectionNew cid backend = Connection <$> newMVar backend <*> newMVar (Just B.empty) - <*> pure (connectionHostname p, connectionPort p) + <*> pure cid -- | Use an already established handle to create a connection object. -- @@ -120,8 +129,9 @@ -> 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 + where withSecurity Nothing = connectionNew cid $ ConnectionStream h + withSecurity (Just tlsSettings) = tlsEstablish h (makeTLSParams cg cid tlsSettings) >>= connectionNew cid . ConnectionTLS + cid = (connectionHostname p, connectionPort p) -- | connect to a destination using the parameter connectTo :: ConnectionContext -- ^ The global context of this connection. @@ -262,7 +272,7 @@ modifyMVar_ (connectionBuffer connection) $ \b -> modifyMVar (connectionBackend connection) $ \backend -> case backend of - (ConnectionStream h) -> do ctx <- tlsEstablish h (makeTLSParams cg params) + (ConnectionStream h) -> do ctx <- tlsEstablish h (makeTLSParams cg (connectionID connection) params) return (ConnectionTLS ctx, Just B.empty) (ConnectionTLS _) -> return (backend, b) @@ -272,9 +282,9 @@ where isSecure (ConnectionStream _) = return False isSecure (ConnectionTLS _) = return True -tlsEstablish :: Handle -> TLS.TLSParams -> IO TLS.Context +tlsEstablish :: Handle -> TLS.ClientParams -> IO TLS.Context tlsEstablish handle tlsParams = do rng <- RNG.makeSystem - ctx <- TLS.contextNewOnHandle handle tlsParams rng + ctx <- TLS.contextNew handle tlsParams rng TLS.handshake ctx return ctx diff --git a/Network/Connection/Types.hs b/Network/Connection/Types.hs --- a/Network/Connection/Types.hs +++ b/Network/Connection/Types.hs @@ -12,8 +12,8 @@ import Control.Concurrent.MVar (MVar) -import Data.Default -import Data.CertificateStore +import Data.Default.Class +import Data.X509.CertificateStore import Data.ByteString (ByteString) import Network.BSD (HostName) @@ -65,17 +65,19 @@ -- 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. + | TLSSettings TLS.ClientParams -- ^ full blown TLS Settings directly using TLS.Params. for power users. deriving (Show) instance Default TLSSettings where def = TLSSettingsSimple False False False +type ConnectionID = (HostName, PortNumber) + -- | This opaque type represent a connection to a destination. data Connection = Connection { connectionBackend :: MVar ConnectionBackend , connectionBuffer :: MVar (Maybe ByteString) -- ^ this is set to 'Nothing' on EOF - , connectionID :: (HostName, PortNumber) -- ^ return a simple tuple of the port and hostname that we're connected to. + , connectionID :: ConnectionID -- ^ return a simple tuple of the port and hostname that we're connected to. } -- | Shared values (certificate store, sessions, ..) between connections diff --git a/connection.cabal b/connection.cabal --- a/connection.cabal +++ b/connection.cabal @@ -1,5 +1,5 @@ Name: connection -Version: 0.1.3.1 +Version: 0.2.0 Description: Simple network library for all your connection need. . @@ -20,21 +20,19 @@ 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 + , data-default-class , network >= 2.3 - , tls >= 1.0 && < 1.2 - , tls-extra >= 0.5 && < 0.7 + , tls >= 1.2 , cprng-aes , socks >= 0.4 - , certificate >= 1.3.0 && < 1.4.0 + , x509 >= 1.4 + , x509-store >= 1.4 + , x509-system >= 1.4 + , x509-validation >= 1.5 Exposed-modules: Network.Connection Other-modules: Network.Connection.Types ghc-options: -Wall