moesocks 0.1.0.14 → 0.1.0.15
raw patch · 14 files changed
+678/−396 lines, 14 files
Files
- CHANGELOG.md +4/−0
- README.md +2/−1
- config.json +1/−1
- moesocks.cabal +5/−1
- src/Network/MoeSocks/App.hs +132/−305
- src/Network/MoeSocks/BuilderAndParser.hs +72/−53
- src/Network/MoeSocks/Common.hs +58/−0
- src/Network/MoeSocks/Config.hs +2/−1
- src/Network/MoeSocks/Constant.hs +3/−0
- src/Network/MoeSocks/Helper.hs +7/−12
- src/Network/MoeSocks/Options.hs +35/−16
- src/Network/MoeSocks/TCP.hs +247/−0
- src/Network/MoeSocks/Type.hs +8/−6
- src/Network/MoeSocks/UDP.hs +102/−0
CHANGELOG.md view
@@ -1,3 +1,7 @@+0.1.0.15+--------+* Add UDP port forwarding+ 0.1.0.14 -------- * Add IPv6 support
README.md view
@@ -14,7 +14,8 @@ Features -------- * TCP port forwarding -* Per connection throttling (as a side effect of trying to find a bug in the+* UDP port forwarding+* TCP per connection throttling (as a side effect of trying to find a bug in the remote) Not working
config.json view
@@ -1,5 +1,5 @@ {- "server":"127.0.0.1",+ "server":"localhost", "server_port":1190, "local_address":"localhost", "local_port":1090,
moesocks.cabal view
@@ -1,6 +1,6 @@ name: moesocks category: Network-version: 0.1.0.14+version: 0.1.0.15 license: Apache-2.0 synopsis: A functional firewall killer description: A socks5 proxy using the client / server architecture.@@ -59,3 +59,7 @@ Network.MoeSocks.Internal.ShadowSocks.Encrypt Network.MoeSocks.Options Network.MoeSocks.Type+ Network.MoeSocks.Common+ Network.MoeSocks.TCP+ Network.MoeSocks.UDP+
src/Network/MoeSocks/App.hs view
@@ -4,7 +4,6 @@ module Network.MoeSocks.App where import Control.Concurrent-import Control.Concurrent.STM import Control.Exception import Control.Lens import Control.Monad@@ -22,7 +21,10 @@ import Network.MoeSocks.Constant import Network.MoeSocks.Helper import Network.MoeSocks.Type-import Network.Socket hiding (send, recv)+import Network.MoeSocks.TCP+import Network.MoeSocks.UDP+import Network.Socket hiding (send, recv, recvFrom, sendTo)+import Network.Socket.ByteString import OpenSSL (withOpenSSL) import OpenSSL.EVP.Cipher (getCipherByName) import Prelude hiding ((-), take)@@ -30,34 +32,11 @@ import System.Log.Handler.Simple import System.Log.Logger import qualified Data.HashMap.Strict as H-import qualified Data.List as L import qualified Data.Text as T import qualified Data.Text.IO as TIO import qualified System.IO as IO import qualified System.Log.Handler as LogHandler --showAddressType :: AddressType -> Text-showAddressType (IPv4_address xs) = view (from _Text) - - concat - L.intersperse "." - - map show - xs ^.. each-showAddressType (Domain_name x) = x -showAddressType (IPv6_address xs) = view (from _Text) -- concat - L.intersperse ":" - - map show -- xs ^.. each--showConnectionType :: ConnectionType -> String-showConnectionType TCP_IP_stream_connection = "TCP_Stream"-showConnectionType TCP_IP_port_binding = "TCP_Bind "-showConnectionType UDP_port = "UDP "--showRequest :: ClientRequest -> String-showRequest _r = - view _Text (showAddressType (_r ^. addressType))- <> ":"- <> show (_r ^. portNumber)- processLocalSocks5Request :: Socket -> IO (ClientRequest, ByteString) processLocalSocks5Request aSocket = do (_partialBytesAfterGreeting, r) <- @@ -79,256 +58,18 @@ pure - (_clientRequest, _partialBytesAfterClientRequest) -localSocks5RequestHandler :: MoeConfig -> Socket -> IO ()-localSocks5RequestHandler aConfig aSocket = do+localSocks5RequestHandler :: MoeConfig -> ByteString -> (Socket, SockAddr) + -> IO ()+localSocks5RequestHandler aConfig _ (aSocket,_) = do _r <- processLocalSocks5Request aSocket - localRequestHandler aConfig _r True aSocket+ localTCPRequestHandler aConfig _r True aSocket -localForwardingRequestHandler :: MoeConfig -> LocalForwarding -> - Socket -> IO ()-localForwardingRequestHandler aConfig aForwarding aSocket = do- let _clientRequest = ClientRequest- TCP_IP_stream_connection- (Domain_name - aForwarding ^. - localForwardingRemoteHost)- (aForwarding ^. localForwardingRemotePort)- - localRequestHandler aConfig (_clientRequest, mempty) False aSocket -localRequestHandler :: MoeConfig -> (ClientRequest, ByteString) -> - Bool -> Socket -> IO ()-localRequestHandler aConfig (_clientRequest, _partialBytesAfterClientRequest) - shouldReplyClient aSocket = do- let - _c = aConfig - _initSocket = - getSocket (_c ^. remote) (_c ^. remotePort) Stream - puts - "L : " <> show _clientRequest- - logSA "L remote socket" _initSocket - - \(_remoteSocket, _remoteAddress) -> do- connect _remoteSocket _remoteAddress - _localPeerAddr <- getPeerName aSocket- _remoteSocketName <- getSocketName _remoteSocket- - when shouldReplyClient - do- let _connectionReplyBuilder = connectionReplyBuilder _remoteSocketName- send_ aSocket - builder_To_ByteString _connectionReplyBuilder- - let _msg = - concat - L.intersperse " -> " - [ - show _localPeerAddr- , showRequest _clientRequest- ]- - _log - "L " -- <> showConnectionType (_clientRequest ^. connectionType)- <> ": " <> _msg-- let handleLocal __remoteSocket = do- (_encrypt, _decrypt) <- getCipher- (aConfig ^. method)- (aConfig ^. password)--- let - _header = shadowSocksRequestBuilder _clientRequest- - sendChannel <- newTBQueueIO - aConfig ^. tcpBufferSizeInPacket- receiveChannel <- newTBQueueIO - aConfig ^. tcpBufferSizeInPacket-- let _logId x = x <> " " <> _msg- _timeout = aConfig ^. timeout * 1000 * 1000- _throttle = - if aConfig ^. throttle- then Just - aConfig ^. throttleSpeed- else Nothing-- let sendThread = do- sendBuilderEncrypted - sendChannel _encrypt _header-- when (_partialBytesAfterClientRequest & isn't _Empty) -- atomically . writeTBQueue sendChannel . Just =<< - _encrypt _partialBytesAfterClientRequest--- let _produce = do- produceLoop (_logId "L --> + Loop")- _timeout- Nothing- aSocket - sendChannel - _encrypt-- let _consume = do- consumeLoop (_logId "L --> - Loop")- _timeout- _throttle- __remoteSocket - sendChannel- finally- (- connectProduction (Just - _logId "L --> +", _produce)- (Just - _logId "L --> -", _consume)- ) -- pure ()-- let receiveThread = do- let _produce = produceLoop (_logId "L <-- + Loop")- _timeout- Nothing- __remoteSocket - receiveChannel- _decrypt-- let _consume = do- consumeLoop (_logId "L <-- - Loop")- _timeout- Nothing- aSocket - receiveChannel- finally - (- connectProduction (Just - _logId "L <-- +", _produce)- (Just - _logId "L <-- -", _consume)- ) -- pure ()-- connectTunnel- (Just - _logId "L -->", sendThread)- (Just - _logId "L <--", receiveThread)--- handleLocal _remoteSocket---remoteRequestHandler:: MoeConfig -> Socket -> IO ()-remoteRequestHandler aConfig aSocket = do- (_encrypt, _decrypt) <- getCipher- (aConfig ^. method)- (aConfig ^. password)- - (_leftOverBytes, _clientRequest) <- parseSocket - "clientRequest"- mempty- _decrypt- shadowSocksRequestParser - aSocket- -- {-puts - "Remote get: " <> show _clientRequest-}- - let- initTarget :: ClientRequest -> IO (Socket, SockAddr)- initTarget _clientRequest = do- let - connectionType_To_SocketType :: ConnectionType -> SocketType- connectionType_To_SocketType TCP_IP_stream_connection = Stream- connectionType_To_SocketType TCP_IP_port_binding = NoSocketType- connectionType_To_SocketType UDP_port = Datagram- - _socketType = connectionType_To_SocketType -- _clientRequest ^. connectionType--- _hostName = _clientRequest ^. addressType . to showAddressType- _port = _clientRequest ^. portNumber-- - getSocket _hostName _port _socketType-- logSA "R target socket" (initTarget _clientRequest) - \_r -> do- let (_targetSocket, _targetSocketAddress) = _r -- connect _targetSocket _targetSocketAddress-- _remotePeerAddr <- getPeerName aSocket- _targetPeerAddr <- getPeerName _targetSocket-- let _msg = - concat - L.intersperse " -> " - - [ - show _remotePeerAddr- , showRequest _clientRequest- ]-- _log - "R " -- <> showConnectionType (_clientRequest ^. connectionType)- <> ": " <> _msg-- let - handleTarget __leftOverBytes __targetSocket = do- sendChannel <- newTBQueueIO - aConfig ^. tcpBufferSizeInPacket- receiveChannel <- newTBQueueIO - aConfig ^. tcpBufferSizeInPacket-- let _logId x = x <> " " <> _msg- _timeout = aConfig ^. timeout * 1000 * 1000- - _throttle = - if aConfig ^. throttle- then Just - aConfig ^. throttleSpeed- else Nothing-- let sendThread = do- when (_leftOverBytes & isn't _Empty) -- atomically - writeTBQueue sendChannel - Just _leftOverBytes-- let _produce = do- produceLoop (_logId "R --> + Loop")- _timeout- Nothing- aSocket- sendChannel- _decrypt-- let _consume = consumeLoop (_logId "R --> - Loop")- _timeout- Nothing- __targetSocket- sendChannel-- finally- (- connectProduction (Just - _logId "R --> +", _produce)- (Just - _logId "R --> -", _consume)- ) -- pure ()-- let receiveThread = do- let _produce = do- produceLoop (_logId "R --> + Loop")- _timeout- Nothing- __targetSocket- receiveChannel- _encrypt--- let _consume = do- consumeLoop (_logId "R --> - Loop")- _timeout- _throttle- aSocket- receiveChannel-- finally - (- connectProduction (Just - _logId "R <-- +", _produce)- (Just - _logId "R <-- -", _consume)- ) -- pure ()-- connectTunnel- (Just - _logId "R -->", sendThread)- (Just - _logId "R <--", receiveThread)- - handleTarget _leftOverBytes _targetSocket- parseConfig :: Text -> MoeMonadT MoeConfig parseConfig aFilePath = do _configFile <- io - TIO.readFile - aFilePath ^. _Text@@ -446,6 +187,9 @@ updateGlobalLogger "moe" - addHandler formattedHandler updateGlobalLogger "moe" - setLevel aLevel +data AppType = TCPApp | UDPApp + deriving (Show, Eq)+ moeApp:: MoeMonadT () moeApp = do _options <- ask @@ -454,6 +198,7 @@ io - puts - show _options _config <- parseConfig - _options ^. configFile+ let _c = _config let _method = _config ^. method . _Text @@ -467,41 +212,85 @@ <> _options ^. configFile . _Text Just _ -> pure () - let localAppBuilder :: String -> (Socket -> IO ()) -> (Socket, SockAddr) -> - IO ()- localAppBuilder aID aHandler s = logSA "L loop" (pure s) - - \(_localSocket, _localAddr) -> do+ let localAppBuilder :: AppType -> String -> + (ByteString -> (Socket, SockAddr) -> IO ()) -> + (Socket, SockAddr) -> IO ()+ localAppBuilder aAppType aID aHandler s = + logSA "L loop" (pure s) - \(_localSocket, _localAddr) -> do _say - "L " <> aID <> ": nyaa!" - setSocketOption _localSocket ReuseAddr 1- bindSocket _localSocket _localAddr - listen _localSocket maxListenQueue+ case aAppType of+ TCPApp -> do+ setSocketOption _localSocket ReuseAddr 1+ bindSocket _localSocket _localAddr+ + listen _localSocket maxListenQueue - let handleLocal _socket = do- (_newSocket, _) <- accept _socket- setSocketCloseOnExec _newSocket- -- send immediately!- setSocketOption _socket NoDelay 1 - - forkIO - catchExceptAsyncLog "L thread" - - logSocket "L client socket" (pure _newSocket) -- aHandler+ let handleLocal _socket = do+ _s@(_newSocket, _newSockAddr) <- accept _socket+ setSocketCloseOnExec _newSocket+ -- send immediately!+ setSocketOption _socket NoDelay 1 + + forkIO - catchExceptAsyncLog "L TCP thread" - + logSA "L TCP client socket" (pure _s) -+ aHandler "" - forever - handleLocal _localSocket+ forever - handleLocal _localSocket + UDPApp -> do+ setSocketOption _localSocket ReuseAddr 1+ bindSocket _localSocket _localAddr++ let handleLocal = do+ (_msg, _sockAddr) <- + recvFrom _localSocket _ReceiveLength++ puts - "L UDP: " <> show _msg+ + let _s = (_localSocket, _sockAddr)++ forkIO - catchExceptAsyncLog "L UDP thread" - + aHandler _msg _s+++++ forever handleLocal+ + let localSocks5App :: (Socket, SockAddr) -> IO ()- localSocks5App = localAppBuilder "socks5" - + localSocks5App = localAppBuilder TCPApp "socks5" - localSocks5RequestHandler _config - localForwardingApp :: LocalForwarding -> (Socket, SockAddr) -> IO ()- localForwardingApp _f = localAppBuilder "forwarding" - - localForwardingRequestHandler _config _f+ showForwarding :: Forward -> String+ showForwarding (Forward _localPort _remoteHost _remotePort) =+ "["+ <> show _localPort + <> " -> " + <> _remoteHost ^. _Text+ <> ":"+ <> show _remotePort+ <> "]" - let remoteApp :: (Socket, SockAddr) -> IO ()- remoteApp s = logSA "R loop" (pure s) -+ forwardTCPApp :: Forward -> (Socket, SockAddr) + -> IO ()+ forwardTCPApp _f _s = do+ let _m = showForwarding _f+ localAppBuilder TCPApp ("TCP forwarding " <> _m)+ (forwardTCPRequestHandler _config _f) _s++ forwardUDPApp :: Forward -> (Socket, SockAddr) -> IO ()+ forwardUDPApp _f _s = do+ let _m = showForwarding _f + localAppBuilder UDPApp ("UDP forwarding " <> _m)+ (forwardUDPRequestHandler _config _f) _s+ + let remoteTCPApp :: (Socket, SockAddr) -> IO ()+ remoteTCPApp s = logSA "R loop" (pure s) - \(_remoteSocket, _remoteAddr) -> do- _say "R : nyaa!"+ _say "R TCP: nyaa!" setSocketOption _remoteSocket ReuseAddr 1 bindSocket _remoteSocket _remoteAddr@@ -518,35 +307,73 @@ forkIO - catchExceptAsyncLog "R thread" - logSocket "R remote socket" (pure _newSocket) -- remoteRequestHandler _config + remoteTCPRequestHandler _config forever - handleRemote _remoteSocket + let remoteUDPApp :: (Socket, SockAddr) -> IO ()+ remoteUDPApp s = logSA "R loop" (pure s) -+ \(_remoteSocket, _remoteAddr) -> do+ _say "R UDP: nyaa!"++ setSocketOption _remoteSocket ReuseAddr 1+ bindSocket _remoteSocket _remoteAddr++ let handleRemote = do+ (_msg, _sockAddr) <- recvFrom _remoteSocket _ReceiveLength++ puts - "R UDP: " <> show _msg++ let _s = (_remoteSocket, _sockAddr)+++ forkIO - catchExceptAsyncLog "R thread" - + remoteUDPRequestHandler _config _msg _s++ ++ forever handleRemote++ let remoteRun :: IO ()- remoteRun = foreverRun - catchExceptAsyncLog "R main app" - do- let _c = _config- getSocket (_c ^. remote) (_c ^. remotePort) Stream- >>= catchExceptAsyncLog "R app" . remoteApp + remoteRun = do+ let _TCPApp = foreverRun - catchExceptAsyncLog "R TCP app" - do+ getSocket (_c ^. remote) (_c ^. remotePort) Stream+ >>= remoteTCPApp ++ let _UDPApp = foreverRun - catchExceptAsyncLog "R UDP app" - do+ getSocket (_c ^. remote) (_c ^. remotePort) Datagram+ >>= remoteUDPApp ++ waitBoth _TCPApp _UDPApp++ localRun :: IO () localRun = do- let _c = _config- _forwardings = _options ^. localForwarding-- let _forwardingApps = do- forM_ _forwardings - \forwarding -> forkIO - do- foreverRun - catchExceptAsyncLog "L Forwarding app" - do+ let _forwardTCPApps = do+ forM_ (_options ^. forwardTCP) - \forwarding -> forkIO - do+ foreverRun - catchExceptAsyncLog "L TCPForwarding app" - do getSocket (_c ^. local) - (forwarding ^. localForwardingPort) + (forwarding ^. forwardLocalPort) Stream- >>= localForwardingApp forwarding+ >>= forwardTCPApp forwarding + let _forwardUDPApps = do+ forM_ (_options ^. forwardUDP) - \forwarding -> forkIO - do+ foreverRun - catchExceptAsyncLog "L UDPForwarding app" - do+ getSocket (_c ^. local) + (forwarding ^. forwardLocalPort) + Datagram+ >>= forwardUDPApp forwarding+ let _socks5App = foreverRun - catchExceptAsyncLog "L socks5 app" - do getSocket (_c ^. local) (_c ^. localPort) Stream >>= localSocks5App - _forwardingApps+ _forwardTCPApps+ _forwardUDPApps _socks5App debugRun :: IO ()
src/Network/MoeSocks/BuilderAndParser.hs view
@@ -25,57 +25,17 @@ socksVersion :: Word8 socksVersion = 5 -socksHeader :: Parser Word8-socksHeader = word8 socksVersion -greetingParser :: Parser ClientGreeting-greetingParser = do- socksHeader- let maxNoOfMethods = 5- _numberOfAuthenticationMethods <- satisfy (<= maxNoOfMethods) - ClientGreeting <$>- count (fromIntegral _numberOfAuthenticationMethods) anyWord8 +-- Builder+ greetingReplyBuilder :: B.Builder greetingReplyBuilder = B.word8 socksVersion <> B.word8 _No_authentication -portParser :: Parser Int-portParser = do- __portNumberPair <- (,) <$> anyWord8 <*> anyWord8- pure - portPairToInt __portNumberPair -portBuilder :: (Integral i) => i -> B.Builder-portBuilder i =- let _i = fromIntegral i :: Word16 - in- foldMapOf both B.word8 -- (decode - runPut - put _i :: (Word8, Word8)) -requestParser :: Parser ClientRequest-requestParser = do- __connectionType <- choice- [- TCP_IP_stream_connection <$ word8 1 - , TCP_IP_port_binding <$ word8 2- , UDP_port <$ word8 3- ]-- word8 _ReservedByte- __addressType <- addressTypeParser- __portNumber <- portParser- pure - - ClientRequest- __connectionType- __addressType - __portNumber--connectionParser :: Parser ClientRequest -connectionParser = do- socksHeader- requestParser- sockAddr_To_Pair :: SockAddr -> (AddressType, Port) sockAddr_To_Pair aSockAddr = case aSockAddr of SockAddrInet _port _host -> @@ -118,6 +78,13 @@ <> show x +portBuilder :: (Integral i) => i -> B.Builder+portBuilder i =+ let _i = fromIntegral i :: Word16 + in+ foldMapOf both B.word8 -+ (decode - runPut - put _i :: (Word8, Word8))+ connectionReplyBuilder :: SockAddr -> B.Builder connectionReplyBuilder aSockAddr = let _r@(__addressType, _port) = sockAddr_To_Pair aSockAddr@@ -164,6 +131,62 @@ addressTypeBuilder (aClientRequest ^. addressType) <> portBuilder (aClientRequest ^. portNumber) ++++++-- Parser++socksHeader :: Parser Word8+socksHeader = word8 socksVersion++greetingParser :: Parser ClientGreeting+greetingParser = do+ socksHeader+ let maxNoOfMethods = 5+ _numberOfAuthenticationMethods <- satisfy (<= maxNoOfMethods)++ ClientGreeting <$>+ count (fromIntegral _numberOfAuthenticationMethods) anyWord8+++portParser :: Parser Int+portParser = do+ __portNumberPair <- (,) <$> anyWord8 <*> anyWord8+ pure - portPairToInt __portNumberPair+++requestParser :: Parser ClientRequest+requestParser = do+ __connectionType <- choice+ [+ TCP_IP_stream_connection <$ word8 1 + , TCP_IP_port_binding <$ word8 2+ , UDP_port <$ word8 3+ ]++ word8 _ReservedByte+ __addressType <- addressTypeParser+ __portNumber <- portParser+ pure - + ClientRequest+ __connectionType+ __addressType + __portNumber++connectionParser :: Parser ClientRequest +connectionParser = do+ socksHeader+ requestParser+++anyWord16 :: Parser Word16+anyWord16 = do+ _b <- (,) <$> anyWord8 <*> anyWord8+ pure - decode - runPut - put _b++ addressTypeParser :: Parser AddressType addressTypeParser = choice [@@ -187,18 +210,14 @@ pure _r ] -anyWord16 :: Parser Word16-anyWord16 = do- _b <- (,) <$> anyWord8 <*> anyWord8- pure - decode - runPut - put _b -shadowSocksRequestParser :: Parser ClientRequest-shadowSocksRequestParser = do- __addressType <- addressTypeParser- __portNumber <- portParser+shadowSocksRequestParser :: ConnectionType -> Parser ClientRequest+shadowSocksRequestParser _connectionType = do+ _addressType <- addressTypeParser+ _portNumber <- portParser pure - ClientRequest- TCP_IP_stream_connection- __addressType - __portNumber+ _connectionType + _addressType + _portNumber
+ src/Network/MoeSocks/Common.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-}++module Network.MoeSocks.Common where++import Control.Lens+import Control.Monad.Writer hiding (listen)+import Data.Text (Text)+import Data.Text.Strict.Lens (utf8)+import Data.Text.Lens+import Network.MoeSocks.Helper+import Network.MoeSocks.Type+import Network.Socket hiding (send, recv, recvFrom, sendTo)+import Prelude hiding ((-), take)+import qualified Data.List as L+import Network.MoeSocks.Internal.ShadowSocks.Encrypt++getCipher :: Text -> Text -> IO (Cipher, Cipher)+getCipher aMethod aPassword =+ getEncDec aMethod (review utf8 aPassword)++showAddressType :: AddressType -> Text+showAddressType (IPv4_address xs) = view (from _Text) - + concat - L.intersperse "." - + map show - xs ^.. each+showAddressType (Domain_name x) = x +showAddressType (IPv6_address xs) = view (from _Text) -+ concat - L.intersperse ":" - + map show - xs ^.. each++showConnectionType :: ConnectionType -> String+showConnectionType TCP_IP_stream_connection = "TCP_Stream"+showConnectionType TCP_IP_port_binding = "TCP_Bind "+showConnectionType UDP_port = "UDP "++showRequest :: ClientRequest -> String+showRequest _r = + view _Text (showAddressType (_r ^. addressType))+ <> ":"+ <> show (_r ^. portNumber)++initTarget :: ClientRequest -> IO (Socket, SockAddr)+initTarget _clientRequest = do+ let + connectionType_To_SocketType :: ConnectionType -> SocketType+ connectionType_To_SocketType TCP_IP_stream_connection = Stream+ connectionType_To_SocketType TCP_IP_port_binding = NoSocketType+ connectionType_To_SocketType UDP_port = Datagram+ + _socketType = connectionType_To_SocketType -+ _clientRequest ^. connectionType+++ _hostName = _clientRequest ^. addressType . to showAddressType+ _port = _clientRequest ^. portNumber++ + getSocket _hostName _port _socketType
src/Network/MoeSocks/Config.hs view
@@ -28,5 +28,6 @@ _runningMode = DebugMode , _configFile = "" , _verbosity = DEBUG- , _localForwarding = []+ , _forwardTCP = []+ , _forwardUDP = pure (Forward 5301 "localhost" 53) }
src/Network/MoeSocks/Constant.hs view
@@ -21,3 +21,6 @@ _DefaultMethod :: Text _DefaultMethod = "aes-256-cfb" ++_ReceiveLength :: Int+_ReceiveLength = 4096
src/Network/MoeSocks/Helper.hs view
@@ -20,8 +20,6 @@ import Data.Monoid import Data.Text (Text) import Data.Text.Lens-import Data.Text.Strict.Lens (utf8)-import Network.MoeSocks.Internal.ShadowSocks.Encrypt import Network.Socket hiding (send, recv) import Network.Socket.ByteString import Prelude hiding (take, (-)) @@ -179,8 +177,8 @@ connectTunnel :: (Maybe String, IO ()) -> (Maybe String, IO ()) -> IO () connectTunnel = waitBothDebug -connectProduction :: (Maybe String, IO ()) -> (Maybe String, IO ()) -> IO ()-connectProduction = waitBothDebug+connectMarket :: (Maybe String, IO ()) -> (Maybe String, IO ()) -> IO ()+connectMarket = waitBothDebug getSocket :: (Integral i, Show i) => Text -> i -> SocketType -> IO (Socket, SockAddr)@@ -204,10 +202,12 @@ setSocketCloseOnExec _socket -- send immediately!- setSocketOption _socket NoDelay 1 + when (aSocketType == Stream) -+ setSocketOption _socket NoDelay 1 - {-puts - "Getting socket: " <> show address-}+ puts - "Getting socket: " <> show addrInfo {-puts - "Socket family: " <> show family-}+ {-puts - "Socket protocol: " <> show protocol -} pure (_socket, address) @@ -215,17 +215,12 @@ hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_NUMERICSERV] , addrSocketType = aSocketType- {-, addrFamily = AF_INET-}+ , addrFamily = AF_INET } builder_To_ByteString :: B.Builder -> ByteString builder_To_ByteString = LB.toStrict . B.toLazyByteString -type Cipher = ByteString -> IO ByteString --getCipher :: Text -> Text -> IO (Cipher, Cipher)-getCipher method password =- getEncDec method (review utf8 password) fromWord8 :: forall t. Binary t => [Word8] -> t
src/Network/MoeSocks/Options.hs view
@@ -48,24 +48,41 @@ in - let _forwarding :: O.Parser String- _forwarding = ( strOption -+ let _forwardTCP :: O.Parser String+ _forwardTCP = ( strOption - short 'L' <> metavar "port:host:hostport" <> help (""- <> "Specify that the given port on the local"+ <> "Specify that the given TCP port on the "+ <> "local" <> "(client) host is to be forwarded to the " <> "given host and port on the remote side." ) ) <|> pure "" + - forwardingParser :: Parser LocalForwarding- forwardingParser = do++ _forwardUDP :: O.Parser String+ _forwardUDP = ( strOption -+ short 'U'+ <> long "LUDP"+ <> metavar "port:host:hostport"+ <> help (""+ <> "Specify that the given UDP port on the "+ <> "local"+ <> "(client) host is to be forwarded to the "+ <> "given host and port on the remote side."+ )+ ) <|> pure ""++ + forwardParser :: Parser Forward+ forwardParser = do skipSpace- _localForwardingPort <- decimal+ _forwardPort <- decimal char ':'- _localForwardingRemoteHost <- + _forwardRemoteHost <- choice [ do @@ -76,19 +93,20 @@ , takeWhile (/= ':') ] char ':'- _localForwardingRemotePort <- decimal+ _forwardRemotePort <- decimal - pure - LocalForwarding _localForwardingPort- _localForwardingRemoteHost- _localForwardingRemotePort+ pure - Forward + _forwardPort+ _forwardRemoteHost+ _forwardRemotePort - forwardingListParser :: Parser [LocalForwarding]- forwardingListParser = many' forwardingParser+ forwardListParser :: Parser [Forward]+ forwardListParser = many' forwardParser - parseForwarding :: String -> [LocalForwarding]+ parseForwarding :: String -> [Forward] parseForwarding x = x ^. from _Text - & parseOnly forwardingListParser + & parseOnly forwardListParser & toListOf (traverse . traverse) in @@ -97,7 +115,8 @@ <$> fmap parseMode _mode <*> fmap (view packed) _config <*> __verbosity- <*> fmap parseForwarding _forwarding+ <*> fmap parseForwarding _forwardTCP+ <*> fmap parseForwarding _forwardUDP opts :: ParserInfo MoeOptions opts = info (helper <*> optionParser) -
+ src/Network/MoeSocks/TCP.hs view
@@ -0,0 +1,247 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-}++module Network.MoeSocks.TCP where++import Control.Concurrent.STM+import Control.Exception+import Control.Lens+import Control.Monad+import Control.Monad.Writer hiding (listen)+import Data.ByteString (ByteString)+import Network.MoeSocks.BuilderAndParser+import Network.MoeSocks.Helper+import Network.MoeSocks.Common+import Network.MoeSocks.Type+import Network.Socket hiding (send, recv, recvFrom, sendTo)+import Prelude hiding ((-), take)+import qualified Data.List as L+++forwardTCPRequestHandler :: MoeConfig -> Forward -> + ByteString -> (Socket, SockAddr) -> IO ()+forwardTCPRequestHandler aConfig aForwarding _ (aSocket,_) = do+ let _clientRequest = ClientRequest+ TCP_IP_stream_connection+ (Domain_name - aForwarding ^. + forwardRemoteHost)+ (aForwarding ^. forwardRemotePort)+ + localTCPRequestHandler aConfig (_clientRequest, mempty) False aSocket++++localTCPRequestHandler :: MoeConfig -> (ClientRequest, ByteString) -> + Bool -> Socket -> IO ()+localTCPRequestHandler aConfig (_clientRequest, _partialBytesAfterClientRequest) + shouldReplyClient aSocket = do+ let + _c = aConfig + _initSocket = + getSocket (_c ^. remote) (_c ^. remotePort) Stream ++ puts - "L : " <> show _clientRequest+ + logSA "L remote socket" _initSocket - + \(_remoteSocket, _remoteAddress) -> do+ connect _remoteSocket _remoteAddress+++ _localPeerAddr <- getPeerName aSocket+ _remoteSocketName <- getSocketName _remoteSocket+ + when shouldReplyClient - do+ let _connectionReplyBuilder = connectionReplyBuilder _remoteSocketName+ send_ aSocket - builder_To_ByteString _connectionReplyBuilder+ ++ let _msg = + concat - L.intersperse " -> " + [ + show _localPeerAddr+ , showRequest _clientRequest+ ]+ + _log - "L " -- <> showConnectionType (_clientRequest ^. connectionType)+ <> ": " <> _msg++ let handleLocal __remoteSocket = do+ (_encrypt, _decrypt) <- getCipher+ (aConfig ^. method)+ (aConfig ^. password)+++ let + _header = shadowSocksRequestBuilder _clientRequest+ + sendChannel <- newTBQueueIO - aConfig ^. tcpBufferSizeInPacket+ receiveChannel <- newTBQueueIO - aConfig ^. tcpBufferSizeInPacket++ let _logId x = x <> " " <> _msg+ _timeout = aConfig ^. timeout * 1000 * 1000+ _throttle = + if aConfig ^. throttle+ then Just - aConfig ^. throttleSpeed+ else Nothing++ let sendThread = do+ sendBuilderEncrypted + sendChannel _encrypt _header++ when (_partialBytesAfterClientRequest & isn't _Empty) -+ atomically . writeTBQueue sendChannel . Just =<< + _encrypt _partialBytesAfterClientRequest+++ let _produce = do+ produceLoop (_logId "L --> + Loop")+ _timeout+ Nothing+ aSocket + sendChannel + _encrypt++ let _consume = do+ consumeLoop (_logId "L --> - Loop")+ _timeout+ _throttle+ __remoteSocket + sendChannel+ finally+ (+ connectMarket (Just - _logId "L --> +", _produce)+ (Just - _logId "L --> -", _consume)+ ) -+ pure ()++ let receiveThread = do+ let _produce = produceLoop (_logId "L <-- + Loop")+ _timeout+ Nothing+ __remoteSocket + receiveChannel+ _decrypt++ let _consume = do+ consumeLoop (_logId "L <-- - Loop")+ _timeout+ Nothing+ aSocket + receiveChannel+ finally + (+ connectMarket (Just - _logId "L <-- +", _produce)+ (Just - _logId "L <-- -", _consume)+ ) -+ pure ()++ connectTunnel+ (Just - _logId "L -->", sendThread)+ (Just - _logId "L <--", receiveThread)+++ handleLocal _remoteSocket+++remoteTCPRequestHandler:: MoeConfig -> Socket -> IO ()+remoteTCPRequestHandler aConfig aSocket = do+ (_encrypt, _decrypt) <- getCipher+ (aConfig ^. method)+ (aConfig ^. password)+ + (_leftOverBytes, _clientRequest) <- parseSocket + "clientRequest"+ mempty+ _decrypt+ (shadowSocksRequestParser + TCP_IP_stream_connection)+ aSocket+ ++ {-puts - "Remote get: " <> show _clientRequest-}+ + logSA "R target socket" (initTarget _clientRequest) - \_r -> do+ let (_targetSocket, _targetSocketAddress) = _r ++ connect _targetSocket _targetSocketAddress++ _remotePeerAddr <- getPeerName aSocket+ _targetPeerAddr <- getPeerName _targetSocket++ let _msg = + concat - L.intersperse " -> " - + [ + show _remotePeerAddr+ , showRequest _clientRequest+ ]++ _log - "R " -- <> showConnectionType (_clientRequest ^. connectionType)+ <> ": " <> _msg++ let + handleTarget __leftOverBytes __targetSocket = do+ sendChannel <- newTBQueueIO - aConfig ^. tcpBufferSizeInPacket+ receiveChannel <- newTBQueueIO - aConfig ^. tcpBufferSizeInPacket++ let _logId x = x <> " " <> _msg+ _timeout = aConfig ^. timeout * 1000 * 1000+ + _throttle = + if aConfig ^. throttle+ then Just - aConfig ^. throttleSpeed+ else Nothing++ let sendThread = do+ when (_leftOverBytes & isn't _Empty) -+ atomically - writeTBQueue sendChannel - Just _leftOverBytes++ let _produce = do+ produceLoop (_logId "R --> + Loop")+ _timeout+ Nothing+ aSocket+ sendChannel+ _decrypt++ let _consume = consumeLoop (_logId "R --> - Loop")+ _timeout+ Nothing+ __targetSocket+ sendChannel++ finally+ (+ connectMarket (Just - _logId "R --> +", _produce)+ (Just - _logId "R --> -", _consume)+ ) -+ pure ()++ let receiveThread = do+ let _produce = do+ produceLoop (_logId "R --> + Loop")+ _timeout+ Nothing+ __targetSocket+ receiveChannel+ _encrypt+++ let _consume = do+ consumeLoop (_logId "R --> - Loop")+ _timeout+ _throttle+ aSocket+ receiveChannel++ finally + (+ connectMarket (Just - _logId "R <-- +", _produce)+ (Just - _logId "R <-- -", _consume)+ ) -+ pure ()++ connectTunnel+ (Just - _logId "R -->", sendThread)+ (Just - _logId "R <--", receiveThread)+ + handleTarget _leftOverBytes _targetSocket
src/Network/MoeSocks/Type.hs view
@@ -72,22 +72,24 @@ data Verbosity = Normal | Verbose deriving (Show, Eq) -data LocalForwarding = LocalForwarding+data Forward = Forward {- _localForwardingPort :: Port- , _localForwardingRemoteHost :: Text- , _localForwardingRemotePort :: Port+ _forwardLocalPort :: Port+ , _forwardRemoteHost :: Text+ , _forwardRemotePort :: Port } deriving (Show, Eq) -makeLenses ''LocalForwarding +makeLenses ''Forward+ data MoeOptions = MoeOptions { _runningMode :: RunningMode , _configFile :: Text , _verbosity :: Priority- , _localForwarding :: [LocalForwarding]+ , _forwardTCP :: [Forward]+ , _forwardUDP :: [Forward] } deriving (Show, Eq)
+ src/Network/MoeSocks/UDP.hs view
@@ -0,0 +1,102 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-}++module Network.MoeSocks.UDP where++import Control.Lens+import Control.Monad+import Data.Attoparsec.ByteString+import Control.Monad.Writer hiding (listen)+import Control.Exception+import Data.ByteString (ByteString)+import Network.MoeSocks.Helper+import Network.MoeSocks.BuilderAndParser+import Network.MoeSocks.Common+import Network.MoeSocks.Type+import Network.Socket hiding (send, recv, recvFrom, sendTo)+import Network.Socket.ByteString+import Prelude hiding ((-), take)+++++forwardUDPRequestHandler :: MoeConfig -> Forward -> + ByteString -> (Socket,SockAddr) -> IO ()+forwardUDPRequestHandler aConfig aForwarding aMessage + (aSocket, aSockAddr) = do++ let _c = aConfig++ let _clientRequest = ClientRequest+ UDP_port+ (Domain_name - aForwarding ^. + forwardRemoteHost)+ (aForwarding ^. forwardRemotePort)+ + puts - "L UDP: " <> show _clientRequest++ _sa <- getSocket (_c ^. remote) (_c ^. remotePort) Datagram++ logSA "L UDP -->:" (pure _sa) - + \(_remoteSocket, _remoteAddr) -> do+ connect _remoteSocket _remoteAddr++ (_encrypt, _decrypt) <- getCipher+ (aConfig ^. method)+ (aConfig ^. password)++ {-let (_encrypt, _decrypt) = (pure, pure)-}++ let + _header = shadowSocksRequestBuilder _clientRequest+ + + let _msg = builder_To_ByteString _header <> aMessage++ puts - "L UDP: " <> show _msg+ + send_ _remoteSocket =<< _encrypt _msg++ _r <- recv_ _remoteSocket >>= _decrypt++ puts - "L UDP <--: " <> show _r+ when (_r & isn't _Empty) - do+ sendAllTo aSocket _r aSockAddr++remoteUDPRequestHandler:: MoeConfig -> ByteString -> (Socket, SockAddr) + -> IO ()+remoteUDPRequestHandler aConfig aMessage (aSocket, aSockAddr) = do+ (_encrypt, _decrypt) <- getCipher+ (aConfig ^. method)+ (aConfig ^. password)+ ++ {-let (_encrypt, _decrypt) = (pure, pure)-}+ + _msg <- _decrypt aMessage++ (_decryptedMessage, _clientRequest) <-+ case parse (shadowSocksRequestParser UDP_port) _msg of+ Done _i _r -> pure (_i, _r)+ _ -> throwIO - ParseException -+ "R Failed to parse UDP request"+ + puts - "R UDP: " <> show _clientRequest+ puts - "R UDP: " <> show _decryptedMessage+ + logSA "R UDP -->:" (initTarget _clientRequest) - \_r -> do+ let (_clientSocket, _clientAddr) = _r++ puts - "R UDP clientSocket: " <> show _r++ connect _clientSocket _clientAddr+ + send_ _clientSocket _decryptedMessage++ _r <- recv_ _clientSocket++ puts - "R UDP <--: " <> show _r++ when (_r & isn't _Empty) - do+ _encryptedMessage <- _encrypt _r+ sendAllTo aSocket _encryptedMessage aSockAddr