diff --git a/moesocks.cabal b/moesocks.cabal --- a/moesocks.cabal +++ b/moesocks.cabal @@ -3,7 +3,7 @@ name: moesocks category: Network -version: 0.1.0.7 +version: 0.1.0.8 license: Apache-2.0 synopsis: moe for all description: A socks5 proxy using the client / server architecture. 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 @@ -3,8 +3,8 @@ module Network.MoeSocks.App where - import Control.Concurrent +import Control.Exception import Control.Lens import Control.Monad import Control.Monad.Except @@ -22,6 +22,8 @@ import Network.MoeSocks.Helper import Network.MoeSocks.Type import Network.Socket hiding (send, recv) +import OpenSSL (withOpenSSL) +import OpenSSL.EVP.Cipher (getCipherByName) import Prelude hiding ((-), take) import System.Log.Formatter import System.Log.Handler.Simple @@ -33,9 +35,6 @@ import qualified System.IO as IO import qualified System.Log.Handler as LogHandler -import OpenSSL (withOpenSSL) -import OpenSSL.EVP.Cipher (getCipherByName) - showAddressType :: AddressType -> Text showAddressType (IPv4_address xs) = view (from _Text) - concat - L.intersperse "." - @@ -50,106 +49,131 @@ showConnectionType TCP_IP_port_binding = "TCP_Bind " showConnectionType UDP_port = "UDP " -localRequestHandler:: MoeConfig -> Socket -> IO () -localRequestHandler aConfig aSocket = do +processLocalSocks5Request :: Socket -> IO (ClientRequest, ByteString) +processLocalSocks5Request aSocket = do (_partialBytesAfterGreeting, r) <- parseSocket "clientGreeting" mempty pure greetingParser aSocket - forM_ (boolToMaybe - - _No_authentication `elem` (r ^. authenticationMethods)) - const - - do - send_ aSocket - builder_To_ByteString greetingReplyBuilder + when (not - _No_authentication `elem` (r ^. authenticationMethods)) - + throwIO - ParseException + "Client does not support no authentication method" - (_partialBytesAfterClientRequest, _clientRequest) <- parseSocket - "clientRequest" - _partialBytesAfterGreeting - pure - connectionParser - aSocket + send_ aSocket - builder_To_ByteString greetingReplyBuilder - puts - "L : " <> show _clientRequest - - let - _c = aConfig - _initSocket = - getSocket (_c ^. remote) (_c ^. remotePort) Stream + (_partialBytesAfterClientRequest, _clientRequest) <- parseSocket + "clientRequest" + _partialBytesAfterGreeting + pure + connectionParser + aSocket - logSA "L remote socket" _initSocket - - \(_remoteSocket, _remoteAddress) -> do - connect _remoteSocket _remoteAddress - _localPeerAddr <- getPeerName aSocket - _remoteSocketName <- getSocketName _remoteSocket + pure - (_clientRequest, _partialBytesAfterClientRequest) - let _connectionReplyBuilder = connectionReplyBuilder _remoteSocketName +localSocks5RequestHandler :: MoeConfig -> Socket -> IO () +localSocks5RequestHandler aConfig aSocket = do + _r <- processLocalSocks5Request aSocket + localRequestHandler 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 showRequest :: ClientRequest -> String - showRequest _r = - view _Text (showAddressType (_r ^. addressType)) - <> ":" - <> show (_r ^. portNumber) - _log - "L " -- <> showConnectionType (_clientRequest ^. connectionType) - <> ": " <> - ( - concat - L.intersperse " -> " - [ - show _localPeerAddr - , showRequest _clientRequest - ] - ) + + let showRequest :: ClientRequest -> String + showRequest _r = + view _Text (showAddressType (_r ^. addressType)) + <> ":" + <> show (_r ^. portNumber) + _log - "L " -- <> showConnectionType (_clientRequest ^. connectionType) + <> ": " <> + ( + concat - L.intersperse " -> " + [ + show _localPeerAddr + , showRequest _clientRequest + ] + ) - let handleLocal __remoteSocket = do - (_encrypt, _decrypt) <- getCipher - (aConfig ^. method) - (aConfig ^. password) + let handleLocal __remoteSocket = do + (_encrypt, _decrypt) <- getCipher + (aConfig ^. method) + (aConfig ^. password) - let - _header = shadowSocksRequestBuilder _clientRequest - - sendChannel <- newChan - receiveChannel <- newChan + let + _header = shadowSocksRequestBuilder _clientRequest + + sendChannel <- newChan + receiveChannel <- newChan - let sendThread = do - sendBuilderEncrypted - sendChannel _encrypt _header + let sendThread = do + sendBuilderEncrypted + sendChannel _encrypt _header - when (_partialBytesAfterClientRequest & isn't _Empty) - - writeChan sendChannel =<< - _encrypt _partialBytesAfterClientRequest + when (_partialBytesAfterClientRequest & isn't _Empty) - + writeChan sendChannel =<< + _encrypt _partialBytesAfterClientRequest - let _produce = produceLoop - aSocket - sendChannel - _encrypt + let _produce = produceLoop + aSocket + sendChannel + _encrypt - let _consume = consumeLoop - __remoteSocket - sendChannel + let _consume = consumeLoop + __remoteSocket + sendChannel - runBoth _produce _consume + runBoth _produce _consume - let receiveThread = do - let _produce = produceLoop - __remoteSocket - receiveChannel - _decrypt + let receiveThread = do + let _produce = produceLoop + __remoteSocket + receiveChannel + _decrypt - let _consume = consumeLoop - aSocket - receiveChannel + let _consume = consumeLoop + aSocket + receiveChannel - runBoth _produce _consume + runBoth _produce _consume - runBothDebug - (Just "L -->", sendThread) - (Just "L <--", receiveThread) + runBothDebug + (Just "L -->", sendThread) + (Just "L <--", receiveThread) - handleLocal _remoteSocket + handleLocal _remoteSocket remoteRequestHandler:: MoeConfig -> Socket -> IO () @@ -324,6 +348,8 @@ _options <- ask io - initLogger - _options ^. verbosity + io - puts - show _options + _config <- parseConfig - _options ^. configFile let _method = _config ^. method . _Text @@ -337,10 +363,11 @@ <> _options ^. configFile . _Text Just _ -> pure () - let localApp :: (Socket, SockAddr) -> IO () - localApp s = logSA "L loop" (pure s) - + let localAppBuilder :: String -> (Socket -> IO ()) -> (Socket, SockAddr) -> + IO () + localAppBuilder aID aHandler s = logSA "L loop" (pure s) - \(_localSocket, _localAddr) -> do - _say "L : nyaa!" + _say - "L " <> aID <> ": nyaa!" setSocketOption _localSocket ReuseAddr 1 bindSocket _localSocket _localAddr @@ -349,12 +376,22 @@ let handleLocal _socket = do (_newSocket, _) <- accept _socket + setSocketCloseOnExec _newSocket + forkIO - catchExceptAsyncLog "L thread" - logSocket "L client socket" (pure _newSocket) - - localRequestHandler _config + aHandler forever - handleLocal _localSocket + let localSocks5App :: (Socket, SockAddr) -> IO () + localSocks5App = localAppBuilder "socks5" - + localSocks5RequestHandler _config + + localForwardingApp :: LocalForwarding -> (Socket, SockAddr) -> IO () + localForwardingApp _f = localAppBuilder "forwarding" - + localForwardingRequestHandler _config _f + let remoteApp :: (Socket, SockAddr) -> IO () remoteApp s = logSA "R loop" (pure s) - \(_remoteSocket, _remoteAddr) -> do @@ -369,6 +406,8 @@ let handleRemote _socket = do (_newSocket, _) <- accept _socket + setSocketCloseOnExec _newSocket + forkIO - catchExceptAsyncLog "R thread" - logSocket "R remote socket" (pure _newSocket) - remoteRequestHandler _config @@ -385,8 +424,22 @@ localRun :: IO () localRun = do let _c = _config - getSocket (_c ^. local) (_c ^. localPort) Stream - >>= catchExceptAsyncLog "L app" . localApp + _forwardings = _options ^. localForwarding + + let _forwardingApps = do + forM_ _forwardings - \forwarding -> forkIO - do + getSocket (_c ^. local) + (forwarding ^. localForwardingPort) + Stream + >>= catchExceptAsyncLog "L Forwarding app" + . localForwardingApp forwarding + + let _socks5App = + getSocket (_c ^. local) (_c ^. localPort) Stream + >>= catchExceptAsyncLog "L socks5 app" . localSocks5App + + _forwardingApps + _socks5App debugRun :: IO () debugRun = do 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 @@ -24,4 +24,5 @@ _runningMode = DebugMode , _configFile = "" , _verbosity = DEBUG + , _localForwarding = [] } 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 @@ -1,5 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} module Network.MoeSocks.Helper where @@ -22,6 +23,7 @@ import Prelude hiding (take, (-)) import System.IO.Unsafe (unsafePerformIO) import System.Log.Logger +import System.Posix.IO (FdOption(CloseOnExec), setFdOption) import qualified Data.ByteString as S import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as LB @@ -178,6 +180,7 @@ let address = addrAddress addrInfo _socket <- socket family socketType protocol + setSocketCloseOnExec _socket {-puts - "Getting socket: " <> show address-} @@ -273,3 +276,10 @@ consumeLoop :: Socket -> Chan ByteString -> IO () consumeLoop aSocket aChan = forever - readChan aChan >>= send_ aSocket + + +-- Copied and slightly modified from: +-- https://github.com/mzero/plush/blob/master/src/Plush/Server/Warp.hs +setSocketCloseOnExec :: Socket -> IO () +setSocketCloseOnExec aSocket = + setFdOption (fromIntegral $ fdSocket aSocket) CloseOnExec True 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 @@ -7,9 +7,11 @@ import Network.MoeSocks.Helper import Network.MoeSocks.Type import Options.Applicative hiding (Parser) -import Prelude hiding ((-)) +import Prelude hiding ((-), takeWhile) import System.Log.Logger import qualified Options.Applicative as O +import Data.Attoparsec.Text (Parser, takeWhile, char, decimal, skipSpace, + parseOnly, many') optionParser :: O.Parser MoeOptions optionParser = @@ -19,7 +21,16 @@ <> metavar "MODE" <> help "local | remote" ) <|> pure "local" + + parseMode :: String -> RunningMode + parseMode x + | x `elem` ["server", "remote"] = RemoteMode + | x `elem` ["client", "local"] = LocalMode + | x == "debug" = DebugMode + | otherwise = DebugMode in + + let _config = ( strOption - short 'c' <> long "config" @@ -37,18 +48,51 @@ <> help "DEBUG|INFO|NOTICE" ) <|> pure INFO in - let parseMode :: String -> RunningMode - parseMode x - | x `elem` ["server", "remote"] = RemoteMode - | x `elem` ["client", "local"] = LocalMode - | x == "debug" = DebugMode - | otherwise = DebugMode + + + let _forwarding :: O.Parser String + _forwarding = ( strOption - + short 'L' + <> metavar "port:host:hostport" + <> help ("" + <> "Specifies that the given 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 + skipSpace + _localForwardingPort <- decimal + char ':' + _localForwardingRemoteHost <- takeWhile (/= ':') + char ':' + _localForwardingRemotePort <- decimal + + pure - LocalForwarding _localForwardingPort + _localForwardingRemoteHost + _localForwardingRemotePort + + forwardingListParser :: Parser [LocalForwarding] + forwardingListParser = many' forwardingParser + + parseForwarding :: String -> [LocalForwarding] + parseForwarding x = + let r = x ^. from _Text & parseOnly forwardingListParser + in + case r of + Left _ -> [] + Right xs -> xs in + MoeOptions <$> fmap parseMode _mode <*> fmap (view packed) _config <*> __verbosity + <*> fmap parseForwarding _forwarding opts :: ParserInfo MoeOptions opts = info (helper <*> optionParser) - 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 @@ -67,11 +67,22 @@ data Verbosity = Normal | Verbose deriving (Show, Eq) +data LocalForwarding = LocalForwarding + { + _localForwardingPort :: Port + , _localForwardingRemoteHost :: Text + , _localForwardingRemotePort :: Port + } + deriving (Show, Eq) + +makeLenses ''LocalForwarding + data MoeOptions = MoeOptions { _runningMode :: RunningMode , _configFile :: Text , _verbosity :: Priority + , _localForwarding :: [LocalForwarding] } deriving (Show, Eq)