From 5b152ad99fecff3361a2ec43aa216223246b5f4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Romain=20G=C3=89RARD?= Date: Sat, 5 Oct 2019 14:31:22 +0200 Subject: [PATCH] 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 --- app/Main.hs | 117 ++++++++++++++++++++++++++++++++----------------- wstunnel.cabal | 1 + 2 files changed, 78 insertions(+), 40 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index d3f14bb..1a0ab51 100644 --- a/app/Main.hs +++ b/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 + } diff --git a/wstunnel.cabal b/wstunnel.cabal index 6a10251..95aa78a 100644 --- a/wstunnel.cabal +++ b/wstunnel.cabal @@ -62,6 +62,7 @@ executable wstunnel , cmdargs , hslogger , text >= 1.2.2.1 + , async , wstunnel default-language: Haskell2010