Socks5 done \O/

app/Main.hs

@@ -146,15 +146,15 @@ main = do
                                       , useSocks = False
                                       }
   else if not $ null (dynamicToRemote cfg)
-    then let (TunnelInfo lHost lPort _ _) = parseTunnelInfo $ (localToRemote cfg) ++ ":127.0.0.1:0"
+    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
                                       }

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

src/Socks5.hs

@@ -1,13 +1,13 @@
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE DeriveAnyClass            #-}
 {-# LANGUAGE DuplicateRecordFields     #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts          #-}
 {-# LANGUAGE NoImplicitPrelude         #-}
 {-# LANGUAGE OverloadedStrings         #-}
 {-# LANGUAGE RankNTypes                #-}
 {-# LANGUAGE RecordWildCards           #-}
 {-# LANGUAGE ScopedTypeVariables       #-}
 {-# LANGUAGE StrictData                #-}
-{-# LANGUAGE ExistentialQuantification            #-}
 
 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
+    let host = BC8.pack serverAddr
-    putWord16be $ fromIntegral serverPort
+    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
+data ServerSettings = ServerSettings
   { listenOn :: PortNumber
   , bindOn   :: HostName
-  , onAuthentification :: (MonadIO m, MonadError IOException m) => RequestAuth -> m ResponseAuth
+  -- , onAuthentification :: (MonadIO m, MonadError IOException m) => RequestAuth -> m ResponseAuth
-  , onRequest          :: (MonadIO m, MonadError IOException m) => Request -> m Response
+  -- , onRequest          :: (MonadIO m, MonadError IOException m) => Request -> m Response
   }
 
 

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 cfg' app = withEndPoint (doTlsIf useTls . tunnelingClientP cfg' $ app)
-  let withTunnel app = withEndPoint (doTlsIf useTls . runTunnelClient $ app)
 
-  let app localH = do
+  let app cfg' localH = do
-        ret <- withTunnel $ \remoteH -> do
+        ret <- withTunnel cfg' $ \remoteH -> do
-          info $ "CREATE tunnel :: " <> show cfg
+          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
+        UDP -> runUDPServer (localBind, localPort) (app cfg)
-        TCP -> runTCPServer (localBind, localPort) app
+        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 -> TunnelSettings -> (TunnelSettings -> N.AppData -> IO()) -> IO ()
-runSocks5Server Socks5.ServerSettings{..} inner = do
+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
+    request <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.Request
-    traceShowM request
     ret <- onRequest request
     N.appWrite cnx (toStrict . encode $ ret)
-    inner cnx
 
+    let cfg' = cfg { destHost = Socks5.addr request, destPort = Socks5.port request }
 
-
+    inner cfg' cnx
-    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
     return ()
 
   return ()
 
   where
-    auth authReq = do
+    onAuthentification :: (MonadIO m, MonadError IOException m) => Socks5.RequestAuth -> m Socks5.ResponseAuth
-      traceShowM authReq
+    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