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

Cosmetic changes

Browse source
This commit is contained in:
Erèbe 2016-05-15 02:09:18 +02:00
parent 1ed3177040
commit 8930a823a2
2 changed files with 43 additions and 42 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
app/Main.hs
View file

@ -10,7 +10,6 @@ import qualified Data.ByteString.Char8 as BC
import System.Console.CmdArgs import System.Console.CmdArgs
import System.Environment (getArgs, withArgs) import System.Environment (getArgs, withArgs)
data WsTunnel = WsTunnel data WsTunnel = WsTunnel
{ localToRemote :: String { localToRemote :: String
, remoteToLocal :: String , remoteToLocal :: String
@ -21,6 +20,18 @@ data WsTunnel = WsTunnel
, _last :: Bool , _last :: Bool
} deriving (Show, Data, Typeable) } deriving (Show, Data, Typeable)
data WsServerInfo = WsServerInfo
{ useTls :: !Bool
, host :: !String
, port :: !Int
} deriving (Show)
data TunnelInfo = TunnelInfo
{ localHost :: !String
, localPort :: !Int
, remoteHost :: !String
, remotePort :: !Int
} deriving (Show)
cmdLine :: WsTunnel cmdLine :: WsTunnel
cmdLine = WsTunnel cmdLine = WsTunnel
@ -44,12 +55,6 @@ cmdLine = WsTunnel
&= helpArg [explicit, name "help", name "h"] &= helpArg [explicit, name "help", name "h"]
data WsServerInfo = WsServerInfo
{ useTls :: !Bool
, host :: !String
, port :: !Int
} deriving (Show)
toPort :: String -> Int toPort :: String -> Int
toPort str = case readMay str of toPort str = case readMay str of
Just por -> por Just por -> por
@ -63,13 +68,6 @@ parseServerInfo server (':':prt) = server {port = toPort prt}
parseServerInfo server hostPath = parseServerInfo (server {host = takeWhile (/= ':') hostPath}) (dropWhile (/= ':') hostPath) parseServerInfo server hostPath = parseServerInfo (server {host = takeWhile (/= ':') hostPath}) (dropWhile (/= ':') hostPath)
data TunnelInfo = TunnelInfo
{ localHost :: !String
, localPort :: !Int
, remoteHost :: !String
, remotePort :: !Int
} deriving (Show)
parseTunnelInfo :: String -> TunnelInfo parseTunnelInfo :: String -> TunnelInfo
parseTunnelInfo str = mk $ BC.unpack <$> BC.split ':' (BC.pack str) parseTunnelInfo str = mk $ BC.unpack <$> BC.split ':' (BC.pack str)
where where
@ -91,7 +89,9 @@ main = do
then putStrLn ("Starting server with opts " ++ show serverInfo ) then putStrLn ("Starting server with opts " ++ show serverInfo )
>> runServer (host serverInfo, port serverInfo) >> runServer (host serverInfo, port serverInfo)
else if not $ null (localToRemote cfg) else if not $ null (localToRemote cfg)
then let (TunnelInfo lHost lPort rHost rPort) = parseTunnelInfo (localToRemote cfg) in runClient (if udpMode cfg then UDP else TCP) (lHost, lPort) (host serverInfo, port serverInfo) (rHost, rPort) then let (TunnelInfo lHost lPort rHost rPort) = parseTunnelInfo (localToRemote cfg)
in runClient (if udpMode cfg then UDP else TCP) (lHost, lPort)
(host serverInfo, port serverInfo) (rHost, rPort)
else return () else return ()

3
src/Lib.hs
View file

@ -1,3 +1,4 @@
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
@ -117,7 +118,7 @@ runTunnelingServer (host, port) = do
let path = parsePath . WS.requestPath $ WS.pendingRequest pendingConn let path = parsePath . WS.requestPath $ WS.pendingRequest pendingConn
case path of case path of
Nothing -> putStrLn "Rejecting connection" >> WS.rejectRequest pendingConn "Invalid tunneling information" Nothing -> putStrLn "Rejecting connection" >> WS.rejectRequest pendingConn "Invalid tunneling information"
Just (proto, rhost, rport) -> do Just (!proto, !rhost, !rport) -> do
conn <- WS.acceptRequest pendingConn conn <- WS.acceptRequest pendingConn
case proto of case proto of
UDP -> runUDPClient (BC.unpack rhost, rport) (propagateRW conn) UDP -> runUDPClient (BC.unpack rhost, rport) (propagateRW conn)