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

Socks5 done \O/

Browse source
This commit is contained in:
Erèbe 2016-08-24 22:49:33 +02:00
parent ff6c4164b8
commit e9b5137afb
4 changed files with 72 additions and 58 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
app/Main.hs
View file

@ -145,16 +145,16 @@ main = do
, proxySetting = parseProxyInfo (proxy cfg)
, useSocks = False
}
else if not $ null (dynamicToRemote cfg)
then let (TunnelInfo lHost lPort _ _) = parseTunnelInfo $ (localToRemote cfg) ++ ":127.0.0.1:0"
else if not $ null (dynamicToRemote cfg)
then let (TunnelInfo lHost lPort _ _) = parseTunnelInfo $ (dynamicToRemote cfg) ++ ":127.0.0.1:1212"
in runClient TunnelSettings { localBind = lHost
, Tunnel.localPort = fromIntegral lPort
, serverHost = Main.host serverInfo
, serverPort = fromIntegral $ Main.port serverInfo
, destHost = ""
, destPort = fromIntegral 0
, destPort = 0
, Tunnel.useTls = Main.useTls serverInfo
, protocol = if udpMode cfg then UDP else TCP
, protocol = SOCKS5
, proxySetting = parseProxyInfo (proxy cfg)
, useSocks = True
}

2
src/Protocols.hs
View file

@ -29,7 +29,7 @@ deriving instance Hashable PortNumber
deriving instance Generic N.SockAddr
deriving instance Hashable N.SockAddr
data Protocol = UDP | TCP deriving (Show, Read)
data Protocol = UDP | TCP | SOCKS5 deriving (Show, Read, Eq)
data UdpAppData = UdpAppData
{ appAddr :: N.SockAddr

45
src/Socks5.hs
View file

@ -1,13 +1,13 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}
module Socks5 where
@ -155,7 +155,7 @@ toHex = foldr showHex "" . unpack
data Response = Response
{ version :: Int
, returnCode :: RetCode
, serverAddr :: HostAddress
, serverAddr :: HostName
, serverPort :: PortNumber
} deriving (Show)
@ -182,8 +182,10 @@ instance Binary Response where
put returnCode
putWord8 0x00 -- Reserved
putWord8 0x03 -- DOMAINNAME
putWord32be serverAddr
putWord16be $ fromIntegral serverPort
let host = BC8.pack serverAddr
putWord8 (fromIntegral . length $ host)
traverse_ put host
putWord16be (fromIntegral serverPort)
get = do
@ -193,23 +195,26 @@ instance Binary Response where
getWord8 -- RESERVED
opCode <- fromIntegral <$> getWord8 -- Type
guard(opCode == 0x03)
addr <- getWord32be
length <- fromIntegral <$> getWord8
host <- either (const T.empty) id . E.decodeUtf8' <$> replicateM length getWord8
guard (not $ null host)
port <- getWord16be
return Response
{ version = version
, returnCode = ret
, serverAddr = addr
, serverAddr = unpack host
, serverPort = fromIntegral port
}
data ServerSettings m = ServerSettings
{ listenOn :: PortNumber
, bindOn :: HostName
, onAuthentification :: (MonadIO m, MonadError IOException m) => RequestAuth -> m ResponseAuth
, onRequest :: (MonadIO m, MonadError IOException m) => Request -> m Response
data ServerSettings = ServerSettings
{ listenOn :: PortNumber
, bindOn :: HostName
-- , onAuthentification :: (MonadIO m, MonadError IOException m) => RequestAuth -> m ResponseAuth
-- , onRequest :: (MonadIO m, MonadError IOException m) => Request -> m Response
}

75
src/Tunnel.hs
View file

@ -236,21 +236,21 @@ runClient :: TunnelSettings -> IO ()
runClient cfg@TunnelSettings{..} = do
let withEndPoint = if isJust proxySetting then httpProxyConnection cfg else tcpConnection cfg
let doTlsIf tlsNeeded app = if tlsNeeded then tlsClientP cfg app else app
let runTunnelClient = tunnelingClientP cfg
let withTunnel app = withEndPoint (doTlsIf useTls . runTunnelClient $ app)
let withTunnel cfg' app = withEndPoint (doTlsIf useTls . tunnelingClientP cfg' $ app)
let app localH = do
ret <- withTunnel $ \remoteH -> do
info $ "CREATE tunnel :: " <> show cfg
let app cfg' localH = do
ret <- withTunnel cfg' $ \remoteH -> do
info $ "CREATE tunnel :: " <> show cfg'
ret <- remoteH <==> toConnection localH
info $ "CLOSE tunnel :: " <> show cfg
info $ "CLOSE tunnel :: " <> show cfg'
return ret
handleError ret
case protocol of
UDP -> runUDPServer (localBind, localPort) app
TCP -> runTCPServer (localBind, localPort) app
UDP -> runUDPServer (localBind, localPort) (app cfg)
TCP -> runTCPServer (localBind, localPort) (app cfg)
SOCKS5 -> runSocks5Server (Socks5.ServerSettings localPort localBind) cfg app
handleError :: Either Error () -> IO ()
handleError (Right ()) = return ()
@ -382,7 +382,7 @@ serverCertificate = "-----BEGIN CERTIFICATE-----\n" <>
toPath :: TunnelSettings -> String
toPath TunnelSettings{..} = "/" <> toLower (show protocol) <> "/" <> destHost <> "/" <> show destPort
toPath TunnelSettings{..} = "/" <> toLower (show $ if protocol == SOCKS5 then TCP else protocol) <> "/" <> destHost <> "/" <> show destPort
fromPath :: ByteString -> Maybe (Protocol, ByteString, Int)
fromPath path = let rets = BC.split '/' . BC.drop 1 $ path
@ -394,41 +394,50 @@ fromPath path = let rets = BC.split '/' . BC.drop 1 $ path
return (proto, h, prt')
runSocks5Server :: Socks5.ServerSettings IO -> (N.AppData -> IO()) -> IO ()
runSocks5Server Socks5.ServerSettings{..} inner = do
runSocks5Server :: Socks5.ServerSettings -> TunnelSettings -> (TunnelSettings -> N.AppData -> IO()) -> IO ()
runSocks5Server Socks5.ServerSettings{..} cfg inner = do
N.runTCPServer (N.serverSettingsTCP (fromIntegral listenOn) (fromString bindOn)) $ \cnx -> do
responseAuth <- join $ onAuthentification . decode . fromStrict <$> N.appRead cnx :: IO Socks5.ResponseAuth
N.appWrite cnx (toStrict $ encode responseAuth)
request <- decode .fromStrict <$> N.appRead cnx :: IO Socks5.Request
traceShowM request
request <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.Request
ret <- onRequest request
N.appWrite cnx (toStrict . encode $ ret)
inner cnx
let cfg' = cfg { destHost = Socks5.addr request, destPort = Socks5.port request }
return ()
return ()
main :: IO ()
main = do
runSocks5Server (Socks5.ServerSettings 8888 "127.0.0.1" auth req) $ \cnx -> do
putStrLn "tota"
da <- N.appRead cnx
putStrLn "toot"
print da
inner cfg' cnx
return ()
return ()
where
auth authReq = do
traceShowM authReq
onAuthentification :: (MonadIO m, MonadError IOException m) => Socks5.RequestAuth -> m Socks5.ResponseAuth
onAuthentification authReq = do
return $ Socks5.ResponseAuth (fromIntegral Socks5.socksVersion) Socks5.NoAuth
req request= do
onRequest :: (MonadIO m, MonadError IOException m) => Socks5.Request -> m Socks5.Response
onRequest request = do
traceShowM request
return $ Socks5.Response (fromIntegral Socks5.socksVersion) Socks5.SUCCEEDED 0x00000000 0x0000
return $ Socks5.Response (fromIntegral Socks5.socksVersion) Socks5.SUCCEEDED (Socks5.addr request) (Socks5.port request)
-- main :: IO ()
-- main = do
-- runSocks5Server (Socks5.ServerSettings 8888 "127.0.0.1") $ \cnx -> do
-- putStrLn "tota"
-- da <- N.appRead cnx
-- putStrLn "toot"
-- print da
-- return ()
-- return ()
-- where
-- auth authReq = do
-- traceShowM authReq
-- return $ Socks5.ResponseAuth (fromIntegral Socks5.socksVersion) Socks5.NoAuth
-- req request= do
-- traceShowM request
-- return $ Socks5.Response (fromIntegral Socks5.socksVersion) Socks5.SUCCEEDED 0x00000000 0x0000