{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} module Network.MoeSocks.Runtime where 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 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 :: C.Config -> O.Options -> [Job] loadJobs aConfig someOptions = let _c = aConfig _remote_TCP_Relay = RemoteRelay Remote_TCP_Relay (_c ^. C.remoteHost) (_c ^. C.remotePort) _remote_UDP_Relay = RemoteRelay Remote_UDP_Relay (_c ^. C.remoteHost) (_c ^. C.remotePort) _localService :: LocalServiceType -> LocalService _localService = LocalService (_c ^. C.localHost) (_c ^. C.remoteHost) (_c ^. C.remotePort) _localService_TCP_Forwards = someOptions ^. O.forward_TCPs & map (_localService . LocalService_TCP_Forward) _localService_UDP_Forwards = someOptions ^. O.forward_UDPs & map (_localService . LocalService_UDP_Forward) _localService_SOCKS5 = LocalService_SOCKS5 (_c ^. 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 :: O.RunningMode -> [Job] -> [Job] filterJobs = \case 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) 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 .~ _jobs )