shadowsocks (empty) → 1.20140617
raw patch · 10 files changed
+776/−0 lines, 10 filesdep +HUnitdep +HsOpenSSLdep +aesonsetup-changed
Dependencies added: HUnit, HsOpenSSL, aeson, base, binary, bytestring, containers, cryptohash, network, optparse-applicative, process, unordered-containers
Files
- LICENSE +21/−0
- Setup.hs +2/−0
- Shadowsocks/Cipher.hsc +110/−0
- Shadowsocks/Encrypt.hs +133/−0
- Shadowsocks/Util.hs +80/−0
- config.json +8/−0
- local.hs +116/−0
- server.hs +101/−0
- shadowsocks.cabal +76/−0
- test.hs +129/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Shadowsocks/Cipher.hsc view
@@ -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 <openssl/evp.h>++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
+ Shadowsocks/Encrypt.hs view
@@ -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
+ Shadowsocks/Util.hs view
@@ -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)+ }
+ config.json view
@@ -0,0 +1,8 @@+{ + "server":"127.0.0.1", + "server_port":8388, + "local_port":1080, + "password":"barfoo!", + "timeout":600, + "method":"table" +}
+ local.hs view
@@ -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
+ server.hs view
@@ -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
+ shadowsocks.cabal view
@@ -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: <https://github.com/clowwindy/shadowsocks>+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
+ test.hs view
@@ -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