moesocks 0.1.0.7 → 0.1.0.8
raw patch · 6 files changed
+212/−93 lines, 6 files
Files
- moesocks.cabal +1/−1
- src/Network/MoeSocks/App.hs +138/−85
- src/Network/MoeSocks/Config.hs +1/−0
- src/Network/MoeSocks/Helper.hs +10/−0
- src/Network/MoeSocks/Options.hs +51/−7
- src/Network/MoeSocks/Type.hs +11/−0
moesocks.cabal view
@@ -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.
src/Network/MoeSocks/App.hs view
@@ -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
src/Network/MoeSocks/Config.hs view
@@ -24,4 +24,5 @@ _runningMode = DebugMode , _configFile = "" , _verbosity = DEBUG+ , _localForwarding = [] }
src/Network/MoeSocks/Helper.hs view
@@ -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
src/Network/MoeSocks/Options.hs view
@@ -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) -
src/Network/MoeSocks/Type.hs view
@@ -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)