|
Packit |
fc2124 |
{-# LANGUAGE DeriveDataTypeable #-}
|
|
Packit |
fc2124 |
-- |
|
|
Packit |
fc2124 |
-- Module : Network.Socks5.Wire
|
|
Packit |
fc2124 |
-- License : BSD-style
|
|
Packit |
fc2124 |
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
|
Packit |
fc2124 |
-- Stability : experimental
|
|
Packit |
fc2124 |
-- Portability : unknown
|
|
Packit |
fc2124 |
module Network.Socks5.Wire
|
|
Packit |
fc2124 |
( SocksHello(..)
|
|
Packit |
fc2124 |
, SocksHelloResponse(..)
|
|
Packit |
fc2124 |
, SocksRequest(..)
|
|
Packit |
fc2124 |
, SocksResponse(..)
|
|
Packit |
fc2124 |
) where
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
import Control.Applicative
|
|
Packit |
fc2124 |
import Control.Monad
|
|
Packit |
fc2124 |
import qualified Data.ByteString as B
|
|
Packit |
fc2124 |
import Data.Serialize
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
import Network.Socket (PortNumber)
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
import Network.Socks5.Types
|
|
Packit |
fc2124 |
import Network.Socks5.Parse as P (anyByte, take)
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
-- | Initial message sent by client with the list of authentification methods supported
|
|
Packit |
fc2124 |
data SocksHello = SocksHello { getSocksHelloMethods :: [SocksMethod] }
|
|
Packit |
fc2124 |
deriving (Show,Eq)
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
-- | Initial message send by server in return from Hello, with the
|
|
Packit |
fc2124 |
-- server chosen method of authentication
|
|
Packit |
fc2124 |
data SocksHelloResponse = SocksHelloResponse { getSocksHelloResponseMethod :: SocksMethod }
|
|
Packit |
fc2124 |
deriving (Show,Eq)
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
-- | Define a SOCKS requests
|
|
Packit |
fc2124 |
data SocksRequest = SocksRequest
|
|
Packit |
fc2124 |
{ requestCommand :: SocksCommand
|
|
Packit |
fc2124 |
, requestDstAddr :: SocksHostAddress
|
|
Packit |
fc2124 |
, requestDstPort :: PortNumber
|
|
Packit |
fc2124 |
} deriving (Show,Eq)
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
-- | Define a SOCKS response
|
|
Packit |
fc2124 |
data SocksResponse = SocksResponse
|
|
Packit |
fc2124 |
{ responseReply :: SocksReply
|
|
Packit |
fc2124 |
, responseBindAddr :: SocksHostAddress
|
|
Packit |
fc2124 |
, responseBindPort :: PortNumber
|
|
Packit |
fc2124 |
} deriving (Show,Eq)
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
getAddr 1 = SocksAddrIPV4 <$> getWord32host
|
|
Packit |
fc2124 |
getAddr 3 = SocksAddrDomainName <$> (getWord8 >>= getByteString . fromIntegral)
|
|
Packit |
fc2124 |
getAddr 4 = SocksAddrIPV6 <$> (liftM4 (,,,) getWord32host getWord32host getWord32host getWord32host)
|
|
Packit |
fc2124 |
getAddr n = error ("cannot get unknown socket address type: " ++ show n)
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
putAddr (SocksAddrIPV4 h) = putWord8 1 >> putWord32host h
|
|
Packit |
fc2124 |
putAddr (SocksAddrDomainName b) = putWord8 3 >> putWord8 (fromIntegral $ B.length b) >> putByteString b
|
|
Packit |
fc2124 |
putAddr (SocksAddrIPV6 (a,b,c,d)) = putWord8 4 >> mapM_ putWord32host [a,b,c,d]
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
getSocksRequest 5 = do
|
|
Packit |
fc2124 |
cmd <- toEnum . fromIntegral <$> getWord8
|
|
Packit |
fc2124 |
_ <- getWord8
|
|
Packit |
fc2124 |
addr <- getWord8 >>= getAddr
|
|
Packit |
fc2124 |
port <- fromIntegral <$> getWord16be
|
|
Packit |
fc2124 |
return $ SocksRequest cmd addr port
|
|
Packit |
fc2124 |
getSocksRequest v =
|
|
Packit |
fc2124 |
error ("unsupported version of the protocol " ++ show v)
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
getSocksResponse 5 = do
|
|
Packit |
fc2124 |
reply <- toEnum . fromIntegral <$> getWord8
|
|
Packit |
fc2124 |
_ <- getWord8
|
|
Packit |
fc2124 |
addr <- getWord8 >>= getAddr
|
|
Packit |
fc2124 |
port <- fromIntegral <$> getWord16be
|
|
Packit |
fc2124 |
return $ SocksResponse reply addr port
|
|
Packit |
fc2124 |
getSocksResponse v =
|
|
Packit |
fc2124 |
error ("unsupported version of the protocol " ++ show v)
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
instance Serialize SocksHello where
|
|
Packit |
fc2124 |
put (SocksHello ms) = do
|
|
Packit |
fc2124 |
putWord8 5
|
|
Packit |
fc2124 |
putWord8 $ fromIntegral $ length ms
|
|
Packit |
fc2124 |
mapM_ (putWord8 . fromIntegral . fromEnum) ms
|
|
Packit |
fc2124 |
get = do
|
|
Packit |
fc2124 |
v <- getWord8
|
|
Packit |
fc2124 |
case v of
|
|
Packit |
fc2124 |
5 -> getWord8 >>= flip replicateM (toEnum . fromIntegral <$> getWord8) . fromIntegral >>= return . SocksHello
|
|
Packit |
fc2124 |
_ -> error "unsupported sock hello version"
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
instance Serialize SocksHelloResponse where
|
|
Packit |
fc2124 |
put (SocksHelloResponse m) = putWord8 5 >> putWord8 (fromIntegral $ fromEnum $ m)
|
|
Packit |
fc2124 |
get = do
|
|
Packit |
fc2124 |
v <- getWord8
|
|
Packit |
fc2124 |
case v of
|
|
Packit |
fc2124 |
5 -> SocksHelloResponse . toEnum . fromIntegral <$> getWord8
|
|
Packit |
fc2124 |
_ -> error "unsupported sock hello response version"
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
instance Serialize SocksRequest where
|
|
Packit |
fc2124 |
put req = do
|
|
Packit |
fc2124 |
putWord8 5
|
|
Packit |
fc2124 |
putWord8 $ fromIntegral $ fromEnum $ requestCommand req
|
|
Packit |
fc2124 |
putWord8 0
|
|
Packit |
fc2124 |
putAddr $ requestDstAddr req
|
|
Packit |
fc2124 |
putWord16be $ fromIntegral $ requestDstPort req
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
get = getWord8 >>= getSocksRequest
|
|
Packit |
fc2124 |
|
|
Packit |
fc2124 |
instance Serialize SocksResponse where
|
|
Packit |
fc2124 |
put req = do
|
|
Packit |
fc2124 |
putWord8 5
|
|
Packit |
fc2124 |
putWord8 $ fromIntegral $ fromEnum $ responseReply req
|
|
Packit |
fc2124 |
putWord8 0
|
|
Packit |
fc2124 |
putAddr $ responseBindAddr req
|
|
Packit |
fc2124 |
putWord16be $ fromIntegral $ responseBindPort req
|
|
Packit |
fc2124 |
get = getWord8 >>= getSocksResponse
|