├── .gitignore ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── app ├── local.hs └── server.hs ├── benchmark ├── benchmark.hs ├── benchmark.py └── benchmark.sh ├── config.json ├── shadowsocks.cabal ├── src └── Shadowsocks │ ├── Encrypt.hs │ └── Util.hs ├── stack.yaml └── test.hs /.gitignore: -------------------------------------------------------------------------------- 1 | *~ 2 | *swp 3 | *.hi 4 | *.o 5 | .stack-work/ 6 | benchmark/benchmark 7 | dist/ 8 | tags 9 | local 10 | server 11 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ## 1.20180408 2 | 3 | * Update to conduit-1.3 4 | 5 | ## 1.20151028 6 | 7 | * Turn off `-threaded` option for Windows 64bit 8 | 9 | ## 1.20150921 10 | 11 | * UDP relay on server 12 | 13 | ## 1.20150811 14 | 15 | * Utilize Data.Conduit.Network of conduit-extra package 16 | 17 | ## 1.20141007 18 | 19 | * Update to optparse-applicative-0.11 20 | 21 | ## 1.20140713 22 | 23 | * Update to HsOpenSSL-0.11 24 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2014 rnons 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # shadowsocks-haskell 2 | 3 | [![Hackage](https://img.shields.io/hackage/v/shadowsocks.svg)](https://hackage.haskell.org/package/shadowsocks) 4 | 5 | Shadowsocks in Haskell. Original python version: https://github.com/clowwindy/shadowsocks 6 | 7 | Compatible with other versions of shadowsocks. 8 | 9 | ## Install from hackage 10 | 11 | You need to have `ghc` and `cabal` installed first. See https://www.haskell.org/downloads. 12 | 13 | ``` 14 | cabal install shadowsocks 15 | ``` 16 | 17 | ## Build from source 18 | 19 | You need to have [stack](https://haskellstack.org) installed first. 20 | 21 | ``` 22 | # build 23 | stack build 24 | # run local 25 | stack exec sslocal 26 | # run remote 27 | stack exec ssserver 28 | ``` 29 | 30 | Or run `stack install` directly, which will copy sslocal/ssserver to `~/.local/bin`. 31 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/local.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import Conduit (ConduitT, await, connect, leftover, 4 | liftIO, yield, ($$+), ($$++), ($$+-), 5 | (.|)) 6 | import Control.Concurrent.Async (race_) 7 | import Data.ByteString (ByteString) 8 | import qualified Data.ByteString as S 9 | import qualified Data.ByteString.Char8 as C 10 | import Data.Conduit.Network (appSink, appSource, clientSettings, 11 | runTCPClient, runTCPServer, 12 | serverSettings) 13 | import Data.Monoid ((<>)) 14 | import GHC.IO.Handle (BufferMode (NoBuffering), 15 | hSetBuffering) 16 | import GHC.IO.Handle.FD (stdout) 17 | 18 | import Shadowsocks.Encrypt (getEncDec) 19 | import Shadowsocks.Util 20 | 21 | initLocal :: ConduitT ByteString ByteString IO () 22 | initLocal = do 23 | await 24 | yield "\x05\x00" 25 | await >>= maybe (return ()) (\request -> do 26 | let (addrType, destAddr, destPort, _) = 27 | either (error . show . UnknownAddrType) 28 | id 29 | (unpackRequest $ S.drop 3 request) 30 | packed = packRequest addrType destAddr destPort 31 | yield "\x05\x00\x00\x01\x00\x00\x00\x00\x10\x10" 32 | liftIO $ C.putStrLn $ "connecting " <> destAddr 33 | <> ":" <> C.pack (show destPort) 34 | leftover packed) 35 | 36 | initRemote :: (ByteString -> IO ByteString) 37 | -> ConduitT ByteString ByteString IO () 38 | initRemote encrypt = do 39 | mAddrToSend <- await 40 | case mAddrToSend of 41 | Just addrToSend -> do 42 | enc <- liftIO $ encrypt addrToSend 43 | yield enc 44 | Nothing -> return () 45 | 46 | main :: IO () 47 | main = do 48 | hSetBuffering stdout NoBuffering 49 | config <- parseConfigOptions 50 | let localSettings = serverSettings (localPort config) "*" 51 | remoteSettings = clientSettings (serverPort config) 52 | (C.pack $ server config) 53 | C.putStrLn $ "starting local at " <> C.pack (show $ localPort config) 54 | runTCPServer localSettings $ \client -> do 55 | (encrypt, decrypt) <- getEncDec (method config) (password config) 56 | (clientSource, ()) <- appSource client $$+ initLocal .| appSink client 57 | runTCPClient remoteSettings $ \appServer -> do 58 | (clientSource', ()) <- 59 | clientSource $$++ initRemote encrypt .| appSink appServer 60 | race_ 61 | (clientSource' $$+- cryptConduit encrypt .| appSink appServer) 62 | (appSource appServer `Conduit.connect` 63 | (cryptConduit decrypt .| appSink client)) 64 | -------------------------------------------------------------------------------- /app/server.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | import Conduit (ConduitT, Void, await, connect, 4 | liftIO, ($$+), ($$+-), (.|)) 5 | import Control.Applicative ((<$>)) 6 | import Control.Concurrent (forkIO) 7 | import Control.Concurrent.Async (race_) 8 | import Control.Exception (throwIO) 9 | import Control.Monad (forever) 10 | import Data.ByteString (ByteString) 11 | import qualified Data.ByteString.Char8 as C 12 | import Data.Conduit (catchC) 13 | import Data.Conduit.Network (appSink, appSockAddr, appSource, 14 | clientSettings, runTCPClient, 15 | runTCPServer, serverSettings) 16 | import Data.Monoid ((<>)) 17 | import Data.Streaming.Network (bindPortUDP) 18 | import GHC.IO.Handle (BufferMode (NoBuffering), 19 | hSetBuffering) 20 | import GHC.IO.Handle.FD (stdout) 21 | import Network.Socket hiding (recvFrom) 22 | import Network.Socket.ByteString (recvFrom, sendAllTo) 23 | 24 | import Shadowsocks.Encrypt (getEncDec) 25 | import Shadowsocks.Util 26 | 27 | initRemote :: (ByteString -> IO ByteString) 28 | -> ConduitT ByteString Void IO (ByteString, Int) 29 | initRemote decrypt = await >>= 30 | maybe (liftIO $ throwIO NoRequestBody) (\encRequest -> do 31 | request <- liftIO $ decrypt encRequest 32 | case unpackRequest request of 33 | Right (_, destAddr, destPort, _) -> return (destAddr, destPort) 34 | Left addrType -> liftIO $ throwIO $ UnknownAddrType addrType 35 | ) 36 | 37 | main :: IO () 38 | main = do 39 | hSetBuffering stdout NoBuffering 40 | config <- parseConfigOptions 41 | let localSettings = serverSettings (serverPort config) "*" 42 | C.putStrLn $ "starting server at " <> C.pack (show $ serverPort config) 43 | 44 | udpSocket <- bindPortUDP (serverPort config) "*" 45 | forkIO $ forever $ do 46 | (encRequest, sourceAddr) <- recvFrom udpSocket 65535 47 | forkIO $ do 48 | (encrypt, decrypt) <- getEncDec (method config) (password config) 49 | request <- decrypt encRequest 50 | let (_, destAddr, destPort, payload) = 51 | either (error . show . UnknownAddrType) 52 | id 53 | (unpackRequest request) 54 | C.putStrLn $ "udp " <> destAddr <> ":" <> C.pack (show destPort) 55 | remoteAddr <- head <$> 56 | getAddrInfo Nothing (Just $ C.unpack destAddr) 57 | (Just $ show destPort) 58 | 59 | remote <- socket (addrFamily remoteAddr) Datagram defaultProtocol 60 | sendAllTo remote payload (addrAddress remoteAddr) 61 | (packet', sockAddr) <- recvFrom remote 65535 62 | let packed = packSockAddr sockAddr 63 | packet <- encrypt $ packed <> packet' 64 | sendAllTo udpSocket packet sourceAddr 65 | close remote 66 | 67 | runTCPServer localSettings $ \client -> do 68 | (encrypt, decrypt) <- getEncDec (method config) (password config) 69 | (clientSource, (host, port)) <- 70 | appSource client $$+ 71 | initRemote decrypt `catchC` \e -> 72 | error $ show (e :: SSException) <> " from " 73 | <> showSockAddr (appSockAddr client) 74 | let remoteSettings = clientSettings port host 75 | C.putStrLn $ "connecting " <> host <> ":" <> C.pack (show port) 76 | runTCPClient remoteSettings $ \appServer -> race_ 77 | (clientSource $$+- cryptConduit decrypt .| appSink appServer) 78 | (appSource appServer `Conduit.connect` 79 | (cryptConduit encrypt .| appSink client)) 80 | -------------------------------------------------------------------------------- /benchmark/benchmark.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | {-# LANGUAGE OverloadedStrings #-} 3 | import Crypto.Hash.MD5 (hash) 4 | import Data.Binary.Get (runGet, getWord64le) 5 | import Data.ByteString (ByteString) 6 | import qualified Data.ByteString as S 7 | import qualified Data.ByteString.Lazy as L 8 | import Data.List (sortBy) 9 | import Data.IntMap.Strict (fromList, (!)) 10 | import Data.Word (Word8, Word64) 11 | 12 | 13 | aPoem :: ByteString 14 | aPoem = "First they came for the Socialists, and I did not speak out-- Because I was not a Socialist. Then they came for the Trade Unionists, and I did not speak out-- Because I was not a Trade Unionist. Then they came for the Jews, and I did not speak out-- Because I was not a Jew. Then they came for me--and there was no one left to speak for me." 15 | 16 | getTable :: ByteString -> [Word8] 17 | getTable key = do 18 | let s = L.fromStrict $ hash key 19 | a = runGet getWord64le s 20 | table = [0..255] 21 | 22 | map fromIntegral $ sortTable 1 a table 23 | 24 | sortTable :: Word64 -> Word64 -> [Word64] -> [Word64] 25 | sortTable 1024 _ table = table 26 | sortTable i a table = sortTable (i+1) a $ sortBy cmp table 27 | where 28 | cmp x y = compare (a `mod` (x + i)) (a `mod` (y + i)) 29 | 30 | main :: IO () 31 | main = do 32 | encrypted <- encrypt aPoem 33 | decrypted <- decrypt encrypted 34 | print $ aPoem == decrypted 35 | where 36 | table = getTable "Don't panic!" 37 | encryptTable = fromList $ zip [0..255] table 38 | decryptTable = fromList $ zip (map fromIntegral table) [0..255] 39 | encrypt :: ByteString -> IO ByteString 40 | encrypt buf = return $ 41 | S.pack $ map (\b -> encryptTable ! fromIntegral b) $ S.unpack buf 42 | decrypt :: ByteString -> IO ByteString 43 | decrypt buf = return $ 44 | S.pack $ map (\b -> decryptTable ! fromIntegral b) $ S.unpack buf 45 | 46 | -------------------------------------------------------------------------------- /benchmark/benchmark.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | import hashlib 3 | import string 4 | import struct 5 | 6 | aPoem = "First they came for the Socialists, and I did not speak out-- Because I was not a Socialist. Then they came for the Trade Unionists, and I did not speak out-- Because I was not a Trade Unionist. Then they came for the Jews, and I did not speak out-- Because I was not a Jew. Then they came for me--and there was no one left to speak for me." 7 | 8 | def get_table(key): 9 | m = hashlib.md5() 10 | m.update(key) 11 | s = m.digest() 12 | (a, b) = struct.unpack(' 6 | homepage: https://github.com/rnons/shadowsocks-haskell 7 | bug-reports: https://github.com/rnons/shadowsocks-haskell/issues 8 | license: MIT 9 | license-file: LICENSE 10 | author: rnons 11 | maintainer: remotenonsense@gmail.com 12 | category: Web 13 | build-type: Simple 14 | cabal-version: 1.18 15 | tested-with: GHC == 8.2.2 16 | data-files: config.json 17 | extra-doc-files: CHANGELOG.md 18 | 19 | source-repository head 20 | type: git 21 | location: git://github.com/rnons/shadowsocks-haskell.git 22 | 23 | library 24 | hs-source-dirs: src 25 | exposed-modules: Shadowsocks.Encrypt, 26 | Shadowsocks.Util 27 | build-depends: base == 4.*, 28 | aeson >= 0.7, 29 | binary >= 0.7, 30 | bytestring >= 0.9, 31 | conduit >= 1.3, 32 | containers >= 0.5, 33 | cryptohash >= 0.11, 34 | directory, 35 | HsOpenSSL >= 0.11, 36 | iproute >= 1.4, 37 | network >= 2.6, 38 | optparse-applicative >= 0.11, 39 | unordered-containers >= 0.2 40 | default-language: Haskell2010 41 | 42 | executable sslocal 43 | hs-source-dirs: app 44 | main-is: local.hs 45 | if os(windows) && arch(x86_64) 46 | ghc-options: -Wall -fno-warn-unused-do-bind 47 | else 48 | ghc-options: -Wall -fno-warn-unused-do-bind -threaded 49 | other-extensions: OverloadedStrings, DeriveGeneric 50 | build-depends: base == 4.*, 51 | shadowsocks, 52 | async >= 2.0, 53 | bytestring >= 0.9, 54 | conduit >= 1.3, 55 | conduit-extra >= 1.3 56 | default-language: Haskell2010 57 | 58 | executable ssserver 59 | hs-source-dirs: app 60 | main-is: server.hs 61 | if os(windows) && arch(x86_64) 62 | ghc-options: -Wall -fno-warn-unused-do-bind 63 | else 64 | ghc-options: -Wall -fno-warn-unused-do-bind -threaded 65 | other-extensions: OverloadedStrings, DeriveGeneric 66 | build-depends: base == 4.*, 67 | shadowsocks, 68 | async >= 2.0, 69 | bytestring >= 0.9, 70 | conduit >= 1.3, 71 | conduit-extra >= 1.3, 72 | network >= 2.6, 73 | streaming-commons >= 0.1.11 74 | default-language: Haskell2010 75 | 76 | test-suite test 77 | type: exitcode-stdio-1.0 78 | main-is: test.hs 79 | ghc-options: -Wall -fno-warn-unused-do-bind 80 | build-depends: base == 4.*, 81 | binary >= 0.7, 82 | bytestring >= 0.9, 83 | containers >= 0.5, 84 | cryptohash >= 0.11, 85 | process >= 1.1, 86 | HUnit >= 1.2 87 | default-language: Haskell2010 88 | -------------------------------------------------------------------------------- /src/Shadowsocks/Encrypt.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Shadowsocks.Encrypt 3 | ( getEncDec 4 | ) where 5 | 6 | import Control.Concurrent.MVar ( newEmptyMVar, isEmptyMVar 7 | , putMVar, readMVar) 8 | import Crypto.Hash.MD5 (hash) 9 | import Data.Binary.Get (runGet, getWord64le) 10 | import Data.ByteString (ByteString) 11 | import qualified Data.ByteString as S 12 | import qualified Data.ByteString.Char8 as C 13 | import qualified Data.ByteString.Lazy as L 14 | import qualified Data.HashMap.Strict as HM 15 | import Data.IntMap.Strict (fromList, (!)) 16 | import Data.List (sortBy) 17 | import Data.Maybe (fromJust) 18 | import Data.Monoid ((<>)) 19 | import Data.Word (Word8, Word64) 20 | import OpenSSL (withOpenSSL) 21 | import OpenSSL.EVP.Cipher (getCipherByName, CryptoMode(..)) 22 | import OpenSSL.EVP.Internal (cipherInitBS, cipherUpdateBS) 23 | import OpenSSL.Random (randBytes) 24 | 25 | 26 | methodSupported :: HM.HashMap String (Int, Int) 27 | methodSupported = HM.fromList 28 | [ ("aes-128-cfb", (16, 16)) 29 | , ("aes-192-cfb", (24, 16)) 30 | , ("aes-256-cfb", (32, 16)) 31 | , ("bf-cfb", (16, 8)) 32 | , ("camellia-128-cfb", (16, 16)) 33 | , ("camellia-192-cfb", (24, 16)) 34 | , ("camellia-256-cfb", (32, 16)) 35 | , ("cast5-cfb", (16, 8)) 36 | , ("des-cfb", (8, 8)) 37 | , ("idea-cfb", (16, 8)) 38 | , ("rc2-cfb", (16, 8)) 39 | , ("rc4", (16, 0)) 40 | , ("seed-cfb", (16, 16)) 41 | ] 42 | 43 | getTable :: ByteString -> [Word8] 44 | getTable key = do 45 | let s = L.fromStrict $ hash key 46 | a = runGet getWord64le s 47 | table = [0..255] 48 | 49 | map fromIntegral $ sortTable 1 a table 50 | 51 | sortTable :: Word64 -> Word64 -> [Word64] -> [Word64] 52 | sortTable 1024 _ table = table 53 | sortTable i a table = sortTable (i+1) a $ sortBy cmp table 54 | where 55 | cmp x y = compare (a `mod` (x + i)) (a `mod` (y + i)) 56 | 57 | evpBytesToKey :: ByteString -> Int -> Int -> (ByteString, ByteString) 58 | evpBytesToKey password keyLen ivLen = 59 | let ms' = S.concat $ ms 0 [] 60 | key = S.take keyLen ms' 61 | iv = S.take ivLen $ S.drop keyLen ms' 62 | in (key, iv) 63 | where 64 | ms :: Int -> [ByteString] -> [ByteString] 65 | ms 0 _ = ms 1 [hash password] 66 | ms i m 67 | | S.length (S.concat m) < keyLen + ivLen = 68 | ms (i+1) (m ++ [hash (last m <> password)]) 69 | | otherwise = m 70 | 71 | getSSLEncDec :: String -> ByteString 72 | -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString) 73 | getSSLEncDec method password = do 74 | let (m0, m1) = fromJust $ HM.lookup method methodSupported 75 | random_iv <- withOpenSSL $ randBytes 32 76 | let cipher_iv = S.take m1 random_iv 77 | let (key, _) = evpBytesToKey password m0 m1 78 | cipherCtx <- newEmptyMVar 79 | decipherCtx <- newEmptyMVar 80 | 81 | cipherMethod <- fmap fromJust $ withOpenSSL $ getCipherByName method 82 | ctx <- cipherInitBS cipherMethod key cipher_iv Encrypt 83 | let 84 | encrypt "" = return "" 85 | encrypt buf = do 86 | empty <- isEmptyMVar cipherCtx 87 | if empty 88 | then do 89 | putMVar cipherCtx () 90 | ciphered <- withOpenSSL $ cipherUpdateBS ctx buf 91 | return $ cipher_iv <> ciphered 92 | else withOpenSSL $ cipherUpdateBS ctx buf 93 | decrypt "" = return "" 94 | decrypt buf = do 95 | empty <- isEmptyMVar decipherCtx 96 | if empty 97 | then do 98 | let decipher_iv = S.take m1 buf 99 | dctx <- cipherInitBS cipherMethod key decipher_iv Decrypt 100 | putMVar decipherCtx dctx 101 | if S.null (S.drop m1 buf) 102 | then return "" 103 | else withOpenSSL $ cipherUpdateBS dctx (S.drop m1 buf) 104 | else do 105 | dctx <- readMVar decipherCtx 106 | withOpenSSL $ cipherUpdateBS dctx buf 107 | 108 | return (encrypt, decrypt) 109 | 110 | getTableEncDec :: ByteString 111 | -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString) 112 | getTableEncDec key = return (encrypt, decrypt) 113 | where 114 | table = getTable key 115 | encryptTable = fromList $ zip [0..255] table 116 | decryptTable = fromList $ zip (map fromIntegral table) [0..255] 117 | encrypt :: ByteString -> IO ByteString 118 | encrypt buf = return $ 119 | S.pack $ map (\b -> encryptTable ! fromIntegral b) $ S.unpack buf 120 | decrypt :: ByteString -> IO ByteString 121 | decrypt buf = return $ 122 | S.pack $ map (\b -> decryptTable ! fromIntegral b) $ S.unpack buf 123 | 124 | getEncDec :: String -> String 125 | -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString) 126 | getEncDec "table" key = getTableEncDec $ C.pack key 127 | getEncDec method key = getSSLEncDec method $ C.pack key 128 | -------------------------------------------------------------------------------- /src/Shadowsocks/Util.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE ScopedTypeVariables #-} 5 | 6 | module Shadowsocks.Util 7 | ( Config (..) 8 | , cryptConduit 9 | , parseConfigOptions 10 | , unpackRequest 11 | , packRequest 12 | , packSockAddr 13 | , showSockAddr 14 | , SSException(..) 15 | ) where 16 | 17 | import Conduit (ConduitT, awaitForever, liftIO, yield) 18 | import Control.Exception (Exception, IOException, catch) 19 | import Data.Aeson (FromJSON (..), Value (..), decode', 20 | (.:)) 21 | import Data.Binary (decode) 22 | import Data.Binary.Get (getWord16be, getWord32le, runGet) 23 | import Data.Binary.Put (putWord16be, putWord32le, runPut) 24 | import Data.ByteString (ByteString) 25 | import qualified Data.ByteString as S 26 | import qualified Data.ByteString.Char8 as C 27 | import qualified Data.ByteString.Lazy as L 28 | import Data.Char (chr, ord) 29 | import Data.IP (fromHostAddress, fromHostAddress6, 30 | toHostAddress, toHostAddress6) 31 | import Data.Maybe (fromMaybe) 32 | import Data.Monoid ((<>)) 33 | import Data.Typeable (Typeable) 34 | import GHC.Generics (Generic) 35 | import Network.Socket (HostAddress, HostAddress6, 36 | SockAddr (..)) 37 | import Options.Applicative 38 | import System.Exit (exitFailure) 39 | import System.IO (hPutStrLn, stderr) 40 | 41 | 42 | data Config = Config 43 | { server :: String 44 | , serverPort :: Int 45 | , localPort :: Int 46 | , password :: String 47 | , timeout :: Int 48 | , method :: String 49 | } deriving (Show, Generic) 50 | 51 | instance FromJSON Config where 52 | parseJSON (Object v) = Config <$> v .: "server" 53 | <*> v .: "server_port" 54 | <*> v .: "local_port" 55 | <*> v .: "password" 56 | <*> v .: "timeout" 57 | <*> v .: "method" 58 | 59 | data Options = Options 60 | { _server :: Maybe String 61 | , _serverPort :: Maybe Int 62 | , _localPort :: Maybe Int 63 | , _password :: Maybe String 64 | , _method :: Maybe String 65 | , _config :: Maybe String 66 | } deriving (Show, Generic) 67 | 68 | type AddrType = Int 69 | 70 | data SSException = UnknownAddrType AddrType 71 | | NoRequestBody 72 | deriving (Show, Typeable) 73 | 74 | instance Exception SSException 75 | 76 | 77 | nullConfig :: Config 78 | nullConfig = Config "" 0 0 "" 0 "" 79 | 80 | readConfig :: FilePath -> IO (Maybe Config) 81 | readConfig fp = decode' <$> L.readFile fp 82 | 83 | configOptions :: Parser Options 84 | configOptions = Options 85 | <$> optional (strOption (long "server" <> short 's' <> metavar "ADDR" 86 | <> help "server address")) 87 | <*> optional (option auto (long "server-port" <> short 'p' <> metavar "PORT" 88 | <> help "server port")) 89 | <*> optional (option auto (long "local-port" <> short 'l' <> metavar "PORT" 90 | <> help "local port")) 91 | <*> optional (strOption (long "password" <> short 'k' <> metavar "PASSWORD" 92 | <> help "password")) 93 | <*> optional (strOption (long "method" <> short 'm' <> metavar "METHOD" 94 | <> help "encryption method, for example, aes-256-cfb")) 95 | <*> optional (strOption (long "config" <> short 'c' <> metavar "CONFIG" 96 | <> help "path to config file")) 97 | 98 | parseConfigOptions :: IO Config 99 | parseConfigOptions = do 100 | o <- execParser $ info (helper <*> configOptions) 101 | (fullDesc <> header "shadowsocks - a fast tunnel proxy") 102 | let configFile = fromMaybe "config.json" (_config o) 103 | mconfig <- readConfig configFile `catch` \(e :: IOException) -> 104 | hPutStrLn stderr ("ERROR: Failed to load " <> show e) >> exitFailure 105 | let c = fromMaybe nullConfig mconfig 106 | return $ c { server = fromMaybe (server c) (_server o) 107 | , serverPort = fromMaybe (serverPort c) (_serverPort o) 108 | , localPort = fromMaybe (localPort c) (_localPort o) 109 | , password = fromMaybe (password c) (_password o) 110 | , method = fromMaybe (method c) (_method o) 111 | } 112 | 113 | cryptConduit :: (ByteString -> IO ByteString) 114 | -> ConduitT ByteString ByteString IO () 115 | cryptConduit crypt = awaitForever $ \input -> do 116 | output <- liftIO $ crypt input 117 | yield output 118 | 119 | unpackRequest :: ByteString -> Either AddrType (AddrType, ByteString, Int, ByteString) 120 | unpackRequest request = case addrType of 121 | 1 -> -- IPv4 122 | let (ip, rest) = S.splitAt 4 request' 123 | addr = C.pack $ show $ fromHostAddress $ runGet getWord32le 124 | $ L.fromStrict ip 125 | in Right (addrType, addr, unpackPort rest, S.drop 2 rest) 126 | 3 -> -- domain name 127 | let addrLen = ord $ C.head request' 128 | (domain, rest) = S.splitAt (addrLen + 1) request' 129 | in Right (addrType, S.tail domain, unpackPort rest, S.drop 2 rest) 130 | 4 -> -- IPv6 131 | let (ip, rest) = S.splitAt 16 request' 132 | addr = C.pack $ show $ fromHostAddress6 $ decode 133 | $ L.fromStrict ip 134 | in Right (addrType, addr, unpackPort rest, S.drop 2 rest) 135 | _ -> Left addrType 136 | where 137 | addrType = fromIntegral $ S.head request 138 | request' = S.drop 1 request 139 | unpackPort = fromIntegral . runGet getWord16be . L.fromStrict . S.take 2 140 | 141 | packPort :: Int -> ByteString 142 | packPort = L.toStrict . runPut . putWord16be . fromIntegral 143 | 144 | packInet :: HostAddress -> Int -> ByteString 145 | packInet host port = 146 | "\x01" <> L.toStrict (runPut $ putWord32le host) 147 | <> packPort port 148 | 149 | packInet6 :: HostAddress6 -> Int -> ByteString 150 | packInet6 (h1, h2, h3, h4) port = 151 | "\x04" <> L.toStrict (runPut (putWord32le h1) 152 | <> runPut (putWord32le h2) 153 | <> runPut (putWord32le h3) 154 | <> runPut (putWord32le h4)) 155 | <> packPort port 156 | 157 | packDomain :: ByteString -> Int -> ByteString 158 | packDomain host port = 159 | "\x03" <> C.singleton (chr $ S.length host) <> host <> packPort port 160 | 161 | packRequest :: Int -> ByteString -> Int -> ByteString 162 | packRequest addrType destAddr destPort = 163 | case addrType of 164 | 1 -> packInet (toHostAddress $ read $ C.unpack destAddr) destPort 165 | 3 -> packDomain destAddr destPort 166 | 4 -> packInet6 (toHostAddress6 $ read $ C.unpack destAddr) destPort 167 | _ -> error $ "Unknown address type: " <> show addrType 168 | 169 | packSockAddr :: SockAddr -> ByteString 170 | packSockAddr addr = 171 | case addr of 172 | SockAddrInet port host -> packInet host $ fromIntegral port 173 | SockAddrInet6 port _ host _ -> packInet6 host $ fromIntegral port 174 | _ -> error "unix socket is not supported" 175 | 176 | showSockAddr :: SockAddr -> String 177 | showSockAddr addr = 178 | case addr of 179 | SockAddrInet port host -> 180 | show (fromHostAddress host) <> ":" <> show port 181 | SockAddrInet6 port _ host _ -> 182 | show (fromHostAddress6 host) <> ":" <> show port 183 | _ -> error "unix socket is not supported" 184 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # For advanced use and comprehensive documentation of the format, please see: 4 | # http://docs.haskellstack.org/en/stable/yaml_configuration/ 5 | 6 | resolver: lts-11.3 7 | 8 | packages: 9 | - '.' 10 | extra-deps: [] 11 | 12 | flags: {} 13 | 14 | extra-package-dbs: [] 15 | -------------------------------------------------------------------------------- /test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Control.Concurrent (forkIO) 3 | import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) 4 | import Crypto.Hash.MD5 (hash) 5 | import Data.Binary.Get (runGet, getWord64le) 6 | import Data.ByteString (ByteString) 7 | import qualified Data.ByteString as S 8 | import qualified Data.ByteString.Lazy as L 9 | import Data.List (sortBy) 10 | import Data.IntMap.Strict (fromList, elems) 11 | import Data.Word (Word8, Word64) 12 | import GHC.IO.Handle (hClose) 13 | import System.Process (createProcess, CreateProcess(std_out), shell 14 | , StdStream(CreatePipe), rawSystem 15 | , interruptProcessGroupOf) 16 | import System.Exit (ExitCode(ExitSuccess)) 17 | import Test.HUnit 18 | 19 | 20 | target1 :: [[Word8]] 21 | target1 = [ 22 | [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, 23 | 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, 24 | 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 25 | , 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, 26 | 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, 27 | 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, 28 | 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, 29 | 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 30 | , 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, 31 | 118, 135, 148, 47, 238, 86, 112, 122, 70, 107, 215, 100, 139, 223, 225, 164, 237, 111, 125, 207, 160, 187, 246, 234 32 | , 161, 188, 193, 249, 252], 33 | [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, 34 | 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, 35 | 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 36 | , 94, 164, 165, 142, 184, 111, 18, 2, 141, 232, 114, 6, 131, 195, 139, 176, 220, 5, 153, 135, 213, 154, 189, 238 37 | , 174, 226, 53, 222, 146, 162, 236, 158, 143, 55, 244, 233, 96, 173, 26, 206, 100, 227, 49, 178, 34, 234, 108, 38 | 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, 39 | 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, 40 | 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, 41 | 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, 42 | 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, 43 | 254, 156, 115, 255, 120, 75, 16]] 44 | 45 | target2 :: [[Word8]] 46 | target2 = [ 47 | [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 48 | , 80, 208, 112, 36, 248, 81, 102, 130, 88, 218, 38, 168, 15, 241, 228, 167, 117, 158, 41, 10, 180, 194, 50, 204, 49 | 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, 50 | 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, 51 | 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, 52 | 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, 53 | 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 54 | , 86, 245, 24, 197, 134, 132, 138, 229, 121, 5, 235, 238, 85, 47, 103, 113, 179, 69, 250, 45, 135, 156, 25, 61, 55 | 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, 56 | 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 57 | , 163, 140, 234, 232, 249], 58 | [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 59 | , 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 60 | , 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 61 | , 11, 72, 92, 221, 27, 32, 176, 124, 205, 189, 177, 246, 35, 112, 219, 61, 129, 170, 173, 100, 84, 242, 157, 26, 62 | 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, 63 | 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, 64 | 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, 65 | 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, 66 | 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, 67 | 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, 68 | 195, 53, 235, 126, 167, 120]] 69 | 70 | getTable :: ByteString -> [Word8] 71 | getTable key = do 72 | let s = L.fromStrict $ hash key 73 | a = runGet getWord64le s 74 | table = [0..255] 75 | 76 | map fromIntegral $ sortTable 1 a table 77 | 78 | sortTable :: Word64 -> Word64 -> [Word64] -> [Word64] 79 | sortTable 1024 _ table = table 80 | sortTable i a table = sortTable (i+1) a $ sortBy cmp table 81 | where 82 | cmp x y = compare (a `mod` (x + i)) (a `mod` (y + i)) 83 | 84 | main :: IO () 85 | main = do 86 | runTestTT tests 87 | 88 | (_, Just p1_out, _, p1_hdl) <- 89 | createProcess (shell "cabal run ssserver") { std_out = CreatePipe } 90 | (_, Just p2_out, _, p2_hdl) <- 91 | createProcess (shell "cabal run sslocal") { std_out = CreatePipe } 92 | 93 | wait1 <- newEmptyMVar 94 | wait2 <- newEmptyMVar 95 | forkIO $ readOut p1_out wait1 96 | forkIO $ readOut p2_out wait2 97 | takeMVar wait1 98 | takeMVar wait2 99 | 100 | code <- rawSystem "curl" [ "http://www.example.com/" 101 | , "-v" 102 | , "-L" 103 | , "--socks5-hostname" 104 | , "127.0.0.1:1080" 105 | ] 106 | putStrLn $ if code == ExitSuccess then "test passed" 107 | else "test failed" 108 | hClose p1_out 109 | hClose p2_out 110 | interruptProcessGroupOf p1_hdl 111 | interruptProcessGroupOf p2_hdl 112 | 113 | where 114 | toDecrypt t = elems $ fromList $ zip (map fromIntegral t) [0..255] 115 | table1 = getTable "foobar!" 116 | decryptTable1 = toDecrypt table1 117 | table2 = getTable "barfoo!" 118 | decryptTable2 = toDecrypt table2 119 | tests = TestList [ table1 ~?= head target1 120 | , decryptTable1 ~?= last target1 121 | , table2 ~?= head target2 122 | , decryptTable2 ~?= last target2 123 | ] 124 | 125 | readOut h wait = do 126 | line <- S.hGetLine h 127 | let (s, _) = S.breakSubstring "starting" line 128 | if S.null s then putMVar wait () 129 | else readOut h wait 130 | --------------------------------------------------------------------------------