socks-0.5.4/0000755000000000000000000000000012232422465011032 5ustar0000000000000000socks-0.5.4/LICENSE0000644000000000000000000000273112232422465012042 0ustar0000000000000000Copyright (c) 2010-2011 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. socks-0.5.4/Example.hs0000644000000000000000000000420112232422465012756 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Network.Socks5 import Network.Socket hiding (recv) import Network.Socket.ByteString import Network.BSD import Network import Data.ByteString.Char8 () import qualified Data.ByteString.Char8 as BC import System.IO (hClose, hFlush) import System.Environment (getArgs) main = do args <- getArgs let serverName = "localhost" let serverPort = 1080 let destinationName = case args of [] -> "www.google.com" (x:_) -> x -- socks server is expected to be running on localhost port 1080 he <- getHostByName serverName let socksServerAddr = SockAddrInet serverPort (head $ hostAddresses he) example1 socksServerAddr destinationName example2 socksServerAddr destinationName example3 serverName serverPort destinationName 80 where -- connect to @destName on port 80 through the socks server -- www.google.com get resolve on the client here and then the sockaddr is -- passed to socksConnectAddr example1 socksServerAddr destName = do socket <- socket AF_INET Stream defaultProtocol gHost <- getHostByName destName let destinationAddr = SockAddrInet 80 (head $ hostAddresses gHost) socksConnectAddr socket socksServerAddr destinationAddr sendAll socket "GET / HTTP/1.0\r\n\r\n" recv socket 4096 >>= putStrLn . show sClose socket -- connect to @destName on port 80 through the socks server -- the server is doing the resolution itself example2 socksServerAddr destName = do socket <- socket AF_INET Stream defaultProtocol socksConnectName socket socksServerAddr destName 80 sendAll socket "GET / HTTP/1.0\r\n\r\n" recv socket 4096 >>= putStrLn . show sClose socket example3 sname sport dname dport = do handle <- socksConnectTo sname (PortNumber sport) dname (PortNumber dport) BC.hPut handle "GET / HTTP/1.0\r\n\r\n" hFlush handle BC.hGet handle 1024 >>= putStrLn . show hClose handle socks-0.5.4/socks.cabal0000644000000000000000000000222612232422465013142 0ustar0000000000000000Name: socks Version: 0.5.4 Description: Socks proxy (version 5) implementation. License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Synopsis: Socks proxy (version 5) implementation. Build-Type: Simple Category: Network stability: experimental Cabal-Version: >=1.6 Homepage: http://github.com/vincenthz/hs-socks data-files: README.md, Example.hs Library Build-Depends: base >= 3 && < 5 , bytestring , cereal >= 0.3.1 , network >= 2.3 Exposed-modules: Network.Socks5 Network.Socks5.Lowlevel Network.Socks5.Types Other-modules: Network.Socks5.Wire Network.Socks5.Conf Network.Socks5.Command ghc-options: -Wall -fno-warn-missing-signatures -fwarn-tabs source-repository head type: git location: git://github.com/vincenthz/hs-socks socks-0.5.4/README.md0000644000000000000000000000120212232422465012304 0ustar0000000000000000Socks ===== Haskell library implementation of the SOCKS 5 protocol. TODO ---- * more socks authentification methods: only no authentification is supported for now. * support of socks' bind for server to client connection (like FTP). * add socks4a and socks4 support. Usage ----- See Example.hs for really simple and straighforward example. The main api is only 2 calls: * socksConnectAddr which connect to a SockAddr (SockAddrInet or SockAddrInet6). The name resolution is left on client side. * socksConnectName which connect to a fully qualified domain name "www.example.com". The proxy server will do the name resolution. socks-0.5.4/Setup.hs0000644000000000000000000000005612232422465012467 0ustar0000000000000000import Distribution.Simple main = defaultMain socks-0.5.4/Network/0000755000000000000000000000000012232422465012463 5ustar0000000000000000socks-0.5.4/Network/Socks5.hs0000644000000000000000000001232112232422465014165 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : Network.Socks5 -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- This is an implementation of SOCKS5 as defined in RFC 1928 -- -- In Wikipedia's words: -- -- SOCKet Secure (SOCKS) is an Internet protocol that routes network packets -- between a client and server through a proxy server. SOCKS5 additionally -- provides authentication so only authorized users may access a server. -- Practically, a SOCKS server will proxy TCP connections to an arbitrary IP -- address as well as providing a means for UDP packets to be forwarded. -- -- BIND and UDP ASSOCIATE messages are not implemented. -- However main usage of SOCKS is covered in this implementation. -- module Network.Socks5 ( -- * Types SocksAddress(..) , SocksHostAddress(..) , SocksReply(..) , SocksError(..) -- * Configuration , module Network.Socks5.Conf -- * Methods , socksConnectWithSocket , socksConnect -- * Variants , socksConnectAddr , socksConnectName , socksConnectTo , socksConnectWith ) where import Control.Monad import Control.Exception import qualified Data.ByteString.Char8 as BC import Network.Socket ( sClose, Socket, SocketType(..), SockAddr(..), Family(..) , socket, socketToHandle, connect) import Network.BSD import Network (PortID(..)) import qualified Network.Socks5.Command as Cmd import Network.Socks5.Conf import Network.Socks5.Types import Network.Socks5.Lowlevel import System.IO -- | connect a user specified new socket to the socks server, -- and connect the stream on the server side to the 'SockAddress' specified. -- -- |socket|-----sockServer----->|server|----destAddr----->|destination| -- socksConnectWithSocket :: Socket -- ^ Socket to use. -> SocksConf -- ^ SOCKS configuration for the server. -> SocksAddress -- ^ SOCKS Address to connect to. -> IO (SocksHostAddress, PortNumber) socksConnectWithSocket sock serverConf destAddr = do serverAddr <- resolveToSockAddr (socksServer serverConf) connect sock serverAddr r <- Cmd.establish sock [SocksMethodNone] when (r == SocksMethodNotAcceptable) $ error "cannot connect with no socks method of authentication" Cmd.rpc_ sock (Connect destAddr) -- | connect a new socket to a socks server and connect the stream on the -- server side to the 'SocksAddress' specified. socksConnect :: SocksConf -- ^ SOCKS configuration for the server. -> SocksAddress -- ^ SOCKS Address to connect to. -> IO (Socket, (SocksHostAddress, PortNumber)) socksConnect serverConf destAddr = getProtocolNumber "tcp" >>= \proto -> bracketOnError (socket AF_INET Stream proto) sClose $ \sock -> do ret <- socksConnectWithSocket sock serverConf destAddr return (sock, ret) -- | connect a new socket to the socks server, and connect the stream on the server side -- to the sockaddr specified. the sockaddr need to be SockAddrInet or SockAddrInet6. -- -- a unix sockaddr will raises an exception. -- -- |socket|-----sockServer----->|server|----destAddr----->|destination| {-# DEPRECATED socksConnectAddr "use socksConnectWithSocket" #-} socksConnectAddr :: Socket -> SockAddr -> SockAddr -> IO () socksConnectAddr sock sockserver destaddr = socksConnectWithSocket sock (defaultSocksConfFromSockAddr sockserver) (socksServer $ defaultSocksConfFromSockAddr destaddr) >> return () -- | connect a new socket to the socks server, and connect the stream to a FQDN -- resolved on the server side. socksConnectName :: Socket -> SockAddr -> String -> PortNumber -> IO () socksConnectName sock sockserver destination port = do socksConnectWithSocket sock (defaultSocksConfFromSockAddr sockserver) (SocksAddress (SocksAddrDomainName $ BC.pack destination) port) >> return () -- | create a new socket and connect in to a destination through the specified -- SOCKS configuration. socksConnectWith :: SocksConf -- ^ SOCKS configuration -> String -- ^ destination hostname -> PortID -- ^ destination port -> IO Socket socksConnectWith socksConf desthost destport = do dport <- resolvePortID destport proto <- getProtocolNumber "tcp" bracketOnError (socket AF_INET Stream proto) sClose $ \sock -> do sockaddr <- resolveToSockAddr (socksServer socksConf) socksConnectName sock sockaddr desthost dport return sock -- | similar to Network connectTo but use a socks proxy with default socks configuration. socksConnectTo :: String -> PortID -> String -> PortID -> IO Handle socksConnectTo sockshost socksport desthost destport = do sport <- resolvePortID socksport let socksConf = defaultSocksConf sockshost sport sock <- socksConnectWith socksConf desthost destport socketToHandle sock ReadWriteMode resolvePortID (Service serv) = getServicePortNumber serv resolvePortID (PortNumber n) = return n resolvePortID _ = error "unsupported unix PortID" socks-0.5.4/Network/Socks5/0000755000000000000000000000000012232422465013632 5ustar0000000000000000socks-0.5.4/Network/Socks5/Command.hs0000644000000000000000000001007112232422465015543 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE CPP #-} -- | -- Module : Network.Socks5.Command -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Network.Socks5.Command ( establish , Connect(..) , Command(..) , connectIPV4 , connectIPV6 , connectDomainName -- * lowlevel interface , rpc , rpc_ , sendSerialized , waitSerialized ) where import Control.Applicative import Control.Exception import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.Serialize import Network.Socket (Socket, PortNumber, HostAddress, HostAddress6) import Network.Socket.ByteString import Network.Socks5.Types import Network.Socks5.Wire establish :: Socket -> [SocksMethod] -> IO SocksMethod establish socket methods = do sendAll socket (encode $ SocksHello methods) getSocksHelloResponseMethod <$> runGetDone get (recv socket 4096) newtype Connect = Connect SocksAddress deriving (Show,Eq,Ord) class Command a where toRequest :: a -> SocksRequest fromRequest :: SocksRequest -> Maybe a instance Command SocksRequest where toRequest = id fromRequest = Just instance Command Connect where toRequest (Connect (SocksAddress ha port)) = SocksRequest { requestCommand = SocksCommandConnect , requestDstAddr = ha , requestDstPort = fromIntegral port } fromRequest req | requestCommand req /= SocksCommandConnect = Nothing | otherwise = Just $ Connect $ SocksAddress (requestDstAddr req) (requestDstPort req) connectIPV4 :: Socket -> HostAddress -> PortNumber -> IO (HostAddress, PortNumber) connectIPV4 socket hostaddr port = onReply <$> rpc_ socket (Connect $ SocksAddress (SocksAddrIPV4 hostaddr) port) where onReply (SocksAddrIPV4 h, p) = (h, p) onReply _ = error "ipv4 requested, got something different" connectIPV6 :: Socket -> HostAddress6 -> PortNumber -> IO (HostAddress6, PortNumber) connectIPV6 socket hostaddr6 port = onReply <$> rpc_ socket (Connect $ SocksAddress (SocksAddrIPV6 hostaddr6) port) where onReply (SocksAddrIPV6 h, p) = (h, p) onReply _ = error "ipv6 requested, got something different" -- TODO: FQDN should only be ascii, maybe putting a "fqdn" data type -- in front to make sure and make the BC.pack safe. connectDomainName :: Socket -> String -> PortNumber -> IO (SocksHostAddress, PortNumber) connectDomainName socket fqdn port = rpc_ socket $ Connect $ SocksAddress (SocksAddrDomainName $ BC.pack fqdn) port sendSerialized :: Serialize a => Socket -> a -> IO () sendSerialized sock a = sendAll sock $ encode a waitSerialized :: Serialize a => Socket -> IO a waitSerialized sock = runGetDone get (getMore sock) rpc :: Command a => Socket -> a -> IO (Either SocksError (SocksHostAddress, PortNumber)) rpc socket req = do sendSerialized socket (toRequest req) onReply <$> runGetDone get (getMore socket) where onReply res@(responseReply -> reply) = case reply of SocksReplySuccess -> Right (responseBindAddr res, fromIntegral $ responseBindPort res) SocksReplyError e -> Left e rpc_ :: Command a => Socket -> a -> IO (SocksHostAddress, PortNumber) rpc_ socket req = rpc socket req >>= either throwIO return -- this function expect all the data to be consumed. this is fine for intertwined message, -- but might not be a good idea for multi messages from one party. runGetDone :: Serialize a => Get a -> IO ByteString -> IO a runGetDone getter ioget = ioget >>= return . runGetPartial getter >>= r where #if MIN_VERSION_cereal(0,4,0) r (Fail s _) = error s #else r (Fail s) = error s #endif r (Partial cont) = ioget >>= r . cont r (Done a b) | not $ B.null b = error "got too many bytes while receiving data" | otherwise = return a getMore :: Socket -> IO ByteString getMore socket = recv socket 4096 socks-0.5.4/Network/Socks5/Types.hs0000644000000000000000000001342712232422465015301 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Network.Socks5.Types -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown module Network.Socks5.Types ( SocksVersion(..) , SocksCommand(..) , SocksMethod(..) , SocksHostAddress(..) , SocksAddress(..) , SocksReply(..) , SocksVersionNotSupported(..) , SocksError(..) ) where import Data.ByteString (ByteString) import Data.Word import Data.Data import Network.Socket (HostAddress, HostAddress6, PortNumber) import Control.Exception import qualified Data.ByteString.Char8 as BC import Numeric (showHex) import Data.List (intersperse) -- | Socks Version data SocksVersion = SocksVer5 deriving (Show,Eq,Ord) -- | Command that can be send and receive on the SOCKS protocol data SocksCommand = SocksCommandConnect | SocksCommandBind | SocksCommandUdpAssociate | SocksCommandOther !Word8 deriving (Show,Eq,Ord) -- | Authentication methods available on the SOCKS protocol. -- -- Only SocksMethodNone is effectively implemented, but -- other value are enumerated for completeness. data SocksMethod = SocksMethodNone | SocksMethodGSSAPI | SocksMethodUsernamePassword | SocksMethodOther !Word8 | SocksMethodNotAcceptable deriving (Show,Eq,Ord) -- | A Host address on the SOCKS protocol. data SocksHostAddress = SocksAddrIPV4 !HostAddress | SocksAddrDomainName !ByteString | SocksAddrIPV6 !HostAddress6 deriving (Eq,Ord) instance Show SocksHostAddress where show (SocksAddrIPV4 ha) = "SocksAddrIPV4(" ++ showHostAddress ha ++ ")" show (SocksAddrIPV6 ha6) = "SocksAddrIPV6(" ++ showHostAddress6 ha6 ++ ")" show (SocksAddrDomainName dn) = "SocksAddrDomainName(" ++ BC.unpack dn ++ ")" -- | Converts a HostAddress to a String in dot-decimal notation showHostAddress :: HostAddress -> String showHostAddress num = concat [show q1, ".", show q2, ".", show q3, ".", show q4] where (num',q1) = num `quotRem` 256 (num'',q2) = num' `quotRem` 256 (num''',q3) = num'' `quotRem` 256 (_,q4) = num''' `quotRem` 256 -- | Converts a IPv6 HostAddress6 to standard hex notation showHostAddress6 :: HostAddress6 -> String showHostAddress6 (a,b,c,d) = (concat . intersperse ":" . map (flip showHex "")) [p1,p2,p3,p4,p5,p6,p7,p8] where (a',p2) = a `quotRem` 65536 (_,p1) = a' `quotRem` 65536 (b',p4) = b `quotRem` 65536 (_,p3) = b' `quotRem` 65536 (c',p6) = c `quotRem` 65536 (_,p5) = c' `quotRem` 65536 (d',p8) = d `quotRem` 65536 (_,p7) = d' `quotRem` 65536 -- | Describe a Socket address on the SOCKS protocol data SocksAddress = SocksAddress !SocksHostAddress !PortNumber deriving (Show,Eq,Ord) -- | Type of reply on the SOCKS protocol data SocksReply = SocksReplySuccess | SocksReplyError SocksError deriving (Show,Eq,Ord,Data,Typeable) -- | SOCKS error that can be received or sent data SocksError = SocksErrorGeneralServerFailure | SocksErrorConnectionNotAllowedByRule | SocksErrorNetworkUnreachable | SocksErrorHostUnreachable | SocksErrorConnectionRefused | SocksErrorTTLExpired | SocksErrorCommandNotSupported | SocksErrorAddrTypeNotSupported | SocksErrorOther Word8 deriving (Show,Eq,Ord,Data,Typeable) -- | Exception returned when using a SOCKS version that is not supported. -- -- This package only implement version 5. data SocksVersionNotSupported = SocksVersionNotSupported deriving (Show,Data,Typeable) instance Exception SocksError instance Exception SocksVersionNotSupported instance Enum SocksCommand where toEnum 1 = SocksCommandConnect toEnum 2 = SocksCommandBind toEnum 3 = SocksCommandUdpAssociate toEnum w | w < 256 = SocksCommandOther $ fromIntegral w | otherwise = error "socks command is only 8 bits" fromEnum SocksCommandConnect = 1 fromEnum SocksCommandBind = 2 fromEnum SocksCommandUdpAssociate = 3 fromEnum (SocksCommandOther w) = fromIntegral w instance Enum SocksMethod where toEnum 0 = SocksMethodNone toEnum 1 = SocksMethodGSSAPI toEnum 2 = SocksMethodUsernamePassword toEnum 0xff = SocksMethodNotAcceptable toEnum w | w < 256 = SocksMethodOther $ fromIntegral w | otherwise = error "socks method is only 8 bits" fromEnum SocksMethodNone = 0 fromEnum SocksMethodGSSAPI = 1 fromEnum SocksMethodUsernamePassword = 2 fromEnum (SocksMethodOther w) = fromIntegral w fromEnum SocksMethodNotAcceptable = 0xff instance Enum SocksError where fromEnum SocksErrorGeneralServerFailure = 1 fromEnum SocksErrorConnectionNotAllowedByRule = 2 fromEnum SocksErrorNetworkUnreachable = 3 fromEnum SocksErrorHostUnreachable = 4 fromEnum SocksErrorConnectionRefused = 5 fromEnum SocksErrorTTLExpired = 6 fromEnum SocksErrorCommandNotSupported = 7 fromEnum SocksErrorAddrTypeNotSupported = 8 fromEnum (SocksErrorOther w) = fromIntegral w toEnum 1 = SocksErrorGeneralServerFailure toEnum 2 = SocksErrorConnectionNotAllowedByRule toEnum 3 = SocksErrorNetworkUnreachable toEnum 4 = SocksErrorHostUnreachable toEnum 5 = SocksErrorConnectionRefused toEnum 6 = SocksErrorTTLExpired toEnum 7 = SocksErrorCommandNotSupported toEnum 8 = SocksErrorAddrTypeNotSupported toEnum w = SocksErrorOther $ fromIntegral w instance Enum SocksReply where fromEnum SocksReplySuccess = 0 fromEnum (SocksReplyError e) = fromEnum e toEnum 0 = SocksReplySuccess toEnum n = SocksReplyError (toEnum n) socks-0.5.4/Network/Socks5/Conf.hs0000644000000000000000000000355712232422465015065 0ustar0000000000000000-- | -- Module : Network.Socks5.Conf -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- typical SOCKS configuration module Network.Socks5.Conf ( SocksConf(..) , socksHost , socksPort , defaultSocksConf , defaultSocksConfFromSockAddr ) where import Network.Socket import Network.Socks5.Types (SocksAddress(..), SocksHostAddress(..), SocksVersion(..)) import qualified Data.ByteString.Char8 as BC -- | SOCKS configuration structure. -- this structure will be extended in future to support authentification. -- use defaultSocksConf to create new record. data SocksConf = SocksConf { socksServer :: SocksAddress -- ^ SOCKS Address , socksVersion :: SocksVersion -- ^ SOCKS version to use } -- | SOCKS Host socksHost :: SocksConf -> SocksHostAddress socksHost conf = ha where (SocksAddress ha _) = socksServer conf -- | SOCKS Port socksPort :: SocksConf -> PortNumber socksPort conf = port where (SocksAddress _ port) = socksServer conf -- | defaultSocksConf create a new record, making sure -- API remains compatible when the record is extended. defaultSocksConf host port = SocksConf server SocksVer5 where server = SocksAddress haddr port haddr = SocksAddrDomainName $ BC.pack host -- | same as defaultSocksConf except the server address is determined from a 'SockAddr' -- -- A unix SockAddr will raises an error. Only Inet and Inet6 types supported defaultSocksConfFromSockAddr sockaddr = SocksConf server SocksVer5 where server = SocksAddress haddr port (haddr,port) = case sockaddr of SockAddrInet p h -> (SocksAddrIPV4 h, p) SockAddrInet6 p _ h _ -> (SocksAddrIPV6 h, p) _ -> error "unsupported unix sockaddr type" socks-0.5.4/Network/Socks5/Lowlevel.hs0000644000000000000000000000176212232422465015765 0ustar0000000000000000module Network.Socks5.Lowlevel ( resolveToSockAddr , socksListen -- * lowlevel types , module Network.Socks5.Wire , module Network.Socks5.Command ) where import Network.Socket import Network.BSD import Network.Socks5.Command import Network.Socks5.Wire import Network.Socks5.Types import qualified Data.ByteString.Char8 as BC resolveToSockAddr :: SocksAddress -> IO SockAddr resolveToSockAddr (SocksAddress sockHostAddr port) = case sockHostAddr of SocksAddrIPV4 ha -> return $ SockAddrInet port ha SocksAddrIPV6 ha6 -> return $ SockAddrInet6 port 0 ha6 0 SocksAddrDomainName bs -> do he <- getHostByName (BC.unpack bs) return $ SockAddrInet port (hostAddress he) socksListen :: Socket -> IO SocksRequest socksListen sock = do hello <- waitSerialized sock case getSocksHelloMethods hello of _ -> do sendSerialized sock (SocksHelloResponse SocksMethodNone) waitSerialized sock socks-0.5.4/Network/Socks5/Wire.hs0000644000000000000000000000733312232422465015102 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Network.Socks5.Wire -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown module Network.Socks5.Wire ( SocksHello(..) , SocksHelloResponse(..) , SocksRequest(..) , SocksResponse(..) ) where import Control.Applicative import Control.Monad import qualified Data.ByteString as B import Data.Serialize 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 <$> (getWord8 >>= getByteString . fromIntegral) 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 >> putWord8 (fromIntegral $ B.length b) >> putByteString b putAddr (SocksAddrIPV6 (a,b,c,d)) = putWord8 4 >> mapM_ putWord32host [a,b,c,d] getSocksRequest 5 = do cmd <- toEnum . fromIntegral <$> getWord8 _ <- getWord8 addr <- getWord8 >>= getAddr port <- fromIntegral <$> getWord16be return $ SocksRequest cmd addr port getSocksRequest v = error ("unsupported version of the protocol " ++ show v) getSocksResponse 5 = do reply <- toEnum . fromIntegral <$> getWord8 _ <- getWord8 addr <- getWord8 >>= getAddr port <- 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 putWord8 $ fromIntegral $ length ms mapM_ (putWord8 . fromIntegral . fromEnum) ms get = do v <- getWord8 case v of 5 -> getWord8 >>= flip replicateM (toEnum . fromIntegral <$> getWord8) . fromIntegral >>= return . SocksHello _ -> error "unsupported sock hello version" instance Serialize SocksHelloResponse where put (SocksHelloResponse m) = putWord8 5 >> putWord8 (fromIntegral $ fromEnum $ m) get = do v <- getWord8 case v of 5 -> SocksHelloResponse . toEnum . fromIntegral <$> getWord8 _ -> error "unsupported sock hello response version" instance Serialize SocksRequest where put req = do putWord8 5 putWord8 $ fromIntegral $ fromEnum $ requestCommand req putWord8 0 putAddr $ requestDstAddr req putWord16be $ fromIntegral $ requestDstPort req get = getWord8 >>= getSocksRequest instance Serialize SocksResponse where put req = do putWord8 5 putWord8 $ fromIntegral $ fromEnum $ responseReply req putWord8 0 putAddr $ responseBindAddr req putWord16be $ fromIntegral $ responseBindPort req get = getWord8 >>= getSocksResponse