socks-0.6.1/Network/0000755000000000000000000000000013457310122012455 5ustar0000000000000000socks-0.6.1/Network/Socks5/0000755000000000000000000000000013544333200013623 5ustar0000000000000000socks-0.6.1/Network/Socks5.hs0000644000000000000000000000665113457310122014170 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 , socksConnectName ) where import Control.Monad import Control.Exception import qualified Data.ByteString.Char8 as BC import Network.Socket ( close, Socket, SocketType(..), Family(..) , socket, connect, PortNumber, defaultProtocol) import qualified Network.Socks5.Command as Cmd import Network.Socks5.Conf import Network.Socks5.Types import Network.Socks5.Lowlevel -- | connect a user specified new socket on the socks server to a destination -- -- The socket in parameter needs to be already connected to the socks server -- -- |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 r <- Cmd.establish (socksVersion serverConf) 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 = bracketOnError (socket AF_INET Stream defaultProtocol) close $ \sock -> do connect sock (socksServer serverConf) ret <- socksConnectWithSocket sock serverConf destAddr return (sock, ret) -- | connect a new socket to the socks server, and connect the stream to a FQDN -- resolved on the server side. -- -- The socket needs to *not* be already connected. -- -- The destination need to be an ASCII string, otherwise unexpected behavior will ensue. -- For unicode destination, punycode encoding should be used. socksConnectName :: Socket -> SocksConf -> String -> PortNumber -> IO () socksConnectName sock sockConf destination port = do connect sock (socksServer sockConf) (_,_) <- socksConnectWithSocket sock sockConf addr return () where addr = SocksAddress (SocksAddrDomainName $ BC.pack destination) port socks-0.6.1/Network/Socks5/Lowlevel.hs0000644000000000000000000000077313457310122015760 0ustar0000000000000000module Network.Socks5.Lowlevel ( socksListen -- * lowlevel types , module Network.Socks5.Wire , module Network.Socks5.Command ) where import Network.Socket import Network.Socks5.Command import Network.Socks5.Wire import Network.Socks5.Types socksListen :: Socket -> IO SocksRequest socksListen sock = do hello <- waitSerialized sock case getSocksHelloMethods hello of _ -> do sendSerialized sock (SocksHelloResponse SocksMethodNone) waitSerialized sock socks-0.6.1/Network/Socks5/Types.hs0000644000000000000000000001377313457305525015312 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 qualified Basement.String as UTF8 import Basement.Compat.IsList import Data.ByteString (ByteString) import Data.Word import Data.Data import Network.Socket (HostAddress, HostAddress6, PortNumber) import Control.Exception import qualified Data.ByteString as B 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 !FQDN | SocksAddrIPV6 !HostAddress6 deriving (Eq,Ord) type FQDN = ByteString instance Show SocksHostAddress where show (SocksAddrIPV4 ha) = "SocksAddrIPV4(" ++ showHostAddress ha ++ ")" show (SocksAddrIPV6 ha6) = "SocksAddrIPV6(" ++ showHostAddress6 ha6 ++ ")" show (SocksAddrDomainName dn) = "SocksAddrDomainName(" ++ showFQDN dn ++ ")" -- | Converts a FQDN to a String showFQDN :: FQDN -> String showFQDN bs = toList $ fst $ UTF8.fromBytesLenient $ fromList $ B.unpack bs -- | 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.6.1/Network/Socks5/Wire.hs0000644000000000000000000000754713457305525015116 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NoImplicitPrelude #-} -- | -- Module : Network.Socks5.Wire -- License : BSD-style -- Maintainer : Vincent Hanquez -- 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 socks-0.6.1/Network/Socks5/Conf.hs0000644000000000000000000000221113457310122015041 0ustar0000000000000000-- | -- Module : Network.Socks5.Conf -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- typical SOCKS configuration module Network.Socks5.Conf ( SocksConf(..) , socksHost , defaultSocksConf , defaultSocksConfFromSockAddr ) where import Network.Socket import Network.Socks5.Types (SocksVersion(..)) -- | SOCKS identification and configuration structure. -- -- this structure will be extended in future to support authentification. -- use defaultSocksConf to create new record. data SocksConf = SocksConf { socksServer :: SockAddr -- ^ Address of server , socksVersion :: SocksVersion -- ^ SOCKS version to use } -- | SOCKS Host socksHost :: SocksConf -> SockAddr socksHost conf = socksServer conf -- | defaultSocksConf create a new record, making sure -- API remains compatible when the record is extended. defaultSocksConf :: SockAddr -> SocksConf defaultSocksConf host = SocksConf host SocksVer5 -- | same as defaultSocksConf. -- -- soft deprecation: use 'defaultSocksConf" defaultSocksConfFromSockAddr = defaultSocksConf socks-0.6.1/Network/Socks5/Command.hs0000644000000000000000000001020713457310122015536 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE NoImplicitPrelude #-} {-# 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 Basement.Compat.Base import Data.ByteString (ByteString) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Prelude import Data.Serialize import Network.Socket (Socket, PortNumber, HostAddress, HostAddress6) import Network.Socket.ByteString import Network.Socks5.Types import Network.Socks5.Wire establish :: SocksVersion -> Socket -> [SocksMethod] -> IO SocksMethod establish SocksVer5 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 = Prelude.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 -> [Char] -> 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, Prelude.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.6.1/Network/Socks5/Parse.hs0000644000000000000000000001725613544333200015244 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# 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 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) #if MIN_VERSION_base(4,13,0) instance MonadFail Parser where #endif fail errorMsg = Parser $ \buf err _ -> err buf ("failed: " ++ errorMsg) 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 (_, b2) | B.null b2 -> 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 (_, b2) | B.null b2 -> 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.6.1/README.md0000644000000000000000000000120213421167724012307 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.6.1/Example.hs0000644000000000000000000000340313457310122012753 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} import Network.Socks5 import Network.Socket hiding (recv, close) import Network.Socket.ByteString import Network.Socket (close) import Network.BSD 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 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, _) <- socksConnect (defaultSocksConf socksServerAddr) (SocksAddress (SocksAddrDomainName $ BC.pack destName) 80) sendAll socket "GET / HTTP/1.0\r\n\r\n" recv socket 4096 >>= putStrLn . show close 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 (defaultSocksConf socksServerAddr) destName 80 sendAll socket "GET / HTTP/1.0\r\n\r\n" recv socket 4096 >>= putStrLn . show close socket socks-0.6.1/LICENSE0000644000000000000000000000273113423316477012050 0ustar0000000000000000Copyright (c) 2010-2019 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.6.1/Setup.hs0000644000000000000000000000005613421167724012472 0ustar0000000000000000import Distribution.Simple main = defaultMain socks-0.6.1/socks.cabal0000644000000000000000000000235213544355273013151 0ustar0000000000000000Name: socks Version: 0.6.1 Synopsis: Socks proxy (ver 5) Description: Socks proxy (version 5) implementation. License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Build-Type: Simple Category: Network stability: experimental Cabal-Version: 1.18 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.6 , basement 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 default-language: Haskell2010 source-repository head type: git location: git://github.com/vincenthz/hs-socks