hex/wstunnel
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add http proxy authorization

Browse source
This commit is contained in:
Erèbe 2016-06-05 22:13:09 +02:00
parent 15016cf330
commit dce0372c4b
3 changed files with 52 additions and 26 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
app/Main.hs
View file

@ -6,7 +6,8 @@ module Main where
import Tunnel import Tunnel
import ClassyPrelude (ByteString, guard, readMay) import ClassyPrelude (ByteString, guard, readMay,
traceShowId)
import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import System.Console.CmdArgs import System.Console.CmdArgs
@ -48,7 +49,7 @@ cmdLine = WsTunnel
-- &= help "Listen on remote and forward traffic from local" -- &= help "Listen on remote and forward traffic from local"
, udpMode = def &= explicit &= name "u" &= name "udp" &= help "forward UDP traffic instead of TCP" , udpMode = def &= explicit &= name "u" &= name "udp" &= help "forward UDP traffic instead of TCP"
, proxy = def &= explicit &= name "p" &= name "httpProxy" , proxy = def &= explicit &= name "p" &= name "httpProxy"
&= help "If set, will use this proxy to connect to the server" &= typ "HOST:PORT" &= help "If set, will use this proxy to connect to the server" &= typ "USER:PASS@HOST:PORT"
, wsTunnelServer = def &= argPos 0 &= typ "ws[s]://wstunnelServer[:port]" , wsTunnelServer = def &= argPos 0 &= typ "ws[s]://wstunnelServer[:port]"
, serverMode = def &= explicit &= name "server" , serverMode = def &= explicit &= name "server"
@ -71,10 +72,10 @@ toPort str = case readMay str of
parseServerInfo :: WsServerInfo -> String -> WsServerInfo parseServerInfo :: WsServerInfo -> String -> WsServerInfo
parseServerInfo server [] = server parseServerInfo server [] = server
parseServerInfo server ('w':'s':':':'/':'/':xs) = parseServerInfo (server {Main.useTls = False, port = 80}) xs parseServerInfo server ('w':'s':':':'/':'/':xs) = parseServerInfo (server {Main.useTls = False, Main.port = 80}) xs
parseServerInfo server ('w':'s':'s':':':'/':'/':xs) = parseServerInfo (server {Main.useTls = True, port = 443}) xs parseServerInfo server ('w':'s':'s':':':'/':'/':xs) = parseServerInfo (server {Main.useTls = True, Main.port = 443}) xs
parseServerInfo server (':':prt) = server {port = toPort prt} parseServerInfo server (':':prt) = server {Main.port = toPort prt}
parseServerInfo server hostPath = parseServerInfo (server {host = takeWhile (/= ':') hostPath}) (dropWhile (/= ':') hostPath) parseServerInfo server hostPath = parseServerInfo (server {Main.host = takeWhile (/= ':') hostPath}) (dropWhile (/= ':') hostPath)
parseTunnelInfo :: String -> TunnelInfo parseTunnelInfo :: String -> TunnelInfo
@ -96,12 +97,23 @@ parseRestrictTo str = let (!h, !p) = fromMaybe (error "Invalid Parameter restart
portNumber <- readMay $ ret !! 1 :: Maybe Int portNumber <- readMay $ ret !! 1 :: Maybe Int
return (BC.pack (head ret), portNumber) return (BC.pack (head ret), portNumber)
parseProxyInfo :: String -> Maybe (String, Int) parseProxyInfo :: String -> Maybe ProxySettings
parseProxyInfo str = do parseProxyInfo str = do
let ret = BC.unpack <$> BC.split ':' (BC.pack str) let ret = BC.split ':' (BC.pack str)
guard (length ret == 2)
portNumber <- readMay $ ret !! 1 :: Maybe Int guard (length ret >= 2)
return (head ret, portNumber) if length ret == 3
then do
portNumber <- readMay $ BC.unpack $ ret !! 2 :: Maybe Int
let cred = (head ret, head (BC.split '@' (ret !! 1)))
let h = BC.split '@' (ret !! 1) !! 1
return $ ProxySettings (BC.unpack h) (fromIntegral portNumber) (Just cred)
else if length ret == 2
then do
portNumber <- readMay . BC.unpack $ ret !! 1 :: Maybe Int
return $ ProxySettings (BC.unpack $ head ret) (fromIntegral portNumber) Nothing
else Nothing
main :: IO () main :: IO ()
main = do main = do
@ -118,18 +130,18 @@ main = do
if serverMode cfg if serverMode cfg
then putStrLn ("Starting server with opts " ++ show serverInfo ) then putStrLn ("Starting server with opts " ++ show serverInfo )
>> runServer (Main.useTls serverInfo) (host serverInfo, fromIntegral $ port serverInfo) (parseRestrictTo $ restrictTo cfg) >> runServer (Main.useTls serverInfo) (Main.host serverInfo, fromIntegral $ Main.port serverInfo) (parseRestrictTo $ restrictTo cfg)
else if not $ null (localToRemote cfg) else if not $ null (localToRemote cfg)
then let (TunnelInfo lHost lPort rHost rPort) = parseTunnelInfo (localToRemote cfg) then let (TunnelInfo lHost lPort rHost rPort) = parseTunnelInfo (localToRemote cfg)
in runClient TunnelSettings { localBind = lHost in runClient TunnelSettings { localBind = lHost
, Tunnel.localPort = fromIntegral lPort , Tunnel.localPort = fromIntegral lPort
, serverHost = host serverInfo , serverHost = Main.host serverInfo
, serverPort = fromIntegral $ port serverInfo , serverPort = fromIntegral $ Main.port serverInfo
, destHost = rHost , destHost = rHost
, destPort = fromIntegral rPort , destPort = fromIntegral rPort
, Tunnel.useTls = Main.useTls serverInfo , Tunnel.useTls = Main.useTls serverInfo
, protocol = if udpMode cfg then UDP else TCP , protocol = if udpMode cfg then UDP else TCP
, proxySetting = (\(h, p) -> (h, fromIntegral p)) <$> parseProxyInfo (proxy cfg) , proxySetting = parseProxyInfo (proxy cfg)
} }
else return () else return ()

35
src/Tunnel.hs
View file

@ -11,6 +11,7 @@ module Tunnel
, runServer , runServer
, TunnelSettings(..) , TunnelSettings(..)
, Protocol(..) , Protocol(..)
, ProxySettings(..)
) where ) where
import ClassyPrelude import ClassyPrelude
@ -36,10 +37,18 @@ import Protocols
import System.IO (IOMode (ReadWriteMode)) import System.IO (IOMode (ReadWriteMode))
import System.Timeout import System.Timeout
import qualified Data.ByteString.Base64 as B64
import Utils import Utils
data ProxySettings = ProxySettings
{ host :: HostName
, port :: PortNumber
, credentials :: Maybe (ByteString, ByteString)
} deriving (Show)
data TunnelSettings = TunnelSettings data TunnelSettings = TunnelSettings
{ proxySetting :: Maybe (HostName, PortNumber) { proxySetting :: Maybe ProxySettings
, localBind :: HostName , localBind :: HostName
, localPort :: PortNumber , localPort :: PortNumber
, serverHost :: HostName , serverHost :: HostName
@ -54,7 +63,7 @@ instance Show TunnelSettings where
show TunnelSettings{..} = localBind <> ":" <> show localPort show TunnelSettings{..} = localBind <> ":" <> show localPort
<> (if isNothing proxySetting <> (if isNothing proxySetting
then mempty then mempty
else " <==PROXY==> " <> fst (fromJust proxySetting) <> ":" <> (show . snd . fromJust $ proxySetting) else " <==PROXY==> " <> host (fromJust proxySetting) <> ":" <> (show . port $ fromJust proxySetting)
) )
<> " <==" <> (if useTls then "WSS" else "WS") <> "==> " <> " <==" <> (if useTls then "WSS" else "WS") <> "==> "
<> serverHost <> ":" <> show serverPort <> serverHost <> ":" <> show serverPort
@ -182,12 +191,13 @@ tcpConnection TunnelSettings{..} app = onError $ do
httpProxyConnection :: (HostName, PortNumber) -> TunnelSettings -> (Connection -> IO (Either Error ())) -> IO (Either Error ()) httpProxyConnection :: TunnelSettings -> (Connection -> IO (Either Error ())) -> IO (Either Error ())
httpProxyConnection endPoint@(host, port) TunnelSettings{..} app = onError $ do httpProxyConnection TunnelSettings{..} app = onError $ do
debug $ "Oppening tcp connection to proxy " <> toStr endPoint let settings = fromJust proxySetting
debug $ "Oppening tcp connection to proxy " <> show settings
ret <- rrunTCPClient (N.clientSettingsTCP (fromIntegral port) (fromString host)) $ \conn -> do ret <- rrunTCPClient (N.clientSettingsTCP (fromIntegral (port settings)) (BC.pack $ host settings)) $ \conn -> do
_ <- sendConnectRequest conn _ <- sendConnectRequest settings conn
responseM <- timeout (1000000 * 10) $ readConnectResponse mempty conn responseM <- timeout (1000000 * 10) $ readConnectResponse mempty conn
let response = fromMaybe "No response of the proxy after 10s" responseM let response = fromMaybe "No response of the proxy after 10s" responseM
@ -195,12 +205,15 @@ httpProxyConnection endPoint@(host, port) TunnelSettings{..} app = onError $ do
then app conn then app conn
else return . Left . ProxyForwardError $ BC.unpack response else return . Left . ProxyForwardError $ BC.unpack response
debug $ "Closing tcp connection to proxy " <> fromString host <> ":" <> show (fromIntegral port :: Int) debug $ "Closing tcp connection to proxy " <> show settings
return ret return ret
where where
sendConnectRequest h = write h $ "CONNECT " <> fromString serverHost <> ":" <> fromString (show serverPort) <> " HTTP/1.0\r\n" credentialsToHeader (user, password) = "Proxy-Authorization: Basic " <> B64.encode (user <> ":" <> password) <> "\r\n"
<> "Host: " <> fromString serverHost <> ":" <> fromString (show serverPort) <> "\r\n\r\n" sendConnectRequest settings h = write h $ "CONNECT " <> fromString serverHost <> ":" <> fromString (show serverPort) <> " HTTP/1.0\r\n"
<> "Host: " <> fromString serverHost <> ":" <> fromString (show serverPort) <> "\r\n"
<> maybe mempty credentialsToHeader (credentials settings)
<> "\r\n"
readConnectResponse buff conn = do readConnectResponse buff conn = do
response <- fromJust <$> read conn response <- fromJust <$> read conn
@ -219,7 +232,7 @@ httpProxyConnection endPoint@(host, port) TunnelSettings{..} app = onError $ do
-- --
runClient :: TunnelSettings -> IO () runClient :: TunnelSettings -> IO ()
runClient cfg@TunnelSettings{..} = do runClient cfg@TunnelSettings{..} = do
let withEndPoint = if isJust proxySetting then httpProxyConnection (fromJust proxySetting) cfg else tcpConnection cfg let withEndPoint = if isJust proxySetting then httpProxyConnection cfg else tcpConnection cfg
let doTlsIf tlsNeeded app = if tlsNeeded then tlsClientP cfg app else app let doTlsIf tlsNeeded app = if tlsNeeded then tlsClientP cfg app else app
let runTunnelClient = tunnelingClientP cfg let runTunnelClient = tunnelingClientP cfg
let withTunnel app = withEndPoint (doTlsIf useTls . runTunnelClient $ app) let withTunnel app = withEndPoint (doTlsIf useTls . runTunnelClient $ app)

1
wstunnel.cabal
View file

@ -27,6 +27,7 @@ library
, network-conduit-tls , network-conduit-tls
, connection , connection
, hslogger , hslogger
, base64-bytestring >= 1.0
default-language: Haskell2010 default-language: Haskell2010