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

82
app/Main.hs
View file

@ -10,7 +10,6 @@ import qualified Data.ByteString.Char8 as BC
import System.Console.CmdArgs
import System.Environment (getArgs, withArgs)
data WsTunnel = WsTunnel
{ localToRemote :: String
, remoteToLocal :: String
@ -21,48 +20,12 @@ data WsTunnel = WsTunnel
, _last :: Bool
} deriving (Show, Data, Typeable)
cmdLine :: WsTunnel
cmdLine = WsTunnel
{ localToRemote = def &= explicit &= name "L" &= name "localToRemote" &= typ "[BIND:]PORT:HOST:PORT"
&= help "Listen on local and forward traffic from remote" &= groupname "Client options"
, remoteToLocal = def &= explicit &= name "R" &= name "RemoteToLocal" &= typ "[BIND:]PORT:HOST:PORT"
&= help "Listen on remote and forward traffic from local"
, udpMode = def &= explicit &= name "u" &= name "udp" &= help "forward UDP traffic instead of TCP"
, wsTunnelServer = def &= argPos 0 &= typ "ws[s]://wstunnelServer[:port]"
, serverMode = def &= explicit &= name "server"
&= help "Start a server that will forward traffic for you" &= groupname "Server options"
, restrictTo = def &= explicit &= name "r" &= name "restrictTo"
&= help "Accept traffic to be forwarded only to this service" &= typ "HOST:PORT"
, _last = def &= explicit &= name "ツ" &= groupname "Common options"
} &= summary ("Use the websockets protocol to tunnel {TCP,UDP} traffic\n"
++ "wsTunnelClient <---> wsTunnelServer <---> RemoteHost\n"
++ "Use secure connection (wss://) to bypass proxies"
)
&= helpArg [explicit, name "help", name "h"]
data WsServerInfo = WsServerInfo
{ useTls :: !Bool
, host :: !String
, port :: !Int
} deriving (Show)
toPort :: String -> Int
toPort str = case readMay str of
Just por -> por
Nothing -> error $ "Invalid port number `" ++ str ++ "`"
parseServerInfo :: WsServerInfo -> String -> WsServerInfo
parseServerInfo server [] = server
parseServerInfo server ('w':'s':':':'/':'/':xs) = parseServerInfo (server {useTls = False, port = 80}) xs
parseServerInfo server ('w':'s':'s':':':'/':'/':xs) = parseServerInfo (server {useTls = True, port = 443}) xs
parseServerInfo server (':':prt) = server {port = toPort prt}
parseServerInfo server hostPath = parseServerInfo (server {host = takeWhile (/= ':') hostPath}) (dropWhile (/= ':') hostPath)
data TunnelInfo = TunnelInfo
{ localHost :: !String
, localPort :: !Int
@ -70,12 +33,47 @@ data TunnelInfo = TunnelInfo
, remotePort :: !Int
} deriving (Show)
cmdLine :: WsTunnel
cmdLine = WsTunnel
{ localToRemote = def &= explicit &= name "L" &= name "localToRemote" &= typ "[BIND:]PORT:HOST:PORT"
&= help "Listen on local and forward traffic from remote" &= groupname "Client options"
, remoteToLocal = def &= explicit &= name "R" &= name "RemoteToLocal" &= typ "[BIND:]PORT:HOST:PORT"
&= help "Listen on remote and forward traffic from local"
, udpMode = def &= explicit &= name "u" &= name "udp" &= help "forward UDP traffic instead of TCP"
, wsTunnelServer = def &= argPos 0 &= typ "ws[s]://wstunnelServer[:port]"
, serverMode = def &= explicit &= name "server"
&= help "Start a server that will forward traffic for you" &= groupname "Server options"
, restrictTo = def &= explicit &= name "r" &= name "restrictTo"
&= help "Accept traffic to be forwarded only to this service" &= typ "HOST:PORT"
, _last = def &= explicit &= name "ツ" &= groupname "Common options"
} &= summary ( "Use the websockets protocol to tunnel {TCP,UDP} traffic\n"
++ "wsTunnelClient <---> wsTunnelServer <---> RemoteHost\n"
++ "Use secure connection (wss://) to bypass proxies"
)
&= helpArg [explicit, name "help", name "h"]
toPort :: String -> Int
toPort str = case readMay str of
Just por -> por
Nothing -> error $ "Invalid port number `" ++ str ++ "`"
parseServerInfo :: WsServerInfo -> String -> WsServerInfo
parseServerInfo server [] = server
parseServerInfo server ('w':'s':':':'/':'/':xs) = parseServerInfo (server {useTls = False, port = 80}) xs
parseServerInfo server ('w':'s':'s':':':'/':'/':xs) = parseServerInfo (server {useTls = True, port = 443}) xs
parseServerInfo server (':':prt) = server {port = toPort prt}
parseServerInfo server hostPath = parseServerInfo (server {host = takeWhile (/= ':') hostPath}) (dropWhile (/= ':') hostPath)
parseTunnelInfo :: String -> TunnelInfo
parseTunnelInfo str = mk $ BC.unpack <$> BC.split ':' (BC.pack str)
where
mk [lPort, host, rPort] = TunnelInfo { localHost = "127.0.0.1", localPort = toPort lPort, remoteHost = host, remotePort = toPort rPort}
mk [bind,lPort, host,rPort] = TunnelInfo { localHost = bind, localPort = toPort lPort, remoteHost = host, remotePort = toPort rPort}
mk _ = error $ "Invalid tunneling information `" ++ str ++ "`, please use format [BIND:]PORT:HOST:PORT"
mk [lPort, host, rPort] = TunnelInfo {localHost = "127.0.0.1", localPort = toPort lPort, remoteHost = host, remotePort = toPort rPort}
mk [bind,lPort, host,rPort] = TunnelInfo {localHost = bind, localPort = toPort lPort, remoteHost = host, remotePort = toPort rPort}
mk _ = error $ "Invalid tunneling information `" ++ str ++ "`, please use format [BIND:]PORT:HOST:PORT"
@ -91,7 +89,9 @@ main = do
then putStrLn ("Starting server with opts " ++ show serverInfo )
>> runServer (host serverInfo, port serverInfo)
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 ()

3
src/Lib.hs
View file

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