hex/wstunnel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Test

Browse source
This commit is contained in:
Erèbe 2016-05-31 18:35:04 +02:00
parent 8d33cf9698
commit 750aeedd6b
2 changed files with 18 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
app/Main.hs
View file

@ -11,6 +11,7 @@ import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import System.Console.CmdArgs import System.Console.CmdArgs
import System.Environment (getArgs, withArgs) import System.Environment (getArgs, withArgs)
import qualified System.Log.Logger as LOG
data WsTunnel = WsTunnel data WsTunnel = WsTunnel
{ localToRemote :: String { localToRemote :: String
@ -105,6 +106,8 @@ main = do
cfg <- if null args then withArgs ["--help"] (cmdArgs cmdLine) else cmdArgs cmdLine cfg <- if null args then withArgs ["--help"] (cmdArgs cmdLine) else cmdArgs cmdLine
let serverInfo = parseServerInfo (WsServerInfo False "" 0) (wsTunnelServer cfg) let serverInfo = parseServerInfo (WsServerInfo False "" 0) (wsTunnelServer cfg)
LOG.updateGlobalLogger "wstunnel" (LOG.setLevel LOG.INFO)
if serverMode cfg if serverMode cfg
then putStrLn ("Starting server with opts " ++ show serverInfo ) then putStrLn ("Starting server with opts " ++ show serverInfo )

22
src/Tunnel.hs
View file

@ -3,6 +3,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
module Tunnel module Tunnel
( runClient ( runClient
@ -33,6 +34,7 @@ import Protocols
import System.IO (IOMode (ReadWriteMode)) import System.IO (IOMode (ReadWriteMode))
import System.Timeout import System.Timeout
import qualified System.Log.Logger as LOG
data TunnelSettings = TunnelSettings data TunnelSettings = TunnelSettings
@ -66,6 +68,10 @@ data Connection = Connection
} }
data Error = ProxyConnectError String
| ProxyForwardError String
deriving (Show, Read)
class ToConnection a where class ToConnection a where
toConnection :: a -> Connection toConnection :: a -> Connection
@ -110,27 +116,29 @@ runTunnelingClientWith info@TunnelSettings{..} app conn = do
httpProxyConnection :: (HostName, PortNumber) -> TunnelSettings -> (Connection -> IO ()) -> IO () httpProxyConnection :: (HostName, PortNumber) -> TunnelSettings -> (Connection -> IO ()) -> IO ()
httpProxyConnection (host, port) TunnelSettings{..} app = httpProxyConnection (host, port) TunnelSettings{..} app =
myTry $ N.runTCPClient (N.clientSettingsTCP (fromIntegral port) (fromString host)) $ \conn -> do mcatch $ N.runTCPClient (N.clientSettingsTCP (fromIntegral port) (fromString host)) $ \conn -> myTry $ do
_ <- sendConnectRequest conn _ <- sendConnectRequest conn
responseM <- timeout (1000000 * 10) $ readProxyResponse mempty conn responseM <- timeout (1000000 * 10) $ readConnectResponse mempty conn
let response = fromMaybe "No response of the proxy aftre 10s" responseM let response = fromMaybe "No response of the proxy after 10s" responseM
if isAuthorized response if isAuthorized response
then app $ toConnection conn then app $ toConnection conn
else putStrLn $ "Proxy refused the connection :: \n" <> fromString (BC.unpack response) else LOG.errorM "wstunnel" $ "Proxy refused the connection :: \n===\n" <> fromString (BC.unpack response) <> "\n==="
where where
sendConnectRequest h = N.appWrite h $ "CONNECT " <> fromString serverHost <> ":" <> fromString (show serverPort) <> " HTTP/1.0\r\n" sendConnectRequest h = N.appWrite h $ "CONNECT " <> fromString serverHost <> ":" <> fromString (show serverPort) <> " HTTP/1.0\r\n"
<> "Host: " <> fromString serverHost <> ":" <> fromString (show serverPort) <>"\r\n\r\n" <> "Host: " <> fromString serverHost <> ":" <> fromString (show serverPort) <> "\r\n\r\n"
readProxyResponse buff conn = do readConnectResponse buff conn = do
response <- N.appRead conn response <- N.appRead conn
if "\r\n\r\n" `BC.isInfixOf` response if "\r\n\r\n" `BC.isInfixOf` response
then return $ buff <> response then return $ buff <> response
else readProxyResponse (buff <> response) conn else readConnectResponse (buff <> response) conn
isAuthorized response = " 200 " `BC.isInfixOf` response isAuthorized response = " 200 " `BC.isInfixOf` response
mcatch action = action `catch` (\(e :: SomeException) -> LOG.errorM "wstunnel" $ "Cannot connect to the proxy :: " <> show e)
tcpConnection :: TunnelSettings -> (Connection -> IO ()) -> IO () tcpConnection :: TunnelSettings -> (Connection -> IO ()) -> IO ()
tcpConnection TunnelSettings{..} app = tcpConnection TunnelSettings{..} app =
myTry $ N.runTCPClient (N.clientSettingsTCP (fromIntegral serverPort) (fromString serverHost)) (app . toConnection) myTry $ N.runTCPClient (N.clientSettingsTCP (fromIntegral serverPort) (fromString serverHost)) (app . toConnection)