diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +The MIT License (MIT) + +Copyright (c) 2014 rnons + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Shadowsocks/Cipher.hsc b/Shadowsocks/Cipher.hsc new file mode 100644 --- /dev/null +++ b/Shadowsocks/Cipher.hsc @@ -0,0 +1,110 @@ +-- Shamelessly taken from https://github.com/phonohawk/HsOpenSSL +-- With ByteString version of cipherInit + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} + +module Shadowsocks.Cipher + ( CryptoMode (..) + , cipherInit + , cipherUpdateBS + , getCipherByName + ) where + +#include + +import Control.Applicative ((<$>)) +import Control.Exception (mask_) +import Control.Monad (void) +import qualified Data.ByteString.Internal as B8 +import Data.ByteString (useAsCStringLen) +import Foreign.C +import Foreign.C.Types +import Foreign.ForeignPtr +import Foreign.Marshal.Alloc (alloca) +import Foreign.Ptr +import Foreign.Storable (Storable(..)) + +foreign import ccall unsafe "EVP_CIPHER_CTX_init" + _cipher_ctx_init :: Ptr EVP_CIPHER_CTX -> IO () + +foreign import ccall unsafe "&EVP_CIPHER_CTX_cleanup" + _cipher_ctx_cleanup :: FunPtr (Ptr EVP_CIPHER_CTX -> IO ()) + +foreign import ccall unsafe "EVP_CIPHER_CTX_block_size" + _cipher_ctx_block_size :: Ptr EVP_CIPHER_CTX -> CInt + +foreign import ccall unsafe "EVP_get_cipherbyname" + _get_cipherbyname :: CString -> IO (Ptr EVP_CIPHER) + +foreign import ccall unsafe "EVP_CipherInit" + _CipherInit :: Ptr EVP_CIPHER_CTX + -> Ptr EVP_CIPHER -> CString -> CString -> CInt -> IO CInt + +foreign import ccall unsafe "EVP_CipherUpdate" + _CipherUpdate :: Ptr EVP_CIPHER_CTX -> Ptr CChar -> Ptr CInt + -> Ptr CChar -> CInt -> IO CInt + +newtype Cipher = Cipher (Ptr EVP_CIPHER) +data EVP_CIPHER + +newtype CipherCtx = CipherCtx (ForeignPtr EVP_CIPHER_CTX) +data EVP_CIPHER_CTX + +newCipherCtx :: IO CipherCtx +newCipherCtx = do + ctx <- mallocForeignPtrBytes (#size EVP_CIPHER_CTX) + mask_ $ do + withForeignPtr ctx _cipher_ctx_init + addForeignPtrFinalizer _cipher_ctx_cleanup ctx + return $ CipherCtx ctx + +withCipherCtxPtr :: CipherCtx -> (Ptr EVP_CIPHER_CTX -> IO a) -> IO a +withCipherCtxPtr (CipherCtx ctx) = withForeignPtr ctx + +-- |@'getCipherByName' name@ returns a symmetric cipher algorithm +-- whose name is @name@. If no algorithms are found, the result is +-- @Nothing@. +getCipherByName :: String -> IO (Maybe Cipher) +getCipherByName name + = withCString name $ \ namePtr -> + do ptr <- _get_cipherbyname namePtr + return $ if ptr == nullPtr then Nothing else Just $ Cipher ptr + +data CryptoMode = Encrypt | Decrypt + +cryptoModeToInt :: CryptoMode -> CInt +cryptoModeToInt Encrypt = 1 +cryptoModeToInt Decrypt = 0 + +cipherInit :: Cipher + -> B8.ByteString -> B8.ByteString -> CryptoMode -> IO CipherCtx +cipherInit (Cipher c) key iv mode + = do ctx <- newCipherCtx + withCipherCtxPtr ctx $ \ ctxPtr -> + useAsCStringLen key $ \ (keyPtr, _) -> + useAsCStringLen iv $ \ (ivPtr, _) -> + _CipherInit ctxPtr c keyPtr ivPtr (cryptoModeToInt mode) + >>= failIf_ (/= 1) + return ctx + +cipherUpdateBS :: CipherCtx -> B8.ByteString -> IO B8.ByteString +cipherUpdateBS ctx inBS = + withCipherCtxPtr ctx $ \ctxPtr -> + useAsCStringLen inBS $ \(inBuf, inLen) -> + let len = inLen + fromIntegral (_cipher_ctx_block_size ctxPtr) - 1 in + B8.createAndTrim len $ \outBuf -> + alloca $ \outLenPtr -> + _CipherUpdate ctxPtr (castPtr outBuf) outLenPtr inBuf + (fromIntegral inLen) + >>= failIf (/= 1) + >> fromIntegral <$> peek outLenPtr + +failIf :: (a -> Bool) -> a -> IO a +failIf f a + | f a = error "error" + | otherwise = return a + +failIf_ :: (a -> Bool) -> a -> IO () +failIf_ f a = void $ failIf f a diff --git a/Shadowsocks/Encrypt.hs b/Shadowsocks/Encrypt.hs new file mode 100644 --- /dev/null +++ b/Shadowsocks/Encrypt.hs @@ -0,0 +1,133 @@ +{-# LANGUAGE OverloadedStrings #-} +module Shadowsocks.Encrypt + ( getEncDec + , iv_len + ) where + +import Control.Concurrent.MVar ( newEmptyMVar, isEmptyMVar + , putMVar, readMVar) +import Crypto.Hash.MD5 (hash) +import Data.Binary.Get (runGet, getWord64le) +import Data.ByteString (ByteString) +import qualified Data.ByteString as S +import qualified Data.ByteString.Char8 as C +import qualified Data.ByteString.Lazy as L +import qualified Data.HashMap.Strict as HM +import Data.IntMap.Strict (fromList, (!)) +import Data.List (sortBy) +import Data.Maybe (fromJust) +import Data.Monoid ((<>)) +import Data.Word (Word8, Word64) +import OpenSSL (withOpenSSL) +import OpenSSL.Random (randBytes) + +import Shadowsocks.Cipher + + +method_supported :: HM.HashMap String (Int, Int) +method_supported = HM.fromList + [ ("aes-128-cfb", (16, 16)) + , ("aes-192-cfb", (24, 16)) + , ("aes-256-cfb", (32, 16)) + , ("bf-cfb", (16, 8)) + , ("camellia-128-cfb", (16, 16)) + , ("camellia-192-cfb", (24, 16)) + , ("camellia-256-cfb", (32, 16)) + , ("cast5-cfb", (16, 8)) + , ("des-cfb", (8, 8)) + , ("idea-cfb", (16, 8)) + , ("rc2-cfb", (16, 8)) + , ("rc4", (16, 0)) + , ("seed-cfb", (16, 16)) + ] + +iv_len :: String -> Int +iv_len method = m1 + where + (_, m1) = method_supported HM.! method + +getTable :: ByteString -> [Word8] +getTable key = do + let s = L.fromStrict $ hash key + a = runGet getWord64le s + table = [0..255] + + map fromIntegral $ sortTable 1 a table + +sortTable :: Word64 -> Word64 -> [Word64] -> [Word64] +sortTable 1024 _ table = table +sortTable i a table = sortTable (i+1) a $ sortBy cmp table + where + cmp x y = compare (a `mod` (x + i)) (a `mod` (y + i)) + +evpBytesToKey :: ByteString -> Int -> Int -> (ByteString, ByteString) +evpBytesToKey password keyLen ivLen = + let ms' = S.concat $ ms 0 [] + key = S.take keyLen ms' + iv = S.take ivLen $ S.drop keyLen ms' + in (key, iv) + where + ms :: Int -> [ByteString] -> [ByteString] + ms 0 _ = ms 1 [hash password] + ms i m + | S.length (S.concat m) < keyLen + ivLen = + ms (i+1) (m ++ [hash (last m <> password)]) + | otherwise = m + +getSSLEncDec :: String -> ByteString + -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString) +getSSLEncDec method password = do + let (m0, m1) = fromJust $ HM.lookup method method_supported + random_iv <- withOpenSSL $ randBytes 32 + let cipher_iv = S.take m1 random_iv + let (key, _) = evpBytesToKey password m0 m1 + cipherCtx <- newEmptyMVar + decipherCtx <- newEmptyMVar + + cipherMethod <- fmap fromJust $ withOpenSSL $ getCipherByName method + ctx <- cipherInit cipherMethod key cipher_iv Encrypt + let + encrypt "" = return "" + encrypt buf = do + empty <- isEmptyMVar cipherCtx + if empty + then do + putMVar cipherCtx () + ciphered <- withOpenSSL $ cipherUpdateBS ctx buf + return $ cipher_iv <> ciphered + else withOpenSSL $ cipherUpdateBS ctx buf + decrypt "" = return "" + decrypt buf = do + empty <- isEmptyMVar decipherCtx + if empty + then do + let decipher_iv = S.take m1 buf + dctx <- cipherInit cipherMethod key decipher_iv Decrypt + putMVar decipherCtx dctx + if S.null (S.drop m1 buf) + then return "" + else withOpenSSL $ cipherUpdateBS dctx (S.drop m1 buf) + else do + dctx <- readMVar decipherCtx + withOpenSSL $ cipherUpdateBS dctx buf + + return (encrypt, decrypt) + +getTableEncDec :: ByteString + -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString) +getTableEncDec key = return (encrypt, decrypt) + where + table = getTable key + encryptTable = fromList $ zip [0..255] table + decryptTable = fromList $ zip (map fromIntegral table) [0..255] + encrypt :: ByteString -> IO ByteString + encrypt buf = return $ + S.pack $ map (\b -> encryptTable ! fromIntegral b) $ S.unpack buf + decrypt :: ByteString -> IO ByteString + decrypt buf = return $ + S.pack $ map (\b -> decryptTable ! fromIntegral b) $ S.unpack buf + +getEncDec :: String -> String + -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString) +getEncDec "table" key = getTableEncDec $ C.pack key +getEncDec method key = getSSLEncDec method $ C.pack key diff --git a/Shadowsocks/Util.hs b/Shadowsocks/Util.hs new file mode 100644 --- /dev/null +++ b/Shadowsocks/Util.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE DeriveGeneric #-} +module Shadowsocks.Util + ( Config (..) + , parseConfigOptions + ) where + +import Control.Monad (liftM) +import Data.Aeson (decode', FromJSON) +import qualified Data.ByteString.Lazy as L +import Data.Maybe (fromMaybe) +import GHC.Generics (Generic) +import Options.Applicative +import Options.Applicative.Types (ReadM(ReadM)) + +data Config = Config + { server :: String + , server_port :: Int + , local_port :: Int + , password :: String + , timeout :: Int + , method :: String + } deriving (Show, Generic) + +instance FromJSON Config + +data Options = Options + { _server :: Maybe String + , _server_port :: Maybe Int + , _local_port :: Maybe Int + , _password :: Maybe String + , _method :: Maybe String + , _config :: Maybe String + } deriving (Show, Generic) + +nullConfig :: Config +nullConfig = Config "" 0 0 "" 0 "" + +readConfig :: FilePath -> IO (Maybe Config) +readConfig fp = liftM decode' $ L.readFile fp + +optStr :: Mod OptionFields (Maybe String) -> Parser (Maybe String) +optStr m = + nullOption $ value Nothing <> reader (success . str) <> m + where + success = ReadM . Right + +maybeOpt :: Read a => Mod OptionFields (Maybe a) -> Parser (Maybe a) +maybeOpt m = + nullOption $ value Nothing <> reader (success . auto) <> m + where + success = ReadM . Right + +configOptions :: Parser Options +configOptions = Options + <$> optStr (long "server" <> short 's' <> metavar "ADDR" + <> help "server address") + <*> maybeOpt (long "server-port" <> short 'p' <> metavar "PORT" + <> help "server port") + <*> maybeOpt (long "local-port" <> short 'l' <> metavar "PORT" + <> help "local port") + <*> optStr (long "password" <> short 'k' <> metavar "PASSWORD" + <> help "password") + <*> optStr (long "method" <> short 'm' <> metavar "METHOD" + <> help "encryption method, for example, aes-256-cfb") + <*> optStr (long "config" <> short 'c' <> metavar "CONFIG" + <> help "path to config file") + +parseConfigOptions :: IO Config +parseConfigOptions = do + o <- execParser $ info (helper <*> configOptions) + (fullDesc <> header "shadowsocks - a fast tunnel proxy") + let configFile = fromMaybe "config.json" (_config o) + mconfig <- readConfig configFile + let c = fromMaybe nullConfig mconfig + return $ c { server = fromMaybe (server c) (_server o) + , server_port = fromMaybe (server_port c) (_server_port o) + , local_port = fromMaybe (local_port c) (_local_port o) + , password = fromMaybe (password c) (_password o) + , method = fromMaybe (method c) (_method o) + } diff --git a/config.json b/config.json new file mode 100644 --- /dev/null +++ b/config.json @@ -0,0 +1,8 @@ +{ + "server":"127.0.0.1", + "server_port":8388, + "local_port":1080, + "password":"barfoo!", + "timeout":600, + "method":"table" +} diff --git a/local.hs b/local.hs new file mode 100644 --- /dev/null +++ b/local.hs @@ -0,0 +1,116 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Control.Applicative ((<$>)) +import Control.Concurrent (forkIO, forkFinally, killThread) +import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar) +import qualified Control.Exception as E +import Control.Monad (forever, void) +import Data.Char (ord) +import Data.Binary.Get (runGet, getWord16be, getWord32le) +import Data.Binary.Put (runPut, putWord16be) +import Data.ByteString (ByteString) +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Char8 as C +import Data.Monoid ((<>)) +import GHC.IO.Handle (hSetBuffering, BufferMode(NoBuffering)) +import GHC.IO.Handle.FD (stdout) +import Network.Socket hiding (recv) +import Network.Socket.ByteString (recv, sendAll) + +import Shadowsocks.Encrypt (getEncDec) +import Shadowsocks.Util + + +main :: IO () +main = withSocketsDo $ do + config <- parseConfigOptions + addrinfos <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) + Nothing + (Just $ show $ local_port config) + let sockAddr = head addrinfos + sock <- socket (addrFamily sockAddr) Stream defaultProtocol + bindSocket sock (addrAddress sockAddr) + listen sock 128 + serverAddr <- getServer (server config) (server_port config) + hSetBuffering stdout NoBuffering + + C.hPutStrLn stdout $ + "starting local at " <> C.pack (show $ local_port config) + mvar <- newEmptyMVar + forkFinally (serveForever sock config serverAddr) + (\_ -> putMVar mvar ()) + takeMVar mvar + +serveForever :: Socket -> Config -> AddrInfo -> IO () +serveForever sock config serverAddr = forever $ do + (conn, _) <- accept sock + void $ forkIO $ sockHandler conn config serverAddr + +sockHandler :: Socket -> Config -> AddrInfo -> IO () +sockHandler conn config serverAddr = + (do + (encrypt, decrypt) <- getEncDec (method config) (password config) + recv conn 262 + send conn "\x05\x00" + msg <- recv conn 4 + let m = C.unpack msg + + (addr, addr_to_send') <- if ord (m !! 3) == 1 + then do + addr_ip <- recv conn 4 + addr <- inet_ntoa $ runGet getWord32le $ L.fromStrict addr_ip + return (C.pack addr, addr_ip) + else do + addr_len <- recv conn 1 + addr <- recv conn (ord $ head $ C.unpack addr_len) + return (addr, addr_len <> addr) + + addr_port <- recv conn 2 + let addr_to_send = S.singleton (msg `S.index` 3) <> addr_to_send' <> addr_port + port = runGet getWord16be $ L.fromStrict addr_port + let reply = "\x05\x00\x00\x01" <> "\x00\x00\x00\x00" <> + L.toStrict (runPut $ putWord16be 2222) + sendAll conn reply + + remote <- socket (addrFamily serverAddr) Stream defaultProtocol + connect remote (addrAddress serverAddr) + encrypt addr_to_send >>= sendAll remote + C.putStrLn $ "connecting " <> addr <> ":" <> C.pack (show port) + wait <- newEmptyMVar + handleTCP conn remote encrypt decrypt wait) + `E.catch` (\e -> do + close conn + void $ print (e :: E.SomeException)) + +getServer :: HostName -> Int -> IO AddrInfo +getServer hostname port = + head <$> getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) + (Just hostname) + (Just $ show port) + +handleTCP :: Socket + -> Socket + -> (ByteString -> IO ByteString) + -> (ByteString -> IO ByteString) + -> MVar () + -> IO () +handleTCP conn remote encrypt decrypt wait = do + hdl1 <- forkIO handleLocal + hdl2 <- forkIO handleRemote + takeMVar wait + killThread hdl1 + killThread hdl2 + close conn + close remote + where + handleLocal = do + inData <- recv conn 4096 >>= encrypt + if S.null inData + then putMVar wait () + else sendAll remote inData >> handleLocal + handleRemote = do + inData <- recv remote 4096 >>= decrypt + if S.null inData + then putMVar wait () + else sendAll conn inData >> handleRemote diff --git a/server.hs b/server.hs new file mode 100644 --- /dev/null +++ b/server.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Control.Applicative ((<$>)) +import Control.Concurrent (forkIO, forkFinally, killThread) +import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar) +import qualified Control.Exception as E +import Control.Monad (forever, void, when) +import Data.Char (ord) +import Data.Binary.Get (runGet, getWord16be, getWord32le) +import Data.ByteString (ByteString) +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Char8 as C +import Data.Monoid ((<>)) +import GHC.IO.Handle (hSetBuffering, BufferMode(NoBuffering)) +import GHC.IO.Handle.FD (stdout) +import Network.Socket hiding (recv) +import Network.Socket.ByteString (recv, sendAll) + +import Shadowsocks.Encrypt (getEncDec, iv_len) +import Shadowsocks.Util + +main :: IO () +main = withSocketsDo $ do + config <- parseConfigOptions + addrinfos <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) + Nothing + (Just $ show $ server_port config) + let sockAddr = head addrinfos + sock <- socket (addrFamily sockAddr) Stream defaultProtocol + bindSocket sock (addrAddress sockAddr) + listen sock 128 + hSetBuffering stdout NoBuffering + + C.hPutStrLn stdout $ + "starting server at " <> C.pack (show $ server_port config) + mvar <- newEmptyMVar + forkFinally (serveForever sock config) + (\_ -> putMVar mvar ()) + takeMVar mvar + +serveForever :: Socket -> Config -> IO () +serveForever sock config = forever $ do + (conn, _) <- accept sock + void $ forkIO $ sockHandler conn config + +sockHandler :: Socket -> Config -> IO () +sockHandler conn config = + (do + (encrypt, decrypt) <- getEncDec (method config) (password config) + let methodName = method config + when (methodName /= "table") + (void $ recv conn (iv_len methodName) >>= decrypt) + addrType <- recv conn 1 >>= decrypt + + addr <- if ord (head $ C.unpack addrType) == 1 + then do + addr_ip <- recv conn 4 >>= decrypt + inet_ntoa $ runGet getWord32le $ L.fromStrict addr_ip + else do + addr_len <- recv conn 1 >>= decrypt + addr <- recv conn (ord $ head $ C.unpack addr_len) >>= decrypt + return $ C.unpack addr + + addr_port <- recv conn 2 >>= decrypt + let port = runGet getWord16be $ L.fromStrict addr_port + + remoteAddr <- head <$> + getAddrInfo Nothing (Just addr) (Just $ show port) + remote <- socket (addrFamily remoteAddr) Stream defaultProtocol + connect remote (addrAddress remoteAddr) + putStrLn $ "connecting " <> addr <> ":" <> show port + wait <- newEmptyMVar + handleTCP conn remote encrypt decrypt wait) + `E.catch` (\e -> void $ print (e :: E.SomeException)) + +handleTCP :: Socket + -> Socket + -> (ByteString -> IO ByteString) + -> (ByteString -> IO ByteString) + -> MVar () + -> IO () +handleTCP conn remote encrypt decrypt wait = do + hdl1 <- forkIO handleLocal + hdl2 <- forkIO handleRemote + takeMVar wait + killThread hdl1 + killThread hdl2 + close conn + close remote + where + handleLocal = do + inData <- recv conn 4096 >>= decrypt + if S.null inData + then putMVar wait () + else sendAll remote inData >> handleLocal + handleRemote = do + inData <- recv remote 4096 >>= encrypt + if S.null inData + then putMVar wait () + else sendAll conn inData >> handleRemote diff --git a/shadowsocks.cabal b/shadowsocks.cabal new file mode 100644 --- /dev/null +++ b/shadowsocks.cabal @@ -0,0 +1,76 @@ +name: shadowsocks +version: 1.20140617 +synopsis: A fast tunnel proxy that help you get through firewalls +description: + Shadowsocks implemented in Haskell. Original python version: +homepage: https://github.com/rnons/shadowsocks-haskell +bug-reports: https://github.com/rnons/shadowsocks-haskell/issues +license: MIT +license-file: LICENSE +author: rnons +maintainer: remotenonsense@gmail.com +category: Web +build-type: Simple +cabal-version: >= 1.10 +tested-with: GHC == 7.8.2 +data-files: config.json + +source-repository head + type: git + location: git://github.com/rnons/shadowsocks-haskell.git + +executable sslocal + main-is: local.hs + ghc-options: -Wall -fno-warn-unused-do-bind -O2 -threaded + other-modules: Shadowsocks.Cipher, + Shadowsocks.Encrypt, + Shadowsocks.Util + other-extensions: OverloadedStrings, DeriveGeneric + build-depends: base == 4.*, + aeson >= 0.7, + binary >= 0.7, + bytestring >= 0.9, + containers >= 0.5, + cryptohash >= 0.11, + HsOpenSSL >= 0.10, + network >= 2.4, + optparse-applicative >= 0.8, + unordered-containers >= 0.2 + default-language: Haskell2010 + +executable ssserver + main-is: server.hs + ghc-options: -Wall -fno-warn-unused-do-bind -O2 -threaded + other-modules: Shadowsocks.Cipher, + Shadowsocks.Encrypt, + Shadowsocks.Util + other-extensions: OverloadedStrings, DeriveGeneric + build-depends: base == 4.*, + aeson >= 0.7, + binary >= 0.7, + bytestring >= 0.9, + containers >= 0.5, + cryptohash >= 0.11, + HsOpenSSL >= 0.10, + network >= 2.4, + optparse-applicative >= 0.8, + unordered-containers >= 0.2 + default-language: Haskell2010 + +test-suite test + type: exitcode-stdio-1.0 + main-is: test.hs + ghc-options: -Wall -fno-warn-unused-do-bind + build-depends: base == 4.*, + aeson >= 0.7, + binary >= 0.7, + bytestring >= 0.9, + containers >= 0.5, + cryptohash >= 0.11, + HsOpenSSL >= 0.10, + network >= 2.4, + optparse-applicative >= 0.8, + process >= 1.1, + HUnit >= 1.2, + unordered-containers >= 0.2 + default-language: Haskell2010 diff --git a/test.hs b/test.hs new file mode 100644 --- /dev/null +++ b/test.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE OverloadedStrings #-} +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) +import Crypto.Hash.MD5 (hash) +import Data.Binary.Get (runGet, getWord64le) +import Data.ByteString (ByteString) +import qualified Data.ByteString as S +import qualified Data.ByteString.Lazy as L +import Data.List (sortBy) +import Data.IntMap.Strict (fromList, elems) +import Data.Word (Word8, Word64) +import GHC.IO.Handle (hClose) +import System.Process (createProcess, CreateProcess(std_out), shell + , StdStream(CreatePipe), rawSystem + , interruptProcessGroupOf) +import System.Exit (ExitCode(ExitSuccess)) +import Test.HUnit + + +target1 :: [[Word8]] +target1 = [ + [60, 53, 84, 138, 217, 94, 88, 23, 39, 242, 219, 35, 12, 157, 165, 181, 255, 143, 83, 247, 162, 16, 31, 209, 190, + 171, 115, 65, 38, 41, 21, 245, 236, 46, 121, 62, 166, 233, 44, 154, 153, 145, 230, 49, 128, 216, 173, 29, 241, 119, + 64, 229, 194, 103, 131, 110, 26, 197, 218, 59, 204, 56, 27, 34, 141, 221, 149, 239, 192, 195, 24, 155, 170, 183, 11 + , 254, 213, 37, 137, 226, 75, 203, 55, 19, 72, 248, 22, 129, 33, 175, 178, 10, 198, 71, 77, 36, 113, 167, 48, 2, + 117, 140, 142, 66, 199, 232, 243, 32, 123, 54, 51, 82, 57, 177, 87, 251, 150, 196, 133, 5, 253, 130, 8, 184, 14, + 152, 231, 3, 186, 159, 76, 89, 228, 205, 156, 96, 163, 146, 18, 91, 132, 85, 80, 109, 172, 176, 105, 13, 50, 235, + 127, 0, 189, 95, 98, 136, 250, 200, 108, 179, 211, 214, 106, 168, 78, 79, 74, 210, 30, 73, 201, 151, 208, 114, 101, + 174, 92, 52, 120, 240, 15, 169, 220, 182, 81, 224, 43, 185, 40, 99, 180, 17, 212, 158, 42, 90, 9, 191, 45, 6, 25, 4 + , 222, 67, 126, 1, 116, 124, 206, 69, 61, 7, 68, 97, 202, 63, 244, 20, 28, 58, 93, 134, 104, 144, 227, 147, 102, + 118, 135, 148, 47, 238, 86, 112, 122, 70, 107, 215, 100, 139, 223, 225, 164, 237, 111, 125, 207, 160, 187, 246, 234 + , 161, 188, 193, 249, 252], + [151, 205, 99, 127, 201, 119, 199, 211, 122, 196, 91, 74, 12, 147, 124, 180, 21, 191, 138, 83, 217, 30, 86, 7, 70, + 200, 56, 62, 218, 47, 168, 22, 107, 88, 63, 11, 95, 77, 28, 8, 188, 29, 194, 186, 38, 198, 33, 230, 98, 43, 148, + 110, 177, 1, 109, 82, 61, 112, 219, 59, 0, 210, 35, 215, 50, 27, 103, 203, 212, 209, 235, 93, 84, 169, 166, 80, 130 + , 94, 164, 165, 142, 184, 111, 18, 2, 141, 232, 114, 6, 131, 195, 139, 176, 220, 5, 153, 135, 213, 154, 189, 238 + , 174, 226, 53, 222, 146, 162, 236, 158, 143, 55, 244, 233, 96, 173, 26, 206, 100, 227, 49, 178, 34, 234, 108, + 207, 245, 204, 150, 44, 87, 121, 54, 140, 118, 221, 228, 155, 78, 3, 239, 101, 64, 102, 17, 223, 41, 137, 225, 229, + 66, 116, 171, 125, 40, 39, 71, 134, 13, 193, 129, 247, 251, 20, 136, 242, 14, 36, 97, 163, 181, 72, 25, 144, 46, + 175, 89, 145, 113, 90, 159, 190, 15, 183, 73, 123, 187, 128, 248, 252, 152, 24, 197, 68, 253, 52, 69, 117, 57, 92, + 104, 157, 170, 214, 81, 60, 133, 208, 246, 172, 23, 167, 160, 192, 76, 161, 237, 45, 4, 58, 10, 182, 65, 202, 240, + 185, 241, 79, 224, 132, 51, 42, 126, 105, 37, 250, 149, 32, 243, 231, 67, 179, 48, 9, 106, 216, 31, 249, 19, 85, + 254, 156, 115, 255, 120, 75, 16]] + +target2 :: [[Word8]] +target2 = [ + [124, 30, 170, 247, 27, 127, 224, 59, 13, 22, 196, 76, 72, 154, 32, 209, 4, 2, 131, 62, 101, 51, 230, 9, 166, 11, 99 + , 80, 208, 112, 36, 248, 81, 102, 130, 88, 218, 38, 168, 15, 241, 228, 167, 117, 158, 41, 10, 180, 194, 50, 204, + 243, 246, 251, 29, 198, 219, 210, 195, 21, 54, 91, 203, 221, 70, 57, 183, 17, 147, 49, 133, 65, 77, 55, 202, 122, + 162, 169, 188, 200, 190, 125, 63, 244, 96, 31, 107, 106, 74, 143, 116, 148, 78, 46, 1, 137, 150, 110, 181, 56, 95, + 139, 58, 3, 231, 66, 165, 142, 242, 43, 192, 157, 89, 175, 109, 220, 128, 0, 178, 42, 255, 20, 214, 185, 83, 160, + 253, 7, 23, 92, 111, 153, 26, 226, 33, 176, 144, 18, 216, 212, 28, 151, 71, 206, 222, 182, 8, 174, 205, 201, 152, + 240, 155, 108, 223, 104, 239, 98, 164, 211, 184, 34, 193, 14, 114, 187, 40, 254, 12, 67, 93, 217, 6, 94, 16, 19, 82 + , 86, 245, 24, 197, 134, 132, 138, 229, 121, 5, 235, 238, 85, 47, 103, 113, 179, 69, 250, 45, 135, 156, 25, 61, + 75, 44, 146, 189, 84, 207, 172, 119, 53, 123, 186, 120, 171, 68, 227, 145, 136, 100, 90, 48, 79, 159, 149, 39, 213, + 236, 126, 52, 60, 225, 199, 105, 73, 233, 252, 118, 215, 35, 115, 64, 37, 97, 129, 161, 177, 87, 237, 141, 173, 191 + , 163, 140, 234, 232, 249], + [117, 94, 17, 103, 16, 186, 172, 127, 146, 23, 46, 25, 168, 8, 163, 39, 174, 67, 137, 175, 121, 59, 9, 128, 179, 199 + , 132, 4, 140, 54, 1, 85, 14, 134, 161, 238, 30, 241, 37, 224, 166, 45, 119, 109, 202, 196, 93, 190, 220, 69, 49 + , 21, 228, 209, 60, 73, 99, 65, 102, 7, 229, 200, 19, 82, 240, 71, 105, 169, 214, 194, 64, 142, 12, 233, 88, 201 + , 11, 72, 92, 221, 27, 32, 176, 124, 205, 189, 177, 246, 35, 112, 219, 61, 129, 170, 173, 100, 84, 242, 157, 26, + 218, 20, 33, 191, 155, 232, 87, 86, 153, 114, 97, 130, 29, 192, 164, 239, 90, 43, 236, 208, 212, 185, 75, 210, 0, + 81, 227, 5, 116, 243, 34, 18, 182, 70, 181, 197, 217, 95, 183, 101, 252, 248, 107, 89, 136, 216, 203, 68, 91, 223, + 96, 141, 150, 131, 13, 152, 198, 111, 44, 222, 125, 244, 76, 251, 158, 106, 24, 42, 38, 77, 2, 213, 207, 249, 147, + 113, 135, 245, 118, 193, 47, 98, 145, 66, 160, 123, 211, 165, 78, 204, 80, 250, 110, 162, 48, 58, 10, 180, 55, 231, + 79, 149, 74, 62, 50, 148, 143, 206, 28, 15, 57, 159, 139, 225, 122, 237, 138, 171, 36, 56, 115, 63, 144, 154, 6, + 230, 133, 215, 41, 184, 22, 104, 254, 234, 253, 187, 226, 247, 188, 156, 151, 40, 108, 51, 83, 178, 52, 3, 31, 255, + 195, 53, 235, 126, 167, 120]] + +getTable :: ByteString -> [Word8] +getTable key = do + let s = L.fromStrict $ hash key + a = runGet getWord64le s + table = [0..255] + + map fromIntegral $ sortTable 1 a table + +sortTable :: Word64 -> Word64 -> [Word64] -> [Word64] +sortTable 1024 _ table = table +sortTable i a table = sortTable (i+1) a $ sortBy cmp table + where + cmp x y = compare (a `mod` (x + i)) (a `mod` (y + i)) + +main :: IO () +main = do + runTestTT tests + + (_, Just p1_out, _, p1_hdl) <- + createProcess (shell "cabal run ssserver") { std_out = CreatePipe } + (_, Just p2_out, _, p2_hdl) <- + createProcess (shell "cabal run sslocal") { std_out = CreatePipe } + + wait1 <- newEmptyMVar + wait2 <- newEmptyMVar + forkIO $ readOut p1_out wait1 + forkIO $ readOut p2_out wait2 + takeMVar wait1 + takeMVar wait2 + + code <- rawSystem "curl" [ "http://www.example.com/" + , "-v" + , "-L" + , "--socks5-hostname" + , "127.0.0.1:1080" + ] + putStrLn $ if code == ExitSuccess then "test passed" + else "test failed" + hClose p1_out + hClose p2_out + interruptProcessGroupOf p1_hdl + interruptProcessGroupOf p2_hdl + + where + toDecrypt t = elems $ fromList $ zip (map fromIntegral t) [0..255] + table1 = getTable "foobar!" + decryptTable1 = toDecrypt table1 + table2 = getTable "barfoo!" + decryptTable2 = toDecrypt table2 + tests = TestList [ table1 ~?= head target1 + , decryptTable1 ~?= last target1 + , table2 ~?= head target2 + , decryptTable2 ~?= last target2 + ] + + readOut h wait = do + line <- S.hGetLine h + let (s, _) = S.breakSubstring "starting" line + if S.null s then putMVar wait () + else readOut h wait