moesocks 0.1.0.26 → 0.1.0.27
raw patch · 8 files changed
+223/−179 lines, 8 files
Files
- CHANGELOG.md +17/−11
- README.md +5/−0
- moesocks.cabal +1/−1
- src/Network/MoeSocks/App.hs +36/−28
- src/Network/MoeSocks/Config.hs +1/−1
- src/Network/MoeSocks/Helper.hs +28/−14
- src/Network/MoeSocks/TCP.hs +105/−100
- src/Network/MoeSocks/UDP.hs +30/−24
CHANGELOG.md view
@@ -1,6 +1,12 @@+0.1.0.27+--------+* Make local respect `forbidden-ip` as well, this reduce unnecessary connection+ to the remote.+* Clean up logging.+ 0.1.0.26 ---------* enable CIDR format in `forbidden-ip`+* Enable CIDR format in `forbidden-ip`. 0.1.0.25 --------@@ -9,12 +15,12 @@ 0.1.0.24 ---------* Make obfuscation flush upper bound configurable in `config.json`-* Fix an IPv6 name resolution bug in remote+* Make obfuscation flush upper bound configurable in `config.json`.+* Fix an IPv6 name resolution bug in remote. 0.1.0.23 ----------* Fix a bug to prevent a half closed connection to hold a file handle+* Fix a bug to prevent a half closed connection to hold a file handle. 0.1.0.22 --------@@ -27,28 +33,28 @@ 0.1.0.20 ---------* Rewrite Encrypt module, cache password hash+* Rewrite Encrypt module, cache password hash. 0.1.0.19 ---------* Fix a memory leak+* Fix a memory leak. 0.1.0.18 ---------* Add complete command line arguments+* Add complete command line arguments. 0.1.0.17 ---------* Add `--disable-socks5` flag to switch off the socks5 service on local+* Add `--disable-socks5` flag to switch off the socks5 service on local. 0.1.0.16 ---------* Add compatibility with shadowsocks for UDP port forwarding+* Add compatibility with shadowsocks for UDP port forwarding. 0.1.0.15 ---------* Add UDP port forwarding+* Add UDP port forwarding. 0.1.0.14 ---------* Add IPv6 support+* Add IPv6 support.
README.md view
@@ -52,6 +52,11 @@ moesocks --help +* You might want to run `moesocks` under some kind of a supervising daemon to+ auto restart the program if it crashes. Yes, it will likely to core dump after+ some random period of time (yes, I'm working on it); On the positive side,+ there is no memory leak!+ Features --------
moesocks.cabal view
@@ -1,6 +1,6 @@ name: moesocks category: Network-version: 0.1.0.26+version: 0.1.0.27 license: Apache-2.0 synopsis: A functional firewall killer description: A socks5 proxy using the client / server architecture.
src/Network/MoeSocks/App.hs view
@@ -66,31 +66,32 @@ let - fixConfig :: Value -> Value- fixConfig (Object _obj) =+ toParsableConfig :: Value -> Value+ toParsableConfig (Object _obj) = Object - _obj & H.toList & fromSS & over (mapped . _1) (T.cons '_') & H.fromList- fixConfig _ = Null+ toParsableConfig _ = Null - formatConfig :: Value -> Value- formatConfig (Object _obj) =+ toReadableConfig :: Value -> Value+ toReadableConfig (Object _obj) = Object - _obj & H.toList & over (mapped . _1) T.tail & H.fromList- formatConfig _ = Null + toReadableConfig _ = Null+ showConfig :: MoeConfig -> Text showConfig = view utf8 . toStrict . encode - . formatConfig + . toReadableConfig . toJSON @@ -105,15 +106,15 @@ filterEssentialConfig _ = Null - mergeConfigObject :: Value -> Value -> Value- mergeConfigObject (Object _x) (Object _y) =+ insertConfig :: Value -> Value -> Value+ insertConfig (Object _x) (Object _y) = Object - _x `H.union` _y- mergeConfigObject _ _ = Null+ insertConfig _ _ = Null - mergeParams :: [(Text, Value)] -> Value -> Value- mergeParams xs (Object _x) =+ insertParams :: [(Text, Value)] -> Value -> Value+ insertParams xs (Object _x) = Object - H.fromList xs `H.union` _x- mergeParams _ _ = Null+ insertParams _ _ = Null optionalConfig = filterEssentialConfig - toJSON defaultMoeConfig@@ -121,9 +122,9 @@ _maybeConfig = _v >>= decode . encode - . flip mergeConfigObject optionalConfig- . mergeParams (aOption ^. params)- . fixConfig + . flip insertConfig optionalConfig+ . insertParams (aOption ^. params)+ . toParsableConfig case _maybeConfig of Nothing -> do@@ -155,7 +156,8 @@ stdoutHandler <- streamHandler IO.stdout DEBUG let formattedHandler = LogHandler.setFormatter stdoutHandler -- simpleLogFormatter "$time $msg"+ --"[$time : $loggername : $prio]+ simpleLogFormatter "$time $prio\t $msg" updateGlobalLogger rootLoggerName removeHandler @@ -192,13 +194,13 @@ -> IO () localAppBuilder aAppType aID aHandler s = logSA "L loop" (pure s) - \(_localSocket, _localAddr) -> do- _say - "L " <> aID <> ": nyaa!" setSocketOption _localSocket ReuseAddr 1 bindSocket _localSocket _localAddr case aAppType of TCP_App -> do+ _info - "LT: " <> aID <> " nyaa!" listen _localSocket maxListenQueue let handleLocal _socket = do@@ -207,13 +209,14 @@ -- send immediately! setSocketOption _socket NoDelay 1 - forkIO - catchExceptAsyncLog "L TCP thread" - + forkIO - catchExceptAsyncLog "LT" - logSA "L TCP client socket" (pure _s) - aHandler "" forever - handleLocal _localSocket UDP_App -> do+ _info - "LU: " <> aID <> " nyaa!" let handleLocal = do (_msg, _sockAddr) <- recvFrom _localSocket _PacketLength@@ -222,15 +225,19 @@ let _s = (_localSocket, _sockAddr) - forkIO - catchExceptAsyncLog "L UDP thread" - + forkIO - catchExceptAsyncLog "LU" - aHandler _msg _s forever handleLocal + let+ showWrapped :: (Show a) => a -> String+ showWrapped x = "[" <> show x <> "]" let localSocks5App :: (Socket, SockAddr) -> IO ()- localSocks5App = localAppBuilder TCP_App "socks5" - - local_Socks5_RequestHandler _env+ localSocks5App _s = localAppBuilder TCP_App + ("Socks5 proxy " <> showWrapped (_s ^. _2)) + (local_Socks5_RequestHandler _env) - _s showForwarding :: Forward -> String showForwarding (Forward _localPort _remoteHost _remotePort) =@@ -242,24 +249,25 @@ <> show _remotePort <> "]" + forward_TCP_App :: Forward -> (Socket, SockAddr) -> IO () forward_TCP_App _f _s = do let _m = showForwarding _f- localAppBuilder TCP_App ("TCP forwarding " <> _m)+ localAppBuilder TCP_App ("TCP port forwarding " <> _m) (local_TCP_ForwardRequestHandler _env _f) _s forward_UDP_App :: Forward -> (Socket, SockAddr) -> IO () forward_UDP_App _f _s = do let _m = showForwarding _f - localAppBuilder UDP_App ("UDP forwarding " <> _m)+ localAppBuilder UDP_App ("UDP port forwarding " <> _m) (local_UDP_ForwardRequestHandler _env _f) _s let remote_TCP_App :: (Socket, SockAddr) -> IO () remote_TCP_App s = logSA "R loop" (pure s) - \(_remoteSocket, _remoteAddr) -> do- _say "R TCP: nyaa!"+ _info - "RT: TCP relay " <> showWrapped _remoteAddr <> " nyaa!" setSocketOption _remoteSocket ReuseAddr 1 bindSocket _remoteSocket _remoteAddr@@ -274,7 +282,7 @@ -- send immediately! setSocketOption _socket NoDelay 1 - forkIO - catchExceptAsyncLog "R thread" - + forkIO - catchExceptAsyncLog "RT" - logSocket "R remote socket" (pure _newSocket) - remote_TCP_RequestHandler _env @@ -283,7 +291,7 @@ let remote_UDP_App :: (Socket, SockAddr) -> IO () remote_UDP_App s = logSA "R loop" (pure s) - \(_remoteSocket, _remoteAddr) -> do- _say "R UDP: nyaa!"+ _info - "RU: UDP relay " <> showWrapped _remoteAddr <> " nyaa!" setSocketOption _remoteSocket ReuseAddr 1 bindSocket _remoteSocket _remoteAddr@@ -296,7 +304,7 @@ let _s = (_remoteSocket, _sockAddr) - forkIO - catchExceptAsyncLog "R thread" - + forkIO - catchExceptAsyncLog "RU" - remote_UDP_RequestHandler _env _msg _s
src/Network/MoeSocks/Config.hs view
@@ -32,6 +32,6 @@ , _forward_UDP = [] , _disableSocks5 = False , _obfuscation = False- , _forbidden_IP = ["127.0.0.1", "::1"]+ , _forbidden_IP = ["127.0.0.1", "0.0.0.0", "::1"] , _params = [] }
src/Network/MoeSocks/Helper.hs view
@@ -67,20 +67,35 @@ {-aIO <* takeMVar syncLock-} aIO +{-puts :: String -> IO ()-}+{-puts = sync . debugM "moe" . ("😽 " <>)-}++{-pute :: String -> IO ()-}+{-pute = sync . errorM "moe" . ("😾 " <>)-}++{-_warning :: String -> IO ()-}+{-_warning = sync . warningM "moe" . ("😾 " <>)-}++{-_info :: String -> IO ()-}+{-_info = sync . infoM "moe" . ("😺 " <>)-}++{-_notice :: String -> IO ()-}+{-_notice = sync . noticeM "moe" . ("😼 " <>)-}+ puts :: String -> IO ()-puts = sync . debugM "moe" . ("😽 " <>)+puts = sync . debugM "moe" pute :: String -> IO ()-pute = sync . errorM "moe" . ("😾 " <>)+pute = sync . errorM "moe" -putw :: String -> IO ()-putw = sync . warningM "moe" . ("😾 " <>)+_warning :: String -> IO ()+_warning = sync . warningM "moe" -_log :: String -> IO ()-_log = sync . infoM "moe" . ("😺 " <>)+_info :: String -> IO ()+_info = sync . infoM "moe" -_say :: String -> IO ()-_say = sync . noticeM "moe" . ("😼 " <>)+_notice :: String -> IO ()+_notice = sync . noticeM "moe" puteT :: Text -> IO () puteT = pute . view _Text@@ -132,9 +147,8 @@ <> " : " <> show e throw e , Handler - \(e :: SomeException) -> - pute - "CatcheAll in "- <> aID- <> " : " <> show e+ pute - aID+ <> ": " <> show e ] catchIO:: String -> IO a -> IO ()@@ -168,7 +182,7 @@ data TimeoutException = TimeoutException String instance Show TimeoutException where- show (TimeoutException s) = "Timeout exception: " ++ s+ show (TimeoutException s) = "Timeout: " ++ s instance Exception TimeoutException @@ -265,7 +279,7 @@ where _loop _buffer = do _randomLength <- randomRIO (0, aFlushBound)- {-_say - "randomLength: " <> show _randomLength-}+ {-_notice - "randomLength: " <> show _randomLength-} let (_thisBuffer, _nextBuffer) = S.splitAt _randomLength _buffer sendAll aSocket _thisBuffer when (_nextBuffer & isn't _Empty) - do@@ -336,7 +350,7 @@ _produce _bytesReceived = flip onException (f S.Nothing) - do _r <- timeoutFor aID aTimeout - recv_ aSocket {-when ("L" `isPrefixOf` aID) - do-}- {-_say - "Get chunk: " <> (show - S.length _r) <> " " <> aID-}+ {-_notice - "Get chunk: " <> (show - S.length _r) <> " " <> aID-} if (_r & isn't _Empty) then do
src/Network/MoeSocks/TCP.hs view
@@ -70,116 +70,121 @@ local_TCP_RequestHandler aEnv (_partialBytesAfterClientRequest, _clientRequest) shouldReplyClient aSocket = do- let - _c = aEnv ^. config - _cipherBox = aEnv ^. cipherBox- _obfuscation = aEnv ^. options . obfuscation- _flushBound = _c ^. obfuscationFlushBound-- _initSocket = - getSocket (_c ^. remote) (_c ^. remotePort) Stream + let _addr = _clientRequest ^. addressType+ _forbidden_IP = aEnv ^. options . forbidden_IP - puts - "L: " <> show _clientRequest- - logSA "L remote socket" _initSocket - - \(_remoteSocket, _remoteAddress) -> do- connect _remoteSocket _remoteAddress+ puts - "checking: " <> show _addr <> " ? " <> show _forbidden_IP+ withCheckedForbidden_IP_List _addr _forbidden_IP - do+ let + _c = aEnv ^. config + _cipherBox = aEnv ^. cipherBox+ _obfuscation = aEnv ^. options . obfuscation+ _flushBound = _c ^. obfuscationFlushBound + _initSocket = + getSocket (_c ^. remote) (_c ^. remotePort) Stream - _localPeerAddr <- getPeerName aSocket- _remoteSocketName <- getSocketName _remoteSocket- - when shouldReplyClient - do- let _connectionReplyBuilder = connectionReplyBuilder _remoteSocketName- send_ aSocket - builder_To_ByteString _connectionReplyBuilder+ puts - "L: " <> show _clientRequest + logSA "L remote socket" _initSocket - + \(_remoteSocket, _remoteAddress) -> do+ connect _remoteSocket _remoteAddress - let _msg = show _localPeerAddr <> " -> " <> showRequest _clientRequest- - _log - "L T: " <> _msg - let handleLocal _remoteSocket = do- _encodeIV <- _cipherBox ^. generate_IV - _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV- - let - _header = shadowSocksRequestBuilder _clientRequest- - _sendChannel <- newTBQueueIO - _c ^. tcpBufferSize- _receiveChannel <- newTBQueueIO - _c ^. tcpBufferSize+ _localPeerAddr <- getPeerName aSocket+ _remoteSocketName <- getSocketName _remoteSocket+ + when shouldReplyClient - do+ let _connectionReplyBuilder = connectionReplyBuilder _remoteSocketName+ send_ aSocket - builder_To_ByteString _connectionReplyBuilder+ - let _logId x = x <> " " <> _msg- _timeout = _c ^. timeout * 1000 * 1000- _throttle = - if _c ^. throttle- then Just - _c ^. throttleSpeed- else Nothing+ let _msg = show _localPeerAddr <> " -> " <> showRequest _clientRequest+ + _info - "LT: " <> _msg - let sendThread = do- sendBytes _sendChannel _encodeIV- sendBuilderEncrypt _sendChannel _encrypt _header+ let handleLocal _remoteSocket = do+ _encodeIV <- _cipherBox ^. generate_IV + _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV+ + let + _header = shadowSocksRequestBuilder _clientRequest+ + _sendChannel <- newTBQueueIO - _c ^. tcpBufferSize+ _receiveChannel <- newTBQueueIO - _c ^. tcpBufferSize - when (_partialBytesAfterClientRequest & isn't _Empty) -- sendBytesEncrypt _sendChannel _encrypt - _partialBytesAfterClientRequest+ let _infoId x = x <> " " <> _msg+ _timeout = _c ^. timeout * 1000 * 1000+ _throttle = + if _c ^. throttle+ then Just - _c ^. throttleSpeed+ else Nothing - let _produce = do- produceLoop (_logId "L --> + Loop")- _timeout- _NoThrottle- aSocket - _sendChannel - _encrypt+ let sendThread = do+ sendBytes _sendChannel _encodeIV+ sendBuilderEncrypt _sendChannel _encrypt _header - let _consume = do- consumeLoop (_logId "L --> - Loop")- _timeout- _throttle- _remoteSocket - _sendChannel- _obfuscation- _flushBound- finally- (- connectMarket (Just - _logId "L --> +", _produce)- (Just - _logId "L --> -", _consume)- ) -- pure ()+ when (_partialBytesAfterClientRequest & isn't _Empty) -+ sendBytesEncrypt _sendChannel _encrypt + _partialBytesAfterClientRequest - let receiveThread = do- _decodeIV <- recv _remoteSocket (_cipherBox ^. ivLength)- _decrypt <- _cipherBox ^. decryptBuilder - _decodeIV+ let _produce = do+ produceLoop (_infoId "L --> + Loop")+ _timeout+ _NoThrottle+ aSocket + _sendChannel + _encrypt - let _produce = produceLoop (_logId "L <-- + Loop")- _timeout- _NoThrottle- _remoteSocket - _receiveChannel- _decrypt+ let _consume = do+ consumeLoop (_infoId "L --> - Loop")+ _timeout+ _throttle+ _remoteSocket + _sendChannel+ _obfuscation+ _flushBound+ finally+ (+ connectMarket (Just - _infoId "L --> +", _produce)+ (Just - _infoId "L --> -", _consume)+ ) -+ pure () - let _consume = do- consumeLoop (_logId "L <-- - Loop")+ let receiveThread = do+ _decodeIV <- recv _remoteSocket (_cipherBox ^. ivLength)+ _decrypt <- _cipherBox ^. decryptBuilder - _decodeIV++ let _produce = produceLoop (_infoId "L <-- + Loop") _timeout _NoThrottle- aSocket + _remoteSocket _receiveChannel- False- _flushBound- finally - (- connectMarket (Just - _logId "L <-- +", _produce)- (Just - _logId "L <-- -", _consume)- ) -- pure ()+ _decrypt - connectTunnel- (Just - _logId "L -->", sendThread)- (Just - _logId "L <--", receiveThread)+ let _consume = do+ consumeLoop (_infoId "L <-- - Loop")+ _timeout+ _NoThrottle+ aSocket + _receiveChannel+ False+ _flushBound+ finally + (+ connectMarket (Just - _infoId "L <-- +", _produce)+ (Just - _infoId "L <-- -", _consume)+ ) -+ pure () + connectTunnel+ (Just - _infoId "L -->", sendThread)+ (Just - _infoId "L <--", receiveThread) - handleLocal _remoteSocket + handleLocal _remoteSocket + remote_TCP_RequestHandler :: Env -> Socket -> IO () remote_TCP_RequestHandler aEnv aSocket = do let@@ -214,14 +219,14 @@ let _msg = show _remotePeerAddr <> " -> " <> showRequest _clientRequest - _log - "R T: " <> _msg+ _info - "RT: " <> _msg let handleTarget _leftOverBytes __targetSocket = do _sendChannel <- newTBQueueIO - _c ^. tcpBufferSize _receiveChannel <- newTBQueueIO - _c ^. tcpBufferSize - let _logId x = x <> " " <> _msg+ let _infoId x = x <> " " <> _msg -- let remote wait slightly longer, so local can timeout -- and disconnect _timeout = (_c ^. timeout + 30) * 1000 * 1000@@ -237,14 +242,14 @@ S.Just _leftOverBytes let _produce = do- produceLoop (_logId "R --> + Loop")+ produceLoop (_infoId "R --> + Loop") _timeout _NoThrottle aSocket _sendChannel _decrypt - let _consume = consumeLoop (_logId "R --> - Loop")+ let _consume = consumeLoop (_infoId "R --> - Loop") _timeout _NoThrottle _targetSocket@@ -254,8 +259,8 @@ finally (- connectMarket (Just - _logId "R --> +", _produce)- (Just - _logId "R --> -", _consume)+ connectMarket (Just - _infoId "R --> +", _produce)+ (Just - _infoId "R --> -", _consume) ) - pure () @@ -265,7 +270,7 @@ sendBytes _receiveChannel _encodeIV let _produce = do- produceLoop (_logId "R <-- + Loop")+ produceLoop (_infoId "R <-- + Loop") _timeout _NoThrottle _targetSocket@@ -274,7 +279,7 @@ let _consume = do- consumeLoop (_logId "R <-- - Loop")+ consumeLoop (_infoId "R <-- - Loop") _timeout _throttle aSocket@@ -284,13 +289,13 @@ finally (- connectMarket (Just - _logId "R <-- +", _produce)- (Just - _logId "R <-- -", _consume)+ connectMarket (Just - _infoId "R <-- +", _produce)+ (Just - _infoId "R <-- -", _consume) ) - pure () connectTunnel- (Just - _logId "R -->", sendThread)- (Just - _logId "R <--", receiveThread)+ (Just - _infoId "R -->", sendThread)+ (Just - _infoId "R <--", receiveThread) handleTarget _leftOverBytes _targetSocket
src/Network/MoeSocks/UDP.hs view
@@ -58,41 +58,47 @@ {-puts - "L UDP: " <> show _clientRequest-} - _sa <- getSocket (_c ^. remote) (_c ^. remotePort) Datagram+ let _addr = _clientRequest ^. addressType+ _forbidden_IP = aEnv ^. options . forbidden_IP - logSA "L UDP -->:" (pure _sa) - - \(_remoteSocket, _remoteAddr) -> do- connect _remoteSocket _remoteAddr+ puts - "checking: " <> show _addr <> " ? " <> show _forbidden_IP+ + withCheckedForbidden_IP_List _addr _forbidden_IP - do+ _sa <- getSocket (_c ^. remote) (_c ^. remotePort) Datagram - _encodeIV <- _cipherBox ^. generate_IV - _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV+ logSA "L UDP -->:" (pure _sa) - + \(_remoteSocket, _remoteAddr) -> do+ connect _remoteSocket _remoteAddr - {-let (_encrypt, _decrypt) = (pure, pure)-}+ _encodeIV <- _cipherBox ^. generate_IV + _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV - let _bytes = buildShadowSocksRequest _clientRequest aMessage+ {-let (_encrypt, _decrypt) = (pure, pure)-} - {-puts - "L UDP: " <> show _bytes-}+ let _bytes = buildShadowSocksRequest _clientRequest aMessage - let _msg = show aSockAddr <> " -> " <> showRequest _clientRequest- _log - "L U: " <> _msg- - _eMsg <- _encrypt (S.Just _bytes)+ {-puts - "L UDP: " <> show _bytes-} - send_ _remoteSocket - _encodeIV <> _eMsg+ let _msg = show aSockAddr <> " -> " <> showRequest _clientRequest+ _info - "LU: " <> _msg+ + _eMsg <- _encrypt (S.Just _bytes) - _response <- recv_ _remoteSocket + send_ _remoteSocket - _encodeIV <> _eMsg - let (_decodeIV, _responseMsg) = S.splitAt (_cipherBox ^. ivLength) - _response- _decrypt <- _cipherBox ^. decryptBuilder - _decodeIV- - (_r, _) <- processAll _decrypt _responseMsg- >>= parseShadowSocksRequest+ _response <- recv_ _remoteSocket - when (_r & isn't _Empty) - do- sendAllTo aSocket _r aSockAddr+ let (_decodeIV, _responseMsg) = S.splitAt (_cipherBox ^. ivLength) + _response+ _decrypt <- _cipherBox ^. decryptBuilder - _decodeIV+ + (_r, _) <- processAll _decrypt _responseMsg+ >>= parseShadowSocksRequest + when (_r & isn't _Empty) - do+ sendAllTo aSocket _r aSockAddr + remote_UDP_RequestHandler :: Env -> ByteString -> (Socket, SockAddr) @@ -124,7 +130,7 @@ puts - "checking: " <> show _addr <> " ? " <> show _forbidden_IP withCheckedForbidden_IP_List _addr _forbidden_IP - do let _msg = show aSockAddr <> " -> " <> showRequest _clientRequest- _log - "R U: " <> _msg+ _info - "RU: " <> _msg connect _targetSocket _targetSocketAddress