socks-0.4.1/0000755000000000000000000000000011712677202011031 5ustar0000000000000000socks-0.4.1/README.md0000644000000000000000000000120211712677202012303 0ustar0000000000000000Socks ===== Haskell library implementation of the SOCKS 5 protocol. TODO ---- * more socks authentification methods: only no authentification is supported for now. * support of socks' bind for server to client connection (like FTP). * add socks4a and socks4 support. Usage ----- See Example.hs for really simple and straighforward example. The main api is only 2 calls: * socksConnectAddr which connect to a SockAddr (SockAddrInet or SockAddrInet6). The name resolution is left on client side. * socksConnectName which connect to a fully qualified domain name "www.example.com". The proxy server will do the name resolution. socks-0.4.1/Example.hs0000644000000000000000000000357111712677202012766 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Network.Socks5 import Network.Socket hiding (recv) import Network.Socket.ByteString import Network.BSD import Network import Data.ByteString.Char8 () import qualified Data.ByteString.Char8 as BC import System.IO (hClose, hFlush) import System.Environment (getArgs) main = do args <- getArgs let serverName = "localhost" let serverPort = 1080 let destinationName = case args of [] -> "www.google.com" (x:_) -> x -- socks server is expected to be running on localhost port 1080 he <- getHostByName serverName let socksServerAddr = SockAddrInet serverPort (head $ hostAddresses he) example1 socksServerAddr destinationName example2 socksServerAddr destinationName example3 serverName serverPort destinationName 80 where -- connect to @destName on port 80 through the socks server -- www.google.com get resolve on the client here and then the sockaddr is -- passed to socksConnectAddr example1 socksServerAddr destName = do socket <- socket AF_INET Stream defaultProtocol gHost <- getHostByName destName let destinationAddr = SockAddrInet 80 (head $ hostAddresses gHost) socksConnectAddr socket socksServerAddr destinationAddr sendAll socket "GET / HTTP/1.0\r\n\r\n" recv socket 4096 >>= putStrLn . show sClose socket -- connect to @destName on port 80 through the socks server -- the server is doing the resolution itself example2 socksServerAddr destName = do socket <- socket AF_INET Stream defaultProtocol socksConnectName socket socksServerAddr destName 80 sendAll socket "GET / HTTP/1.0\r\n\r\n" recv socket 4096 >>= putStrLn . show sClose socket example3 sname sport dname dport = do handle <- socksConnectTo sname (PortNumber sport) dname (PortNumber dport) BC.hPut handle "GET / HTTP/1.0\r\n\r\n" hFlush handle BC.hGet handle 1024 >>= putStrLn . show hClose handle socks-0.4.1/LICENSE0000644000000000000000000000273111712677202012041 0ustar0000000000000000Copyright (c) 2010-2011 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. socks-0.4.1/Setup.hs0000644000000000000000000000005611712677202012466 0ustar0000000000000000import Distribution.Simple main = defaultMain socks-0.4.1/socks.cabal0000644000000000000000000000206211712677202013137 0ustar0000000000000000Name: socks Version: 0.4.1 Description: Socks proxy (version 5) implementation. License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: Vincent Hanquez Synopsis: Socks proxy (version 5) implementation. Build-Type: Simple Category: Network stability: experimental Cabal-Version: >=1.6 Homepage: http://github.com/vincenthz/hs-socks data-files: README.md, Example.hs Library Build-Depends: base >= 3 && < 5 , bytestring , cereal >= 0.3 , network >= 2.3 Exposed-modules: Network.Socks5 Other-modules: Network.Socks5.Wire Network.Socks5.Types Network.Socks5.Command ghc-options: -Wall -fno-warn-missing-signatures source-repository head type: git location: git://github.com/vincenthz/hs-socks socks-0.4.1/Network/0000755000000000000000000000000011712677202012462 5ustar0000000000000000socks-0.4.1/Network/Socks5.hs0000644000000000000000000000663211712677202014174 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : Network.Socks5 -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Network.Socks5 ( SocksConf(..) , defaultSocksConf , socksConnectAddr , socksConnectName , socksConnectTo , socksConnectWith ) where import Control.Monad import Control.Exception import Network.Socket import Network.BSD import Network.Socks5.Command import Network.Socks5.Types import Network import System.IO -- | SOCKS configuration structure. -- this structure will be extended in future to support authentification. -- use defaultSocksConf to create new record. data SocksConf = SocksConf { socksHost :: String -- ^ SOCKS host. , socksPort :: PortNumber -- ^ SOCKS port. , socksVersion :: Int -- ^ SOCKS version to use, only 5 supported for now. } -- | defaultSocksConf create a new record, making sure -- API remains compatible when the record is extended. defaultSocksConf host port = SocksConf host port 5 withSocks sock sockaddr f = do connect sock sockaddr r <- socks5Establish sock [SocksMethodNone] when (r == SocksMethodNotAcceptable) $ error "cannot connect with no socks method of authentication" f -- | 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| socksConnectAddr :: Socket -> SockAddr -> SockAddr -> IO () socksConnectAddr sock sockserver destaddr = withSocks sock sockserver $ do case destaddr of SockAddrInet p h -> socks5ConnectIPV4 sock h p >> return () SockAddrInet6 p _ h _ -> socks5ConnectIPV6 sock h p >> return () _ -> error "unsupported unix sockaddr type" -- | 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 = withSocks sock sockserver $ do _ <- socks5ConnectDomainName sock 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 sockConf desthost destport = do dport <- resolvePortID destport proto <- getProtocolNumber "tcp" bracketOnError (socket AF_INET Stream proto) sClose $ \sock -> do he <- getHostByName $ socksHost sockConf let sockaddr = SockAddrInet (socksPort sockConf) (hostAddress he) 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 Handle socksConnectTo sockshost socksport desthost destport = do sport <- resolvePortID socksport let socksConf = defaultSocksConf sockshost sport sock <- socksConnectWith socksConf desthost destport socketToHandle sock ReadWriteMode resolvePortID (Service serv) = getServicePortNumber serv resolvePortID (PortNumber n) = return n resolvePortID _ = error "unsupported unix PortID" socks-0.4.1/Network/Socks5/0000755000000000000000000000000011712677202013631 5ustar0000000000000000socks-0.4.1/Network/Socks5/Command.hs0000644000000000000000000000567011712677202015553 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : Network.Socks5.Command -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- module Network.Socks5.Command ( socks5Establish , socks5ConnectIPV4 , socks5ConnectIPV6 , socks5ConnectDomainName -- * lowlevel interface , socks5Rpc ) 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 socks5Establish :: Socket -> [SocksMethod] -> IO SocksMethod socks5Establish socket methods = do sendAll socket (encode $ SocksHello methods) getSocksHelloResponseMethod <$> runGetDone get (recv socket 4096) socks5ConnectIPV4 :: Socket -> HostAddress -> PortNumber -> IO (HostAddress, PortNumber) socks5ConnectIPV4 socket hostaddr port = onReply <$> socks5Rpc socket request where request = SocksRequest { requestCommand = SocksCommandConnect , requestDstAddr = SocksAddrIPV4 hostaddr , requestDstPort = fromIntegral port } onReply (SocksAddrIPV4 h, p) = (h, p) onReply _ = error "ipv4 requested, got something different" socks5ConnectIPV6 :: Socket -> HostAddress6 -> PortNumber -> IO (HostAddress6, PortNumber) socks5ConnectIPV6 socket hostaddr6 port = onReply <$> socks5Rpc socket request where request = SocksRequest { requestCommand = SocksCommandConnect , requestDstAddr = SocksAddrIPV6 hostaddr6 , requestDstPort = fromIntegral port } 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. socks5ConnectDomainName :: Socket -> String -> PortNumber -> IO (SocksAddr, PortNumber) socks5ConnectDomainName socket fqdn port = socks5Rpc socket $ SocksRequest { requestCommand = SocksCommandConnect , requestDstAddr = SocksAddrDomainName $ BC.pack fqdn , requestDstPort = fromIntegral port } socks5Rpc :: Socket -> SocksRequest -> IO (SocksAddr, PortNumber) socks5Rpc socket req = do sendAll socket (encode req) onReply <$> runGetDone get (recv socket 4096) where onReply res@(responseReply -> reply) | reply /= SocksReplySuccess = throw $ SocksError reply | otherwise = (responseBindAddr res, fromIntegral $ responseBindPort res) runGetDone :: Show a => Get a -> IO ByteString -> IO a runGetDone getter ioget = ioget >>= return . runGetPartial getter >>= r where r (Fail s) = error s 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 socks-0.4.1/Network/Socks5/Types.hs0000644000000000000000000000667711712677202015311 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Network.Socks5.Types -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown module Network.Socks5.Types ( SocksCommand(..) , SocksMethod(..) , SocksAddr(..) , SocksReply(..) , SocksVersionNotSupported(..) , SocksError(..) ) where import Data.ByteString (ByteString) import Data.Word import Data.Data import Network.Socket (HostAddress, HostAddress6) import Control.Exception data SocksCommand = SocksCommandConnect | SocksCommandBind | SocksCommandUdpAssociate | SocksCommandOther Word8 deriving (Show,Eq,Ord) data SocksMethod = SocksMethodNone | SocksMethodGSSAPI | SocksMethodUsernamePassword | SocksMethodOther Word8 | SocksMethodNotAcceptable deriving (Show,Eq,Ord) data SocksAddr = SocksAddrIPV4 HostAddress | SocksAddrDomainName ByteString | SocksAddrIPV6 HostAddress6 deriving (Show,Eq) data SocksReply = SocksReplySuccess | SocksReplyGeneralServerFailure | SocksReplyConnectionNotAllowedByRule | SocksReplyNetworkUnreachable | SocksReplyHostUnreachable | SocksReplyConnectionRefused | SocksReplyTTLExpired | SocksReplyCommandNotSupported | SocksReplyAddrTypeNotSupported | SocksReplyOther Word8 deriving (Show,Eq,Ord,Data,Typeable) data SocksVersionNotSupported = SocksVersionNotSupported deriving (Show,Data,Typeable) data SocksError = SocksError SocksReply deriving (Show,Eq,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 SocksReply where fromEnum SocksReplySuccess = 0 fromEnum SocksReplyGeneralServerFailure = 1 fromEnum SocksReplyConnectionNotAllowedByRule = 2 fromEnum SocksReplyNetworkUnreachable = 3 fromEnum SocksReplyHostUnreachable = 4 fromEnum SocksReplyConnectionRefused = 5 fromEnum SocksReplyTTLExpired = 6 fromEnum SocksReplyCommandNotSupported = 7 fromEnum SocksReplyAddrTypeNotSupported = 8 fromEnum (SocksReplyOther w) = fromIntegral w toEnum 0 = SocksReplySuccess toEnum 1 = SocksReplyGeneralServerFailure toEnum 2 = SocksReplyConnectionNotAllowedByRule toEnum 3 = SocksReplyNetworkUnreachable toEnum 4 = SocksReplyHostUnreachable toEnum 5 = SocksReplyConnectionRefused toEnum 6 = SocksReplyTTLExpired toEnum 7 = SocksReplyCommandNotSupported toEnum 8 = SocksReplyAddrTypeNotSupported toEnum w | w < 256 = SocksReplyOther $ fromIntegral w | otherwise = error "sock reply is only 8 bits" socks-0.4.1/Network/Socks5/Wire.hs0000644000000000000000000000631411712677202015077 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Network.Socks5.Wire -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown module Network.Socks5.Wire ( SocksHello(..) , SocksHelloResponse(..) , SocksRequest(..) , SocksResponse(..) ) where import Control.Applicative import Control.Monad import qualified Data.ByteString as B import Data.Serialize import Network.Socket (PortNumber) import Network.Socks5.Types data SocksHello = SocksHello { getSocksHelloMethods :: [SocksMethod] } deriving (Show,Eq) data SocksHelloResponse = SocksHelloResponse { getSocksHelloResponseMethod :: SocksMethod } deriving (Show,Eq) data SocksRequest = SocksRequest { requestCommand :: SocksCommand , requestDstAddr :: SocksAddr , requestDstPort :: PortNumber } deriving (Show,Eq) data SocksResponse = SocksResponse { responseReply :: SocksReply , responseBindAddr :: SocksAddr , responseBindPort :: PortNumber } deriving (Show,Eq) getAddr 1 = SocksAddrIPV4 <$> getWord32be getAddr 3 = SocksAddrDomainName <$> (getWord8 >>= getByteString . fromIntegral) getAddr 4 = SocksAddrIPV6 <$> (liftM4 (,,,) getWord32le getWord32le getWord32le getWord32le) 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