1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- |
-- Module : Network.Socks5.Wire
-- License : BSD-style
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
-- Stability : experimental
-- Portability : unknown
module Network.Socks5.Wire
( SocksHello(..)
, SocksHelloResponse(..)
, SocksRequest(..)
, SocksResponse(..)
) where
import Basement.Compat.Base
import Control.Monad
import qualified Data.ByteString as B
import Data.Serialize
import qualified Prelude
import Network.Socket (PortNumber)
import Network.Socks5.Types
-- | Initial message sent by client with the list of authentification methods supported
data SocksHello = SocksHello { getSocksHelloMethods :: [SocksMethod] }
deriving (Show,Eq)
-- | Initial message send by server in return from Hello, with the
-- server chosen method of authentication
data SocksHelloResponse = SocksHelloResponse { getSocksHelloResponseMethod :: SocksMethod }
deriving (Show,Eq)
-- | Define a SOCKS requests
data SocksRequest = SocksRequest
{ requestCommand :: SocksCommand
, requestDstAddr :: SocksHostAddress
, requestDstPort :: PortNumber
} deriving (Show,Eq)
-- | Define a SOCKS response
data SocksResponse = SocksResponse
{ responseReply :: SocksReply
, responseBindAddr :: SocksHostAddress
, responseBindPort :: PortNumber
} deriving (Show,Eq)
getAddr 1 = SocksAddrIPV4 <$> getWord32host
getAddr 3 = SocksAddrDomainName <$> (getLength8 >>= getByteString)
getAddr 4 = SocksAddrIPV6 <$> (liftM4 (,,,) getWord32host getWord32host getWord32host getWord32host)
getAddr n = error ("cannot get unknown socket address type: " <> show n)
putAddr (SocksAddrIPV4 h) = putWord8 1 >> putWord32host h
putAddr (SocksAddrDomainName b) = putWord8 3 >> putLength8 (B.length b) >> putByteString b
putAddr (SocksAddrIPV6 (a,b,c,d)) = putWord8 4 >> mapM_ putWord32host [a,b,c,d]
putEnum8 :: Enum e => e -> Put
putEnum8 = putWord8 . Prelude.fromIntegral . fromEnum
getEnum8 :: Enum e => Get e
getEnum8 = toEnum . Prelude.fromIntegral <$> getWord8
putLength8 :: Int -> Put
putLength8 = putWord8 . Prelude.fromIntegral
getLength8 :: Get Int
getLength8 = Prelude.fromIntegral <$> getWord8
getSocksRequest 5 = do
cmd <- getEnum8
_ <- getWord8
addr <- getWord8 >>= getAddr
port <- Prelude.fromIntegral <$> getWord16be
return $ SocksRequest cmd addr port
getSocksRequest v =
error ("unsupported version of the protocol " <> show v)
getSocksResponse 5 = do
reply <- getEnum8
_ <- getWord8
addr <- getWord8 >>= getAddr
port <- Prelude.fromIntegral <$> getWord16be
return $ SocksResponse reply addr port
getSocksResponse v =
error ("unsupported version of the protocol " <> show v)
instance Serialize SocksHello where
put (SocksHello ms) = do
putWord8 5
putLength8 (Prelude.length ms)
mapM_ putEnum8 ms
get = do
v <- getWord8
case v of
5 -> SocksHello <$> (getLength8 >>= flip replicateM getEnum8)
_ -> error "unsupported sock hello version"
instance Serialize SocksHelloResponse where
put (SocksHelloResponse m) = putWord8 5 >> putEnum8 m
get = do
v <- getWord8
case v of
5 -> SocksHelloResponse <$> getEnum8
_ -> error "unsupported sock hello response version"
instance Serialize SocksRequest where
put req = do
putWord8 5
putEnum8 $ requestCommand req
putWord8 0
putAddr $ requestDstAddr req
putWord16be $ Prelude.fromIntegral $ requestDstPort req
get = getWord8 >>= getSocksRequest
instance Serialize SocksResponse where
put req = do
putWord8 5
putEnum8 $ responseReply req
putWord8 0
putAddr $ responseBindAddr req
putWord16be $ Prelude.fromIntegral $ responseBindPort req
get = getWord8 >>= getSocksResponse
|
