From e9b5137afbd9d86c4d5614bef474a9a7d22582fd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Er=C3=A8be?= Date: Wed, 24 Aug 2016 22:49:33 +0200 Subject: [PATCH] Socks5 done \O/ --- app/Main.hs | 8 +++--- src/Protocols.hs | 2 +- src/Socks5.hs | 45 ++++++++++++++++------------- src/Tunnel.hs | 75 +++++++++++++++++++++++++++--------------------- 4 files changed, 72 insertions(+), 58 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index d09ef4a..77d9660 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 } diff --git a/src/Protocols.hs b/src/Protocols.hs index 9fa9bf6..366201e 100644 --- a/src/Protocols.hs +++ b/src/Protocols.hs @@ -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 diff --git a/src/Socks5.hs b/src/Socks5.hs index 617aefa..196a7a1 100644 --- a/src/Socks5.hs +++ b/src/Socks5.hs @@ -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 } diff --git a/src/Tunnel.hs b/src/Tunnel.hs index 1cea229..4a4acd5 100644 --- a/src/Tunnel.hs +++ b/src/Tunnel.hs @@ -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