From 8930a823a2054a8dc8b859aedf86de3071281f8f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Er=C3=A8be?= Date: Sun, 15 May 2016 02:09:18 +0200 Subject: [PATCH] Cosmetic changes --- app/Main.hs | 82 ++++++++++++++++++++++++++--------------------------- src/Lib.hs | 3 +- 2 files changed, 43 insertions(+), 42 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 999c88f..876334e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 () diff --git a/src/Lib.hs b/src/Lib.hs index 5981053..a56d56e 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -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)