shadowsocks 1.20150811 → 1.20150921
raw patch · 5 files changed
+128/−56 lines, 5 filesdep +networkdep +streaming-commons
Dependencies added: network, streaming-commons
Files
- CHANGELOG.md +15/−0
- Shadowsocks/Util.hs +73/−1
- local.hs +5/−27
- server.hs +30/−27
- shadowsocks.cabal +5/−1
+ CHANGELOG.md view
@@ -0,0 +1,15 @@+## 1.20150921++* UDP relay on server++## 1.20150811++* Utilize Data.Conduit.Network of conduit-extra package++## 1.20141007++* Update to optparse-applicative-0.11++## 1.20140713++* Update to HsOpenSSL-0.11
Shadowsocks/Util.hs view
@@ -1,17 +1,31 @@ {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+ module Shadowsocks.Util ( Config (..)- , parseConfigOptions , cryptConduit+ , parseConfigOptions+ , unpackRequest+ , packRequest+ , packSockAddr ) where import Conduit (Conduit, awaitForever, yield, liftIO) import Control.Monad (liftM) import Data.Aeson (decode', FromJSON)+import Data.Binary (decode)+import Data.Binary.Get (runGet, getWord16be, getWord32le)+import Data.Binary.Put (runPut, putWord16be, putWord32le) 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.Char (chr, ord)+import Data.IP ( fromHostAddress, fromHostAddress6+ , toHostAddress, toHostAddress6) import Data.Maybe (fromMaybe) import GHC.Generics (Generic)+import Network.Socket (HostAddress, HostAddress6, SockAddr(..)) import Options.Applicative data Config = Config@@ -74,3 +88,61 @@ cryptConduit crypt = awaitForever $ \input -> do output <- liftIO $ crypt input yield output++unpackRequest :: ByteString -> (Int, ByteString, Int, ByteString)+unpackRequest request = (addrType, destAddr, destPort, payload)+ where+ addrType = fromIntegral $ S.head request+ request' = S.drop 1 request+ (destAddr, port, payload) = case addrType of+ 1 -> -- IPv4+ let (ip, rest) = S.splitAt 4 request'+ addr = C.pack $ show $ fromHostAddress $ runGet getWord32le+ $ L.fromStrict ip+ in (addr, S.take 2 rest, S.drop 2 rest)+ 3 -> -- domain name+ let addrLen = ord $ C.head request'+ (domain, rest) = S.splitAt (addrLen + 1) request'+ in (S.tail domain, S.take 2 rest, S.drop 2 rest)+ 4 -> -- IPv6+ let (ip, rest) = S.splitAt 16 request'+ addr = C.pack $ show $ fromHostAddress6 $ decode+ $ L.fromStrict ip+ in (addr, S.take 2 rest, S.drop 2 rest)+ _ -> error $ "Unknown address type: " <> show addrType+ destPort = fromIntegral $ runGet getWord16be $ L.fromStrict port++packPort :: Int -> ByteString+packPort = L.toStrict . runPut . putWord16be . fromIntegral++packInet :: HostAddress -> Int -> ByteString+packInet host port =+ "\x01" <> L.toStrict (runPut $ putWord32le host)+ <> packPort port++packInet6 :: HostAddress6 -> Int -> ByteString+packInet6 (h1, h2, h3, h4) port = + "\x04" <> L.toStrict (runPut (putWord32le h1)+ <> runPut (putWord32le h2)+ <> runPut (putWord32le h3)+ <> runPut (putWord32le h4))+ <> packPort port++packDomain :: ByteString -> Int -> ByteString+packDomain host port =+ "\x03" <> C.singleton (chr $ S.length host) <> host <> packPort port++packRequest :: Int -> ByteString -> Int -> ByteString+packRequest addrType destAddr destPort =+ case addrType of+ 1 -> packInet (toHostAddress $ read $ C.unpack destAddr) destPort+ 3 -> packDomain destAddr destPort+ 4 -> packInet6 (toHostAddress6 $ read $ C.unpack destAddr) destPort+ _ -> error $ "Unknown address type: " <> show addrType++packSockAddr :: SockAddr -> ByteString+packSockAddr addr =+ case addr of+ SockAddrInet port host -> packInet host $ fromIntegral port+ SockAddrInet6 port _ host _ -> packInet6 host $ fromIntegral port+ _ -> error "unix socket is not supported"
local.hs view
@@ -5,16 +5,11 @@ import Control.Concurrent.Async (race_) 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.Binary (decode)-import Data.Binary.Get (runGet, getWord16be, getWord32le)-import Data.Char (ord) import Data.Conduit.Network ( runTCPServer, runTCPClient , serverSettings, clientSettings , appSource, appSink) import Data.Monoid ((<>))-import Data.IP (fromHostAddress, fromHostAddress6) import GHC.IO.Handle (hSetBuffering, BufferMode(NoBuffering)) import GHC.IO.Handle.FD (stdout) @@ -26,29 +21,12 @@ await yield "\x05\x00" await >>= maybe (return ()) (\request -> do- let addrType = request `S.index` 3- request' = S.drop 4 request- (addr, payload, addrPort) <- case addrType of- 1 -> do -- IPv4- let (ip, rest) = S.splitAt 4 request'- addr = C.pack $ show $ fromHostAddress $ runGet getWord32le- $ L.fromStrict ip- return (addr, ip, S.take 2 rest)- 3 -> do -- domain name- let addrLen = ord $ C.head request'- (domain, rest) = S.splitAt (addrLen + 1) request'- return (S.tail domain, domain, S.take 2 rest)- 4 -> do -- IPv6- let (ip, rest) = S.splitAt 16 request'- addr = C.pack $ show $ fromHostAddress6 $ decode- $ L.fromStrict ip- return (addr, ip, S.take 2 rest)- _ -> error $ C.unpack $ S.snoc "Unknown address type: " addrType+ let (addrType, destAddr, destPort, _) = unpackRequest (S.drop 3 request)+ packed = packRequest addrType destAddr destPort yield "\x05\x00\x00\x01\x00\x00\x00\x00\x10\x10"- let addrToSend = S.singleton addrType <> payload <> addrPort- port = runGet getWord16be $ L.fromStrict addrPort- liftIO $ C.putStrLn $ "connecting " <> addr <> ":" <> C.pack (show port)- leftover addrToSend)+ liftIO $ C.putStrLn $ "connecting " <> destAddr+ <> ":" <> C.pack (show destPort)+ leftover packed) initRemote :: (ByteString -> IO ByteString) -> Conduit ByteString IO ByteString
server.hs view
@@ -1,50 +1,32 @@ {-# LANGUAGE OverloadedStrings #-} import Conduit (Sink, await, liftIO, (=$), ($$), ($$+), ($$+-))+import Control.Applicative ((<$>))+import Control.Concurrent (forkIO) import Control.Concurrent.Async (race_)-import Data.Binary (decode)-import Data.Binary.Get (runGet, getWord16be, getWord32le)+import Control.Monad (forever) 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.Char (ord) import Data.Conduit.Network ( runTCPServer, runTCPClient , serverSettings, clientSettings , appSource, appSink) import Data.Monoid ((<>))-import Data.IP (fromHostAddress, fromHostAddress6)+import Data.Streaming.Network(bindPortUDP) import GHC.IO.Handle (hSetBuffering, BufferMode(NoBuffering)) import GHC.IO.Handle.FD (stdout)+import Network.Socket hiding (recvFrom)+import Network.Socket.ByteString (recvFrom, sendAllTo) import Shadowsocks.Encrypt (getEncDec) import Shadowsocks.Util initRemote :: (ByteString -> IO ByteString) -> Sink ByteString IO (ByteString, Int)-initRemote decrypt = await >>= +initRemote decrypt = await >>= maybe (error "Invalid request") (\encRequest -> do request <- liftIO $ decrypt encRequest- let addrType = S.head request - request' = S.drop 1 request- (addr, addrPort) <- case addrType of- 1 -> do -- IPv4- let (ip, rest) = S.splitAt 4 request'- addr = C.pack $ show $ fromHostAddress $ runGet getWord32le- $ L.fromStrict ip- return (addr, S.take 2 rest)- 3 -> do -- domain name- let addrLen = ord $ C.head request'- (domain, rest) = S.splitAt (addrLen + 1) request'- return (S.tail domain, S.take 2 rest)- 4 -> do -- IPv6- let (ip, rest) = S.splitAt 16 request'- addr = C.pack $ show $ fromHostAddress6 $ decode- $ L.fromStrict ip- return (addr, S.take 2 rest)- _ -> error $ C.unpack $ S.snoc "Unknown address type: " addrType - let port = fromIntegral $ runGet getWord16be $ L.fromStrict addrPort- return (addr, port))+ let (_, destAddr, destPort, _) = unpackRequest request+ return (destAddr, destPort)) main :: IO () main = do@@ -52,6 +34,27 @@ config <- parseConfigOptions let localSettings = serverSettings (server_port config) "*" C.putStrLn $ "starting server at " <> C.pack (show $ server_port config)++ udpSocket <- bindPortUDP (server_port config) "*"+ forkIO $ forever $ do+ (encRequest, sourceAddr) <- recvFrom udpSocket 65535+ forkIO $ do+ (encrypt, decrypt) <- getEncDec (method config) (password config)+ request <- decrypt encRequest+ let (_, destAddr, destPort, payload) = unpackRequest request+ C.putStrLn $ "udp " <> destAddr <> ":" <> C.pack (show destPort)+ remoteAddr <- head <$>+ getAddrInfo Nothing (Just $ C.unpack destAddr)+ (Just $ show destPort)++ remote <- socket (addrFamily remoteAddr) Datagram defaultProtocol+ sendAllTo remote payload (addrAddress remoteAddr)+ (packet', sockAddr) <- recvFrom remote 65535+ let packed = packSockAddr sockAddr+ packet <- encrypt $ packed <> packet'+ sendAllTo udpSocket packet sourceAddr+ close remote+ runTCPServer localSettings $ \client -> do (encrypt, decrypt) <- getEncDec (method config) (password config) (clientSource, (host, port)) <-
shadowsocks.cabal view
@@ -1,5 +1,5 @@ name: shadowsocks-version: 1.20150811+version: 1.20150921 synopsis: A fast SOCKS5 proxy that help you get through firewalls description: Shadowsocks implemented in Haskell. Original python version: <https://github.com/clowwindy/shadowsocks>@@ -14,6 +14,7 @@ cabal-version: >= 1.10 tested-with: GHC == 7.10.2 data-files: config.json+extra-doc-files: CHANGELOG.md source-repository head type: git@@ -36,6 +37,7 @@ cryptohash >= 0.11, HsOpenSSL >= 0.11, iproute >= 1.4,+ network >= 2.6, optparse-applicative >= 0.11, unordered-containers >= 0.2 default-language: Haskell2010@@ -57,7 +59,9 @@ cryptohash >= 0.11, HsOpenSSL >= 0.11, iproute >= 1.4,+ network >= 2.6, optparse-applicative >= 0.11,+ streaming-commons >= 0.1.11, unordered-containers >= 0.2 default-language: Haskell2010