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

Improve signatures

Browse source
This commit is contained in:
Erèbe 2016-05-29 12:39:56 +02:00
parent cf9ad075f4
commit ed22e0db33
1 changed files with 23 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
src/Tunnel.hs
View file

@ -56,6 +56,7 @@ instance Show TunnelSettings where
<> serverHost <> ":" <> show serverPort <> serverHost <> ":" <> show serverPort
<> " <==" <> show protocol <> "==> " <> destHost <> ":" <> show destPort <> " <==" <> show protocol <> "==> " <> destHost <> ":" <> show destPort
data Connection = Connection data Connection = Connection
{ read :: IO (Maybe ByteString) { read :: IO (Maybe ByteString)
, write :: ByteString -> IO () , write :: ByteString -> IO ()
@ -98,14 +99,15 @@ instance ToConnection NC.Connection where
connectionToStream :: Connection -> IO WS.Stream connectionToStream :: Connection -> IO WS.Stream
connectionToStream Connection{..} = WS.makeStream read (write . toStrict . fromJust) connectionToStream Connection{..} = WS.makeStream read (write . toStrict . fromJust)
runTunnelingClientWith :: TunnelSettings -> (Connection -> IO ()) -> Connection -> IO () runTunnelingClientWith :: TunnelSettings -> (Connection -> IO ()) -> IO (Connection -> IO ())
runTunnelingClientWith info@TunnelSettings{..} app conn = do runTunnelingClientWith info@TunnelSettings{..} app = do
putStrLn $ "OPEN tunnel " <> tshow info putStrLn $ "OPEN tunnel " <> tshow info
stream <- connectionToStream conn return $ \conn -> do
void $ WS.runClientWithStream stream serverHost (toPath info) WS.defaultConnectionOptions [] $ \conn' -> stream <- connectionToStream conn
app (toConnection conn') void $ WS.runClientWithStream stream serverHost (toPath info) WS.defaultConnectionOptions [] $ \conn' ->
app (toConnection conn')
putStrLn $ "CLOSE tunnel " <> tshow info
putStrLn $ "CLOSE tunnel " <> tshow info
httpProxyConnection :: (HostName, PortNumber) -> TunnelSettings -> (Connection -> IO ()) -> IO () httpProxyConnection :: (HostName, PortNumber) -> TunnelSettings -> (Connection -> IO ()) -> IO ()
httpProxyConnection (host, port) TunnelSettings{..} app = httpProxyConnection (host, port) TunnelSettings{..} app =
@ -131,8 +133,8 @@ 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)
runTLSClient :: TunnelSettings -> Connection -> (Connection -> IO ()) -> IO () runTLSClient :: TunnelSettings -> (Connection -> IO ()) -> IO (Connection -> IO ())
runTLSClient TunnelSettings{..} conn app = do runTLSClient TunnelSettings{..} app = do
let tlsSettings = NC.TLSSettingsSimple { NC.settingDisableCertificateValidation = True let tlsSettings = NC.TLSSettingsSimple { NC.settingDisableCertificateValidation = True
, NC.settingDisableSession = False , NC.settingDisableSession = False
, NC.settingUseServerName = False , NC.settingUseServerName = False
@ -143,12 +145,13 @@ runTLSClient TunnelSettings{..} conn app = do
, NC.connectionUseSocks = Nothing , NC.connectionUseSocks = Nothing
} }
context <- NC.initConnectionContext return $ \conn -> do
let socket = fromJust . N.appRawSocket . fromJust $ rawConnection conn context <- NC.initConnectionContext
h <- N.socketToHandle socket ReadWriteMode let socket = fromJust . N.appRawSocket . fromJust $ rawConnection conn
h <- N.socketToHandle socket ReadWriteMode
connection <- NC.connectFromHandle context h connectionParams connection <- NC.connectFromHandle context h connectionParams
app (toConnection connection) app (toConnection connection)
runTlsTunnelingServer :: (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO () runTlsTunnelingServer :: (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO ()
@ -218,13 +221,15 @@ myTry f = void $ catch f (\(_ :: SomeException) -> return ())
runClient :: TunnelSettings -> IO () runClient :: TunnelSettings -> IO ()
runClient cfg@TunnelSettings{..} = do runClient cfg@TunnelSettings{..} = do
let out app = (if isJust proxySetting then httpProxyConnection (fromJust proxySetting) cfg else tcpConnection cfg) $ \cnx -> let withTcp = if isJust proxySetting then httpProxyConnection (fromJust proxySetting) cfg else tcpConnection cfg
(if useTls then runTLSClient cfg cnx else \app' -> app' cnx) $ \cnx' -> let doTlsIf tlsNeeded app = if tlsNeeded then runTLSClient cfg app else return app
runTunnelingClientWith cfg app cnx' let tunnelClient = runTunnelingClientWith cfg
let tunnelServer app = tunnelClient app >>= doTlsIf useTls >>= withTcp
case protocol of case protocol of
UDP -> runUDPServer (localBind, localPort) (\hOther -> out (`propagateRW` toConnection hOther)) UDP -> runUDPServer (localBind, localPort) (\localH -> tunnelServer (`propagateRW` toConnection localH))
TCP -> runTCPServer (localBind, localPort) (\hOther -> out (`propagateRW` toConnection hOther)) TCP -> runTCPServer (localBind, localPort) (\localH -> tunnelServer (`propagateRW` toConnection localH))
runServer :: Bool -> (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO () runServer :: Bool -> (HostName, PortNumber) -> ((ByteString, Int) -> Bool) -> IO ()