Listen to TCP/UDP & mutiple -L command line arguments
Former-commit-id: fe7931a137877131be0cb6b4ac199bf5496595f0 Former-commit-id: 7fb3cd78bea5a3a32e6985e520d0e421761e7d3f [formerly 03bfbe7e9089a9cba6640d181afcc047015409ed] [formerly d416b3b6ac3cb913d7ab3458751b3a30055597aa [formerly b014bab246971877d16bb3e8c17d574963d0895a [formerly b014bab246971877d16bb3e8c17d574963d0895a [formerly b014bab246971877d16bb3e8c17d574963d0895a [formerly a7943c24ae097faff115a31d7ce4edd3288b02e4]]]]] Former-commit-id: 06859f28a16cd8688fbfcfe11a282b44bad9d80b [formerly 749b4cdf6bb72b8ec19ba5f2a26548b58f45effb] Former-commit-id: 50ffd10f9893a802f0c94f846ac96116e657240a Former-commit-id: b73912cf8bf61a6f41f830d7442a1ea1e96fbc91 Former-commit-id: 8d1f6e18acc1c6066ff6bbb7a5e993e0ec989e84 Former-commit-id: db4d1219cc0948d94b6870e94cbbf7d3db0ec942 [formerly fe3a3843d756b4ac5bb275740cf750cbcd94850d] Former-commit-id: f9424ba8d27baa2e2b03eae29459701b80255c09
This commit is contained in:
Romain GÉRARD
parent
8a416d4f57
commit
5b152ad99f
2 changed files with 78 additions and 40 deletions
117
app/Main.hs
117
app/Main.hs
|
|
@ -15,9 +15,10 @@ import System.Environment (getArgs, withArgs)
|
|||
import qualified Logger
|
||||
import Tunnel
|
||||
import Types
|
||||
import Control.Concurrent.Async as Async
|
||||
|
||||
data WsTunnel = WsTunnel
|
||||
{ localToRemote :: String
|
||||
{ localToRemote :: [String]
|
||||
-- , remoteToLocal :: String
|
||||
, dynamicToRemote :: String
|
||||
, wsTunnelServer :: String
|
||||
|
|
@ -48,13 +49,14 @@ data TunnelInfo = TunnelInfo
|
|||
cmdLine :: WsTunnel
|
||||
cmdLine = WsTunnel
|
||||
{ localToRemote = def &= explicit &= name "L" &= name "localToRemote" &= typ "[BIND:]PORT:HOST:PORT"
|
||||
&= help "Listen on local and forwards traffic from remote" &= groupname "Client options"
|
||||
&= help "Listen on local and forwards traffic from remote. Can be used multiple time" &= groupname "Client options"
|
||||
-- , remoteToLocal = def &= explicit &= name "R" &= name "RemoteToLocal" &= typ "[BIND:]PORT:HOST:PORT"
|
||||
-- &= help "Listen on remote and forward traffic from local"
|
||||
, dynamicToRemote= def &= explicit &= name "D" &= name "dynamicToRemote" &= typ "[BIND:]PORT"
|
||||
&= help "Listen on local and dynamically (with socks5 proxy) forwards traffic from remote" &= groupname "Client options"
|
||||
, udpMode = def &= explicit &= name "u" &= name "udp" &= help "forward UDP traffic instead of TCP" &= groupname "Client options"
|
||||
, udpTimeout = def &= explicit &= name "udpTimeoutSec" &= help "When using udp forwarding, timeout in seconds after when the tunnel connection is closed. Default 30sec, -1 means no timeout" &= groupname "Client options"
|
||||
, udpTimeout = def &= explicit &= name "udpTimeoutSec" &= help "When using udp forwarding, timeout in seconds after when the tunnel connection is closed. Default 30sec, -1 means no timeout"
|
||||
&= groupname "Client options"
|
||||
, pathPrefix = def &= explicit &= name "upgradePathPrefix"
|
||||
&= help "Use a specific prefix that will show up in the http path in the upgrade request. Useful if you need to route requests server side but don't have vhosts"
|
||||
&= typ "String" &= groupname "Client options"
|
||||
|
|
@ -142,42 +144,77 @@ main = do
|
|||
then Logger.VERBOSE
|
||||
else Logger.NORMAL)
|
||||
|
||||
|
||||
if serverMode cfg
|
||||
then putStrLn ("Starting server with opts " <> tshow serverInfo )
|
||||
>> runServer (Main.useTls serverInfo) (Main.host serverInfo, fromIntegral $ Main.port serverInfo) (parseRestrictTo $ restrictTo cfg)
|
||||
else if not $ null (localToRemote cfg)
|
||||
then let (TunnelInfo lHost lPort rHost rPort) = parseTunnelInfo (localToRemote cfg)
|
||||
in runClient TunnelSettings { localBind = lHost
|
||||
, Types.localPort = fromIntegral lPort
|
||||
, serverHost = Main.host serverInfo
|
||||
, serverPort = fromIntegral $ Main.port serverInfo
|
||||
, destHost = rHost
|
||||
, destPort = fromIntegral rPort
|
||||
, Types.useTls = Main.useTls serverInfo
|
||||
, protocol = if lPort == 0 then STDIO else if udpMode cfg then UDP else TCP
|
||||
, proxySetting = parseProxyInfo (proxy cfg)
|
||||
, useSocks = False
|
||||
, upgradePrefix = pathPrefix cfg
|
||||
, udpTimeout = Main.udpTimeout cfg
|
||||
}
|
||||
else if not $ null (dynamicToRemote cfg)
|
||||
then let (TunnelInfo lHost lPort _ _) = parseTunnelInfo $ (dynamicToRemote cfg) ++ ":127.0.0.1:1212"
|
||||
in runClient TunnelSettings { localBind = lHost
|
||||
, Types.localPort = fromIntegral lPort
|
||||
, serverHost = Main.host serverInfo
|
||||
, serverPort = fromIntegral $ Main.port serverInfo
|
||||
, destHost = ""
|
||||
, destPort = 0
|
||||
, Types.useTls = Main.useTls serverInfo
|
||||
, protocol = SOCKS5
|
||||
, proxySetting = parseProxyInfo (proxy cfg)
|
||||
, useSocks = True
|
||||
, upgradePrefix = pathPrefix cfg
|
||||
, udpTimeout = Main.udpTimeout cfg
|
||||
}
|
||||
else return ()
|
||||
|
||||
|
||||
runApp cfg serverInfo
|
||||
putStrLn "Goodbye !"
|
||||
return ()
|
||||
|
||||
|
||||
runApp :: WsTunnel -> WsServerInfo -> IO ()
|
||||
runApp cfg serverInfo
|
||||
-- server mode
|
||||
| serverMode cfg = do
|
||||
putStrLn $ "Starting server with opts " <> tshow serverInfo
|
||||
runServer (Main.useTls serverInfo) (Main.host serverInfo, fromIntegral $ Main.port serverInfo) (parseRestrictTo $ restrictTo cfg)
|
||||
|
||||
-- -L localToRemote tunnels
|
||||
| not . null $ localToRemote cfg = do
|
||||
let tunnelInfos = parseTunnelInfo <$> localToRemote cfg
|
||||
let tunnelSettings = tunnelInfos >>= \tunnelInfo -> [toTcpLocalToRemoteTunnelSetting cfg serverInfo tunnelInfo, toUdpLocalToRemoteTunnelSetting cfg serverInfo tunnelInfo]
|
||||
Async.mapConcurrently_ runClient tunnelSettings
|
||||
|
||||
-- -D dynamicToRemote tunnels
|
||||
| not . null $ dynamicToRemote cfg = do
|
||||
let tunnelSetting = toDynamicTunnelSetting cfg serverInfo . parseTunnelInfo $ (dynamicToRemote cfg) ++ ":127.0.0.1:1212"
|
||||
runClient tunnelSetting
|
||||
|
||||
| otherwise = do
|
||||
putStrLn "Cannot parse correctly the command line. Please fill an issue"
|
||||
|
||||
where
|
||||
toTcpLocalToRemoteTunnelSetting cfg serverInfo (TunnelInfo lHost lPort rHost rPort) =
|
||||
TunnelSettings {
|
||||
localBind = lHost
|
||||
, Types.localPort = fromIntegral lPort
|
||||
, serverHost = Main.host serverInfo
|
||||
, serverPort = fromIntegral $ Main.port serverInfo
|
||||
, destHost = rHost
|
||||
, destPort = fromIntegral rPort
|
||||
, Types.useTls = Main.useTls serverInfo
|
||||
, protocol = TCP
|
||||
, proxySetting = parseProxyInfo (proxy cfg)
|
||||
, useSocks = False
|
||||
, upgradePrefix = pathPrefix cfg
|
||||
, udpTimeout = Main.udpTimeout cfg
|
||||
}
|
||||
|
||||
toUdpLocalToRemoteTunnelSetting cfg serverInfo (TunnelInfo lHost lPort rHost rPort) =
|
||||
TunnelSettings {
|
||||
localBind = lHost
|
||||
, Types.localPort = fromIntegral lPort
|
||||
, serverHost = Main.host serverInfo
|
||||
, serverPort = fromIntegral $ Main.port serverInfo
|
||||
, destHost = rHost
|
||||
, destPort = fromIntegral rPort
|
||||
, Types.useTls = Main.useTls serverInfo
|
||||
, protocol = UDP
|
||||
, proxySetting = parseProxyInfo (proxy cfg)
|
||||
, useSocks = False
|
||||
, upgradePrefix = pathPrefix cfg
|
||||
, udpTimeout = Main.udpTimeout cfg
|
||||
}
|
||||
|
||||
toDynamicTunnelSetting cfg serverInfo (TunnelInfo lHost lPort _ _) =
|
||||
TunnelSettings {
|
||||
localBind = lHost
|
||||
, Types.localPort = fromIntegral lPort
|
||||
, serverHost = Main.host serverInfo
|
||||
, serverPort = fromIntegral $ Main.port serverInfo
|
||||
, destHost = ""
|
||||
, destPort = 0
|
||||
, Types.useTls = Main.useTls serverInfo
|
||||
, protocol = SOCKS5
|
||||
, proxySetting = parseProxyInfo (proxy cfg)
|
||||
, useSocks = True
|
||||
, upgradePrefix = pathPrefix cfg
|
||||
, udpTimeout = Main.udpTimeout cfg
|
||||
}
|
||||
|
|
|
|||
|
|
@ -62,6 +62,7 @@ executable wstunnel
|
|||
, cmdargs
|
||||
, hslogger
|
||||
, text >= 1.2.2.1
|
||||
, async
|
||||
, wstunnel
|
||||
|
||||
default-language: Haskell2010
|
||||
|
|
|
|||
Loading…
Reference in a new issue