diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +0.1.2.10 +------- +* Fix not parsing snake case in config, a bug in introduced in 0.1.2.0 + 0.1.2.0 ------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -55,9 +55,10 @@ Drawbacks ========== -* UDP over SOCKS5 is not implemented +* UDP over SOCKS5 is not implemented. * More then 2 times slower then the original Python implementation (measured at - 20M/s vs 43M/s on an Intel P8800, using the AES-256-CFB method) + 20M/s vs 43M/s on an Intel P8800, using the AES-256-CFB method). +* Currently only works on Linux. TCP Fast Open (TFO) 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.2.0 +version: 0.1.2.10 license: Apache-2.0 synopsis: A functional firewall killer description: A SOCKS5 proxy using the client / server architecture. @@ -23,8 +23,9 @@ executable moesocks main-is: Main.hs - ghc-options: -Wall -fno-warn-unused-do-bind -O2 + ghc-options: -Wall -fno-warn-unused-do-bind -threaded + ---O2 -- -rtsopts "-with-rtsopts=-N -c" build-depends: base > 4 && <= 5 , HsOpenSSL @@ -58,11 +59,12 @@ Network.MoeSocks.BuilderAndParser Network.MoeSocks.Common Network.MoeSocks.Config - Network.MoeSocks.Constant Network.MoeSocks.Encrypt Network.MoeSocks.Helper Network.MoeSocks.Internal.Socket + Network.MoeSocks.Modules.Resource Network.MoeSocks.Options + Network.MoeSocks.Runtime Network.MoeSocks.TCP Network.MoeSocks.Type 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,40 +4,29 @@ module Network.MoeSocks.App where import Control.Concurrent +import Control.Concurrent.STM import Control.Concurrent.Async hiding (waitBoth) import Control.Lens import Control.Monad import Control.Monad.Except import Control.Monad.Reader hiding (local) import Control.Monad.Writer hiding (listen) -import Data.Aeson hiding (Result) -import Data.Aeson.Lens import Data.ByteString (ByteString) -import Data.Maybe (fromMaybe) -import Data.Text (Text) import Data.Text.Lens -import Network.MoeSocks.Config -import Network.MoeSocks.Constant -import Network.MoeSocks.Encrypt (initCipherBox, safeMethods, unsafeMethods) import Network.MoeSocks.Common +import Network.MoeSocks.Encrypt (initCipherBox, safeMethods, unsafeMethods) import Network.MoeSocks.Helper +import Network.MoeSocks.Modules.Resource (loadConfig) +import Network.MoeSocks.Runtime import Network.MoeSocks.TCP import Network.MoeSocks.Type import Network.MoeSocks.UDP import Network.Socket hiding (send, recv, recvFrom, sendTo) import Network.Socket.ByteString import Prelude hiding ((-), take) -import System.Log.Formatter -import System.Log.Handler.Simple -import System.Log.Logger -import qualified Data.HashMap.Strict as H -import qualified Data.Map as Map -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 - +_PacketLength :: Int +_PacketLength = 4096 withGateOptions :: Options -> IO a -> IO () withGateOptions aOption aIO = do @@ -56,114 +45,7 @@ else () <$ aIO -parseConfig :: Options -> MoeMonadT Config -parseConfig aOption = do - let _maybeFilePath = aOption ^. configFile - - _v <- case _maybeFilePath of - Nothing -> pure - Just - Object mempty - Just _filePath -> fmap (preview _JSON) - - io - TIO.readFile - _filePath ^. _Text - - let - - asList :: ([(Text, Value)] -> [(Text, Value)]) -> Value -> Value - asList f = over _Object - H.fromList . f . H.toList - - fromShadowSocksConfig :: Text -> Text - fromShadowSocksConfig x = - let fixes = Map.fromList - [ - ("server", "remoteAddress") - , ("server_port", "remotePort") - , ("local_address", "localAddress") - , ("local_port", "localPort") - ] - - in - fixes ^? ix x & fromMaybe x - - toParsableConfig :: Value -> Value - toParsableConfig = asList - each . _1 %~ ( - T.cons '_' - {-. toHaskellNamingConvention-} - . fromShadowSocksConfig - ) - - toReadableConfig :: Value -> Value - toReadableConfig = asList - each . _1 %~ T.tail - - showConfig :: Config -> Text - showConfig = review _JSON - . toReadableConfig - . review _JSON - - filterEssentialConfig :: Value -> Value - filterEssentialConfig = over _Object - \_obj -> - foldl (flip H.delete) _obj - - [ - "_password" - ] - - insertConfig :: Value -> Value -> Value - insertConfig (Object _from) = over _Object (_from `H.union`) - insertConfig _ = const Null - - insertParams :: [(Text, Value)] -> Value -> Value - insertParams _from = over _Object (H.fromList _from `H.union`) - - fallbackConfig :: Value -> Value -> Value - fallbackConfig = flip insertConfig - - optionalConfig = filterEssentialConfig - toJSON defaultConfig - - _maybeConfig = -- trace ("JSON: " <> show _v) - _v - >>= decode - . encode - . fallbackConfig optionalConfig - . insertParams (aOption ^. params) - . toParsableConfig - - case _maybeConfig of - Nothing -> do - let _r = - execWriter - do - tell "\n\n" - case _maybeFilePath of - Just _filePath -> do - tell "Failed to parse configuration file: " - tell _filePath - tell "\n" - tell "Example: \n" - tell - showConfig defaultConfig <> "\n" - Nothing -> do - tell "The password argument '-k' is required.\n" - tell "Alternatively, use '-c' to provide a " - tell "configuration file.\n" - - throwError - _r ^. _Text - - Just _config -> do - let configStr = showConfig _config ^. _Text :: String - io - debug_ - "Using config: " <> configStr - pure - _config - -initLogger :: Priority -> IO () -initLogger aLevel = do - stdoutHandler <- streamHandler IO.stdout DEBUG - let formattedHandler = - LogHandler.setFormatter stdoutHandler - - --"[$time : $loggername : $prio] - simpleLogFormatter "$time $prio\t $msg" - - updateGlobalLogger rootLoggerName removeHandler - - updateGlobalLogger "moe" removeHandler - updateGlobalLogger "moe" - addHandler formattedHandler - updateGlobalLogger "moe" - setLevel aLevel - -data RelayType = TCP_Relay | UDP_Relay +data ServiceType = TCP_Service | UDP_Service deriving (Show, Eq) moeApp:: MoeMonadT () @@ -173,7 +55,7 @@ io - debug_ - show _options - _config <- parseConfig - _options + _config <- loadConfig - _options let _c = _config let _method = _config ^. method @@ -186,19 +68,19 @@ let _env = Env _options _config _cipherBox - let localRelay :: RelayType + let localService :: ServiceType -> String -> (ByteString -> (Socket, SockAddr) -> IO ()) -> (Socket, SockAddr) -> IO () - localRelay aRelayType aID aHandler s = + localService aServiceType aID aHandler s = logSA "L loop" (pure s) - \(_localSocket, _localAddr) -> do setSocketOption _localSocket ReuseAddr 1 bindSocket _localSocket _localAddr - case aRelayType of - TCP_Relay -> do + case aServiceType of + TCP_Service -> do info_ - "LT: " <> aID <> " nyaa!" when (_c ^. fastOpen) - @@ -217,7 +99,7 @@ forever - handleLocal _localSocket - UDP_Relay -> do + UDP_Service -> do info_ - "LU: " <> aID <> " nyaa!" let handleLocal = do (_msg, _sockAddr) <- @@ -237,7 +119,7 @@ showWrapped x = "[" <> show x <> "]" let local_SOCKS5 :: (Socket, SockAddr) -> IO () - local_SOCKS5 _s = localRelay TCP_Relay + local_SOCKS5 _s = localService TCP_Service ("SOCKS5 proxy " <> showWrapped (_s ^. _2)) (local_SOCKS5_RequestHandler _env) - _s @@ -255,14 +137,14 @@ localForward_TCP :: Forward -> (Socket, SockAddr) -> IO () localForward_TCP _f _s = do let _m = showForwarding _f - localRelay TCP_Relay ("TCP port forwarding " <> _m) + localService TCP_Service ("TCP port forwarding " <> _m) (local_TCP_ForwardRequestHandler _env _f) _s localForward_UDP :: Forward -> (Socket, SockAddr) -> IO () localForward_UDP _f _s = do let _m = showForwarding _f - localRelay UDP_Relay ("UDP port forwarding " <> _m) + localService UDP_Service ("UDP port forwarding " <> _m) (local_UDP_ForwardRequestHandler _env _f) _s @@ -311,97 +193,69 @@ forever handleRemote - let runRemoteRelay :: RemoteRelay -> IO RemoteRelay + -- Run + + let runRemoteRelay :: RemoteRelay -> IO () runRemoteRelay _remoteRelay = do let _address = _remoteRelay ^. remoteRelayAddress _port = _remoteRelay ^. remoteRelayPort - _relay_ID <- fmap Relay_ID - async - foreverRun - do - case _remoteRelay ^. remoteRelayType of - Remote_TCP_Relay -> catchExceptAsyncLog "R TCP Relay" - do - getSocket _address _port Stream - >>= remote_TCP_Relay + case _remoteRelay ^. remoteRelayType of + Remote_TCP_Relay -> catchExceptAsyncLog "R TCP Relay" - do + getSocket _address _port Stream + >>= remote_TCP_Relay - Remote_UDP_Relay -> catchExceptAsyncLog "R UDP Relay" - do - getSocket _address _port Datagram - >>= remote_UDP_Relay + Remote_UDP_Relay -> catchExceptAsyncLog "R UDP Relay" - do + getSocket _address _port Datagram + >>= remote_UDP_Relay - pure - _remoteRelay & relay_ID ?~ _relay_ID + + let runLocalService :: LocalService -> IO () + runLocalService _localService = do + case _localService ^. localServiceType of + LocalService_TCP_Forward forwarding -> + catchExceptAsyncLog "L TCP_Forwarding" - do + getSocket (_localService ^. localServiceAddress) + (forwarding ^. forwardLocalPort) + Stream + >>= localForward_TCP forwarding + + LocalService_UDP_Forward forwarding -> + catchExceptAsyncLog "L UDP_Forwarding" - do + getSocket (_localService ^. localServiceAddress) + (forwarding ^. forwardLocalPort) + Datagram + >>= localForward_UDP forwarding + + LocalService_SOCKS5 _port -> + catchExceptAsyncLog "L SOCKS5" - do + getSocket (_localService ^. localServiceAddress) _port Stream + >>= local_SOCKS5 - let - runRemote :: IO () - runRemote = do - let config_To_Runtime :: Config -> Runtime -> Runtime - config_To_Runtime _config _runtime = - let _remote_TCP_Relay = - RemoteRelay - Remote_TCP_Relay - (_config ^. remoteAddress) - (_config ^. remotePort) - Nothing + runJob :: Job -> TVar JobStatus -> IO () + runJob (RemoteRelayJob x) _ = runRemoteRelay x + runJob (LocalServiceJob x) _ = runLocalService x + + runApp :: [Job] -> IO () + runApp someJobs = do + _jobs <- (forM someJobs - \_job -> (,) _job + <$> newTVarIO initialJobStatus) + _asyncs <- mapM (async . foreverRun . (uncurry runJob)) _jobs + + _mainThread <- async - do + waitAnyCancel - _asyncs - _remote_UDP_Relay = - RemoteRelay - Remote_UDP_Relay - (_config ^. remoteAddress) - (_config ^. remotePort) - Nothing - in - _runtime & remoteRelays .~ [_remote_TCP_Relay, _remote_UDP_Relay] - - relays <- mapM runRemoteRelay - - config_To_Runtime _c mempty ^. remoteRelays + _uiThread <- async - forever - do + let _statuses = _jobs ^.. each . _2 :: [TVar JobStatus] + {-forM_ _statuses - readTVarIO >=> print-} + sleep 5 - waitAnyCancel - relays ^.. each . relay_ID . _Just . unRelay_ID + waitAnyCancel [_mainThread, _uiThread] pure () - - - runLocal :: IO () - runLocal = do - let _localForward_TCPs = do - forM_ (_options ^. forward_TCPs) - \forwarding -> forkIO - do - foreverRun - catchExceptAsyncLog "L TCP_Forwarding" - do - getSocket (_c ^. localAddress) - (forwarding ^. forwardLocalPort) - Stream - >>= localForward_TCP forwarding - - let _localForward_UDPs = do - forM_ (_options ^. forward_UDPs) - \forwarding -> forkIO - do - foreverRun - catchExceptAsyncLog "L UDP_Forwarding" - do - getSocket (_c ^. localAddress) - (forwarding ^. forwardLocalPort) - Datagram - >>= localForward_UDP forwarding - - let _local_SOCKS5 = foreverRun - catchExceptAsyncLog "L SOCKS5" - do - getSocket (_c ^. localAddress) (_c ^. localPort) Stream - >>= local_SOCKS5 - _localForward_TCPs - _localForward_UDPs - if (_options ^. disable_SOCKS5) - then - if (_options ^. forward_TCPs & isn't _Empty) - || (_options ^. forward_UDPs & isn't _Empty) - then - forever - sleep 1000 - else - error_ "Nothing to run!" - - else _local_SOCKS5 + io - runApp - filterJobs (_options ^. runningMode) - loadJobs _c _options - runDebug :: IO () - runDebug = do - catchExceptAsyncLog "runDebug" - do - waitBothDebug - (Just "runLocal", runLocal) - (Just "runRemote", runRemote) - io - case _options ^. runningMode of - DebugMode -> runDebug - RemoteMode -> runRemote - LocalMode -> runLocal 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 @@ -10,7 +10,6 @@ import Data.Monoid import Data.Text.Lens import Data.Text.Strict.Lens (utf8) -import Network.MoeSocks.Constant import Network.MoeSocks.Helper import Network.MoeSocks.Type import Network.Socket @@ -19,14 +18,24 @@ import qualified Data.ByteString.Builder as B import qualified Prelude as P -{-import Debug.Trace-} -socksVersion :: Word8 -socksVersion = 5 +_No_authentication :: Word8 +_No_authentication = 0 + +_Request_Granted :: Word8 +_Request_Granted = 0 +_ReservedByte :: Word8 +_ReservedByte = 0 +_SpaceCode :: Word8 +_SpaceCode = 32 + +socksVersion :: Word8 +socksVersion = 5 + -- Builder greetingReplyBuilder :: B.Builder @@ -113,7 +122,7 @@ connectionType_To_Word8 :: ConnectionType -> Word8 connectionType_To_Word8 TCP_IP_StreamConnection = 1 -connectionType_To_Word8 TCP_IP_PortBinding = 2 +{-connectionType_To_Word8 TCP_IP_PortBinding = 2-} connectionType_To_Word8 UDP_Port = 3 @@ -161,7 +170,7 @@ __connectionType <- choice [ TCP_IP_StreamConnection <$ word8 1 - , TCP_IP_PortBinding <$ word8 2 + {-, TCP_IP_PortBinding <$ word8 2-} , UDP_Port <$ word8 3 ] diff --git a/src/Network/MoeSocks/Common.hs b/src/Network/MoeSocks/Common.hs --- a/src/Network/MoeSocks/Common.hs +++ b/src/Network/MoeSocks/Common.hs @@ -7,38 +7,26 @@ import Control.Monad.Writer hiding (listen) import Data.IP import Data.Maybe -import Data.Text (Text) 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 -showAddressType :: AddressType -> Text -showAddressType (IPv4_Address xs) = xs ^.. each . to show - ^.. folding (concat . L.intersperse ".") - ^. from _Text - -showAddressType (DomainName x) = x -showAddressType (IPv6_Address xs) = xs ^.. each . to show - ^.. folding (concat . L.intersperse ":") - ^. from _Text - makePrisms ''IPRange checkForbidden_IP_List :: AddressType -> [IPRange] -> Bool checkForbidden_IP_List _address@(IPv4_Address _) aForbidden_IP_List = isJust - do - _ip <- showAddressType _address ^. _Text ^? _Show + _ip <- show _address ^? _Show findOf (each . _IPv4Range) (isMatchedTo _ip) aForbidden_IP_List checkForbidden_IP_List _address@(IPv6_Address _) aForbidden_IP_List = isJust - do - _ip <- showAddressType _address ^. _Text ^? _Show + _ip <- show _address ^? _Show findOf (each . _IPv6Range) (isMatchedTo _ip) aForbidden_IP_List checkForbidden_IP_List _ _ = False @@ -46,19 +34,19 @@ withCheckedForbidden_IP_List :: AddressType -> [IPRange] -> IO a -> IO () withCheckedForbidden_IP_List aAddressType aForbidden_IP_List aIO = if checkForbidden_IP_List aAddressType aForbidden_IP_List - then error_ - showAddressType aAddressType ^. _Text + then error_ - show aAddressType <> " is in forbidden-ip list" else () <$ aIO showConnectionType :: ConnectionType -> String showConnectionType TCP_IP_StreamConnection = "TCP_Stream" -showConnectionType TCP_IP_PortBinding = "TCP_Bind " +-- showConnectionType TCP_IP_PortBinding = "TCP_Bind " showConnectionType UDP_Port = "UDP " showRequest :: ClientRequest -> String showRequest _r = - _r ^. addressType . to showAddressType . _Text + _r ^. addressType . to show <> ":" <> _r ^. portNumber . to show @@ -71,17 +59,25 @@ addressType_To_Family (IPv6_Address _) = Just AF_INET6 addressType_To_Family _ = Nothing -connectionType_To_SocketType :: ConnectionType -> SocketType -connectionType_To_SocketType TCP_IP_StreamConnection = Stream -connectionType_To_SocketType TCP_IP_PortBinding = NoSocketType -connectionType_To_SocketType UDP_Port = Datagram +_SocketType :: Prism' SocketType ConnectionType +_SocketType = prism' connectionType_To_SocketType socketType_To_connectionType + where + connectionType_To_SocketType :: ConnectionType -> SocketType + connectionType_To_SocketType TCP_IP_StreamConnection = Stream + {-connectionType_To_SocketType TCP_IP_PortBinding = NoSocketType-} + connectionType_To_SocketType UDP_Port = Datagram + socketType_To_connectionType :: SocketType -> Maybe ConnectionType + socketType_To_connectionType Stream = Just TCP_IP_StreamConnection + socketType_To_connectionType Datagram = Just UDP_Port + socketType_To_connectionType _ = Nothing + + initTarget :: ClientRequest -> IO (Socket, SockAddr) initTarget _clientRequest = do let - _socketType = _clientRequest ^. - connectionType . to connectionType_To_SocketType - _hostName = _clientRequest ^. addressType . to showAddressType + _socketType = _clientRequest ^. connectionType . re _SocketType + _hostName = _clientRequest ^. addressType . to show . from _Text _port = _clientRequest ^. portNumber _family = _clientRequest ^. addressType . to addressType_To_Family diff --git a/src/Network/MoeSocks/Constant.hs b/src/Network/MoeSocks/Constant.hs deleted file mode 100644 --- a/src/Network/MoeSocks/Constant.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Network.MoeSocks.Constant where - -import Data.Word - -_No_authentication :: Word8 -_No_authentication = 0 - -_Request_Granted :: Word8 -_Request_Granted = 0 - -_ReservedByte :: Word8 -_ReservedByte = 0 - -_SpaceCode :: Word8 -_SpaceCode = 32 - -_PacketLength :: Int -_PacketLength = 4096 - - -_NoThrottle :: Maybe a -_NoThrottle = Nothing 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 @@ -14,6 +14,7 @@ import Data.Binary import Data.Binary.Put import Data.ByteString (ByteString) +import Data.Char (isUpper) import Data.Maybe import Data.Monoid import Data.Text (Text) @@ -32,6 +33,7 @@ import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as LB import qualified Data.Strict as S +import qualified Data.Text as T -- BEGIN backports @@ -42,6 +44,8 @@ -- END backports +is :: APrism s t a b -> s -> Bool +is x = not . isn't x type HCipher = S.Maybe ByteString -> IO ByteString type HQueue = TBQueue (S.Maybe ByteString) @@ -446,8 +450,12 @@ tryIO :: String -> IO a -> IO (Either IOException a) tryIO _ = try -- . logException aID -{-toHaskellNamingConvention :: Text -> Text-} -{-toHaskellNamingConvention x = x -} - {-& T.split (`elem` ['_', '-'])-} - {-& over (_tail . traversed) T.toTitle-} - {-& T.concat-} +toHaskellNamingConvention :: Text -> Text +toHaskellNamingConvention x = + let xs = x & T.split (`elem` ['_', '-']) + in + if xs & anyOf each (T.all isUpper) + then x + else xs + & over (_tail . traversed) T.toTitle + & T.concat diff --git a/src/Network/MoeSocks/Modules/Resource.hs b/src/Network/MoeSocks/Modules/Resource.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/Modules/Resource.hs @@ -0,0 +1,113 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} + +module Network.MoeSocks.Modules.Resource where + +import Control.Lens +import Control.Monad +import Control.Monad.Except +import Control.Monad.Writer hiding (listen) +import Data.Aeson hiding (Result) +import Data.Aeson.Lens +import Data.Maybe (fromMaybe) +import Data.Text (Text) +import Data.Text.Lens +import Network.MoeSocks.Config +import Network.MoeSocks.Helper +import Network.MoeSocks.Type +import Prelude hiding ((-), take) +import qualified Data.HashMap.Strict as H +import qualified Data.Map as Map +import qualified Data.Text as T +import qualified Data.Text.IO as TIO + +loadConfig :: Options -> MoeMonadT Config +loadConfig aOption = do + let _maybeFilePath = aOption ^. configFile + + _v <- case _maybeFilePath of + Nothing -> pure - Just - Object mempty + Just _filePath -> fmap (preview _JSON) - + io - TIO.readFile - _filePath ^. _Text + + let + + asList :: ([(Text, Value)] -> [(Text, Value)]) -> Value -> Value + asList f = over _Object - H.fromList . f . H.toList + + fromShadowSocksConfig :: Text -> Text + fromShadowSocksConfig x = + let fixes = Map.fromList + [ + ("server", "remoteAddress") + , ("server_port", "remotePort") + ] + + in + fixes ^? ix x & fromMaybe x + + toParsableConfig :: Value -> Value + toParsableConfig = asList - each . _1 %~ ( + T.cons '_' + . toHaskellNamingConvention + . fromShadowSocksConfig + ) + + toReadableConfig :: Value -> Value + toReadableConfig = asList - each . _1 %~ T.tail + + showConfig :: Config -> Text + showConfig = review _JSON + . toReadableConfig + . review _JSON + + filterEssentialConfig :: Value -> Value + filterEssentialConfig = over _Object - \_obj -> + foldl (flip H.delete) _obj - + [ + "_password" + ] + + insertConfig :: Value -> Value -> Value + insertConfig (Object _from) = over _Object (_from `H.union`) + insertConfig _ = const Null + + insertParams :: [(Text, Value)] -> Value -> Value + insertParams _from = over _Object (H.fromList _from `H.union`) + + fallbackConfig :: Value -> Value -> Value + fallbackConfig = flip insertConfig + + optionalConfig = filterEssentialConfig - toJSON defaultConfig + + _maybeConfig = -- trace ("JSON: " <> show _v) + _v + >>= decode + . encode + . fallbackConfig optionalConfig + . insertParams (aOption ^. params) + . toParsableConfig + + case _maybeConfig of + Nothing -> do + let _r = + execWriter - do + tell "\n\n" + case _maybeFilePath of + Just _filePath -> do + tell "Failed to parse configuration file: " + tell _filePath + tell "\n" + tell "Example: \n" + tell - showConfig defaultConfig <> "\n" + Nothing -> do + tell "The password argument '-k' is required.\n" + tell "Alternatively, use '-c' to provide a " + tell "configuration file.\n" + + throwError - _r ^. _Text + + Just _config -> do + let configStr = showConfig _config ^. _Text :: String + io - debug_ - "Using config: " <> configStr + pure - _config diff --git a/src/Network/MoeSocks/Runtime.hs b/src/Network/MoeSocks/Runtime.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/Runtime.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE LambdaCase #-} + +module Network.MoeSocks.Runtime where + +import Control.Lens +import Control.Monad.Writer hiding (listen) +import Network.MoeSocks.Helper +import Network.MoeSocks.Type +import Prelude hiding ((-), take) +import System.Log.Formatter +import System.Log.Handler.Simple +import System.Log.Logger +import qualified System.IO as IO +import qualified System.Log.Handler as LogHandler + + + +initLogger :: Priority -> IO () +initLogger aLevel = do + stdoutHandler <- streamHandler IO.stdout DEBUG + let formattedHandler = + LogHandler.setFormatter stdoutHandler - + --"[$time : $loggername : $prio] + simpleLogFormatter "$time $prio\t $msg" + + updateGlobalLogger rootLoggerName removeHandler + + updateGlobalLogger "moe" removeHandler + updateGlobalLogger "moe" - addHandler formattedHandler + updateGlobalLogger "moe" - setLevel aLevel + + +loadJobs :: Config -> Options -> [Job] +loadJobs aConfig aOptions = + let _c = aConfig + + _remote_TCP_Relay = + RemoteRelay + Remote_TCP_Relay + (_c ^. remoteAddress) + (_c ^. remotePort) + + _remote_UDP_Relay = + RemoteRelay + Remote_UDP_Relay + (_c ^. remoteAddress) + (_c ^. remotePort) + + _localService :: LocalServiceType -> LocalService + _localService = LocalService + (_c ^. localAddress) + (_c ^. remoteAddress) + (_c ^. remotePort) + + _localService_TCP_Forwards = + aOptions ^. forward_TCPs + & map (_localService . LocalService_TCP_Forward) + + _localService_UDP_Forwards = + aOptions ^. forward_UDPs + & map (_localService . LocalService_UDP_Forward) + + _localService_SOCKS5 = + LocalService_SOCKS5 (_c ^. localPort) + & _localService + + _remoteRelays = [_remote_TCP_Relay, _remote_UDP_Relay] + _localServices = _localService_TCP_Forwards + <> _localService_UDP_Forwards + <> pure _localService_SOCKS5 + in + + map RemoteRelayJob _remoteRelays + <> map LocalServiceJob _localServices + +filterJobs :: RunningMode -> [Job] -> [Job] +filterJobs = \case + DebugMode -> id + RemoteMode -> filter - is _RemoteRelayJob + LocalMode -> filter - is _LocalServiceJob diff --git a/src/Network/MoeSocks/TCP.hs b/src/Network/MoeSocks/TCP.hs --- a/src/Network/MoeSocks/TCP.hs +++ b/src/Network/MoeSocks/TCP.hs @@ -10,7 +10,6 @@ import Data.ByteString (ByteString) import Network.MoeSocks.BuilderAndParser import Network.MoeSocks.Common -import Network.MoeSocks.Constant import Network.MoeSocks.Encrypt (identityCipher) import Network.MoeSocks.Helper import Network.MoeSocks.Type @@ -20,6 +19,9 @@ import qualified Data.ByteString as S import qualified Data.Strict as S +_NoThrottle :: Maybe a +_NoThrottle = Nothing + local_SOCKS5_RequestHandler :: Env -> ByteString -> (Socket, SockAddr) @@ -55,8 +57,8 @@ let _clientRequest = ClientRequest TCP_IP_StreamConnection (DomainName - aForwarding ^. - forwardRemoteHost) - (aForwarding ^. forwardRemotePort) + forwardTargetAddress) + (aForwarding ^. forwardTargetPort) local_TCP_RequestHandler aEnv (mempty, _clientRequest) False aSocket 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 @@ -7,15 +7,17 @@ import Control.Monad.Except import Control.Monad.Reader import Control.Concurrent.Async +import Control.Concurrent.STM import Data.Aeson import Data.ByteString (ByteString) import Data.Text (Text) +import Data.Text.Lens import Data.IP import Data.Word -import Data.Monoid -import GHC.Generics +import GHC.Generics (Generic) import System.Log.Logger import qualified Data.Strict as S +import qualified Data.List as L data ClientGreeting = ClientGreeting { @@ -27,7 +29,7 @@ data ConnectionType = TCP_IP_StreamConnection - | TCP_IP_PortBinding +-- | TCP_IP_PortBinding | UDP_Port deriving (Show, Eq) @@ -35,8 +37,20 @@ IPv4_Address (Word8, Word8, Word8, Word8) | DomainName Text | IPv6_Address [Word16] - deriving (Show, Eq) + deriving (Eq) +instance Show AddressType where + show = showAddressType + where + showAddressType :: AddressType -> String + showAddressType (IPv4_Address xs) = xs ^.. each . to show + ^.. folding + (concat . L.intersperse ".") + + showAddressType (DomainName x) = x ^. _Text + showAddressType (IPv6_Address xs) = xs ^.. each . to show + ^.. folding + (concat . L.intersperse ":") type Port = Int data ClientRequest = ClientRequest @@ -82,8 +96,8 @@ data Forward = Forward { _forwardLocalPort :: Port - , _forwardRemoteHost :: Text - , _forwardRemotePort :: Port + , _forwardTargetAddress :: Text + , _forwardTargetPort :: Port } deriving (Show, Eq) @@ -127,24 +141,25 @@ makeLenses ''CipherBox -data LocalRelayType = - Local_TCP_Relay Forward - | Local_UDP_Relay Forward - | Local_SOCKS_Relay Int +data LocalServiceType = + LocalService_TCP_Forward Forward + | LocalService_UDP_Forward Forward + | LocalService_SOCKS5 Int deriving (Show, Eq) -makePrisms ''LocalRelayType +makePrisms ''LocalServiceType -data LocalRelay = LocalRelay + +data LocalService = LocalService { - _localRelayType :: LocalRelayType - , _localRelayAddress :: Text - , _localRelayRemoteAddress :: Text - , _localRelayRemotePort :: Int + _localServiceAddress :: Text + , _localServiceRemoteAddress :: Text + , _localServiceRemotePort :: Int + , _localServiceType :: LocalServiceType } deriving (Show, Eq) -makeLenses ''LocalRelay +makeLenses ''LocalService data RemoteRelayType = Remote_TCP_Relay @@ -153,38 +168,47 @@ makePrisms ''RemoteRelayType -newtype Relay_ID = Relay_ID { _unRelay_ID :: Async () } - deriving (Eq, Ord) -makeLenses ''Relay_ID - -instance Show Relay_ID where - show _ = "Relay ID" - data RemoteRelay = RemoteRelay { _remoteRelayType :: RemoteRelayType , _remoteRelayAddress :: Text , _remoteRelayPort :: Int - , _relay_ID :: Maybe Relay_ID } deriving (Show, Eq) makeLenses ''RemoteRelay +data Job = + RemoteRelayJob RemoteRelay + | LocalServiceJob LocalService + deriving (Show, Eq) + +makePrisms ''Job + +type Async_ID = Async () + +data JobStatus = JobStatus + { + _incomingSpeed :: Double + , _incomingTotal :: Double + , _outgoingSpeed :: Double + , _outgoingTotal :: Double + , _numberOfRequests :: Int + } + deriving (Show, Eq) + +makeLenses ''JobStatus + +initialJobStatus :: JobStatus +initialJobStatus = JobStatus 0 0 0 0 0 + data Runtime = Runtime { - _localRelays :: [LocalRelay] - , _remoteRelays :: [RemoteRelay] + _jobs :: [(Job, Async_ID, TVar JobStatus)] } - deriving (Show, Eq) makeLenses ''Runtime - -instance Monoid Runtime where - mempty = Runtime [] [] - Runtime x y `mappend` Runtime x' y' = Runtime (x <> x') (y <> y') - data Env = Env { diff --git a/src/Network/MoeSocks/UDP.hs b/src/Network/MoeSocks/UDP.hs --- a/src/Network/MoeSocks/UDP.hs +++ b/src/Network/MoeSocks/UDP.hs @@ -53,8 +53,8 @@ let _clientRequest = ClientRequest UDP_Port (DomainName - aForwarding ^. - forwardRemoteHost) - (aForwarding ^. forwardRemotePort) + forwardTargetAddress) + (aForwarding ^. forwardTargetPort) {-debug_ - "L UDP: " <> show _clientRequest-}