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:
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 qualified Logger
|
||||||
import Tunnel
|
import Tunnel
|
||||||
import Types
|
import Types
|
||||||
|
import Control.Concurrent.Async as Async
|
||||||
|
|
||||||
data WsTunnel = WsTunnel
|
data WsTunnel = WsTunnel
|
||||||
{ localToRemote :: String
|
{ localToRemote :: [String]
|
||||||
-- , remoteToLocal :: String
|
-- , remoteToLocal :: String
|
||||||
, dynamicToRemote :: String
|
, dynamicToRemote :: String
|
||||||
, wsTunnelServer :: String
|
, wsTunnelServer :: String
|
||||||
|
@ -48,13 +49,14 @@ data TunnelInfo = TunnelInfo
|
||||||
cmdLine :: WsTunnel
|
cmdLine :: WsTunnel
|
||||||
cmdLine = WsTunnel
|
cmdLine = WsTunnel
|
||||||
{ localToRemote = def &= explicit &= name "L" &= name "localToRemote" &= typ "[BIND:]PORT:HOST:PORT"
|
{ 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"
|
-- , remoteToLocal = def &= explicit &= name "R" &= name "RemoteToLocal" &= typ "[BIND:]PORT:HOST:PORT"
|
||||||
-- &= help "Listen on remote and forward traffic from local"
|
-- &= help "Listen on remote and forward traffic from local"
|
||||||
, dynamicToRemote= def &= explicit &= name "D" &= name "dynamicToRemote" &= typ "[BIND:]PORT"
|
, 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"
|
&= 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"
|
, 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"
|
, 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"
|
&= 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"
|
&= typ "String" &= groupname "Client options"
|
||||||
|
@ -142,42 +144,77 @@ main = do
|
||||||
then Logger.VERBOSE
|
then Logger.VERBOSE
|
||||||
else Logger.NORMAL)
|
else Logger.NORMAL)
|
||||||
|
|
||||||
|
runApp cfg serverInfo
|
||||||
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 ()
|
|
||||||
|
|
||||||
|
|
||||||
putStrLn "Goodbye !"
|
putStrLn "Goodbye !"
|
||||||
return ()
|
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
|
, cmdargs
|
||||||
, hslogger
|
, hslogger
|
||||||
, text >= 1.2.2.1
|
, text >= 1.2.2.1
|
||||||
|
, async
|
||||||
, wstunnel
|
, wstunnel
|
||||||
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
Loading…
Reference in a new issue