connection 0.2.8 → 0.3.1
raw patch · 5 files changed
Files
- LICENSE +1/−1
- Network/Connection.hs +76/−59
- Network/Connection/Types.hs +4/−1
- README.md +56/−54
- connection.cabal +6/−6
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2012 Vincent Hanquez <vincent@snarc.org>+Copyright (c) 2012-2019 Vincent Hanquez <vincent@snarc.org> All rights reserved.
Network/Connection.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -47,9 +48,9 @@ -- * TLS related operation , connectionSetSecure , connectionIsSecure+ , connectionSessionManager ) where -import Control.Applicative import Control.Concurrent.MVar import Control.Monad (join) import qualified Control.Exception as E@@ -60,13 +61,11 @@ import System.X509 (getSystemCertificateStore) -import Network.Socks5-import qualified Network as N+import Network.Socks5 (defaultSocksConf, socksConnectWithSocket, SocksAddress(..), SocksHostAddress(..)) import Network.Socket-import Network.BSD (getProtocolNumber)-import qualified Network.Socket as N (close) import qualified Network.Socket.ByteString as N +import Data.Tuple (swap) import Data.Default.Class import Data.Data import Data.ByteString (ByteString)@@ -103,6 +102,10 @@ , TLS.sessionEstablish = \sessionID sessionData -> modifyMVar_ mvar (return . M.insert sessionID sessionData) , TLS.sessionInvalidate = \sessionID -> modifyMVar_ mvar (return . M.delete sessionID)+#if MIN_VERSION_tls(1,5,0)+ , TLS.sessionResumeOnlyOnce = \sessionID ->+ modifyMVar mvar (pure . swap . M.updateLookupWithKey (\_ _ -> Nothing) sessionID)+#endif } -- | Initialize the library with shared parameters between connection.@@ -114,7 +117,7 @@ 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.clientSupported = def { TLS.supportedCiphers = TLS.ciphersuite_default } , TLS.clientShared = def { TLS.sharedCAStore = globalCertificateStore cg , TLS.sharedValidationCache = validationCache@@ -171,63 +174,77 @@ -> ConnectionParams -- ^ The parameters for this connection (where to connect, and such). -> IO Connection -- ^ The new established connection on success. connectTo cg cParams = do- conFct <- getConFct (connectionUseSocks cParams)- let doConnect = conFct (connectionHostname cParams) (N.PortNumber $ connectionPort cParams)- E.bracketOnError doConnect N.close $ \h->+ let conFct = doConnect (connectionUseSocks cParams)+ (connectionHostname cParams)+ (connectionPort cParams)+ E.bracketOnError conFct (close . fst) $ \(h, _) -> connectFromSocket cg h cParams where- getConFct Nothing = return resolve'- getConFct (Just (OtherProxy h p)) = return $ \_ _ -> resolve' h (N.PortNumber p)- getConFct (Just (SockSettingsSimple h p)) = return $ socksConnectTo' h (N.PortNumber p)- getConFct (Just (SockSettingsEnvironment v)) = do- -- if we can't get the environment variable or that the variable cannot be parsed- -- we connect directly.- let name = maybe "SOCKS_SERVER" id v- evar <- E.try (getEnv name)- case evar of- Left (_ :: E.IOException) -> return resolve'- Right var ->- case parseSocks var of- Nothing -> return resolve'- Just (sHost, sPort) -> return $ socksConnectTo' sHost (N.PortNumber $ fromIntegral (sPort :: Int))+ sockConnect sockHost sockPort h p = do+ (sockServ, servAddr) <- resolve' sockHost sockPort+ let sockConf = defaultSocksConf servAddr+ let destAddr = SocksAddress (SocksAddrDomainName $ BC.pack h) p+ (dest, _) <- socksConnectWithSocket sockServ sockConf destAddr+ case dest of+ SocksAddrIPV4 h4 -> return (sockServ, SockAddrInet p h4)+ SocksAddrIPV6 h6 -> return (sockServ, SockAddrInet6 p 0 h6 0)+ SocksAddrDomainName _ -> error "internal error: socks connect return a resolved address as domain name" - -- Try to parse "host:port" or "host"- parseSocks s =- case break (== ':') s of- (sHost, "") -> Just (sHost, 1080)- (sHost, ':':portS) ->- case reads portS of- [(sPort,"")] -> Just (sHost, sPort)- _ -> Nothing- _ -> Nothing - resolve' host portid = do- let serv = case portid of- N.Service serv -> serv- N.PortNumber n -> show n- _ -> error "cannot resolve service" - proto <- getProtocolNumber "tcp"- let hints = defaultHints { addrFlags = [AI_ADDRCONFIG]- , addrProtocol = proto- , addrSocketType = Stream }- addrs <- getAddrInfo (Just hints) (Just host) (Just serv)- firstSuccessful $ map tryToConnect addrs+ doConnect proxy h p =+ case proxy of+ Nothing -> resolve' h p+ Just (OtherProxy proxyHost proxyPort) -> resolve' proxyHost proxyPort+ Just (SockSettingsSimple sockHost sockPort) ->+ sockConnect sockHost sockPort h p+ Just (SockSettingsEnvironment envName) -> do+ -- if we can't get the environment variable or that the string cannot be parsed+ -- we connect directly.+ let name = maybe "SOCKS_SERVER" id envName+ evar <- E.try (getEnv name)+ case evar of+ Left (_ :: E.IOException) -> resolve' h p+ Right var ->+ case parseSocks var of+ Nothing -> resolve' h p+ Just (sockHost, sockPort) -> sockConnect sockHost sockPort h p++ -- Try to parse "host:port" or "host"+ -- if port is ommited then the default SOCKS port (1080) is assumed+ parseSocks :: String -> Maybe (String, PortNumber)+ parseSocks s =+ case break (== ':') s of+ (sHost, "") -> Just (sHost, 1080)+ (sHost, ':':portS) ->+ case reads portS of+ [(sPort,"")] -> Just (sHost, sPort)+ _ -> Nothing+ _ -> Nothing++ -- Try to resolve the host/port into an address (zero to many of them), then+ -- try to connect from the first address to the last, returning the first one that+ -- succeed+ resolve' :: String -> PortNumber -> IO (Socket, SockAddr)+ resolve' host port = do+ let hints = defaultHints { addrFlags = [AI_ADDRCONFIG], addrSocketType = Stream }+ addrs <- getAddrInfo (Just hints) (Just host) (Just $ show port)+ firstSuccessful $ map tryToConnect addrs+ where+ tryToConnect addr =+ E.bracketOnError+ (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))+ (close)+ (\sock -> connect sock (addrAddress addr) >> return (sock, addrAddress addr))+ firstSuccessful = go [] where- tryToConnect addr =- E.bracketOnError- (socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr))- (N.close)- (\sock -> connect sock (addrAddress addr) >> return sock)- firstSuccessful = go []- where- go :: [E.IOException] -> [IO a] -> IO a- go [] [] = E.throwIO $ HostNotResolved host- go l@(_:_) [] = E.throwIO $ HostCannotConnect host l- go acc (act:followingActs) = do- er <- E.try act- case er of- Left err -> go (err:acc) followingActs- Right r -> return r+ go :: [E.IOException] -> [IO a] -> IO a+ go [] [] = E.throwIO $ HostNotResolved host+ go l@(_:_) [] = E.throwIO $ HostCannotConnect host l+ go acc (act:followingActs) = do+ er <- E.try act+ case er of+ Left err -> go (err:acc) followingActs+ Right r -> return r -- | Put a block of data in the connection. connectionPut :: Connection -> ByteString -> IO ()@@ -369,7 +386,7 @@ connectionClose :: Connection -> IO () connectionClose = withBackend backendClose where backendClose (ConnectionTLS ctx) = ignoreIOExc (TLS.bye ctx) `E.finally` TLS.contextClose ctx- backendClose (ConnectionSocket sock) = N.close sock+ backendClose (ConnectionSocket sock) = close sock backendClose (ConnectionStream h) = hClose h ignoreIOExc action = action `E.catch` \(_ :: E.IOException) -> return ()
Network/Connection/Types.hs view
@@ -16,7 +16,6 @@ import Data.X509.CertificateStore import Data.ByteString (ByteString) -import Network.BSD (HostName) import Network.Socket (PortNumber, Socket) import qualified Network.TLS as TLS @@ -26,6 +25,10 @@ data ConnectionBackend = ConnectionStream Handle | ConnectionSocket Socket | ConnectionTLS TLS.Context+++-- | Hostname This could either be a name string (punycode encoded) or an ipv4/ipv6+type HostName = String -- | Connection Parameters to establish a Connection. --
README.md view
@@ -14,68 +14,70 @@ 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 = 4567- , connectionUseSecure = Nothing- , connectionUseSocks = Nothing- }- connectionPut con (B.singleton 0xa)- r <- connectionGet con 1- putStrLn $ show r- connectionClose con+```haskell+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 = 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 = 4567- , connectionUseSecure = Nothing- , connectionUseSocks = Just $ SockSettingsSimple "localhost" 1080- }-+```haskell+con <- connectTo ctx $ ConnectionParams+ { connectionHostname = "www.example.com"+ , connectionPort = 4567+ , connectionUseSecure = Nothing+ , connectionUseSocks = Just $ SockSettingsSimple "localhost" 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 = 4567- , connectionUseSecure = Just def- , connectionUseSocks = Nothing- }-+```haskell+con <- connectTo ctx $ ConnectionParams+ { connectionHostname = "www.example.com"+ , connectionPort = 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+```haskell+{-# 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 = 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"+main = do+ ctx <- initConnectionContext+ con <- connectTo ctx $ ConnectionParams+ { connectionHostname = "www.example.com"+ , connectionPort = 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+ -- 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+ -- the connection is from now on using TLS, we can send secret for example+ connectionPut con "PASSWORD 123\n"+ connectionClose con+```
connection.cabal view
@@ -1,5 +1,5 @@ Name: connection-Version: 0.2.8+Version: 0.3.1 Description: Simple network library for all your connection need. .@@ -17,19 +17,19 @@ Category: Network stability: experimental Cabal-Version: >=1.6-Homepage: http://github.com/vincenthz/hs-connection+Homepage: https://github.com/vincenthz/hs-connection extra-source-files: README.md CHANGELOG.md Library Build-Depends: base >= 3 && < 5+ , basement , bytestring- , byteable , containers , data-default-class- , network >= 2.3- , tls >= 1.3- , socks >= 0.5.5+ , network >= 2.6.3+ , tls >= 1.4+ , socks >= 0.6 , x509 >= 1.5 , x509-store >= 1.5 , x509-system >= 1.5