crypton-socks-0.6.2/example/0000755000000000000000000000000015034312425014155 5ustar0000000000000000crypton-socks-0.6.2/src/0000755000000000000000000000000015034255057013320 5ustar0000000000000000crypton-socks-0.6.2/src/Network/0000755000000000000000000000000015034277424014753 5ustar0000000000000000crypton-socks-0.6.2/src/Network/Socks5/0000755000000000000000000000000015034312425016111 5ustar0000000000000000crypton-socks-0.6.2/src/Network/Socks5.hs0000644000000000000000000001010115034312645016442 0ustar0000000000000000{- | Module : Network.Socks5 License : BSD-style Copyright : (c) 2010-2019 Vincent Hanquez Stability : experimental Portability : unknown This is an implementation of the SOCKS Protocol Version 5 as defined in [RFC 1928](https://datatracker.ietf.org/doc/html/rfc1928). In Wikipedia's words: SOCKS is an Internet protocol that exchanges network packets between a client and server through a proxy server. SOCKS5 optionally provides authentication so only authorized users may access a server. Practically, a SOCKS server proxies TCP connections to an arbitrary IP address, and provides a means for UDP packets to be forwarded. A SOCKS server accepts incoming client connection on TCP port 1080. BIND and UDP ASSOCIATE messages are not implemented. However the main usage of SOCKS is implemented. -} module Network.Socks5 ( -- * Types SocksAddress (..) , SocksHostAddress (..) , SocksReply (..) , SocksError (..) -- * Configuration , SocksConf (..) , socksHost , defaultSocksConf , defaultSocksConfFromSockAddr -- * Methods , socksConnectWithSocket , socksConnect -- * Variants , socksConnectName ) where import Control.Exception ( bracketOnError ) import Control.Monad ( when ) import Data.ByteString.Char8 ( pack ) import Network.Socket ( close, Socket, SocketType(..), Family(..), socket, connect , PortNumber, defaultProtocol ) import Network.Socks5.Command ( Connect (..), establish, rpc_ ) import Network.Socks5.Conf ( SocksConf (..), defaultSocksConf , defaultSocksConfFromSockAddr, socksHost ) import Network.Socks5.Types ( SocksAddress (..), SocksError (..), SocksHostAddress (..) , SocksMethod (..), SocksReply (..) ) -- | Connect a user-specified new socket on the SOCKS server to a destination. -- -- The specified socket needs to be connected to the SOCKS server already. -- -- |socket|-----sockServer----->|server|----destAddr----->|destination| -- socksConnectWithSocket :: Socket -- ^ The socket to use. -> SocksConf -- ^ The SOCKS configuration for the server. -> SocksAddress -- ^ The SOCKS address to connect to. -> IO (SocksHostAddress, PortNumber) socksConnectWithSocket sock serverConf destAddr = do r <- establish (socksVersion serverConf) sock [SocksMethodNone] when (r == SocksMethodNotAcceptable) $ error "cannot connect with no socks method of authentication" rpc_ sock (Connect destAddr) -- | Connect a new socket to a SOCKS server and connect the stream on the -- server side to the specified SOCKS address. socksConnect :: SocksConf -- ^ The SOCKS configuration for the server. -> SocksAddress -- ^ The 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 -- fully-qualified domain name (FQDN) resolved on the server side. socksConnectName :: Socket -- ^ The socket to use. The socket must *not* be connected already. -> SocksConf -- ^ The SOCKS configuration for the server. -> String -- ^ Destination FQDN. Should comprise only ASCII characters, otherwise -- unexpected behaviour will ensure. For FQDN including other Unicode code -- points, Punycode encoding should be used. -> PortNumber -- ^ The port number to use. -> IO () socksConnectName sock sockConf destination port = do connect sock (socksServer sockConf) (_, _) <- socksConnectWithSocket sock sockConf addr return () where addr = SocksAddress (SocksAddrDomainName $ pack destination) port crypton-socks-0.6.2/src/Network/Socks5/Lowlevel.hs0000644000000000000000000000203515034303135020234 0ustar0000000000000000{- | Module : Network.Socks5.LowLevel License : BSD-style Copyright : (c) 2010-2019 Vincent Hanquez Stability : experimental Portability : unknown Low level types and functions for interacting with a SOCKS server. -} module Network.Socks5.Lowlevel ( socksListen -- * Low level types and functions , module Network.Socks5.Wire , module Network.Socks5.Command ) where import Data.Functor ( void ) import Network.Socket ( Socket ) import Network.Socks5.Command import Network.Socks5.Types ( SocksMethod (..) ) import Network.Socks5.Wire -- | For the specified socket, wait for a SOCKS Hello, send a SOCKS Hello -- response (specifying no authentification method), and wait for a SOCKS -- request. socksListen :: Socket -- ^ The socket to use. -> IO SocksRequest socksListen sock = do void (waitSerialized sock :: IO SocksHello) sendSerialized sock (SocksHelloResponse SocksMethodNone) waitSerialized sock crypton-socks-0.6.2/src/Network/Socks5/Types.hs0000644000000000000000000001704415034315405017560 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {- | Module : Network.Socks5.Types License : BSD-style Copyright : (c) 2010-2019 Vincent Hanquez Stability : experimental Portability : unknown -} module Network.Socks5.Types ( SocksVersion (..) , SocksCommand (..) , SocksMethod (..) , SocksHostAddress (..) , SocksAddress (..) , SocksReply (..) , SocksVersionNotSupported (..) , SocksError (..) , SocksFQDN ) where import Control.Exception ( Exception ) import Data.ByteString ( ByteString ) import Data.Data ( Data, Typeable ) import qualified Data.List as L import Data.Word ( Word8 ) import Network.Socket ( HostAddress, HostAddress6, PortNumber ) import Numeric ( showHex ) -- | Type representing SOCKS protocol versions. data SocksVersion = SocksVer5 -- ^ SOCKS Protocol Version 5. The only version implemented by the library. deriving (Eq, Ord, Show) -- | Type representing commands that can be sent or received under the SOCKS -- protocol. data SocksCommand = SocksCommandConnect -- ^ The CONNECT request. | SocksCommandBind -- ^ The BIND request. Not implemented by the library. | SocksCommandUdpAssociate -- ^ The UDP ASSOCIATE request. Not implemented by the library. | SocksCommandOther !Word8 -- ^ Other requests. None are specified by the SOCKS Protocol Version 5. deriving (Eq, Ord, Show) -- | Type representing authentication methods available under the SOCKS -- protocol. -- -- Only 'SocksMethodNone' is effectively implemented, but other values are -- enumerated for completeness. data SocksMethod = SocksMethodNone -- ^ NO AUTHENTICATION REQUIRED. | SocksMethodGSSAPI -- ^ GSSAPI. | SocksMethodUsernamePassword -- ^ USERNAME/PASSWORD. | SocksMethodOther !Word8 -- ^ IANA ASSIGNED or RESERVED FOR PRIVATE METHODS. | SocksMethodNotAcceptable -- ^ NO ACCEPTABLE METHODS. deriving (Eq, Ord, Show) -- | Type representing host addresses under the SOCKS protocol. data SocksHostAddress = SocksAddrIPV4 !HostAddress -- ^ A version-4 IP address. | SocksAddrDomainName !SocksFQDN -- ^ A fully-qualified domain name (FQDN). | SocksAddrIPV6 !HostAddress6 -- ^ A version-6 IP address. deriving (Eq, Ord) -- | Type synonym representing fully-qualified domain names (FQDN). The SOCKS -- Protocol Version 5 does not specify an encoding for a FQDN other than there -- is no terminating @NUL@ octet (byte). -- -- This library's API assumes that FQDN values comprise only ASCII characters. -- Domain names that include other Unicode code points should be -- Punycode encoded. type SocksFQDN = ByteString instance Show SocksHostAddress where show (SocksAddrIPV4 ha) = "SocksAddrIPV4(" ++ showHostAddress ha ++ ")" show (SocksAddrIPV6 ha6) = "SocksAddrIPV6(" ++ showHostAddress6 ha6 ++ ")" show (SocksAddrDomainName dn) = "SocksAddrDomainName(" ++ showFQDN dn ++ ")" -- | Converts the specified fully-qualified domain name (FQDN) to a 'String'. showFQDN :: SocksFQDN -> String showFQDN = show -- | Converts the specified SOCKS host address 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 the specified IPv6 host address to standard hex notation. showHostAddress6 :: HostAddress6 -> String showHostAddress6 (a, b, c, d) = (L.intercalate ":" . map (`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 -- | Type representing socket addresses under the SOCKS protocol. data SocksAddress = SocksAddress !SocksHostAddress !PortNumber deriving (Eq, Ord, Show) -- | Type representing replies under the SOCKS protocol. data SocksReply = SocksReplySuccess -- ^ The server reports that the request succeeded. | SocksReplyError SocksError -- ^ The server reports that the request did not succeed. deriving (Eq, Data, Ord, Show, Typeable) -- | Type representing SOCKS errors that can be part of a SOCKS reply. data SocksError = SocksErrorGeneralServerFailure -- ^ General SOCKS server failure. | SocksErrorConnectionNotAllowedByRule -- ^ Connection not allowed by ruleset. | SocksErrorNetworkUnreachable -- ^ Network unreachable. | SocksErrorHostUnreachable -- ^ Host unreachable. | SocksErrorConnectionRefused -- ^ Connection refused. | SocksErrorTTLExpired -- ^ TTL expired. | SocksErrorCommandNotSupported -- ^ Command not supported. | SocksErrorAddrTypeNotSupported -- ^ Address type not supported. | SocksErrorOther Word8 -- ^ Other error. Unassigned in SOCKS Protocol Version 5. deriving (Eq, Data, Ord, Show, Typeable) -- | Type representing exceptions. data SocksVersionNotSupported = SocksVersionNotSupported -- ^ The SOCKS protocol version is not supported. This library only -- implements SOCKS Protocol Version 5. deriving (Data, Show, 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) crypton-socks-0.6.2/src/Network/Socks5/Command.hs0000644000000000000000000001375415034312425020035 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} {- | Module : Network.Socks5.Command License : BSD-style Copyright : (c) 2010-2019 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.Exception ( throwIO ) import Data.ByteString ( ByteString ) import qualified Data.ByteString as B import Data.ByteString.Char8 ( pack ) import Data.Serialize ( Get, Result (..), Serialize (..), encode, runGetPartial ) import Network.Socket ( HostAddress, HostAddress6, PortNumber, Socket ) import Network.Socket.ByteString ( recv, sendAll ) import Network.Socks5.Types ( SocksAddress (..), SocksCommand (..), SocksError (..) , SocksHostAddress (..), SocksMethod (..), SocksReply (..) , SocksVersion (..) ) import Network.Socks5.Wire ( SocksHello (..), SocksHelloResponse (..) , SocksRequest (..), SocksResponse (..) ) -- | Establish a connection with a SOCKS server. establish :: SocksVersion -- ^ The SOCKS protocol version to use. -> Socket -- ^ The socket to use. -> [SocksMethod] -- ^ A list of the authentification methods supported. -> IO SocksMethod establish SocksVer5 socket methods = do sendAll socket (encode $ SocksHello methods) getSocksHelloResponseMethod <$> runGetDone get (recv socket 4096) -- | Type representing connect commands. newtype Connect = Connect SocksAddress deriving (Eq, Ord, Show) -- | A type class for types that can yield a SOCKS request or, optionally, be -- obtained from a SOCKS request. 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) -- | Connect using IPv4. connectIPV4 :: Socket -- ^ The socket to use. -> HostAddress -- ^ The host address. -> PortNumber -- ^ The port number to use. -> 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" -- | Connect using IPv6. connectIPV6 :: Socket -- ^ The socket to use. -> HostAddress6 -- ^ The host address. -> PortNumber -- ^ The port number to use. -> 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" -- | Connect using a fully-qualified domain name (FQDN). -- 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 -- ^ The socket to use. -> String -- ^ Destination FQDN. Should comprise only ASCII characters, otherwise -- unexpected behaviour will ensure. For FQDN including other Unicode code -- points, Punycode encoding should be used. -> PortNumber -- ^ The port number to use. -> IO (SocksHostAddress, PortNumber) connectDomainName socket fqdn port = rpc_ socket $ Connect $ SocksAddress (SocksAddrDomainName $ pack fqdn) port -- | Send data to the specified socket. sendSerialized :: Serialize a => Socket -- ^ The socket to use. -> a -- ^ The data. -> IO () sendSerialized sock a = sendAll sock $ encode a -- | Wait for data from the specified socket. waitSerialized :: Serialize a => Socket -- ^ The socket to use. -> IO a waitSerialized sock = runGetDone get (getMore sock) -- | Try to execute the specified command with the specified socket. rpc :: Command a => Socket -- ^ The socket to use. -> a -- ^ The command. -> 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 -- | As for 'rpc' but throws an exception if it does not succeed. rpc_ :: Command a => Socket -- ^ The socket to use. -> a -- ^ The command. -> IO (SocksHostAddress, PortNumber) rpc_ socket req = rpc socket req >>= either throwIO return -- This function expects all the data to be consumed. This is fine for -- intertwined messages, 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 >>= r . runGetPartial getter 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 crypton-socks-0.6.2/src/Network/Socks5/Conf.hs0000644000000000000000000000276315034315552017346 0ustar0000000000000000{- | Module : Network.Socks5.Conf License : BSD-style Copyright : (c) 2010-2019 Vincent Hanquez Stability : experimental Portability : unknown Typical SOCKS configuration. -} module Network.Socks5.Conf ( SocksConf (..) , socksHost , defaultSocksConf , defaultSocksConfFromSockAddr ) where import Network.Socket ( SockAddr ) import Network.Socks5.Types ( SocksVersion (..) ) -- | Type representing SOCKS identification and configuration structures. -- -- The data constructors may be extended in the future to support -- authentification. Use the smart constructor 'defaultSocksConf' -- and 'socksHost'. data SocksConf = SocksConf { socksServer :: SockAddr -- ^ The address of the server. , socksVersion :: SocksVersion -- ^ The SOCKS protocol version to use. } -- | Yield the socket address of the server from the specified configuration. socksHost :: SocksConf -- ^ The configuration. -> SockAddr socksHost = socksServer -- | Yield a configuration given the specified socket addresss. defaultSocksConf :: SockAddr -- ^ The address of the server. -> SocksConf defaultSocksConf host = SocksConf host SocksVer5 -- | Same as 'defaultSocksConf'. defaultSocksConfFromSockAddr :: SockAddr -> SocksConf defaultSocksConfFromSockAddr = defaultSocksConf {-# DEPRECATED defaultSocksConfFromSockAddr "Will be removed from future package versions. Use defaultSocksConf instead." #-} crypton-socks-0.6.2/src/Network/Socks5/Parse.hs0000644000000000000000000001735515034303135017530 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {- | Module : Network.Socks5.Parse License : BSD-style Copyright : (c) 2010-2019 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 ( Alternative (..) ) import Control.Monad ( MonadPlus (..) ) import Data.ByteString ( ByteString ) import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B ( toForeignPtr ) import Data.Word ( Word8 ) import Foreign.ForeignPtr ( withForeignPtr ) import Foreign.Storable ( Storable, peekByteOff, sizeOf ) 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 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 v = Parser $ \buf _ ok -> ok buf v (<*>) 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 needs 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) ParseOK -------------------------------------------------------------------------------- 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 one, 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@ holds 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 crypton-socks-0.6.2/src/Network/Socks5/Wire.hs0000644000000000000000000001055415034303135017356 0ustar0000000000000000{- | Module : Network.Socks5.Wire License : BSD-style Copyright : (c) 2010-2019 Vincent Hanquez Stability : experimental Portability : unknown -} module Network.Socks5.Wire ( SocksHello (..) , SocksHelloResponse (..) , SocksRequest (..) , SocksResponse (..) ) where import Control.Monad ( liftM4, replicateM ) import qualified Data.ByteString as B import Data.Serialize ( Get, Put, PutM (..), Serialize (..), getByteString , getWord16be, getWord32host, getWord8, putByteString , putWord16be, putWord32host, putWord8 ) import Network.Socket ( PortNumber ) import Network.Socks5.Types ( SocksCommand, SocksHostAddress (..), SocksMethod , SocksReply ) -- | Type representing initial messages sent by a client with the list of -- authentification methods supported. newtype SocksHello = SocksHello { getSocksHelloMethods :: [SocksMethod] } deriving (Eq, Show) -- | Type representing initial messages sent by a server in response to Hello, -- with the server's chosen method of authentication. newtype SocksHelloResponse = SocksHelloResponse { getSocksHelloResponseMethod :: SocksMethod } deriving (Eq, Show) -- | Type representing SOCKS requests. data SocksRequest = SocksRequest { requestCommand :: SocksCommand , requestDstAddr :: SocksHostAddress , requestDstPort :: PortNumber } deriving (Eq, Show) -- | Type representing SOCKS responses. data SocksResponse = SocksResponse { responseReply :: SocksReply , responseBindAddr :: SocksHostAddress , responseBindPort :: PortNumber } deriving (Eq, Show) getAddr :: (Eq a, Num a, Show a) => a -> Get SocksHostAddress 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 :: SocksHostAddress -> PutM () 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 . fromIntegral . fromEnum getEnum8 :: Enum e => Get e getEnum8 = toEnum . fromIntegral <$> getWord8 putLength8 :: Int -> Put putLength8 = putWord8 . fromIntegral getLength8 :: Get Int getLength8 = fromIntegral <$> getWord8 getSocksRequest :: (Eq a, Num a, Show a) => a -> Get SocksRequest getSocksRequest 5 = do cmd <- getEnum8 _ <- getWord8 addr <- getWord8 >>= getAddr port <- fromIntegral <$> getWord16be return $ SocksRequest cmd addr port getSocksRequest v = error ("unsupported version of the protocol " <> show v) getSocksResponse :: (Eq a, Num a, Show a) => a -> Get SocksResponse getSocksResponse 5 = do reply <- getEnum8 _ <- 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 putLength8 (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 $ fromIntegral $ requestDstPort req get = getWord8 >>= getSocksRequest instance Serialize SocksResponse where put req = do putWord8 5 putEnum8 $ responseReply req putWord8 0 putAddr $ responseBindAddr req putWord16be $ fromIntegral $ responseBindPort req get = getWord8 >>= getSocksResponse crypton-socks-0.6.2/example/Example.hs0000644000000000000000000000437315034312425016113 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {- | Module : Main License : BSD-style Copyright : (c) 2010-2019 Vincent Hanquez Stability : experimental Portability : unknown An example application. -} module Main ( main ) where import Data.ByteString.Char8 ( pack ) import Network.BSD ( getHostByName, hostAddresses ) import Network.Socket ( Family (..), SockAddr (..), SocketType (..), close , defaultProtocol ) import qualified Network.Socket as Network import Network.Socket.ByteString ( recv, sendAll ) import Network.Socks5 ( SocksAddress (..), SocksHostAddress (..), defaultSocksConf , socksConnect, socksConnectName ) import System.Environment ( getArgs ) main :: IO () main = do args <- getArgs let serverName = "localhost" serverPort = 1080 destinationName = case args of [] -> "www.google.com" (x:_) -> x -- A SOCKS server is expected to be running on localhost port 1080. he <- getHostByName serverName case hostAddresses he of [] -> putStrLn "Error: expected a host address." (ha:_) -> do let socksServerAddr = SockAddrInet serverPort ha example1 socksServerAddr destinationName example2 socksServerAddr destinationName where -- Connect to @destName on port 80 through the SOCKS server. www.google.com -- gets resolved on the client here and then the sockaddr is passed to -- socksConnectAddr. example1 socksServerAddr destName = do (socket, _) <- socksConnect (defaultSocksConf socksServerAddr) (SocksAddress (SocksAddrDomainName $ pack destName) 80) sendAll socket "GET / HTTP/1.0\r\n\r\n" recv socket 4096 >>= print close socket -- Connect to @destName on port 80 through the SOCKS server. The server is -- doing the resolution itself. example2 socksServerAddr destName = do socket <- Network.socket AF_INET Stream defaultProtocol socksConnectName socket (defaultSocksConf socksServerAddr) destName 80 sendAll socket "GET / HTTP/1.0\r\n\r\n" recv socket 4096 >>= print close socket crypton-socks-0.6.2/CHANGELOG.md0000644000000000000000000000246415034316454014347 0ustar0000000000000000Change log for `crypton-socks` All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). ## 0.6.2 * Move library modules to directory `src` and example application to directory `example`. * Change data types `SocksHello` and `SocksHelloResponse` (each with a single, unary data constructor without strictness annotation) to `newtype`. * Add missing top-level signatures to library. * Name the example application `crypton-socks-example`, and move it being built behind Cabal flag `example` (default: false). * Export the `SocksFQDN` type synonym, representing fully-qualified domain names (FQDN) under the SOCKS Protocol Version 5. The API assumes that such values comprise only ASCII characters. Domain names that include other Unicode code points should be Punycode encoded. * Remove dependency on the `basement` package. * Deprecate `defaultSocksConfFromSockAddr`, soft deprecated from 22 April 2019. ## 0.6.1 * Rename `socks-0.6.1` package as `crypton-socks-0.6.1`. * Change maintainer field to `Mike Pilgrem ` and `Kazu Yamamoto `. * Add `CHANGELOG.md`. crypton-socks-0.6.2/README.md0000644000000000000000000000210015034312425013772 0ustar0000000000000000crypton-socks ============= Originally forked from [socks-0.6.1](https://hackage.haskell.org/package/socks-0.6.1). Haskell library implementing the SOCKS Protocol Version 5. Usage ----- See `example/Example.hs` for really simple and straighforward examples. The main API of the library is three functions: * `socksConnectWithSocket` which connects to a `SocksAddress` specifying a `SocksHostAddress` (`SocksAddrIPV4`, `SocksAddrDomainName` or `SocksAddrIPV6`). The name resolution is done on the client side. * `socksConnect` connects a new socket to a SOCKS server, with `socksConnectWithSocket`. * `socksConnectName` which connects to a fully qualified domain name (FQDN) (for example, `www.example.com`). The name resolution is done by the proxy server. History ------- The [`socks`](https://hackage.haskell.org/package/socks) package was originated and then maintained by Vincent Hanquez. For published reasons, he does not intend to develop the package further after version 0.6.1 but he also does not want to introduce other maintainers. crypton-socks-0.6.2/LICENSE0000644000000000000000000000276415032545040013537 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. crypton-socks-0.6.2/Setup.hs0000644000000000000000000000006015032545040014151 0ustar0000000000000000import Distribution.Simple main = defaultMain crypton-socks-0.6.2/crypton-socks.cabal0000644000000000000000000000374115034312425016331 0ustar0000000000000000cabal-version: 1.18 -- This file has been generated from package.yaml by hpack version 0.38.1. -- -- see: https://github.com/sol/hpack name: crypton-socks version: 0.6.2 synopsis: SOCKS Protocol Version 5 description: A library implementing SOCKS Protocol Version 5. category: Network stability: experimental homepage: http://github.com/mpilgrem/crypton-socks bug-reports: https://github.com/mpilgrem/crypton-socks/issues author: Vincent Hanquez maintainer: Mike Pilgrem , Kazu Yamamoto copyright: Vincent Hanquez license: BSD3 license-file: LICENSE build-type: Simple extra-doc-files: CHANGELOG.md README.md source-repository head type: git location: https://github.com/mpilgrem/crypton-socks flag example description: Build the example application. manual: True default: False flag network-3-0-0-0 description: Use network-3.0.0.0 or later. If used the example application has a dependency on network-bsd. manual: False default: True library exposed-modules: Network.Socks5 Network.Socks5.Lowlevel Network.Socks5.Types other-modules: Network.Socks5.Command Network.Socks5.Conf Network.Socks5.Parse Network.Socks5.Wire hs-source-dirs: src ghc-options: -Wall build-depends: base >=3 && <5 , bytestring , cereal >=0.3.1 , network >=2.6 default-language: Haskell2010 executable crypton-socks-example main-is: Example.hs hs-source-dirs: example ghc-options: -Wall build-depends: base >=3 && <5 , bytestring , crypton-socks default-language: Haskell2010 if !flag(example) buildable: False if flag(network-3-0-0-0) build-depends: network >=3.0.0.0 , network-bsd else build-depends: network >=2.6