socks-0.5.5/0000755000000000000000000000000012712555200011030 5ustar0000000000000000socks-0.5.5/Example.hs0000644000000000000000000000420112712555200012754 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.5/LICENSE0000644000000000000000000000273112712555200012040 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.5/README.md0000644000000000000000000000120212712555200012302 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.5/Setup.hs0000644000000000000000000000005612712555200012465 0ustar0000000000000000import Distribution.Simple main = defaultMain socks-0.5.5/socks.cabal0000644000000000000000000000230012712555200013131 0ustar0000000000000000Name: socks Version: 0.5.5 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 extra-doc-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 Network.Socks5.Parse ghc-options: -Wall -fno-warn-missing-signatures -fwarn-tabs source-repository head type: git location: git://github.com/vincenthz/hs-socks socks-0.5.5/Network/0000755000000000000000000000000012712555200012461 5ustar0000000000000000socks-0.5.5/Network/Socks5.hs0000644000000000000000000001311512712555200014165 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' , 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 Socket socksConnectTo' sockshost socksport desthost destport = do sport <- resolvePortID socksport let socksConf = defaultSocksConf sockshost sport socksConnectWith socksConf desthost destport -- | 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.5/Network/Socks5/0000755000000000000000000000000012712555200013630 5ustar0000000000000000socks-0.5.5/Network/Socks5/Command.hs0000644000000000000000000001007112712555200015541 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.5/Network/Socks5/Conf.hs0000644000000000000000000000355712712555200015063 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.5/Network/Socks5/Lowlevel.hs0000644000000000000000000000176212712555200015763 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.5/Network/Socks5/Parse.hs0000644000000000000000000001707612712555200015251 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -- | -- Module : Network.Socks5.Parse -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : portable -- -- A very simple bytestring parser related to Parsec and Attoparsec -- -- Simple example: -- -- > > parse ((,) <$> take 2 <*> byte 0x20 <*> (bytes "abc" *> anyByte)) "xx abctest" -- > ParseOK "est" ("xx", 116) -- module Network.Socks5.Parse ( Parser , Result(..) -- * run the Parser , parse , parseFeed -- * Parser methods , byte , anyByte , bytes , take , takeWhile , takeAll , skip , skipWhile , skipAll , takeStorable ) where import Control.Applicative import Control.Monad import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B (toForeignPtr) import Data.Word import Foreign.Storable (Storable, peekByteOff, sizeOf) import Foreign.ForeignPtr (withForeignPtr) import Prelude hiding (take, takeWhile) import System.IO.Unsafe (unsafePerformIO) -- | Simple parsing result, that represent respectively: -- -- * failure: with the error message -- -- * continuation: that need for more input data -- -- * success: the remaining unparsed data and the parser value data Result a = ParseFail String | ParseMore (ByteString -> Result a) | ParseOK ByteString a instance Show a => Show (Result a) where show (ParseFail err) = "ParseFailure: " ++ err show (ParseMore _) = "ParseMore _" show (ParseOK b a) = "ParseOK " ++ show a ++ " " ++ show b type Failure r = ByteString -> String -> Result r type Success a r = ByteString -> a -> Result r -- | Simple ByteString parser structure newtype Parser a = Parser { runParser :: forall r . ByteString -> Failure r -> Success a r -> Result r } instance Monad Parser where fail errorMsg = Parser $ \buf err _ -> err buf ("failed: " ++ errorMsg) return v = Parser $ \buf _ ok -> ok buf v m >>= k = Parser $ \buf err ok -> runParser m buf err (\buf' a -> runParser (k a) buf' err ok) instance MonadPlus Parser where mzero = fail "Parser.MonadPlus.mzero" mplus f g = Parser $ \buf err ok -> -- rewrite the err callback of @f to call @g runParser f buf (\_ _ -> runParser g buf err ok) ok instance Functor Parser where fmap f p = Parser $ \buf err ok -> runParser p buf err (\b a -> ok b (f a)) instance Applicative Parser where pure = return (<*>) d e = d >>= \b -> e >>= \a -> return (b a) instance Alternative Parser where empty = fail "Parser.Alternative.empty" (<|>) = mplus -- | Run a parser on an @initial ByteString. -- -- If the Parser need more data than available, the @feeder function -- is automatically called and fed to the More continuation. parseFeed :: Monad m => m B.ByteString -> Parser a -> B.ByteString -> m (Result a) parseFeed feeder p initial = loop $ parse p initial where loop (ParseMore k) = feeder >>= (loop . k) loop r = return r -- | Run a Parser on a ByteString and return a 'Result' parse :: Parser a -> ByteString -> Result a parse p s = runParser p s (\_ msg -> ParseFail msg) (\b a -> ParseOK b a) ------------------------------------------------------------ getMore :: Parser () getMore = Parser $ \buf err ok -> ParseMore $ \nextChunk -> if B.null nextChunk then err buf "EOL: need more data" else ok (B.append buf nextChunk) () getAll :: Parser () getAll = Parser $ \buf err ok -> ParseMore $ \nextChunk -> if B.null nextChunk then ok buf () else runParser getAll (B.append buf nextChunk) err ok flushAll :: Parser () flushAll = Parser $ \buf err ok -> ParseMore $ \nextChunk -> if B.null nextChunk then ok buf () else runParser getAll B.empty err ok ------------------------------------------------------------ -- | Get the next byte from the parser anyByte :: Parser Word8 anyByte = Parser $ \buf err ok -> case B.uncons buf of Nothing -> runParser (getMore >> anyByte) buf err ok Just (c1,b2) -> ok b2 c1 -- | Parse a specific byte at current position -- -- if the byte is different than the expected on, -- this parser will raise a failure. byte :: Word8 -> Parser () byte w = Parser $ \buf err ok -> case B.uncons buf of Nothing -> runParser (getMore >> byte w) buf err ok Just (c1,b2) | c1 == w -> ok b2 () | otherwise -> err buf ("byte " ++ show w ++ " : failed") -- | Parse a sequence of bytes from current position -- -- if the following bytes don't match the expected -- bytestring completely, the parser will raise a failure bytes :: ByteString -> Parser () bytes allExpected = consumeEq allExpected where errMsg = "bytes " ++ show allExpected ++ " : failed" -- partially consume as much as possible or raise an error. consumeEq expected = Parser $ \actual err ok -> let eLen = B.length expected in if B.length actual >= eLen then -- enough data for doing a full match let (aMatch,aRem) = B.splitAt eLen actual in if aMatch == expected then ok aRem () else err actual errMsg else -- not enough data, match as much as we have, and then recurse. let (eMatch, eRem) = B.splitAt (B.length actual) expected in if actual == eMatch then runParser (getMore >> consumeEq eRem) B.empty err ok else err actual errMsg ------------------------------------------------------------ -- | Take a storable from the current position in the stream takeStorable :: Storable d => Parser d takeStorable = anyStorable undefined where anyStorable :: Storable d => d -> Parser d anyStorable a = do (fptr, off, _) <- B.toForeignPtr <$> take (sizeOf a) return $ unsafePerformIO $ withForeignPtr fptr $ \ptr -> peekByteOff ptr off -- | Take @n bytes from the current position in the stream take :: Int -> Parser ByteString take n = Parser $ \buf err ok -> if B.length buf >= n then let (b1,b2) = B.splitAt n buf in ok b2 b1 else runParser (getMore >> take n) buf err ok -- | Take bytes while the @predicate hold from the current position in the stream takeWhile :: (Word8 -> Bool) -> Parser ByteString takeWhile predicate = Parser $ \buf err ok -> case B.span predicate buf of (_, "") -> runParser (getMore >> takeWhile predicate) buf err ok (b1, b2) -> ok b2 b1 -- | Take the remaining bytes from the current position in the stream takeAll :: Parser ByteString takeAll = Parser $ \buf err ok -> runParser (getAll >> returnBuffer) buf err ok where returnBuffer = Parser $ \buf _ ok -> ok B.empty buf -- | Skip @n bytes from the current position in the stream skip :: Int -> Parser () skip n = Parser $ \buf err ok -> if B.length buf >= n then ok (B.drop n buf) () else runParser (getMore >> skip (n - B.length buf)) B.empty err ok -- | Skip bytes while the @predicate hold from the current position in the stream skipWhile :: (Word8 -> Bool) -> Parser () skipWhile p = Parser $ \buf err ok -> case B.span p buf of (_, "") -> runParser (getMore >> skipWhile p) B.empty err ok (_, b2) -> ok b2 () -- | Skip all the remaining bytes from the current position in the stream skipAll :: Parser () skipAll = Parser $ \buf err ok -> runParser flushAll buf err ok socks-0.5.5/Network/Socks5/Types.hs0000644000000000000000000001342712712555200015277 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.5/Network/Socks5/Wire.hs0000644000000000000000000000741412712555200015100 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 import Network.Socks5.Parse as P (anyByte, take) -- | 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