diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +0.1.0.15 +-------- +* Add UDP port forwarding + 0.1.0.14 -------- * Add IPv6 support diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/config.json b/config.json --- a/config.json +++ b/config.json @@ -1,5 +1,5 @@ { - "server":"127.0.0.1", + "server":"localhost", "server_port":1190, "local_address":"localhost", "local_port":1090, diff --git a/moesocks.cabal b/moesocks.cabal --- a/moesocks.cabal +++ b/moesocks.cabal @@ -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 + diff --git a/src/Network/MoeSocks/App.hs b/src/Network/MoeSocks/App.hs --- a/src/Network/MoeSocks/App.hs +++ b/src/Network/MoeSocks/App.hs @@ -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 () diff --git a/src/Network/MoeSocks/BuilderAndParser.hs b/src/Network/MoeSocks/BuilderAndParser.hs --- a/src/Network/MoeSocks/BuilderAndParser.hs +++ b/src/Network/MoeSocks/BuilderAndParser.hs @@ -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 diff --git a/src/Network/MoeSocks/Common.hs b/src/Network/MoeSocks/Common.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/Common.hs @@ -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 diff --git a/src/Network/MoeSocks/Config.hs b/src/Network/MoeSocks/Config.hs --- a/src/Network/MoeSocks/Config.hs +++ b/src/Network/MoeSocks/Config.hs @@ -28,5 +28,6 @@ _runningMode = DebugMode , _configFile = "" , _verbosity = DEBUG - , _localForwarding = [] + , _forwardTCP = [] + , _forwardUDP = pure (Forward 5301 "localhost" 53) } diff --git a/src/Network/MoeSocks/Constant.hs b/src/Network/MoeSocks/Constant.hs --- a/src/Network/MoeSocks/Constant.hs +++ b/src/Network/MoeSocks/Constant.hs @@ -21,3 +21,6 @@ _DefaultMethod :: Text _DefaultMethod = "aes-256-cfb" + +_ReceiveLength :: Int +_ReceiveLength = 4096 diff --git a/src/Network/MoeSocks/Helper.hs b/src/Network/MoeSocks/Helper.hs --- a/src/Network/MoeSocks/Helper.hs +++ b/src/Network/MoeSocks/Helper.hs @@ -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 diff --git a/src/Network/MoeSocks/Options.hs b/src/Network/MoeSocks/Options.hs --- a/src/Network/MoeSocks/Options.hs +++ b/src/Network/MoeSocks/Options.hs @@ -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) - diff --git a/src/Network/MoeSocks/TCP.hs b/src/Network/MoeSocks/TCP.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/TCP.hs @@ -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 diff --git a/src/Network/MoeSocks/Type.hs b/src/Network/MoeSocks/Type.hs --- a/src/Network/MoeSocks/Type.hs +++ b/src/Network/MoeSocks/Type.hs @@ -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) diff --git a/src/Network/MoeSocks/UDP.hs b/src/Network/MoeSocks/UDP.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/UDP.hs @@ -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