diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 diff --git a/Shadowsocks/Util.hs b/Shadowsocks/Util.hs --- a/Shadowsocks/Util.hs +++ b/Shadowsocks/Util.hs @@ -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" diff --git a/local.hs b/local.hs --- a/local.hs +++ b/local.hs @@ -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 diff --git a/server.hs b/server.hs --- a/server.hs +++ b/server.hs @@ -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)) <- diff --git a/shadowsocks.cabal b/shadowsocks.cabal --- a/shadowsocks.cabal +++ b/shadowsocks.cabal @@ -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: @@ -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