Add support for socks5 ipv4

Former-commit-id: 93f444c7554b05a247beb3cef3f9e9e67dbdf04e
Former-commit-id: 9f48bc09d61b4b0723553ad7635382570dd8568a [formerly 726f62c02f451aa3d3bce2d43f82fb89ac57df6f] [formerly ecc452136b37f5387b8328f0a067ef14d3ae20ea [formerly a198098e9a56b46b7e699f43287c479bc80c7dc1 [formerly a198098e9a56b46b7e699f43287c479bc80c7dc1 [formerly a198098e9a56b46b7e699f43287c479bc80c7dc1 [formerly c42827e3842267f52c65419a91c91672294d8e60]]]]]
Former-commit-id: 7302ac40185825650c63dbbbb7746fa628ec7aea [formerly 2f2dbaf7687a712ecf7efe02c937c667bccce360]
Former-commit-id: dca93f1ee79fbf5a7243fc664c3e71b9ffeedfdd
Former-commit-id: 01939d01a83faea0e336403371fdcfbcf668694c
Former-commit-id: d3f7507bdee393f93c79fba6aac49fa68d6788cc
Former-commit-id: 7715e5d09783415843b188584ff4f339171bb266 [formerly c2fe751fae043fca4df6a3bbe0fcf790feaa3115]
Former-commit-id: 57ea26c8efe39e0f025b806af4607edd1bc928f4

src/Protocols.hs

@@ -133,7 +133,7 @@ runSocks5Server socksSettings@Socks5.ServerSettings{..} cfg inner = do
     -- Get the request and update dynamically the tunnel config
     request <- decode . fromStrict <$> N.appRead cnx :: IO Socks5.Request
     debug $ "Socks5 forward request " <> show request
-    let responseRequest =  encode $ Socks5.Response (fromIntegral Socks5.socksVersion) Socks5.SUCCEEDED (Socks5.addr request) (Socks5.port request)
+    let responseRequest =  encode $ Socks5.Response (fromIntegral Socks5.socksVersion) Socks5.SUCCEEDED (Socks5.addr request) (Socks5.port request) (Socks5.addrType request)
     let cfg' = cfg { destHost = Socks5.addr request, destPort = Socks5.port request }
     N.appWrite cnx (toStrict responseRequest)
 

src/Socks5.hs

@@ -16,8 +16,9 @@ import qualified Data.ByteString        as BC
 import qualified Data.ByteString.Char8  as BC8
 import           Data.Either
 import qualified Data.Text              as T
+import qualified Data.Text.Read         as T
 import qualified Data.Text.Encoding     as E
-import           Network.Socket         (HostAddress, HostName, PortNumber)
+import           Network.Socket         (HostName, PortNumber)
 import           Numeric                (showHex)
 
 import           Control.Monad.Except   (MonadError)
@@ -34,6 +35,10 @@ data AuthMethod = NoAuth
                 | NotAllowed
                 deriving (Show, Read)
 
+data AddressType = DOMAIN_NAME
+                | IPv4
+                deriving (Show, Read, Eq)
+
 data RequestAuth = RequestAuth
   { version :: Int
   , methods :: Vector AuthMethod
@@ -90,6 +95,7 @@ data Request = Request
   , command :: Command
   , addr    :: HostName
   , port    :: PortNumber
+  , addrType :: AddressType
   } deriving (Show)
 
 data Command = Connect
@@ -113,10 +119,17 @@ instance Binary Request where
     putWord8 (fromIntegral version)
     put command
     putWord8 0x00 -- RESERVED
-    putWord8 0x03 -- DOMAINNAME
+    _ <- if addrType == DOMAIN_NAME 
+    then do 
+      putWord8 0x03
       let host = BC8.pack addr
       putWord8 (fromIntegral . length $ host)
       traverse_ put host
+    else do
+      putWord8 0x01
+      let ipv4 = fst . Data.Either.fromRight (0, mempty) . T.decimal . T.pack <$> splitElem '.' addr
+      traverse_ putWord8 ipv4
+      
     putWord16be (fromIntegral port)
 
 
@@ -147,6 +160,7 @@ instance Binary Request where
       , command = cmd
       , addr = unpack host
       , port = port
+      , addrType = if opCode == 0x03 then DOMAIN_NAME else IPv4
       }
 
 
@@ -159,6 +173,7 @@ data Response = Response
   , returnCode :: RetCode
   , serverAddr :: HostName
   , serverPort :: PortNumber
+  , serverAddrType   :: AddressType
   } deriving (Show)
 
 data RetCode = SUCCEEDED
@@ -183,10 +198,17 @@ instance Binary Response where
     putWord8 socksVersion
     put returnCode
     putWord8 0x00 -- Reserved
-    putWord8 0x03 -- DOMAINNAME
+    _ <- if serverAddrType == DOMAIN_NAME
+    then do
+      putWord8 0x03
       let host = BC8.pack serverAddr
       putWord8 (fromIntegral . length $ host)
       traverse_ put host
+    else do
+      putWord8 0x01
+      let ipv4 = fst . Data.Either.fromRight (0, mempty) . T.decimal . T.pack <$> splitElem '.' serverAddr
+      traverse_ putWord8 ipv4
+
     putWord16be (fromIntegral serverPort)
 
 
@@ -196,11 +218,16 @@ instance Binary Response where
     ret <- toEnum . min maxBound . fromIntegral <$> getWord8
     getWord8 -- RESERVED
     opCode <- fromIntegral <$> getWord8 -- Type
-    guard(opCode == 0x03)
+    guard(opCode == 0x03 || opCode == 0x01)
+    host <- if opCode == 0x03
+            then do
               length <- fromIntegral <$> getWord8
-    host <- fromRight T.empty . E.decodeUtf8' <$> replicateM length getWord8
+              fromRight T.empty . E.decodeUtf8' <$> replicateM length getWord8
+            else do
+              ipv4 <- replicateM 4 getWord8 :: Get [Word8]
+              let ipv4Str = T.intercalate "." $ fmap (tshow . fromEnum) ipv4
+              return ipv4Str
     guard (not $ null host)
-
     port <- getWord16be
 
     return Response
@@ -208,6 +235,7 @@ instance Binary Response where
       , returnCode = ret
       , serverAddr = unpack host
       , serverPort = fromIntegral port
+      , serverAddrType = if opCode == 0x03 then DOMAIN_NAME else IPv4
       }
 
 

test/Spec.hs

@@ -208,7 +208,7 @@ testSocks5Tunneling useTLS = do
   rrunTCPClient (N.clientSettingsTCP (fromIntegral 8081) "localhost") $ \cnx -> do 
     write cnx (toStrict . encode $ Socks5.RequestAuth (fromIntegral Socks5.socksVersion) (fromList [Socks5.NoAuth]))
     _ <- read cnx 
-    write cnx (toStrict . encode $ Socks5.Request (fromIntegral Socks5.socksVersion) Socks5.Connect "localhost" 8082)
+    write cnx (toStrict . encode $ Socks5.Request (fromIntegral Socks5.socksVersion) Socks5.Connect "localhost" 8082 Socks5.DOMAIN_NAME)
     _ <- read cnx 
     write cnx needle