moesocks 0.1.2.20 → 0.1.2.30
raw patch · 21 files changed
+892/−687 lines, 21 files
Files
- CHANGELOG.md +4/−0
- config.json +2/−2
- moesocks.cabal +8/−3
- src/Main.hs +2/−2
- src/Network/MoeSocks/App.hs +36/−234
- src/Network/MoeSocks/Bootstrap.hs +144/−0
- src/Network/MoeSocks/Common.hs +3/−3
- src/Network/MoeSocks/Config.hs +0/−40
- src/Network/MoeSocks/Default.hs +72/−0
- src/Network/MoeSocks/Encrypt.hs +10/−5
- src/Network/MoeSocks/Handler.hs +212/−0
- src/Network/MoeSocks/Modules/Resource.hs +0/−117
- src/Network/MoeSocks/Options.hs +11/−9
- src/Network/MoeSocks/Runtime.hs +73/−18
- src/Network/MoeSocks/TCP.hs +45/−30
- src/Network/MoeSocks/Type.hs +8/−219
- src/Network/MoeSocks/Type/Bootstrap/Config.hs +32/−0
- src/Network/MoeSocks/Type/Bootstrap/Option.hs +31/−0
- src/Network/MoeSocks/Type/Common.hs +20/−0
- src/Network/MoeSocks/Type/Runtime.hs +170/−0
- src/Network/MoeSocks/UDP.hs +9/−5
CHANGELOG.md view
@@ -1,3 +1,7 @@+0.1.2.30+--------+* Refactor internal to make a runtime independent of Config and Options+ 0.1.2.20 -------- * Fix IPv6, finally tested on a real IPv6 network..
config.json view
@@ -1,7 +1,7 @@ {- "remoteAddress":"0.0.0.0",+ "remoteHost":"0.0.0.0", "remotePort":1190,- "localAddress":"localhost",+ "localHost":"localhost", "localPort":1090, "password":"birthday!", "fastOpen":false,
moesocks.cabal view
@@ -1,6 +1,6 @@ name: moesocks category: Network-version: 0.1.2.20+version: 0.1.2.30 license: Apache-2.0 synopsis: A functional firewall killer description: A SOCKS5 proxy using the client / server architecture.@@ -56,15 +56,20 @@ default-language: Haskell2010 other-modules: Network.MoeSocks.App+ Network.MoeSocks.Bootstrap Network.MoeSocks.BuilderAndParser Network.MoeSocks.Common- Network.MoeSocks.Config+ Network.MoeSocks.Default Network.MoeSocks.Encrypt+ Network.MoeSocks.Handler 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.Type.Bootstrap.Config+ Network.MoeSocks.Type.Bootstrap.Option+ Network.MoeSocks.Type.Common+ Network.MoeSocks.Type.Runtime Network.MoeSocks.UDP
src/Main.hs view
@@ -1,8 +1,8 @@ module Main where import Control.Monad.Except-import Control.Monad.Reader hiding (local) import Network.MoeSocks.App+import Network.MoeSocks.Bootstrap import Network.MoeSocks.Helper import Network.MoeSocks.Options import Options.Applicative hiding (Parser)@@ -14,7 +14,7 @@ _options <- execParser opts withGateOptions _options - do- r <- runExceptT - runReaderT moeApp _options+ r <- runExceptT - moeApp _options case r of Left e -> error_ e >> exitFailure Right _ -> pure ()
src/Network/MoeSocks/App.hs view
@@ -3,256 +3,58 @@ module Network.MoeSocks.App where -import Control.Concurrent-import Control.Concurrent.STM import Control.Concurrent.Async hiding (waitBoth)+{-import Control.Concurrent.STM-} import Control.Lens import Control.Monad-import Control.Monad.Except-import Control.Monad.Reader hiding (local)-import Control.Monad.Writer hiding (listen)-import Data.ByteString (ByteString)-import Data.Text.Lens-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.Handler (runRemoteRelay, runLocalService)+import Network.MoeSocks.Helper +import Network.MoeSocks.Bootstrap (loadConfig)+import Network.MoeSocks.Runtime (initRuntime) import Network.MoeSocks.Type-import Network.MoeSocks.UDP-import Network.Socket hiding (send, recv, recvFrom, sendTo)-import Network.Socket.ByteString import Prelude hiding ((-), take)--_PacketLength :: Int-_PacketLength = 4096--withGateOptions :: Options -> IO a -> IO ()-withGateOptions aOption aIO = do- if aOption ^. listMethods- then do- let _br = putStrLn ""-- _br- putStrLn "Recommended:"- itraverse_ (\k _ -> putStrLn - "\t\t" <> k ^. _Text) - safeMethods-- _br- putStrLn "Supported:"- itraverse_ (\k _ -> putStrLn - "\t\t" <> k ^. _Text) - unsafeMethods-- else- () <$ aIO--data ServiceType = TCP_Service | UDP_Service- deriving (Show, Eq)--moeApp:: MoeMonadT ()-moeApp = do- _options <- ask- io - initLogger - _options ^. verbosity-- io - debug_ - show _options-- _config <- loadConfig - _options- let _c = _config-- let _method = _config ^. method-- _cipherBox <- (io - initCipherBox _method (_config ^. password)) >>= \case- Nothing -> throwError - "Invalid method '"- <> _method ^. _Text- Just (a, b, c, d) -> pure - CipherBox a b c d-- let _env = Env _options _config _cipherBox--- let localService :: ServiceType- -> String- -> (ByteString -> (Socket, SockAddr) -> IO ())- -> (Socket, SockAddr)- -> IO ()- localService aServiceType aID aHandler s =- logSA "L loop" (pure s) - \(_localSocket, _localAddr) -> do-- setSocketOption _localSocket ReuseAddr 1- bindSocket _localSocket _localAddr-- case aServiceType of- TCP_Service -> do- info_ - "LT: " <> aID <> " nyaa!"-- when (_c ^. fastOpen) -- setSocket_TCP_FAST_OPEN _localSocket-- listen _localSocket maxListenQueue-- let handleLocal _socket = do- _s@(_newSocket, _newSockAddr) <- accept _socket- setSocketCloseOnExec _newSocket- setSocketConfig _c _socket-- forkIO - catchExceptAsyncLog "LT" -- logSA "L TCP client socket" (pure _s) -- aHandler ""-- forever - handleLocal _localSocket-- UDP_Service -> do- info_ - "LU: " <> aID <> " nyaa!"- let handleLocal = do- (_msg, _sockAddr) <-- recvFrom _localSocket _PacketLength-- debug_ - "L UDP: " <> show _msg-- let _s = (_localSocket, _sockAddr)-- forkIO - catchExceptAsyncLog "LU" -- aHandler _msg _s-- forever handleLocal-- let- showWrapped :: (Show a) => a -> String- showWrapped x = "[" <> show x <> "]"-- let local_SOCKS5 :: (Socket, SockAddr) -> IO ()- local_SOCKS5 _s = localService TCP_Service- ("SOCKS5 proxy " <> showWrapped (_s ^. _2))- (local_SOCKS5_RequestHandler _env) - _s-- showForwarding :: Forward -> String- showForwarding (Forward _localPort _remoteHost _remotePort) =- "["- <> show _localPort- <> " -> "- <> _remoteHost ^. _Text- <> ":"- <> show _remotePort- <> "]"+import qualified Network.MoeSocks.Type.Bootstrap.Option as O - localForward_TCP :: Forward -> (Socket, SockAddr) -> IO ()- localForward_TCP _f _s = do- let _m = showForwarding _f- 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- localService UDP_Service ("UDP port forwarding " <> _m)- (local_UDP_ForwardRequestHandler _env _f)- _s-- let remote_TCP_Relay :: (Socket, SockAddr) -> IO ()- remote_TCP_Relay s = logSA "R loop" (pure s) -- \(_remoteSocket, _remoteAddr) -> do- info_ - "RT: TCP relay " <> showWrapped _remoteAddr <> " nyaa!"-- setSocketOption _remoteSocket ReuseAddr 1- bindSocket _remoteSocket _remoteAddr-- when (_c ^. fastOpen) -- setSocket_TCP_FAST_OPEN _remoteSocket-- listen _remoteSocket maxListenQueue-- let handleRemote _socket = do- (_newSocket, _) <- accept _socket- setSocketCloseOnExec _newSocket- setSocketConfig _c _socket-- forkIO - catchExceptAsyncLog "RT" -- logSocket "R remote socket" (pure _newSocket) -- remote_TCP_RequestHandler _env-- forever - handleRemote _remoteSocket-- let remote_UDP_Relay :: (Socket, SockAddr) -> IO ()- remote_UDP_Relay s = logSA "R loop" (pure s) -- \(_remoteSocket, _remoteAddr) -> do- info_ - "RU: UDP relay " <> showWrapped _remoteAddr <> " nyaa!"-- setSocketOption _remoteSocket ReuseAddr 1- bindSocket _remoteSocket _remoteAddr-- let handleRemote = do- (_msg, _sockAddr) <- recvFrom _remoteSocket _PacketLength-- debug_ - "R UDP: " <> show _msg+{-runJob :: Env -> Job -> TVar JobStatus -> IO ()-}+{-runJob aEnv (RemoteRelayJob x) _ = runRemoteRelay aEnv x-}+{-runJob aEnv (LocalServiceJob x) _ = runLocalService aEnv x-} - let _s = (_remoteSocket, _sockAddr)+{-runApp :: Env -> [Job] -> IO ()-}+{-runApp aEnv someJobs = do-}+ {-_jobs <- (forM someJobs - \_job -> (,) _job-}+ {-<$> newTVarIO initialJobStatus)-}+ {-_asyncs <- mapM (async . foreverRun . (uncurry (runJob aEnv))) _jobs-} + {-_mainThread <- async - do-}+ {-waitAnyCancel - _asyncs-} - forkIO - catchExceptAsyncLog "RU" -- remote_UDP_RequestHandler _env _msg _s+ {-_uiThread <- async - forever - do-}+ {-let _statuses = _jobs ^.. each . _2 :: [TVar JobStatus]-}+ {-[>forM_ _statuses - readTVarIO >=> print<]-}+ {-sleep 5-} - forever handleRemote+ {-waitAnyCancel [_mainThread, _uiThread]-} - -- Run+ {-pure ()-} - let runRemoteRelay :: RemoteRelay -> IO ()- runRemoteRelay _remoteRelay = do- let _address = _remoteRelay ^. remoteRelayHost- _port = _remoteRelay ^. remoteRelayPort+runJob :: Env -> Job -> IO ()+runJob aEnv (RemoteRelayJob x) = runRemoteRelay aEnv x+runJob aEnv (LocalServiceJob x) = runLocalService aEnv x - case _remoteRelay ^. remoteRelayType of- Remote_TCP_Relay -> catchExceptAsyncLog "R TCP Relay" - do- getSocket _address _port Stream- >>= remote_TCP_Relay+runApp :: Env -> [Job] -> IO ()+runApp aEnv someJobs = do+ _asyncs <- mapM (async . foreverRun . runJob aEnv) someJobs+ waitAnyCancel - _asyncs - Remote_UDP_Relay -> catchExceptAsyncLog "R UDP Relay" - do- getSocket _address _port Datagram- >>= remote_UDP_Relay+ pure () - let runLocalService :: LocalService -> IO ()- runLocalService _localService = do- case _localService ^. localServiceType of- LocalService_TCP_Forward forwarding ->- catchExceptAsyncLog "L TCP_Forwarding" - do- getSocket (_localService ^. localServiceHost)- (forwarding ^. forwardLocalPort)- Stream- >>= localForward_TCP forwarding-- LocalService_UDP_Forward forwarding ->- catchExceptAsyncLog "L UDP_Forwarding" - do- getSocket (_localService ^. localServiceHost)- (forwarding ^. forwardLocalPort)- Datagram- >>= localForward_UDP forwarding-- LocalService_SOCKS5 _port ->- catchExceptAsyncLog "L SOCKS5" - do- getSocket (_localService ^. localServiceHost) _port Stream- >>= local_SOCKS5-- 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-- _uiThread <- async - forever - do- let _statuses = _jobs ^.. each . _2 :: [TVar JobStatus]- {-forM_ _statuses - readTVarIO >=> print-}- sleep 5-- waitAnyCancel [_mainThread, _uiThread]-- pure ()+moeApp:: O.Options -> MoeMonad ()+moeApp someOptions = do+ let _options = someOptions+ _config <- loadConfig - _options + (_runtime, _jobs) <- initRuntime _config _options - io - runApp - filterJobs (_options ^. runningMode) - loadJobs _c _options+ io - runApp (_runtime ^. env) _jobs
+ src/Network/MoeSocks/Bootstrap.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Network.MoeSocks.Bootstrap 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.Default+import Network.MoeSocks.Encrypt (safeMethods, unsafeMethods)+import Network.MoeSocks.Helper+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+import qualified Network.MoeSocks.Type.Bootstrap.Config as C+import qualified Network.MoeSocks.Type.Bootstrap.Option as O++withGateOptions :: O.Options -> IO a -> IO ()+withGateOptions aOption aIO = do+ if aOption ^. O.listMethods+ then do+ let _br = putStrLn ""++ _br+ putStrLn "Recommended:"+ itraverse_ (\k _ -> putStrLn - "\t\t" <> k ^. _Text) - safeMethods++ _br+ putStrLn "Supported:"+ itraverse_ (\k _ -> putStrLn - "\t\t" <> k ^. _Text) - unsafeMethods++ else+ () <$ aIO++loadConfig :: O.Options -> ExceptT String IO C.Config+loadConfig aOption = do+ let _maybeFilePath = aOption ^. O.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++ fixConfig:: Text -> Text+ fixConfig x =+ let _remoteHost = "remoteHost"+ _remotePort = "remotePort"+ _localHost = "localHost"++ fixes = Map.fromList+ [+ ("server" , _remoteHost )+ , ("remote" , _remoteHost )+ , ("remoteAddress", _remoteHost )++ , ("server_port" , _remotePort )++ , ("local" , _localHost )+ , ("localAddress" , _localHost )+ , ("local_address", _localHost )++ ]++ in+ fixes ^? ix x & fromMaybe x++ toParsableConfig :: Value -> Value+ toParsableConfig = asList - each . _1 %~ (+ T.cons '_'+ . toHaskellNamingConvention+ . fixConfig+ )++ toReadableConfig :: Value -> Value+ toReadableConfig = asList - each . _1 %~ T.tail++ showConfig :: C.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 ^. O.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
src/Network/MoeSocks/Common.hs view
@@ -84,9 +84,9 @@ getSocketWithHint _family _hostName _port _socketType -setSocketConfig:: Config -> Socket -> IO ()-setSocketConfig aConfig aSocket = do+setSocketConfig:: Env -> Socket -> IO ()+setSocketConfig aEnv aSocket = do setSocketOption aSocket NoDelay 1 - when (aConfig ^. socketOption_TCP_NOTSENT_LOWAT) - do+ when (aEnv ^. socketOption_TCP_NOTSENT_LOWAT) - do tryIO "setSocket_TCP_NOTSENT_LOWAT" - setSocket_TCP_NOTSENT_LOWAT aSocket pure ()
− src/Network/MoeSocks/Config.hs
@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.MoeSocks.Config where--import Network.MoeSocks.Type-import System.Log.Logger--defaultConfig :: Config-defaultConfig = Config- {- _remoteHost = "0.0.0.0"- , _remotePort = 8388 - , _localHost = "127.0.0.1"- , _localPort = 1080- , _password = "moesocks"- , _method = "aes-256-cfb"- , _timeout = 300- , _tcpBufferSize = 256- , _throttle = False- , _throttleSpeed = 8000 -- in Kilobytes- , _obfuscationFlushBound = 4096- , _fastOpen = False- , _socketOption_TCP_NOTSENT_LOWAT = True- }---defaultOptions :: Options-defaultOptions = Options- {- _runningMode = DebugMode- , _configFile = Nothing- , _verbosity = DEBUG- , _forward_TCPs = []- , _forward_UDPs = []- , _disable_SOCKS5 = False- , _obfuscation = False- , _forbidden_IPs = ["127.0.0.1", "0.0.0.0", "::1"]- , _listMethods = False- , _params = []- }
+ src/Network/MoeSocks/Default.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.MoeSocks.Default where++import Control.Lens+import Network.MoeSocks.Encrypt (constCipherBox)+import Network.MoeSocks.Type+import System.Log.Logger+import qualified Network.MoeSocks.Type.Bootstrap.Config as C+import qualified Network.MoeSocks.Type.Bootstrap.Option as O++defaultConfig :: C.Config+defaultConfig = C.Config+ {+ C._remoteHost = "0.0.0.0"+ , C._remotePort = 8388 + , C._localHost = "127.0.0.1"+ , C._localPort = 1080+ , C._password = "moesocks"+ , C._method = "aes-256-cfb"+ , C._timeout = 300+ , C._tcpBufferSize = 256+ , C._throttle = False+ , C._throttleSpeed = 8000 -- in Kilobytes+ , C._obfuscationFlushBound = 4096+ , C._fastOpen = False+ , C._socketOption_TCP_NOTSENT_LOWAT = True+ }+++defaultOptions :: O.Options+defaultOptions = O.Options+ {+ O._runningMode = O.DebugMode+ , O._configFile = Nothing+ , O._verbosity = DEBUG+ , O._forward_TCPs = []+ , O._forward_UDPs = []+ , O._disable_SOCKS5 = False+ , O._obfuscation = False+ , O._forbidden_IPs = ["127.0.0.1", "0.0.0.0", "::1"]+ , O._listMethods = False+ , O._params = []+ } ++defaultEnv :: Env+defaultEnv =+ let _c = defaultConfig+ _o = defaultOptions+ in+ Env+ {+ _timeout = _c ^. C.timeout+ , _tcpBufferSize = _c ^. C.tcpBufferSize+ , _throttle = _c ^. C.throttle+ , _throttleSpeed = _c ^. C.throttleSpeed+ , _obfuscationFlushBound = _c ^. C.obfuscationFlushBound + , _fastOpen = _c ^. C.fastOpen+ , _socketOption_TCP_NOTSENT_LOWAT = _c ^. C.socketOption_TCP_NOTSENT_LOWAT+ , _obfuscation = _o ^. O.obfuscation+ , _forbidden_IPs = _o ^. O.forbidden_IPs+ {-, _config = defaultConfig-}+ , _cipherBox = let (a,b,c,d) = constCipherBox in CipherBox a b c d+ }++defaultRuntime :: Runtime+defaultRuntime =+ Runtime+ {+ _jobs = []+ , _env = defaultEnv+ }
src/Network/MoeSocks/Encrypt.hs view
@@ -8,9 +8,10 @@ module Network.MoeSocks.Encrypt ( initCipherBox+, constCipherBox , identityCipher-, ssl , safeMethods+, ssl , unsafeMethods ) where@@ -136,12 +137,16 @@ identityCipher :: Cipher identityCipher = pure . S.fromMaybe mempty +constCipherBox :: CipherBox+constCipherBox = + let constCipher = const - pure identityCipher+ in + (0, pure mempty, constCipher, constCipher)++ initCipherBox :: Text -> Text -> IO (Maybe CipherBox) initCipherBox aMethod aPassword - | aMethod == "none" = let constCipher = const - pure identityCipher- in- pure - Just (0, pure mempty, constCipher, constCipher)-+ | aMethod == "none" = pure - Just constCipherBox | otherwise = ssl - fmap (preview _Right) - runExceptT - initCipherBox' aMethod aPassword
+ src/Network/MoeSocks/Handler.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}++module Network.MoeSocks.Handler where++import Control.Concurrent+import Control.Lens+import Control.Monad+import Control.Monad.Writer hiding (listen)+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Text.Lens+import Network.MoeSocks.Common+import Network.MoeSocks.Helper+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)++_PacketLength :: Int+_PacketLength = 4096++data ServiceType = TCP_Service | UDP_Service+ deriving (Show, Eq)++localService :: Env+ -> ServiceType+ -> String+ -> (ByteString -> (Socket, SockAddr) -> IO ())+ -> (Socket, SockAddr)+ -> IO ()+localService _env aServiceType aID aHandler s =+ logSA "L loop" (pure s) - \(_localSocket, _localAddr) -> do++ setSocketOption _localSocket ReuseAddr 1+ bindSocket _localSocket _localAddr++ case aServiceType of+ TCP_Service -> do+ info_ - "LT: " <> aID <> " nyaa!"++ when (_env ^. fastOpen) -+ setSocket_TCP_FAST_OPEN _localSocket++ listen _localSocket maxListenQueue++ let handleLocal _socket = do+ _s@(_newSocket, _newSockAddr) <- accept _socket+ setSocketCloseOnExec _newSocket+ setSocketConfig _env _socket++ forkIO - catchExceptAsyncLog "LT" -+ logSA "L TCP client socket" (pure _s) -+ aHandler ""++ forever - handleLocal _localSocket++ UDP_Service -> do+ info_ - "LU: " <> aID <> " nyaa!"+ let handleLocal = do+ (_msg, _sockAddr) <-+ recvFrom _localSocket _PacketLength++ debug_ - "L UDP: " <> show _msg++ let _s = (_localSocket, _sockAddr)++ forkIO - catchExceptAsyncLog "LU" -+ aHandler _msg _s++ forever handleLocal+++showWrapped :: (Show a) => a -> String+showWrapped x = "[" <> show x <> "]"++local_SOCKS5 :: Env -> Text -> Int -> (Socket, SockAddr) -> IO ()+local_SOCKS5 _env _remoteHost _remotePort _s = + localService _env TCP_Service+ ("SOCKS5 proxy " <> showWrapped (_s ^. _2))+ (local_SOCKS5_RequestHandler _env+ _remoteHost+ _remotePort) - _s++showForwarding :: Forward -> String+showForwarding (Forward _localPort _remoteHost _remotePort) =+ "["+ <> show _localPort+ <> " -> "+ <> _remoteHost ^. _Text+ <> ":"+ <> show _remotePort+ <> "]"+++localForward_TCP :: Env -> Text -> Int -> Forward -> (Socket, SockAddr) + -> IO ()+localForward_TCP _env _remoteHost _remotePort _f _s = do+ let _m = showForwarding _f+ localService _env TCP_Service ("TCP port forwarding " <> _m)+ (local_TCP_ForwardRequestHandler + _env+ _remoteHost+ _remotePort+ _f)+ _s++localForward_UDP :: Env -> Text -> Int -> Forward -> (Socket, SockAddr) + -> IO ()+localForward_UDP _env _remoteHost _remotePort _f _s = do+ let _m = showForwarding _f+ localService _env UDP_Service ("UDP port forwarding " <> _m)+ (local_UDP_ForwardRequestHandler + _env + _remoteHost+ _remotePort+ _f)+ _s++remote_TCP_Relay :: Env -> (Socket, SockAddr) -> IO ()+remote_TCP_Relay _env s = logSA "R loop" (pure s) -+ \(_remoteSocket, _remoteAddr) -> do+ info_ - "RT: TCP relay " <> showWrapped _remoteAddr <> " nyaa!"++ setSocketOption _remoteSocket ReuseAddr 1+ bindSocket _remoteSocket _remoteAddr++ when (_env ^. fastOpen) -+ setSocket_TCP_FAST_OPEN _remoteSocket++ listen _remoteSocket maxListenQueue++ let handleRemote _socket = do+ (_newSocket, _) <- accept _socket+ setSocketCloseOnExec _newSocket+ setSocketConfig _env _socket++ forkIO - catchExceptAsyncLog "RT" -+ logSocket "R remote socket" (pure _newSocket) -+ remote_TCP_RequestHandler _env++ forever - handleRemote _remoteSocket++remote_UDP_Relay :: Env -> (Socket, SockAddr) -> IO ()+remote_UDP_Relay _env s = logSA "R loop" (pure s) -+ \(_remoteSocket, _remoteAddr) -> do+ info_ - "RU: UDP relay " <> showWrapped _remoteAddr <> " nyaa!"++ setSocketOption _remoteSocket ReuseAddr 1+ bindSocket _remoteSocket _remoteAddr++ let handleRemote = do+ (_msg, _sockAddr) <- recvFrom _remoteSocket _PacketLength++ debug_ - "R UDP: " <> show _msg++ let _s = (_remoteSocket, _sockAddr)+++ forkIO - catchExceptAsyncLog "RU" -+ remote_UDP_RequestHandler _env _msg _s++ forever handleRemote+++runRemoteRelay :: Env -> RemoteRelay -> IO ()+runRemoteRelay _env _remoteRelay = do+ let _address = _remoteRelay ^. remoteRelayHost+ _port = _remoteRelay ^. remoteRelayPort++ case _remoteRelay ^. remoteRelayType of+ Remote_TCP_Relay -> catchExceptAsyncLog "R TCP Relay" - do+ getSocket _address _port Stream+ >>= remote_TCP_Relay _env++ Remote_UDP_Relay -> catchExceptAsyncLog "R UDP Relay" - do+ getSocket _address _port Datagram+ >>= remote_UDP_Relay _env+++runLocalService :: Env -> LocalService -> IO ()+runLocalService _env _localService = do+ case _localService ^. localServiceType of+ LocalService_TCP_Forward forwarding ->+ catchExceptAsyncLog "L TCP_Forwarding" - do+ getSocket (_localService ^. localServiceHost)+ (forwarding ^. forwardLocalPort)+ Stream+ >>= localForward_TCP _env + (_localService ^. localServiceRemoteHost)+ (_localService ^. localServiceRemotePort)+ forwarding++ LocalService_UDP_Forward forwarding ->+ catchExceptAsyncLog "L UDP_Forwarding" - do+ getSocket (_localService ^. localServiceHost)+ (forwarding ^. forwardLocalPort)+ Datagram+ >>= localForward_UDP _env + (_localService ^. localServiceRemoteHost)+ (_localService ^. localServiceRemotePort)+ forwarding++ LocalService_SOCKS5 _port ->+ catchExceptAsyncLog "L SOCKS5" - do+ getSocket (_localService ^. localServiceHost) _port Stream+ >>= local_SOCKS5 _env + (_localService ^. localServiceRemoteHost)+ (_localService ^. localServiceRemotePort)+
− src/Network/MoeSocks/Modules/Resource.hs
@@ -1,117 +0,0 @@-{-# 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 - - fixConfig:: Text -> Text- fixConfig x = - let fixes = Map.fromList- [- ("server", "remoteHost")- , ("server_port", "remotePort")- , ("local_address", "localHost")-- , ("remoteAddress", "remoteHost")- , ("localAddress", "localHost")- ]-- in- fixes ^? ix x & fromMaybe x-- toParsableConfig :: Value -> Value- toParsableConfig = asList - each . _1 %~ (- T.cons '_' - . toHaskellNamingConvention- . fixConfig - ) -- 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
src/Network/MoeSocks/Options.hs view
@@ -8,9 +8,11 @@ import Data.Maybe import Data.Text (Text) import Data.Text.Lens-import Network.MoeSocks.Config+import Network.MoeSocks.Default import Network.MoeSocks.Helper-import Network.MoeSocks.Type+import Network.MoeSocks.Type.Bootstrap.Option+import Network.MoeSocks.Type.Common+import qualified Network.MoeSocks.Type.Bootstrap.Config as C import Options.Applicative hiding (Parser) import Prelude hiding ((-), takeWhile) import System.Log.Logger@@ -70,7 +72,7 @@ _tcpBufferSize = intParam - long "tcp-buffer-size" <> metavar "SIZE"- <> defaultHelp (_c ^. tcpBufferSize+ <> defaultHelp (_c ^. C.tcpBufferSize & show & view (from _Text)) ("The number of packets used as a "@@ -86,13 +88,13 @@ _remote = textParam - short 's' <> metavar "REMOTE"- <> defaultHelp (_c ^. remoteHost)+ <> defaultHelp (_c ^. C.remoteHost) "remote address" _remotePort = intParam - short 'p' <> metavar "REMOTE_PORT"- <> defaultHelp (_c ^. remotePort + <> defaultHelp (_c ^. C.remotePort & show & view (from _Text)) "remote port"@@ -100,13 +102,13 @@ _local = textParam - short 'b' <> metavar "LOCAL"- <> defaultHelp (_c ^. localHost)+ <> defaultHelp (_c ^. C.localHost) "local address" _localPort = intParam - short 'l' <> metavar "LOCAL PORT"- <> defaultHelp (_c ^. localPort+ <> defaultHelp (_c ^. C.localPort & show & view (from _Text)) "local port"@@ -119,13 +121,13 @@ _method = textParam - short 'm' <> metavar "METHOD"- <> defaultHelp (_c ^. method)+ <> defaultHelp (_c ^. C.method) "encryption method" _timeout = intParam - short 't' <> metavar "TIMEOUT"- <> defaultHelp (_c ^. timeout+ <> defaultHelp (_c ^. C.timeout & show & view (from _Text)) "Timeout connection in seconds"
src/Network/MoeSocks/Runtime.hs view
@@ -5,8 +5,15 @@ import Control.Lens import Control.Monad.Writer hiding (listen)+import Control.Monad.Except import Network.MoeSocks.Helper import Network.MoeSocks.Type+import Network.MoeSocks.Bootstrap+import Network.MoeSocks.Encrypt+import Network.MoeSocks.Default+import Data.Text.Lens+import qualified Network.MoeSocks.Type.Bootstrap.Config as C+import qualified Network.MoeSocks.Type.Bootstrap.Option as O import Prelude hiding ((-), take) import System.Log.Formatter import System.Log.Handler.Simple@@ -14,8 +21,6 @@ import qualified System.IO as IO import qualified System.Log.Handler as LogHandler -- initLogger :: Priority -> IO () initLogger aLevel = do stdoutHandler <- streamHandler IO.stdout DEBUG@@ -31,38 +36,39 @@ updateGlobalLogger "moe" - setLevel aLevel -loadJobs :: Config -> Options -> [Job]-loadJobs aConfig aOptions = ++loadJobs :: C.Config -> O.Options -> [Job]+loadJobs aConfig someOptions = let _c = aConfig _remote_TCP_Relay = RemoteRelay Remote_TCP_Relay- (_c ^. remoteHost)- (_c ^. remotePort)+ (_c ^. C.remoteHost)+ (_c ^. C.remotePort) _remote_UDP_Relay = RemoteRelay Remote_UDP_Relay- (_c ^. remoteHost)- (_c ^. remotePort)+ (_c ^. C.remoteHost)+ (_c ^. C.remotePort) _localService :: LocalServiceType -> LocalService _localService = LocalService - (_c ^. localHost)- (_c ^. remoteHost)- (_c ^. remotePort)+ (_c ^. C.localHost)+ (_c ^. C.remoteHost)+ (_c ^. C.remotePort) _localService_TCP_Forwards = - aOptions ^. forward_TCPs + someOptions ^. O.forward_TCPs & map (_localService . LocalService_TCP_Forward) _localService_UDP_Forwards =- aOptions ^. forward_UDPs + someOptions ^. O.forward_UDPs & map (_localService . LocalService_UDP_Forward) _localService_SOCKS5 =- LocalService_SOCKS5 (_c ^. localPort)+ LocalService_SOCKS5 (_c ^. C.localPort) & _localService _remoteRelays = [_remote_TCP_Relay, _remote_UDP_Relay]@@ -74,8 +80,57 @@ map RemoteRelayJob _remoteRelays <> map LocalServiceJob _localServices -filterJobs :: RunningMode -> [Job] -> [Job]+filterJobs :: O.RunningMode -> [Job] -> [Job] filterJobs = \case- DebugMode -> id- RemoteMode -> filter - is _RemoteRelayJob- LocalMode -> filter - is _LocalServiceJob+ O.DebugMode -> id+ O.RemoteMode -> filter - is _RemoteRelayJob+ O.LocalMode -> filter - is _LocalServiceJob+++initEnv :: C.Config -> O.Options -> ExceptT String IO Env+initEnv aConfig someOptions = do+ let _o = someOptions+ _c = aConfig++ io - initLogger - _o ^. O.verbosity+ io - debug_ - show _o+ + _config <- loadConfig - _o++ let _method = _c ^. C.method++ _cipherBox <- (io - initCipherBox _method (_c ^. C.password)) >>= \case+ Nothing -> throwError - "Invalid method '"+ <> _method ^. _Text+ Just (a, b, c, d) -> pure - CipherBox a b c d++ let _env = defaultEnv+ & cipherBox .~ _cipherBox++ pure - _env++initRuntime :: C.Config -> O.Options -> ExceptT String IO (Runtime, [Job])+initRuntime aConfig someOptions = do+ let _c = aConfig+ _o = someOptions+ _s = _c ^. C.socketOption_TCP_NOTSENT_LOWAT++ _env <- initEnv aConfig someOptions+ + let _env' = _env+ & timeout .~ _c ^. C.timeout+ & tcpBufferSize .~ _c ^. C.tcpBufferSize+ & throttle .~ _c ^. C.throttle+ & throttleSpeed .~ _c ^. C.throttleSpeed+ & obfuscationFlushBound .~ _c ^. C.obfuscationFlushBound + & fastOpen .~ _c ^. C.fastOpen+ & socketOption_TCP_NOTSENT_LOWAT .~ _s+ & obfuscation .~ _o ^. O.obfuscation+ & forbidden_IPs .~ _o ^. O.forbidden_IPs+ + let _jobs = loadJobs _c _o & filterJobs (_o ^. O.runningMode)++ pure - ( defaultRuntime+ & env .~ _env'+ , _jobs+ )
src/Network/MoeSocks/TCP.hs view
@@ -5,9 +5,9 @@ import Control.Concurrent.STM import Control.Exception import Control.Lens-import Control.Monad import Control.Monad.Writer hiding (listen) import Data.ByteString (ByteString)+import Data.Text (Text) import Network.MoeSocks.BuilderAndParser import Network.MoeSocks.Common import Network.MoeSocks.Encrypt (identityCipher)@@ -23,10 +23,12 @@ _NoThrottle = Nothing local_SOCKS5_RequestHandler :: Env+ -> Text+ -> Int -> ByteString -> (Socket, SockAddr) -> IO ()-local_SOCKS5_RequestHandler aEnv _ (aSocket,_) = do+local_SOCKS5_RequestHandler aEnv aRemoteHost aRemotePort _ (aSocket,_) = do (_partialBytesAfterGreeting, _r) <- parseSocket "clientGreeting" mempty identityCipher greetingParser aSocket@@ -44,54 +46,69 @@ connectionParser aSocket - local_TCP_RequestHandler aEnv _parsedRequest True aSocket+ local_TCP_RequestHandler aEnv + aRemoteHost + aRemotePort + _parsedRequest + True + aSocket local_TCP_ForwardRequestHandler :: Env+ -> Text+ -> Int -> Forward -> ByteString -> (Socket, SockAddr) -> IO ()-local_TCP_ForwardRequestHandler aEnv aForwarding _ (aSocket,_) = do+local_TCP_ForwardRequestHandler aEnv aRemoteHost aRemotePort aForwarding _ + (aSocket,_) = do let _clientRequest = ClientRequest TCP_IP_StreamConnection (DomainName - aForwarding ^. forwardTargetHost) (aForwarding ^. forwardTargetPort) - local_TCP_RequestHandler aEnv- (mempty, _clientRequest) False aSocket+ local_TCP_RequestHandler aEnv+ aRemoteHost+ aRemotePort+ (mempty, _clientRequest) + False + aSocket local_TCP_RequestHandler :: Env+ -> Text+ -> Int -> (ByteString, ClientRequest) -> Bool -> Socket -> IO () local_TCP_RequestHandler aEnv+ aRemoteHost+ aRemotePort (_partialBytesAfterClientRequest, _clientRequest) shouldReplyClient aSocket = do let _addr = _clientRequest ^. addressType- _forbidden_IPs = aEnv ^. options . forbidden_IPs+ _forbidden_IPs = aEnv ^. forbidden_IPs debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs withCheckedForbidden_IP_List _addr _forbidden_IPs - do let - _c = aEnv ^. config _cipherBox = aEnv ^. cipherBox- _obfuscation = aEnv ^. options . obfuscation- _flushBound = _c ^. obfuscationFlushBound+ _obfuscation = aEnv ^. obfuscation+ _flushBound = aEnv ^. obfuscationFlushBound _initSocket = - getSocket (_c ^. remoteHost) (_c ^. remotePort) Stream + getSocket aRemoteHost aRemotePort Stream debug_ - "L: " <> show _clientRequest logSA "L remote socket" _initSocket - \(_remoteSocket, _remoteHost) -> do- setSocketConfig _c _remoteSocket+ setSocketConfig aEnv _remoteSocket _remoteSocketName <- getSocketName _remoteSocket @@ -112,14 +129,14 @@ let _header = shadowSocksRequestBuilder _clientRequest - _sendChannel <- newTBQueueIO - _c ^. tcpBufferSize- _receiveChannel <- newTBQueueIO - _c ^. tcpBufferSize+ _sendChannel <- newTBQueueIO - aEnv ^. tcpBufferSize+ _receiveChannel <- newTBQueueIO - aEnv ^. tcpBufferSize let info_Id x = x <> " " <> _msg- _timeout = _c ^. timeout * 1000 * 1000+ _timeout = aEnv ^. timeout * 1000 * 1000 _throttle = - if _c ^. throttle- then Just - _c ^. throttleSpeed+ if aEnv ^. throttle+ then Just - aEnv ^. throttleSpeed else Nothing _eHeader <- _encrypt - S.Just - builder_To_ByteString _header@@ -130,7 +147,7 @@ let _initBytes = _encodeIV <> _eHeader <> _ePartial <> _eInit - if _c ^. fastOpen+ if aEnv ^. fastOpen then sendFast _remoteSocket _initBytes _remoteHost else do@@ -199,11 +216,9 @@ remote_TCP_RequestHandler :: Env -> Socket -> IO () remote_TCP_RequestHandler aEnv aSocket = do let- _obfuscation = aEnv ^. options . obfuscation+ _obfuscation = aEnv ^. obfuscation _cipherBox = aEnv ^. cipherBox- _c = aEnv ^. config- _options = aEnv ^. options- _flushBound = _c ^. obfuscationFlushBound+ _flushBound = aEnv ^. obfuscationFlushBound _decodeIV <- recv aSocket (_cipherBox ^. ivLength) _decrypt <- _cipherBox ^. decryptBuilder - _decodeIV@@ -219,11 +234,11 @@ logSA "R target socket" (initTarget _clientRequest) - \_r -> do let (_targetSocket, _targetHost) = _r (_addr, _) = sockAddr_To_Pair _targetHost- _forbidden_IPs = _options ^. forbidden_IPs+ _forbidden_IPs = aEnv ^. forbidden_IPs debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs withCheckedForbidden_IP_List _addr _forbidden_IPs - do- setSocketConfig _c _targetSocket+ setSocketConfig aEnv _targetSocket _remotePeerAddr <- getPeerName aSocket let _msg = showRelay _remotePeerAddr _clientRequest@@ -232,7 +247,7 @@ let _initBytes = _partialBytesAfterRequest - if _c ^. fastOpen+ if aEnv ^. fastOpen then sendFast _targetSocket _initBytes _targetHost else do@@ -241,17 +256,17 @@ let handleTarget __targetSocket = do- _sendChannel <- newTBQueueIO - _c ^. tcpBufferSize- _receiveChannel <- newTBQueueIO - _c ^. tcpBufferSize+ _sendChannel <- newTBQueueIO - aEnv ^. tcpBufferSize+ _receiveChannel <- newTBQueueIO - aEnv ^. tcpBufferSize let info_Id x = x <> " " <> _msg -- let remote wait slightly longer, so local can timeout -- and disconnect- _timeout = (_c ^. timeout + 30) * 1000 * 1000+ _timeout = (aEnv ^. timeout + 30) * 1000 * 1000 _throttle = - if _c ^. throttle- then Just - _c ^. throttleSpeed+ if aEnv ^. throttle+ then Just - aEnv ^. throttleSpeed else Nothing let sendThread = do
src/Network/MoeSocks/Type.hs view
@@ -1,225 +1,14 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} -module Network.MoeSocks.Type where--import Control.Lens-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 GHC.Generics (Generic)-import System.Log.Logger-import Numeric (showHex)-import qualified Data.Strict as S-import qualified Data.List as L--data ClientGreeting = ClientGreeting- {- _authenticationMethods :: [Word8]- }- deriving (Show)--makeLenses ''ClientGreeting--data ConnectionType =- TCP_IP_StreamConnection--- | TCP_IP_PortBinding- | UDP_Port- deriving (Show, Eq)--data AddressType = - IPv4_Address (Word8, Word8, Word8, Word8)- | DomainName Text- | IPv6_Address [Word16]- 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 (flip showHex "")- ^.. folding - (concat . L.intersperse ":")-type Port = Int--data ClientRequest = ClientRequest- {- _connectionType :: ConnectionType- , _addressType :: AddressType- , _portNumber :: Port- }- deriving (Show, Eq)--makeLenses ''ClientRequest---data Config = Config- {- _remoteHost :: Text- , _remotePort :: Int- , _localHost :: Text- , _localPort :: Int- , _password :: Text- , _method :: Text- , _timeout :: Int- , _tcpBufferSize :: Int -- in packets- , _throttle :: Bool- , _throttleSpeed :: Double- , _obfuscationFlushBound :: Int -- should be greater then MTU- , _fastOpen :: Bool- , _socketOption_TCP_NOTSENT_LOWAT :: Bool- }- deriving (Show, Eq, Generic)--instance FromJSON Config-instance ToJSON Config--makeLenses ''Config--data RunningMode = RemoteMode | LocalMode | DebugMode- deriving (Show, Eq)--data Verbosity = Normal | Verbose- deriving (Show, Eq)--data Forward = Forward- {- _forwardLocalPort :: Port- , _forwardTargetHost :: Text- , _forwardTargetPort :: Port- }- deriving (Show, Eq)---makeLenses ''Forward--{-data Profile = Mac-}- {-| Linux-}- {-deriving (Show, Eq, Read)-}--{-makePrisms ''Profile-}--data Options = Options- {- _runningMode :: RunningMode- , _configFile :: Maybe Text- , _verbosity :: Priority- , _forward_TCPs :: [Forward]- , _forward_UDPs :: [Forward]- , _disable_SOCKS5 :: Bool- , _obfuscation :: Bool- , _forbidden_IPs :: [IPRange]- , _listMethods :: Bool- , _params :: [(Text, Value)]- }- deriving (Show, Eq)--makeLenses ''Options--type Cipher = S.Maybe ByteString -> IO ByteString -type IV = ByteString-type CipherBuilder = IV -> IO Cipher--data CipherBox = CipherBox- {- _ivLength :: Int- , _generate_IV :: IO IV- , _encryptBuilder :: CipherBuilder- , _decryptBuilder :: CipherBuilder- }--makeLenses ''CipherBox--data LocalServiceType =- LocalService_TCP_Forward Forward- | LocalService_UDP_Forward Forward- | LocalService_SOCKS5 Int- deriving (Show, Eq)--makePrisms ''LocalServiceType---data LocalService = LocalService- {- _localServiceHost :: Text- , _localServiceRemoteAddress :: Text- , _localServiceRemotePort :: Int- , _localServiceType :: LocalServiceType- }- deriving (Show, Eq)--makeLenses ''LocalService--data RemoteRelayType =- Remote_TCP_Relay- | Remote_UDP_Relay- deriving (Show, Eq)--makePrisms ''RemoteRelayType---data RemoteRelay = RemoteRelay- {- _remoteRelayType :: RemoteRelayType- , _remoteRelayHost :: Text- , _remoteRelayPort :: Int- }- 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- {- _jobs :: [(Job, Async_ID, TVar JobStatus)]- }--makeLenses ''Runtime--data Env = Env- {- _options :: Options- , _config :: Config- , _cipherBox :: CipherBox- }--makeLenses ''Env+module Network.MoeSocks.Type +(+ module Network.MoeSocks.Type.Runtime+, module Network.MoeSocks.Type.Common+)+where +import Network.MoeSocks.Type.Runtime +import Network.MoeSocks.Type.Common -type MoeMonadT = ReaderT Options (ExceptT String IO)
+ src/Network/MoeSocks/Type/Bootstrap/Config.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.MoeSocks.Type.Bootstrap.Config where++import Control.Lens+import Data.Aeson+import Data.Text (Text)+import GHC.Generics (Generic)++data Config = Config+ {+ _remoteHost :: Text+ , _remotePort :: Int+ , _localHost :: Text+ , _localPort :: Int+ , _password :: Text+ , _method :: Text+ , _timeout :: Int+ , _tcpBufferSize :: Int -- in packets+ , _throttle :: Bool+ , _throttleSpeed :: Double+ , _obfuscationFlushBound :: Int -- should be greater then MTU+ , _fastOpen :: Bool+ , _socketOption_TCP_NOTSENT_LOWAT :: Bool+ }+ deriving (Show, Eq, Generic)++instance FromJSON Config+instance ToJSON Config++makeLenses ''Config
+ src/Network/MoeSocks/Type/Bootstrap/Option.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.MoeSocks.Type.Bootstrap.Option where++import Control.Lens+import Data.Aeson+import Data.Text (Text)+import Data.IP+import System.Log.Logger+import Network.MoeSocks.Type.Common++data RunningMode = RemoteMode | LocalMode | DebugMode+ deriving (Show, Eq)++data Options = Options+ {+ _runningMode :: RunningMode+ , _configFile :: Maybe Text+ , _verbosity :: Priority+ , _forward_TCPs :: [Forward]+ , _forward_UDPs :: [Forward]+ , _disable_SOCKS5 :: Bool+ , _obfuscation :: Bool+ , _forbidden_IPs :: [IPRange]+ , _listMethods :: Bool+ , _params :: [(Text, Value)]+ }+ deriving (Show, Eq)++makeLenses ''Options
+ src/Network/MoeSocks/Type/Common.hs view
@@ -0,0 +1,20 @@++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.MoeSocks.Type.Common where++import Control.Lens+import Data.Text (Text)++type Port = Int++data Forward = Forward+ {+ _forwardLocalPort :: Port+ , _forwardTargetHost :: Text+ , _forwardTargetPort :: Port+ }+ deriving (Show, Eq)++makeLenses ''Forward
+ src/Network/MoeSocks/Type/Runtime.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.MoeSocks.Type.Runtime where++import Control.Concurrent.Async+import Control.Concurrent.STM+import Control.Lens+import Control.Monad.Except+import Data.ByteString (ByteString)+import Data.Text (Text)+import Data.Text.Lens+import Data.Word+import Data.IP+import Network.MoeSocks.Type.Common+import Numeric (showHex)+import qualified Data.List as L+import qualified Data.Strict as S++data ClientGreeting = ClientGreeting+ {+ _authenticationMethods :: [Word8]+ }+ deriving (Show)++makeLenses ''ClientGreeting++data ConnectionType =+ TCP_IP_StreamConnection+-- | TCP_IP_PortBinding+ | UDP_Port+ deriving (Show, Eq)++data AddressType = + IPv4_Address (Word8, Word8, Word8, Word8)+ | DomainName Text+ | IPv6_Address [Word16]+ 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 (flip showHex "")+ ^.. folding + (concat . L.intersperse ":")+data ClientRequest = ClientRequest+ {+ _connectionType :: ConnectionType+ , _addressType :: AddressType+ , _portNumber :: Port+ }+ deriving (Show, Eq)++makeLenses ''ClientRequest+++data Verbosity = Normal | Verbose+ deriving (Show, Eq)++type Cipher = S.Maybe ByteString -> IO ByteString +type IV = ByteString+type CipherBuilder = IV -> IO Cipher++data CipherBox = CipherBox+ {+ _ivLength :: Int+ , _generate_IV :: IO IV+ , _encryptBuilder :: CipherBuilder+ , _decryptBuilder :: CipherBuilder+ }++makeLenses ''CipherBox++data LocalServiceType =+ LocalService_TCP_Forward Forward+ | LocalService_UDP_Forward Forward+ | LocalService_SOCKS5 Int+ deriving (Show, Eq)++makePrisms ''LocalServiceType+++data LocalService = LocalService+ {+ _localServiceHost :: Text+ , _localServiceRemoteHost :: Text+ , _localServiceRemotePort :: Int+ , _localServiceType :: LocalServiceType+ }+ deriving (Show, Eq)++makeLenses ''LocalService++data RemoteRelayType =+ Remote_TCP_Relay+ | Remote_UDP_Relay+ deriving (Show, Eq)++makePrisms ''RemoteRelayType+++data RemoteRelay = RemoteRelay+ {+ _remoteRelayType :: RemoteRelayType+ , _remoteRelayHost :: Text+ , _remoteRelayPort :: Int+ }+ 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 Env = Env+ {+ _timeout :: Int+ , _tcpBufferSize :: Int -- in packets+ , _throttle :: Bool+ , _throttleSpeed :: Double+ , _obfuscationFlushBound :: Int -- should be greater then MTU+ , _fastOpen :: Bool+ , _socketOption_TCP_NOTSENT_LOWAT :: Bool+ , _obfuscation :: Bool+ , _forbidden_IPs :: [IPRange]++ , _cipherBox :: CipherBox+ }++makeLenses ''Env+++data Runtime = Runtime+ {+ _jobs :: [(Job, Async_ID, TVar JobStatus)]+ , _env :: Env+ }++makeLenses ''Runtime++type MoeMonad = ExceptT String IO+
src/Network/MoeSocks/UDP.hs view
@@ -8,6 +8,7 @@ import Control.Monad.Writer hiding (listen) import Data.Attoparsec.ByteString import Data.ByteString (ByteString)+import Data.Text (Text) import Network.MoeSocks.BuilderAndParser import Network.MoeSocks.Common import Network.MoeSocks.Helper@@ -38,16 +39,20 @@ (<>) <$> f (S.Just x) <*> f S.Nothing local_UDP_ForwardRequestHandler :: Env+ -> Text+ -> Port -> Forward -> ByteString -> (Socket,SockAddr) -> IO () local_UDP_ForwardRequestHandler aEnv+ aRemoteHost+ aRemotePort aForwarding aMessage (aSocket, aSockAddr) = do - let _c = aEnv ^. config+ let _cipherBox = aEnv ^. cipherBox let _clientRequest = ClientRequest@@ -59,12 +64,12 @@ {-debug_ - "L UDP: " <> show _clientRequest-} let _addr = _clientRequest ^. addressType- _forbidden_IPs = aEnv ^. options . forbidden_IPs+ _forbidden_IPs = aEnv ^. forbidden_IPs debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs withCheckedForbidden_IP_List _addr _forbidden_IPs - do- _sa <- getSocket (_c ^. remoteHost) (_c ^. remotePort) Datagram+ _sa <- getSocket aRemoteHost aRemotePort Datagram logSA "L UDP -->:" (pure _sa) - \(_remoteSocket, _remoteAddr) -> do@@ -108,7 +113,6 @@ aMessage (aSocket, aSockAddr) = do let _cipherBox = aEnv ^. cipherBox- _options = aEnv ^. options let (_decodeIV, _eMsg) = S.splitAt (_cipherBox ^. ivLength) aMessage@@ -126,7 +130,7 @@ let (_targetSocket, _targetSocketAddress) = _r (_addr, _) = sockAddr_To_Pair _targetSocketAddress- _forbidden_IPs = _options ^. forbidden_IPs+ _forbidden_IPs = aEnv ^. forbidden_IPs debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs withCheckedForbidden_IP_List _addr _forbidden_IPs - do