crypton-socks (empty) → 0.6.1

raw patch · 13 files changed

+948/−0 lines, 13 filesdep +basedep +basementdep +bytestringsetup-changed

Dependencies added: base, basement, bytestring, cereal, network

Files

CHANGELOG.md +14/−0
Example.hs +46/−0
LICENSE +27/−0
Network/Socks5.hs +89/−0
Network/Socks5/Command.hs +112/−0
Network/Socks5/Conf.hs +40/−0
Network/Socks5/Lowlevel.hs +18/−0
Network/Socks5/Parse.hs +221/−0
Network/Socks5/Types.hs +176/−0
Network/Socks5/Wire.hs +124/−0
README.md +31/−0
Setup.hs +2/−0
crypton-socks.cabal +48/−0

+ CHANGELOG.md view

@@ -0,0 +1,14 @@+Change log for `crypton-socks`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## 0.6.1
+
+* Rename `socks-0.6.1` package as `crypton-socks-0.6.1`.
+* Change maintainer field to `Mike Pilgrem <public@pilgrem.com>` and
+  `Kazu Yamamoto <kazu@iij.ad.jp>`.
+* Add `CHANGELOG.md`.

+ Example.hs view

@@ -0,0 +1,46 @@+{-# 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

+ LICENSE view

@@ -0,0 +1,27 @@+Copyright (c) 2010-2019 Vincent Hanquez <vincent@snarc.org>
+
+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.

+ Network/Socks5.hs view

@@ -0,0 +1,89 @@+{-# 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 view

@@ -0,0 +1,112 @@+{-# 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 view

@@ -0,0 +1,40 @@+-- |
+-- 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 view

@@ -0,0 +1,18 @@+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 view

@@ -0,0 +1,221 @@+{-# 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 view

@@ -0,0 +1,176 @@+{-# 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 view

@@ -0,0 +1,124 @@+{-# 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

@@ -0,0 +1,31 @@+crypton-socks
+=============
+
+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.
+
+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.
+
+History
+-------
+
+The [`socks`](https://hackage.haskell.org/package/socks) package was originated
+and then maintained by Vincent Hanquez. For published reasons, he does not
+intend to develop the package further after version 0.6.1 but he also does not
+want to introduce other maintainers.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

+ crypton-socks.cabal view

@@ -0,0 +1,48 @@+cabal-version: 1.18
+
+-- This file has been generated from package.yaml by hpack version 0.38.1.
+--
+-- see: https://github.com/sol/hpack
+
+name:           crypton-socks
+version:        0.6.1
+synopsis:       Socks proxy (ver 5)
+description:    Socks proxy (version 5) implementation.
+category:       Network
+stability:      experimental
+homepage:       http://github.com/mpilgrem/socks5
+bug-reports:    https://github.com/mpilgrem/socks5/issues
+author:         Vincent Hanquez <vincent@snarc.org>
+maintainer:     Mike Pilgrem <public@pilgrem.com>,
+                Kazu Yamamoto <kazu@iij.ad.jp>
+copyright:      Vincent Hanquez <vincent@snarc.org>
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+extra-doc-files:
+    CHANGELOG.md
+    README.md
+    Example.hs
+
+source-repository head
+  type: git
+  location: https://github.com/mpilgrem/socks5
+
+library
+  exposed-modules:
+      Network.Socks5
+      Network.Socks5.Lowlevel
+      Network.Socks5.Types
+  other-modules:
+      Network.Socks5.Command
+      Network.Socks5.Conf
+      Network.Socks5.Parse
+      Network.Socks5.Wire
+  ghc-options: -Wall -fno-warn-missing-signatures -fwarn-tabs
+  build-depends:
+      base >=3 && <5
+    , basement
+    , bytestring
+    , cereal >=0.3.1
+    , network >=2.6
+  default-language: Haskell2010