crypton-socks 0.6.1 → 0.6.2
raw patch · 19 files changed
+1110/−848 lines, 19 filesdep +crypton-socksdep +network-bsddep −basementdep ~networknew-component:exe:crypton-socks-examplePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: crypton-socks, network-bsd
Dependencies removed: basement
Dependency ranges changed: network
API changes (from Hackage documentation)
- Network.Socks5.Lowlevel: data SocksHello
- Network.Socks5.Lowlevel: data SocksHelloResponse
+ Network.Socks5.Lowlevel: newtype SocksHello
+ Network.Socks5.Lowlevel: newtype SocksHelloResponse
+ Network.Socks5.Types: type SocksFQDN = ByteString
- Network.Socks5: SocksAddrDomainName :: !FQDN -> SocksHostAddress
+ Network.Socks5: SocksAddrDomainName :: !SocksFQDN -> SocksHostAddress
- Network.Socks5.Lowlevel: connectDomainName :: Socket -> [Char] -> PortNumber -> IO (SocksHostAddress, PortNumber)
+ Network.Socks5.Lowlevel: connectDomainName :: Socket -> String -> PortNumber -> IO (SocksHostAddress, PortNumber)
- Network.Socks5.Types: SocksAddrDomainName :: !FQDN -> SocksHostAddress
+ Network.Socks5.Types: SocksAddrDomainName :: !SocksFQDN -> SocksHostAddress
Files
- CHANGELOG.md +16/−0
- Example.hs +0/−46
- Network/Socks5.hs +0/−89
- Network/Socks5/Command.hs +0/−112
- Network/Socks5/Conf.hs +0/−40
- Network/Socks5/Lowlevel.hs +0/−18
- Network/Socks5/Parse.hs +0/−221
- Network/Socks5/Types.hs +0/−176
- Network/Socks5/Wire.hs +0/−124
- README.md +10/−13
- crypton-socks.cabal +39/−9
- example/Example.hs +66/−0
- src/Network/Socks5.hs +109/−0
- src/Network/Socks5/Command.hs +193/−0
- src/Network/Socks5/Conf.hs +48/−0
- src/Network/Socks5/Lowlevel.hs +34/−0
- src/Network/Socks5/Parse.hs +239/−0
- src/Network/Socks5/Types.hs +215/−0
- src/Network/Socks5/Wire.hs +141/−0
CHANGELOG.md view
@@ -6,6 +6,22 @@ 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`.
− Example.hs
@@ -1,46 +0,0 @@-{-# 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
− Network/Socks5.hs
@@ -1,89 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE ViewPatterns #-} --- | --- Module : Network.Socks5 --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- 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
− Network/Socks5/Command.hs
@@ -1,112 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE ViewPatterns #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE CPP #-} --- | --- Module : Network.Socks5.Command --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- 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
− Network/Socks5/Conf.hs
@@ -1,40 +0,0 @@--- | --- Module : Network.Socks5.Conf --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- 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
− Network/Socks5/Lowlevel.hs
@@ -1,18 +0,0 @@-module 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
− Network/Socks5/Parse.hs
@@ -1,221 +0,0 @@-{-# LANGUAGE CPP #-} -{-# LANGUAGE Rank2Types #-} -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE OverloadedStrings #-} --- | --- Module : Network.Socks5.Parse --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- 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
− Network/Socks5/Types.hs
@@ -1,176 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-} --- | --- Module : Network.Socks5.Types --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- 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)
− Network/Socks5/Wire.hs
@@ -1,124 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE NoImplicitPrelude #-} --- | --- Module : Network.Socks5.Wire --- License : BSD-style --- Maintainer : Vincent Hanquez <vincent@snarc.org> --- Stability : experimental --- Portability : unknown -module Network.Socks5.Wire - ( SocksHello(..) - , SocksHelloResponse(..) - , SocksRequest(..) - , SocksResponse(..) - ) where - -import Basement.Compat.Base -import Control.Monad -import qualified Data.ByteString as B -import Data.Serialize -import qualified Prelude - -import Network.Socket (PortNumber) - -import Network.Socks5.Types - --- | Initial message sent by client with the list of authentification methods supported -data SocksHello = SocksHello { getSocksHelloMethods :: [SocksMethod] } - deriving (Show,Eq) - --- | Initial message send by server in return from Hello, with the --- server chosen method of authentication -data SocksHelloResponse = SocksHelloResponse { getSocksHelloResponseMethod :: SocksMethod } - deriving (Show,Eq) - --- | Define a SOCKS requests -data SocksRequest = SocksRequest - { requestCommand :: SocksCommand - , requestDstAddr :: SocksHostAddress - , requestDstPort :: PortNumber - } deriving (Show,Eq) - --- | Define a SOCKS response -data SocksResponse = SocksResponse - { responseReply :: SocksReply - , responseBindAddr :: SocksHostAddress - , responseBindPort :: PortNumber - } deriving (Show,Eq) - -getAddr 1 = SocksAddrIPV4 <$> getWord32host -getAddr 3 = SocksAddrDomainName <$> (getLength8 >>= getByteString) -getAddr 4 = SocksAddrIPV6 <$> (liftM4 (,,,) getWord32host getWord32host getWord32host getWord32host) -getAddr n = error ("cannot get unknown socket address type: " <> show n) - -putAddr (SocksAddrIPV4 h) = putWord8 1 >> putWord32host h -putAddr (SocksAddrDomainName b) = putWord8 3 >> putLength8 (B.length b) >> putByteString b -putAddr (SocksAddrIPV6 (a,b,c,d)) = putWord8 4 >> mapM_ putWord32host [a,b,c,d] - -putEnum8 :: Enum e => e -> Put -putEnum8 = putWord8 . Prelude.fromIntegral . fromEnum - -getEnum8 :: Enum e => Get e -getEnum8 = toEnum . Prelude.fromIntegral <$> getWord8 - -putLength8 :: Int -> Put -putLength8 = putWord8 . Prelude.fromIntegral - -getLength8 :: Get Int -getLength8 = Prelude.fromIntegral <$> getWord8 - -getSocksRequest 5 = do - cmd <- getEnum8 - _ <- getWord8 - addr <- getWord8 >>= getAddr - port <- Prelude.fromIntegral <$> getWord16be - return $ SocksRequest cmd addr port -getSocksRequest v = - error ("unsupported version of the protocol " <> show v) - -getSocksResponse 5 = do - reply <- getEnum8 - _ <- getWord8 - addr <- getWord8 >>= getAddr - port <- Prelude.fromIntegral <$> getWord16be - return $ SocksResponse reply addr port -getSocksResponse v = - error ("unsupported version of the protocol " <> show v) - -instance Serialize SocksHello where - put (SocksHello ms) = do - putWord8 5 - putLength8 (Prelude.length ms) - mapM_ putEnum8 ms - get = do - v <- getWord8 - case v of - 5 -> SocksHello <$> (getLength8 >>= flip replicateM getEnum8) - _ -> error "unsupported sock hello version" - -instance Serialize SocksHelloResponse where - put (SocksHelloResponse m) = putWord8 5 >> putEnum8 m - get = do - v <- getWord8 - case v of - 5 -> SocksHelloResponse <$> getEnum8 - _ -> error "unsupported sock hello response version" - -instance Serialize SocksRequest where - put req = do - putWord8 5 - putEnum8 $ requestCommand req - putWord8 0 - putAddr $ requestDstAddr req - putWord16be $ Prelude.fromIntegral $ requestDstPort req - - get = getWord8 >>= getSocksRequest - -instance Serialize SocksResponse where - put req = do - putWord8 5 - putEnum8 $ responseReply req - putWord8 0 - putAddr $ responseBindAddr req - putWord16be $ Prelude.fromIntegral $ responseBindPort req - get = getWord8 >>= getSocksResponse
README.md view
@@ -3,24 +3,21 @@ Originally forked from [socks-0.6.1](https://hackage.haskell.org/package/socks-0.6.1). -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. +Haskell library implementing the SOCKS Protocol Version 5. Usage ----- -See Example.hs for really simple and straighforward example. The main api is only 2 calls: +See `example/Example.hs` for really simple and straighforward examples. The +main API of the library is three functions: - * 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. +* `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 -------
crypton-socks.cabal view
@@ -5,13 +5,13 @@ -- see: https://github.com/sol/hpack name: crypton-socks -version: 0.6.1 -synopsis: Socks proxy (ver 5) -description: Socks proxy (version 5) implementation. +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/socks5 -bug-reports: https://github.com/mpilgrem/socks5/issues +homepage: http://github.com/mpilgrem/crypton-socks +bug-reports: https://github.com/mpilgrem/crypton-socks/issues author: Vincent Hanquez <vincent@snarc.org> maintainer: Mike Pilgrem <public@pilgrem.com>, Kazu Yamamoto <kazu@iij.ad.jp> @@ -22,12 +22,21 @@ extra-doc-files: CHANGELOG.md README.md - Example.hs source-repository head type: git - location: https://github.com/mpilgrem/socks5 + 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 @@ -38,11 +47,32 @@ Network.Socks5.Conf Network.Socks5.Parse Network.Socks5.Wire - ghc-options: -Wall -fno-warn-missing-signatures -fwarn-tabs + hs-source-dirs: + src + ghc-options: -Wall build-depends: base >=3 && <5 - , basement , 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
+ example/Example.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-} + +{- | +Module : Main +License : BSD-style +Copyright : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org> +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
+ src/Network/Socks5.hs view
@@ -0,0 +1,109 @@+{- | +Module : Network.Socks5 +License : BSD-style +Copyright : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org> +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
+ src/Network/Socks5/Command.hs view
@@ -0,0 +1,193 @@+{-# LANGUAGE CPP #-} +{-# LANGUAGE ViewPatterns #-} + +{- | +Module : Network.Socks5.Command +License : BSD-style +Copyright : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org> +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
+ src/Network/Socks5/Conf.hs view
@@ -0,0 +1,48 @@+{- | +Module : Network.Socks5.Conf +License : BSD-style +Copyright : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org> +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." #-}
+ src/Network/Socks5/Lowlevel.hs view
@@ -0,0 +1,34 @@+{- | +Module : Network.Socks5.LowLevel +License : BSD-style +Copyright : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org> +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
+ src/Network/Socks5/Parse.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE Rank2Types #-} + +{- | +Module : Network.Socks5.Parse +License : BSD-style +Copyright : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org> +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
+ src/Network/Socks5/Types.hs view
@@ -0,0 +1,215 @@+{-# LANGUAGE DeriveDataTypeable #-} + +{- | +Module : Network.Socks5.Types +License : BSD-style +Copyright : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org> +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)
+ src/Network/Socks5/Wire.hs view
@@ -0,0 +1,141 @@+{- | +Module : Network.Socks5.Wire +License : BSD-style +Copyright : (c) 2010-2019 Vincent Hanquez <vincent@snarc.org> +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