From fc2124f2b53314c215b37d215844311f992a3da3 Mon Sep 17 00:00:00 2001 From: Packit Date: Sep 25 2020 16:00:15 +0000 Subject: ghc-socks-0.5.6 base --- diff --git a/Example.hs b/Example.hs new file mode 100644 index 0000000..73d9798 --- /dev/null +++ b/Example.hs @@ -0,0 +1,55 @@ +{-# LANGUAGE OverloadedStrings #-} +import Network.Socks5 +import Network.Socket hiding (recv, sClose) +import Network.Socket.ByteString +import Network.BSD +import Network +import Data.ByteString.Char8 () +import qualified Data.ByteString.Char8 as BC + +import System.IO (hClose, hFlush) +import System.Environment (getArgs) + +main = do + args <- getArgs + let serverName = "localhost" + let serverPort = 1080 + let destinationName = case args of + [] -> "www.google.com" + (x:_) -> x + -- socks server is expected to be running on localhost port 1080 + he <- getHostByName serverName + let socksServerAddr = SockAddrInet serverPort (head $ hostAddresses he) + + example1 socksServerAddr destinationName + example2 socksServerAddr destinationName + + example3 serverName serverPort destinationName 80 + + where + -- connect to @destName on port 80 through the socks server + -- www.google.com get resolve on the client here and then the sockaddr is + -- passed to socksConnectAddr + example1 socksServerAddr destName = do + socket <- socket AF_INET Stream defaultProtocol + socksConnectWithSocket socket (defaultSocksConfFromSockAddr socksServerAddr) + (SocksAddress (SocksAddrDomainName $ BC.pack destName) 80) + + sendAll socket "GET / HTTP/1.0\r\n\r\n" + recv socket 4096 >>= putStrLn . show + sClose socket + -- connect to @destName on port 80 through the socks server + -- the server is doing the resolution itself + example2 socksServerAddr destName = do + socket <- socket AF_INET Stream defaultProtocol + socksConnectName socket socksServerAddr destName 80 + sendAll socket "GET / HTTP/1.0\r\n\r\n" + recv socket 4096 >>= putStrLn . show + sClose socket + + example3 sname sport dname dport = do + handle <- socksConnectTo sname (PortNumber sport) dname (PortNumber dport) + BC.hPut handle "GET / HTTP/1.0\r\n\r\n" + hFlush handle + BC.hGet handle 1024 >>= putStrLn . show + hClose handle diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..ce6a6cb --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) 2010-2011 Vincent Hanquez + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Network/Socks5.hs b/Network/Socks5.hs new file mode 100644 index 0000000..24bf3ac --- /dev/null +++ b/Network/Socks5.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module : Network.Socks5 +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- This is an implementation of SOCKS5 as defined in RFC 1928 +-- +-- In Wikipedia's words: +-- +-- SOCKet Secure (SOCKS) is an Internet protocol that routes network packets +-- between a client and server through a proxy server. SOCKS5 additionally +-- provides authentication so only authorized users may access a server. +-- Practically, a SOCKS server will proxy TCP connections to an arbitrary IP +-- address as well as providing a means for UDP packets to be forwarded. +-- +-- BIND and UDP ASSOCIATE messages are not implemented. +-- However main usage of SOCKS is covered in this implementation. +-- +module Network.Socks5 + ( + -- * Types + SocksAddress(..) + , SocksHostAddress(..) + , SocksReply(..) + , SocksError(..) + -- * Configuration + , module Network.Socks5.Conf + -- * Methods + , socksConnectWithSocket + , socksConnect + -- * Variants + , socksConnectAddr + , socksConnectName + , socksConnectTo' + , socksConnectTo + , socksConnectWith + ) where + +import Control.Monad +import Control.Exception +import qualified Data.ByteString.Char8 as BC +import Network.Socket ( close, Socket, SocketType(..), SockAddr(..), Family(..) + , socket, socketToHandle, connect) +import Network.BSD +import Network (PortID(..)) + +import qualified Network.Socks5.Command as Cmd +import Network.Socks5.Conf +import Network.Socks5.Types +import Network.Socks5.Lowlevel + +import System.IO + +-- | connect a user specified new socket to the socks server, +-- and connect the stream on the server side to the 'SockAddress' specified. +-- +-- |socket|-----sockServer----->|server|----destAddr----->|destination| +-- +socksConnectWithSocket :: Socket -- ^ Socket to use. + -> SocksConf -- ^ SOCKS configuration for the server. + -> SocksAddress -- ^ SOCKS Address to connect to. + -> IO (SocksHostAddress, PortNumber) +socksConnectWithSocket sock serverConf destAddr = do + serverAddr <- resolveToSockAddr (socksServer serverConf) + connect sock serverAddr + r <- Cmd.establish sock [SocksMethodNone] + when (r == SocksMethodNotAcceptable) $ error "cannot connect with no socks method of authentication" + Cmd.rpc_ sock (Connect destAddr) + +-- | connect a new socket to a socks server and connect the stream on the +-- server side to the 'SocksAddress' specified. +socksConnect :: SocksConf -- ^ SOCKS configuration for the server. + -> SocksAddress -- ^ SOCKS Address to connect to. + -> IO (Socket, (SocksHostAddress, PortNumber)) +socksConnect serverConf destAddr = + getProtocolNumber "tcp" >>= \proto -> + bracketOnError (socket AF_INET Stream proto) close $ \sock -> do + ret <- socksConnectWithSocket sock serverConf destAddr + return (sock, ret) + +-- | connect a new socket to the socks server, and connect the stream on the server side +-- to the sockaddr specified. the sockaddr need to be SockAddrInet or SockAddrInet6. +-- +-- a unix sockaddr will raises an exception. +-- +-- |socket|-----sockServer----->|server|----destAddr----->|destination| +{-# DEPRECATED socksConnectAddr "use socksConnectWithSocket" #-} +socksConnectAddr :: Socket -> SockAddr -> SockAddr -> IO () +socksConnectAddr sock sockserver destaddr = + socksConnectWithSocket sock + (defaultSocksConfFromSockAddr sockserver) + (socksServer $ defaultSocksConfFromSockAddr destaddr) >> + return () + +-- | connect a new socket to the socks server, and connect the stream to a FQDN +-- resolved on the server side. +socksConnectName :: Socket -> SockAddr -> String -> PortNumber -> IO () +socksConnectName sock sockserver destination port = do + socksConnectWithSocket sock + (defaultSocksConfFromSockAddr sockserver) + (SocksAddress (SocksAddrDomainName $ BC.pack destination) port) + >> return () + +-- | create a new socket and connect in to a destination through the specified +-- SOCKS configuration. +socksConnectWith :: SocksConf -- ^ SOCKS configuration + -> String -- ^ destination hostname + -> PortID -- ^ destination port + -> IO Socket +socksConnectWith socksConf desthost destport = do + dport <- resolvePortID destport + proto <- getProtocolNumber "tcp" + bracketOnError (socket AF_INET Stream proto) close $ \sock -> do + sockaddr <- resolveToSockAddr (socksServer socksConf) + socksConnectName sock sockaddr desthost dport + return sock + +-- | similar to Network connectTo but use a socks proxy with default socks configuration. +socksConnectTo' :: String -> PortID -> String -> PortID -> IO Socket +socksConnectTo' sockshost socksport desthost destport = do + sport <- resolvePortID socksport + let socksConf = defaultSocksConf sockshost sport + socksConnectWith socksConf desthost destport + +-- | similar to Network connectTo but use a socks proxy with default socks configuration. +socksConnectTo :: String -> PortID -> String -> PortID -> IO Handle +socksConnectTo sockshost socksport desthost destport = do + sport <- resolvePortID socksport + let socksConf = defaultSocksConf sockshost sport + sock <- socksConnectWith socksConf desthost destport + socketToHandle sock ReadWriteMode + +resolvePortID (Service serv) = getServicePortNumber serv +resolvePortID (PortNumber n) = return n +resolvePortID _ = error "unsupported unix PortID" diff --git a/Network/Socks5/Command.hs b/Network/Socks5/Command.hs new file mode 100644 index 0000000..db95fbd --- /dev/null +++ b/Network/Socks5/Command.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} +-- | +-- Module : Network.Socks5.Command +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +module Network.Socks5.Command + ( establish + , Connect(..) + , Command(..) + , connectIPV4 + , connectIPV6 + , connectDomainName + -- * lowlevel interface + , rpc + , rpc_ + , sendSerialized + , waitSerialized + ) where + +import Control.Applicative +import Control.Exception +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as BC +import Data.Serialize + +import Network.Socket (Socket, PortNumber, HostAddress, HostAddress6) +import Network.Socket.ByteString + +import Network.Socks5.Types +import Network.Socks5.Wire + +establish :: Socket -> [SocksMethod] -> IO SocksMethod +establish socket methods = do + sendAll socket (encode $ SocksHello methods) + getSocksHelloResponseMethod <$> runGetDone get (recv socket 4096) + +newtype Connect = Connect SocksAddress deriving (Show,Eq,Ord) + +class Command a where + toRequest :: a -> SocksRequest + fromRequest :: SocksRequest -> Maybe a + +instance Command SocksRequest where + toRequest = id + fromRequest = Just + +instance Command Connect where + toRequest (Connect (SocksAddress ha port)) = SocksRequest + { requestCommand = SocksCommandConnect + , requestDstAddr = ha + , requestDstPort = fromIntegral port + } + fromRequest req + | requestCommand req /= SocksCommandConnect = Nothing + | otherwise = Just $ Connect $ SocksAddress (requestDstAddr req) (requestDstPort req) + +connectIPV4 :: Socket -> HostAddress -> PortNumber -> IO (HostAddress, PortNumber) +connectIPV4 socket hostaddr port = onReply <$> rpc_ socket (Connect $ SocksAddress (SocksAddrIPV4 hostaddr) port) + where onReply (SocksAddrIPV4 h, p) = (h, p) + onReply _ = error "ipv4 requested, got something different" + +connectIPV6 :: Socket -> HostAddress6 -> PortNumber -> IO (HostAddress6, PortNumber) +connectIPV6 socket hostaddr6 port = onReply <$> rpc_ socket (Connect $ SocksAddress (SocksAddrIPV6 hostaddr6) port) + where onReply (SocksAddrIPV6 h, p) = (h, p) + onReply _ = error "ipv6 requested, got something different" + +-- TODO: FQDN should only be ascii, maybe putting a "fqdn" data type +-- in front to make sure and make the BC.pack safe. +connectDomainName :: Socket -> String -> PortNumber -> IO (SocksHostAddress, PortNumber) +connectDomainName socket fqdn port = rpc_ socket $ Connect $ SocksAddress (SocksAddrDomainName $ BC.pack fqdn) port + +sendSerialized :: Serialize a => Socket -> a -> IO () +sendSerialized sock a = sendAll sock $ encode a + +waitSerialized :: Serialize a => Socket -> IO a +waitSerialized sock = runGetDone get (getMore sock) + +rpc :: Command a => Socket -> a -> IO (Either SocksError (SocksHostAddress, PortNumber)) +rpc socket req = do + sendSerialized socket (toRequest req) + onReply <$> runGetDone get (getMore socket) + where onReply res@(responseReply -> reply) = + case reply of + SocksReplySuccess -> Right (responseBindAddr res, fromIntegral $ responseBindPort res) + SocksReplyError e -> Left e + +rpc_ :: Command a => Socket -> a -> IO (SocksHostAddress, PortNumber) +rpc_ socket req = rpc socket req >>= either throwIO return + +-- this function expect all the data to be consumed. this is fine for intertwined message, +-- but might not be a good idea for multi messages from one party. +runGetDone :: Serialize a => Get a -> IO ByteString -> IO a +runGetDone getter ioget = ioget >>= return . runGetPartial getter >>= r where +#if MIN_VERSION_cereal(0,4,0) + r (Fail s _) = error s +#else + r (Fail s) = error s +#endif + r (Partial cont) = ioget >>= r . cont + r (Done a b) + | not $ B.null b = error "got too many bytes while receiving data" + | otherwise = return a + +getMore :: Socket -> IO ByteString +getMore socket = recv socket 4096 diff --git a/Network/Socks5/Conf.hs b/Network/Socks5/Conf.hs new file mode 100644 index 0000000..c29ff7b --- /dev/null +++ b/Network/Socks5/Conf.hs @@ -0,0 +1,51 @@ +-- | +-- Module : Network.Socks5.Conf +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +-- +-- typical SOCKS configuration +module Network.Socks5.Conf + ( SocksConf(..) + , socksHost + , socksPort + , defaultSocksConf + , defaultSocksConfFromSockAddr + ) where + +import Network.Socket +import Network.Socks5.Types (SocksAddress(..), SocksHostAddress(..), SocksVersion(..)) +import qualified Data.ByteString.Char8 as BC + +-- | SOCKS configuration structure. +-- this structure will be extended in future to support authentification. +-- use defaultSocksConf to create new record. +data SocksConf = SocksConf + { socksServer :: SocksAddress -- ^ SOCKS Address + , socksVersion :: SocksVersion -- ^ SOCKS version to use + } + +-- | SOCKS Host +socksHost :: SocksConf -> SocksHostAddress +socksHost conf = ha where (SocksAddress ha _) = socksServer conf + +-- | SOCKS Port +socksPort :: SocksConf -> PortNumber +socksPort conf = port where (SocksAddress _ port) = socksServer conf + +-- | defaultSocksConf create a new record, making sure +-- API remains compatible when the record is extended. +defaultSocksConf host port = SocksConf server SocksVer5 + where server = SocksAddress haddr port + haddr = SocksAddrDomainName $ BC.pack host + +-- | same as defaultSocksConf except the server address is determined from a 'SockAddr' +-- +-- A unix SockAddr will raises an error. Only Inet and Inet6 types supported +defaultSocksConfFromSockAddr sockaddr = SocksConf server SocksVer5 + where server = SocksAddress haddr port + (haddr,port) = case sockaddr of + SockAddrInet p h -> (SocksAddrIPV4 h, p) + SockAddrInet6 p _ h _ -> (SocksAddrIPV6 h, p) + _ -> error "unsupported unix sockaddr type" diff --git a/Network/Socks5/Lowlevel.hs b/Network/Socks5/Lowlevel.hs new file mode 100644 index 0000000..c10d9b9 --- /dev/null +++ b/Network/Socks5/Lowlevel.hs @@ -0,0 +1,29 @@ +module Network.Socks5.Lowlevel + ( resolveToSockAddr + , socksListen + -- * lowlevel types + , module Network.Socks5.Wire + , module Network.Socks5.Command + ) where + +import Network.Socket +import Network.BSD +import Network.Socks5.Command +import Network.Socks5.Wire +import Network.Socks5.Types +import qualified Data.ByteString.Char8 as BC + +resolveToSockAddr :: SocksAddress -> IO SockAddr +resolveToSockAddr (SocksAddress sockHostAddr port) = + case sockHostAddr of + SocksAddrIPV4 ha -> return $ SockAddrInet port ha + SocksAddrIPV6 ha6 -> return $ SockAddrInet6 port 0 ha6 0 + SocksAddrDomainName bs -> do he <- getHostByName (BC.unpack bs) + return $ SockAddrInet port (hostAddress he) + +socksListen :: Socket -> IO SocksRequest +socksListen sock = do + hello <- waitSerialized sock + case getSocksHelloMethods hello of + _ -> do sendSerialized sock (SocksHelloResponse SocksMethodNone) + waitSerialized sock diff --git a/Network/Socks5/Parse.hs b/Network/Socks5/Parse.hs new file mode 100644 index 0000000..d857274 --- /dev/null +++ b/Network/Socks5/Parse.hs @@ -0,0 +1,217 @@ +{-# LANGUAGE Rank2Types #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Network.Socks5.Parse +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : portable +-- +-- A very simple bytestring parser related to Parsec and Attoparsec +-- +-- Simple example: +-- +-- > > parse ((,) <$> take 2 <*> byte 0x20 <*> (bytes "abc" *> anyByte)) "xx abctest" +-- > ParseOK "est" ("xx", 116) +-- +module Network.Socks5.Parse + ( Parser + , Result(..) + -- * run the Parser + , parse + , parseFeed + -- * Parser methods + , byte + , anyByte + , bytes + , take + , takeWhile + , takeAll + , skip + , skipWhile + , skipAll + , takeStorable + ) where + +import Control.Applicative +import Control.Monad +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Internal as B (toForeignPtr) +import Data.Word +import Foreign.Storable (Storable, peekByteOff, sizeOf) +import Foreign.ForeignPtr (withForeignPtr) +import Prelude hiding (take, takeWhile) + +import System.IO.Unsafe (unsafePerformIO) + +-- | Simple parsing result, that represent respectively: +-- +-- * failure: with the error message +-- +-- * continuation: that need for more input data +-- +-- * success: the remaining unparsed data and the parser value +data Result a = + ParseFail String + | ParseMore (ByteString -> Result a) + | ParseOK ByteString a + +instance Show a => Show (Result a) where + show (ParseFail err) = "ParseFailure: " ++ err + show (ParseMore _) = "ParseMore _" + show (ParseOK b a) = "ParseOK " ++ show a ++ " " ++ show b + +type Failure r = ByteString -> String -> Result r +type Success a r = ByteString -> a -> Result r + +-- | Simple ByteString parser structure +newtype Parser a = Parser + { runParser :: forall r . ByteString -> Failure r -> Success a r -> Result r } + +instance Monad Parser where + fail errorMsg = Parser $ \buf err _ -> err buf ("failed: " ++ errorMsg) + return v = Parser $ \buf _ ok -> ok buf v + m >>= k = Parser $ \buf err ok -> + runParser m buf err (\buf' a -> runParser (k a) buf' err ok) +instance MonadPlus Parser where + mzero = fail "Parser.MonadPlus.mzero" + mplus f g = Parser $ \buf err ok -> + -- rewrite the err callback of @f to call @g + runParser f buf (\_ _ -> runParser g buf err ok) ok +instance Functor Parser where + fmap f p = Parser $ \buf err ok -> + runParser p buf err (\b a -> ok b (f a)) +instance Applicative Parser where + pure = return + (<*>) d e = d >>= \b -> e >>= \a -> return (b a) +instance Alternative Parser where + empty = fail "Parser.Alternative.empty" + (<|>) = mplus + +-- | Run a parser on an @initial ByteString. +-- +-- If the Parser need more data than available, the @feeder function +-- is automatically called and fed to the More continuation. +parseFeed :: Monad m => m B.ByteString -> Parser a -> B.ByteString -> m (Result a) +parseFeed feeder p initial = loop $ parse p initial + where loop (ParseMore k) = feeder >>= (loop . k) + loop r = return r + +-- | Run a Parser on a ByteString and return a 'Result' +parse :: Parser a -> ByteString -> Result a +parse p s = runParser p s (\_ msg -> ParseFail msg) (\b a -> ParseOK b a) + +------------------------------------------------------------ +getMore :: Parser () +getMore = Parser $ \buf err ok -> ParseMore $ \nextChunk -> + if B.null nextChunk + then err buf "EOL: need more data" + else ok (B.append buf nextChunk) () + +getAll :: Parser () +getAll = Parser $ \buf err ok -> ParseMore $ \nextChunk -> + if B.null nextChunk + then ok buf () + else runParser getAll (B.append buf nextChunk) err ok + +flushAll :: Parser () +flushAll = Parser $ \buf err ok -> ParseMore $ \nextChunk -> + if B.null nextChunk + then ok buf () + else runParser getAll B.empty err ok + +------------------------------------------------------------ + +-- | Get the next byte from the parser +anyByte :: Parser Word8 +anyByte = Parser $ \buf err ok -> + case B.uncons buf of + Nothing -> runParser (getMore >> anyByte) buf err ok + Just (c1,b2) -> ok b2 c1 + +-- | Parse a specific byte at current position +-- +-- if the byte is different than the expected on, +-- this parser will raise a failure. +byte :: Word8 -> Parser () +byte w = Parser $ \buf err ok -> + case B.uncons buf of + Nothing -> runParser (getMore >> byte w) buf err ok + Just (c1,b2) | c1 == w -> ok b2 () + | otherwise -> err buf ("byte " ++ show w ++ " : failed") + +-- | Parse a sequence of bytes from current position +-- +-- if the following bytes don't match the expected +-- bytestring completely, the parser will raise a failure +bytes :: ByteString -> Parser () +bytes allExpected = consumeEq allExpected + where errMsg = "bytes " ++ show allExpected ++ " : failed" + + -- partially consume as much as possible or raise an error. + consumeEq expected = Parser $ \actual err ok -> + let eLen = B.length expected in + if B.length actual >= eLen + then -- enough data for doing a full match + let (aMatch,aRem) = B.splitAt eLen actual + in if aMatch == expected + then ok aRem () + else err actual errMsg + else -- not enough data, match as much as we have, and then recurse. + let (eMatch, eRem) = B.splitAt (B.length actual) expected + in if actual == eMatch + then runParser (getMore >> consumeEq eRem) B.empty err ok + else err actual errMsg + +------------------------------------------------------------ + +-- | Take a storable from the current position in the stream +takeStorable :: Storable d + => Parser d +takeStorable = anyStorable undefined + where + anyStorable :: Storable d => d -> Parser d + anyStorable a = do + (fptr, off, _) <- B.toForeignPtr <$> take (sizeOf a) + return $ unsafePerformIO $ withForeignPtr fptr $ \ptr -> peekByteOff ptr off + +-- | Take @n bytes from the current position in the stream +take :: Int -> Parser ByteString +take n = Parser $ \buf err ok -> + if B.length buf >= n + then let (b1,b2) = B.splitAt n buf in ok b2 b1 + else runParser (getMore >> take n) buf err ok + +-- | Take bytes while the @predicate hold from the current position in the stream +takeWhile :: (Word8 -> Bool) -> Parser ByteString +takeWhile predicate = Parser $ \buf err ok -> + case B.span predicate buf of + (_, 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 diff --git a/Network/Socks5/Types.hs b/Network/Socks5/Types.hs new file mode 100644 index 0000000..7fbec25 --- /dev/null +++ b/Network/Socks5/Types.hs @@ -0,0 +1,168 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Network.Socks5.Types +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +module Network.Socks5.Types + ( SocksVersion(..) + , SocksCommand(..) + , SocksMethod(..) + , SocksHostAddress(..) + , SocksAddress(..) + , SocksReply(..) + , SocksVersionNotSupported(..) + , SocksError(..) + ) where + +import Data.ByteString (ByteString) +import Data.Word +import Data.Data +import Network.Socket (HostAddress, HostAddress6, PortNumber) +import Control.Exception +import qualified Data.ByteString.Char8 as BC +import Numeric (showHex) +import Data.List (intersperse) + +-- | Socks Version +data SocksVersion = SocksVer5 + deriving (Show,Eq,Ord) + +-- | Command that can be send and receive on the SOCKS protocol +data SocksCommand = + SocksCommandConnect + | SocksCommandBind + | SocksCommandUdpAssociate + | SocksCommandOther !Word8 + deriving (Show,Eq,Ord) + +-- | Authentication methods available on the SOCKS protocol. +-- +-- Only SocksMethodNone is effectively implemented, but +-- other value are enumerated for completeness. +data SocksMethod = + SocksMethodNone + | SocksMethodGSSAPI + | SocksMethodUsernamePassword + | SocksMethodOther !Word8 + | SocksMethodNotAcceptable + deriving (Show,Eq,Ord) + +-- | A Host address on the SOCKS protocol. +data SocksHostAddress = + SocksAddrIPV4 !HostAddress + | SocksAddrDomainName !ByteString + | SocksAddrIPV6 !HostAddress6 + deriving (Eq,Ord) + +instance Show SocksHostAddress where + show (SocksAddrIPV4 ha) = "SocksAddrIPV4(" ++ showHostAddress ha ++ ")" + show (SocksAddrIPV6 ha6) = "SocksAddrIPV6(" ++ showHostAddress6 ha6 ++ ")" + show (SocksAddrDomainName dn) = "SocksAddrDomainName(" ++ BC.unpack dn ++ ")" + +-- | Converts a HostAddress to a String in dot-decimal notation +showHostAddress :: HostAddress -> String +showHostAddress num = concat [show q1, ".", show q2, ".", show q3, ".", show q4] + where (num',q1) = num `quotRem` 256 + (num'',q2) = num' `quotRem` 256 + (num''',q3) = num'' `quotRem` 256 + (_,q4) = num''' `quotRem` 256 + +-- | Converts a IPv6 HostAddress6 to standard hex notation +showHostAddress6 :: HostAddress6 -> String +showHostAddress6 (a,b,c,d) = + (concat . intersperse ":" . map (flip showHex "")) + [p1,p2,p3,p4,p5,p6,p7,p8] + where (a',p2) = a `quotRem` 65536 + (_,p1) = a' `quotRem` 65536 + (b',p4) = b `quotRem` 65536 + (_,p3) = b' `quotRem` 65536 + (c',p6) = c `quotRem` 65536 + (_,p5) = c' `quotRem` 65536 + (d',p8) = d `quotRem` 65536 + (_,p7) = d' `quotRem` 65536 + +-- | Describe a Socket address on the SOCKS protocol +data SocksAddress = SocksAddress !SocksHostAddress !PortNumber + deriving (Show,Eq,Ord) + +-- | Type of reply on the SOCKS protocol +data SocksReply = + SocksReplySuccess + | SocksReplyError SocksError + deriving (Show,Eq,Ord,Data,Typeable) + +-- | SOCKS error that can be received or sent +data SocksError = + SocksErrorGeneralServerFailure + | SocksErrorConnectionNotAllowedByRule + | SocksErrorNetworkUnreachable + | SocksErrorHostUnreachable + | SocksErrorConnectionRefused + | SocksErrorTTLExpired + | SocksErrorCommandNotSupported + | SocksErrorAddrTypeNotSupported + | SocksErrorOther Word8 + deriving (Show,Eq,Ord,Data,Typeable) + +-- | Exception returned when using a SOCKS version that is not supported. +-- +-- This package only implement version 5. +data SocksVersionNotSupported = SocksVersionNotSupported + deriving (Show,Data,Typeable) + +instance Exception SocksError +instance Exception SocksVersionNotSupported + +instance Enum SocksCommand where + toEnum 1 = SocksCommandConnect + toEnum 2 = SocksCommandBind + toEnum 3 = SocksCommandUdpAssociate + toEnum w + | w < 256 = SocksCommandOther $ fromIntegral w + | otherwise = error "socks command is only 8 bits" + fromEnum SocksCommandConnect = 1 + fromEnum SocksCommandBind = 2 + fromEnum SocksCommandUdpAssociate = 3 + fromEnum (SocksCommandOther w) = fromIntegral w + +instance Enum SocksMethod where + toEnum 0 = SocksMethodNone + toEnum 1 = SocksMethodGSSAPI + toEnum 2 = SocksMethodUsernamePassword + toEnum 0xff = SocksMethodNotAcceptable + toEnum w + | w < 256 = SocksMethodOther $ fromIntegral w + | otherwise = error "socks method is only 8 bits" + fromEnum SocksMethodNone = 0 + fromEnum SocksMethodGSSAPI = 1 + fromEnum SocksMethodUsernamePassword = 2 + fromEnum (SocksMethodOther w) = fromIntegral w + fromEnum SocksMethodNotAcceptable = 0xff + +instance Enum SocksError where + fromEnum SocksErrorGeneralServerFailure = 1 + fromEnum SocksErrorConnectionNotAllowedByRule = 2 + fromEnum SocksErrorNetworkUnreachable = 3 + fromEnum SocksErrorHostUnreachable = 4 + fromEnum SocksErrorConnectionRefused = 5 + fromEnum SocksErrorTTLExpired = 6 + fromEnum SocksErrorCommandNotSupported = 7 + fromEnum SocksErrorAddrTypeNotSupported = 8 + fromEnum (SocksErrorOther w) = fromIntegral w + toEnum 1 = SocksErrorGeneralServerFailure + toEnum 2 = SocksErrorConnectionNotAllowedByRule + toEnum 3 = SocksErrorNetworkUnreachable + toEnum 4 = SocksErrorHostUnreachable + toEnum 5 = SocksErrorConnectionRefused + toEnum 6 = SocksErrorTTLExpired + toEnum 7 = SocksErrorCommandNotSupported + toEnum 8 = SocksErrorAddrTypeNotSupported + toEnum w = SocksErrorOther $ fromIntegral w + +instance Enum SocksReply where + fromEnum SocksReplySuccess = 0 + fromEnum (SocksReplyError e) = fromEnum e + toEnum 0 = SocksReplySuccess + toEnum n = SocksReplyError (toEnum n) diff --git a/Network/Socks5/Wire.hs b/Network/Socks5/Wire.hs new file mode 100644 index 0000000..161b09d --- /dev/null +++ b/Network/Socks5/Wire.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Network.Socks5.Wire +-- License : BSD-style +-- Maintainer : Vincent Hanquez +-- Stability : experimental +-- Portability : unknown +module Network.Socks5.Wire + ( SocksHello(..) + , SocksHelloResponse(..) + , SocksRequest(..) + , SocksResponse(..) + ) where + +import Control.Applicative +import Control.Monad +import qualified Data.ByteString as B +import Data.Serialize + +import Network.Socket (PortNumber) + +import Network.Socks5.Types +import Network.Socks5.Parse as P (anyByte, take) + +-- | Initial message sent by client with the list of authentification methods supported +data SocksHello = SocksHello { getSocksHelloMethods :: [SocksMethod] } + deriving (Show,Eq) + +-- | Initial message send by server in return from Hello, with the +-- server chosen method of authentication +data SocksHelloResponse = SocksHelloResponse { getSocksHelloResponseMethod :: SocksMethod } + deriving (Show,Eq) + +-- | Define a SOCKS requests +data SocksRequest = SocksRequest + { requestCommand :: SocksCommand + , requestDstAddr :: SocksHostAddress + , requestDstPort :: PortNumber + } deriving (Show,Eq) + +-- | Define a SOCKS response +data SocksResponse = SocksResponse + { responseReply :: SocksReply + , responseBindAddr :: SocksHostAddress + , responseBindPort :: PortNumber + } deriving (Show,Eq) + +getAddr 1 = SocksAddrIPV4 <$> getWord32host +getAddr 3 = SocksAddrDomainName <$> (getWord8 >>= getByteString . fromIntegral) +getAddr 4 = SocksAddrIPV6 <$> (liftM4 (,,,) getWord32host getWord32host getWord32host getWord32host) +getAddr n = error ("cannot get unknown socket address type: " ++ show n) + +putAddr (SocksAddrIPV4 h) = putWord8 1 >> putWord32host h +putAddr (SocksAddrDomainName b) = putWord8 3 >> putWord8 (fromIntegral $ B.length b) >> putByteString b +putAddr (SocksAddrIPV6 (a,b,c,d)) = putWord8 4 >> mapM_ putWord32host [a,b,c,d] + +getSocksRequest 5 = do + cmd <- toEnum . fromIntegral <$> getWord8 + _ <- getWord8 + addr <- getWord8 >>= getAddr + port <- fromIntegral <$> getWord16be + return $ SocksRequest cmd addr port +getSocksRequest v = + error ("unsupported version of the protocol " ++ show v) + +getSocksResponse 5 = do + reply <- toEnum . fromIntegral <$> getWord8 + _ <- getWord8 + addr <- getWord8 >>= getAddr + port <- fromIntegral <$> getWord16be + return $ SocksResponse reply addr port +getSocksResponse v = + error ("unsupported version of the protocol " ++ show v) + +instance Serialize SocksHello where + put (SocksHello ms) = do + putWord8 5 + putWord8 $ fromIntegral $ length ms + mapM_ (putWord8 . fromIntegral . fromEnum) ms + get = do + v <- getWord8 + case v of + 5 -> getWord8 >>= flip replicateM (toEnum . fromIntegral <$> getWord8) . fromIntegral >>= return . SocksHello + _ -> error "unsupported sock hello version" + +instance Serialize SocksHelloResponse where + put (SocksHelloResponse m) = putWord8 5 >> putWord8 (fromIntegral $ fromEnum $ m) + get = do + v <- getWord8 + case v of + 5 -> SocksHelloResponse . toEnum . fromIntegral <$> getWord8 + _ -> error "unsupported sock hello response version" + +instance Serialize SocksRequest where + put req = do + putWord8 5 + putWord8 $ fromIntegral $ fromEnum $ requestCommand req + putWord8 0 + putAddr $ requestDstAddr req + putWord16be $ fromIntegral $ requestDstPort req + + get = getWord8 >>= getSocksRequest + +instance Serialize SocksResponse where + put req = do + putWord8 5 + putWord8 $ fromIntegral $ fromEnum $ responseReply req + putWord8 0 + putAddr $ responseBindAddr req + putWord16be $ fromIntegral $ responseBindPort req + get = getWord8 >>= getSocksResponse diff --git a/README.md b/README.md new file mode 100644 index 0000000..540dac8 --- /dev/null +++ b/README.md @@ -0,0 +1,21 @@ +Socks +===== + +Haskell library implementation of the SOCKS 5 protocol. + +TODO +---- + + * more socks authentification methods: only no authentification is supported for now. + * support of socks' bind for server to client connection (like FTP). + * add socks4a and socks4 support. + +Usage +----- + +See Example.hs for really simple and straighforward example. The main api is only 2 calls: + + * socksConnectAddr which connect to a SockAddr (SockAddrInet or SockAddrInet6). + The name resolution is left on client side. + * socksConnectName which connect to a fully qualified domain name "www.example.com". + The proxy server will do the name resolution. diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/socks.cabal b/socks.cabal new file mode 100644 index 0000000..9884a75 --- /dev/null +++ b/socks.cabal @@ -0,0 +1,34 @@ +Name: socks +Version: 0.5.6 +Synopsis: Socks proxy (ver 5) +Description: Socks proxy (version 5) implementation. +License: BSD3 +License-file: LICENSE +Copyright: Vincent Hanquez +Author: Vincent Hanquez +Maintainer: Vincent Hanquez +Build-Type: Simple +Category: Network +stability: experimental +Cabal-Version: >=1.18 +Homepage: http://github.com/vincenthz/hs-socks +extra-doc-files: README.md, Example.hs + +Library + Build-Depends: base >= 3 && < 5 + , bytestring + , cereal >= 0.3.1 + , network >= 2.4 + Exposed-modules: Network.Socks5 + Network.Socks5.Lowlevel + Network.Socks5.Types + Other-modules: Network.Socks5.Wire + Network.Socks5.Conf + Network.Socks5.Command + Network.Socks5.Parse + ghc-options: -Wall -fno-warn-missing-signatures -fwarn-tabs + default-language: Haskell2010 + +source-repository head + type: git + location: git://github.com/vincenthz/hs-socks