moesocks 0.1.2.10 → 0.1.2.20
raw patch · 14 files changed
+145/−131 lines, 14 files
Files
- CHANGELOG.md +5/−1
- config.json +2/−2
- moesocks.cabal +1/−1
- src/Network/MoeSocks/App.hs +51/−54
- src/Network/MoeSocks/Common.hs +4/−4
- src/Network/MoeSocks/Config.hs +2/−2
- src/Network/MoeSocks/Helper.hs +15/−9
- src/Network/MoeSocks/Internal/Socket.hs +2/−0
- src/Network/MoeSocks/Modules/Resource.hs +8/−4
- src/Network/MoeSocks/Options.hs +4/−4
- src/Network/MoeSocks/Runtime.hs +4/−4
- src/Network/MoeSocks/TCP.hs +9/−9
- src/Network/MoeSocks/Type.hs +7/−6
- src/Network/MoeSocks/UDP.hs +31/−31
CHANGELOG.md view
@@ -1,6 +1,10 @@+0.1.2.20+--------+* Fix IPv6, finally tested on a real IPv6 network..+ 0.1.2.10 --------* Fix not parsing snake case in config, a bug in introduced in 0.1.2.0+* Fix not parsing snake case in config, a bug introduced in 0.1.2.0 0.1.2.0 -------
config.json view
@@ -1,7 +1,7 @@ {- "remote":"0.0.0.0",+ "remoteAddress":"0.0.0.0", "remotePort":1190,- "local":"localhost",+ "localAddress":"localhost", "localPort":1090, "password":"birthday!", "fastOpen":false,
moesocks.cabal view
@@ -1,6 +1,6 @@ name: moesocks category: Network-version: 0.1.2.10+version: 0.1.2.20 license: Apache-2.0 synopsis: A functional firewall killer description: A SOCKS5 proxy using the client / server architecture.
src/Network/MoeSocks/App.hs view
@@ -50,35 +50,35 @@ moeApp:: MoeMonadT () moeApp = do- _options <- ask + _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 '" + 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) + let localService :: ServiceType+ -> String+ -> (ByteString -> (Socket, SockAddr) -> IO ())+ -> (Socket, SockAddr) -> IO ()- localService aServiceType aID aHandler s = + 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!"@@ -92,8 +92,8 @@ _s@(_newSocket, _newSockAddr) <- accept _socket setSocketCloseOnExec _newSocket setSocketConfig _c _socket- - forkIO - catchExceptAsyncLog "LT" - ++ forkIO - catchExceptAsyncLog "LT" - logSA "L TCP client socket" (pure _s) - aHandler "" @@ -102,32 +102,32 @@ UDP_Service -> do info_ - "LU: " <> aID <> " nyaa!" let handleLocal = do- (_msg, _sockAddr) <- + (_msg, _sockAddr) <- recvFrom _localSocket _PacketLength debug_ - "L UDP: " <> show _msg- + let _s = (_localSocket, _sockAddr) - forkIO - catchExceptAsyncLog "LU" - + 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)) + ("SOCKS5 proxy " <> showWrapped (_s ^. _2)) (local_SOCKS5_RequestHandler _env) - _s showForwarding :: Forward -> String showForwarding (Forward _localPort _remoteHost _remotePort) = "["- <> show _localPort - <> " -> " + <> show _localPort+ <> " -> " <> _remoteHost ^. _Text <> ":" <> show _remotePort@@ -138,16 +138,16 @@ localForward_TCP _f _s = do let _m = showForwarding _f localService TCP_Service ("TCP port forwarding " <> _m)- (local_TCP_ForwardRequestHandler _env _f) + (local_TCP_ForwardRequestHandler _env _f) _s localForward_UDP :: Forward -> (Socket, SockAddr) -> IO () localForward_UDP _f _s = do- let _m = showForwarding _f + let _m = showForwarding _f localService UDP_Service ("UDP port forwarding " <> _m)- (local_UDP_ForwardRequestHandler _env _f) + (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@@ -158,17 +158,17 @@ 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" - ++ forkIO - catchExceptAsyncLog "RT" - logSocket "R remote socket" (pure _newSocket) -- remote_TCP_RequestHandler _env + remote_TCP_RequestHandler _env forever - handleRemote _remoteSocket @@ -188,7 +188,7 @@ let _s = (_remoteSocket, _sockAddr) - forkIO - catchExceptAsyncLog "RU" - + forkIO - catchExceptAsyncLog "RU" - remote_UDP_RequestHandler _env _msg _s forever handleRemote@@ -197,53 +197,53 @@ let runRemoteRelay :: RemoteRelay -> IO () runRemoteRelay _remoteRelay = do- let _address = _remoteRelay ^. remoteRelayAddress+ 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 + >>= remote_TCP_Relay Remote_UDP_Relay -> catchExceptAsyncLog "R UDP Relay" - do getSocket _address _port Datagram- >>= remote_UDP_Relay + >>= remote_UDP_Relay - + let runLocalService :: LocalService -> IO () runLocalService _localService = do case _localService ^. localServiceType of- LocalService_TCP_Forward forwarding -> + LocalService_TCP_Forward forwarding -> catchExceptAsyncLog "L TCP_Forwarding" - do- getSocket (_localService ^. localServiceAddress) - (forwarding ^. forwardLocalPort) + getSocket (_localService ^. localServiceHost)+ (forwarding ^. forwardLocalPort) Stream >>= localForward_TCP forwarding- + LocalService_UDP_Forward forwarding -> catchExceptAsyncLog "L UDP_Forwarding" - do- getSocket (_localService ^. localServiceAddress) - (forwarding ^. forwardLocalPort) + getSocket (_localService ^. localServiceHost)+ (forwarding ^. forwardLocalPort) Datagram >>= localForward_UDP forwarding- + LocalService_SOCKS5 _port -> catchExceptAsyncLog "L SOCKS5" - do- getSocket (_localService ^. localServiceAddress) _port Stream- >>= local_SOCKS5 + getSocket (_localService ^. localServiceHost) _port Stream+ >>= local_SOCKS5 runJob :: Job -> TVar JobStatus -> IO () runJob (RemoteRelayJob x) _ = runRemoteRelay x- runJob (LocalServiceJob x) _ = runLocalService x - + runJob (LocalServiceJob x) _ = runLocalService x+ runApp :: [Job] -> IO () runApp someJobs = do- _jobs <- (forM someJobs - \_job -> (,) _job + _jobs <- (forM someJobs - \_job -> (,) _job <$> newTVarIO initialJobStatus)- _asyncs <- mapM (async . foreverRun . (uncurry runJob)) _jobs - + _asyncs <- mapM (async . foreverRun . (uncurry runJob)) _jobs+ _mainThread <- async - do- waitAnyCancel - _asyncs + waitAnyCancel - _asyncs _uiThread <- async - forever - do let _statuses = _jobs ^.. each . _2 :: [TVar JobStatus]@@ -253,9 +253,6 @@ waitAnyCancel [_mainThread, _uiThread] pure ()- - io - runApp - filterJobs (_options ^. runningMode) - loadJobs _c _options --+ io - runApp - filterJobs (_options ^. runningMode) - loadJobs _c _options
src/Network/MoeSocks/Common.hs view
@@ -54,10 +54,10 @@ showRelay aSockAddr aClientRequest = show aSockAddr <> " -> " <> showRequest aClientRequest -addressType_To_Family :: AddressType -> Maybe Family-addressType_To_Family (IPv4_Address _) = Just AF_INET-addressType_To_Family (IPv6_Address _) = Just AF_INET6-addressType_To_Family _ = Nothing+addressType_To_Family :: AddressType -> Family+addressType_To_Family (IPv4_Address _) = AF_INET+addressType_To_Family (IPv6_Address _) = AF_INET6+addressType_To_Family _ = AF_UNSPEC _SocketType :: Prism' SocketType ConnectionType _SocketType = prism' connectionType_To_SocketType socketType_To_connectionType
src/Network/MoeSocks/Config.hs view
@@ -8,9 +8,9 @@ defaultConfig :: Config defaultConfig = Config {- _remoteAddress = "0.0.0.0"+ _remoteHost = "0.0.0.0" , _remotePort = 8388 - , _localAddress = "127.0.0.1"+ , _localHost = "127.0.0.1" , _localPort = 1080 , _password = "moesocks" , _method = "aes-256-cfb"
src/Network/MoeSocks/Helper.hs view
@@ -20,6 +20,7 @@ import Data.Text (Text) import Data.Text.Lens import Data.Time.Clock+import Data.List (sortOn) import Debug.Trace (trace) import Network.MoeSocks.Internal.Socket (sendAllToFastOpen) import Network.Socket hiding (send, recv)@@ -198,18 +199,24 @@ getSocket :: (Integral i, Show i) => Text -> i -> SocketType -> IO (Socket, SockAddr)-getSocket = getSocketWithHint Nothing+getSocket = getSocketWithHint AF_UNSPEC getSocketWithHint :: (Integral i, Show i) => - Maybe Family -> Text -> i -> SocketType -> + Family -> Text -> i -> SocketType -> IO (Socket, SockAddr)-getSocketWithHint maybeFamily aHost aPort aSocketType = do- {-debug_ - "getSocket: " <> show aHost <> ":" <> show aPort-}+getSocketWithHint aFamily aHost aPort aSocketType = do+ {-info_ - "getSocketWithHint: " <> show aFamily <> -}+ {-" " <> show aHost <> ":" <> show aPort-} - maybeAddrInfo <- firstOf folded <$>- getAddrInfo (Just hints) + _addrs <- getAddrInfo (Just hints) (Just - aHost ^. _Text) (Just - show aPort) + <&> sortOn addrFamily++ {-info_ - "Get socket addrs: " <> show _addrs-}++ maybeAddrInfo <- firstOf folded <$> pure _addrs+ case maybeAddrInfo of Nothing -> error - "Error in getSocket for: " <> aHost ^. _Text <> ":" <> show aPort@@ -226,19 +233,18 @@ when (aSocketType == Stream) - setSocketOption _socket NoDelay 1 - debug_ - "Getting socket: " <> show addrInfo+ debug_ - "Got socket: " <> show addrInfo {-debug_ - "Socket family: " <> show family-} {-debug_ - "Socket protocol: " <> show protocol -} pure (_socket, address) where- _family = maybeFamily & fromMaybe AF_INET hints = defaultHints { addrFlags = [AI_ADDRCONFIG, AI_NUMERICSERV] , addrSocketType = aSocketType- , addrFamily = _family+ , addrFamily = aFamily } builder_To_ByteString :: B.Builder -> ByteString
src/Network/MoeSocks/Internal/Socket.hs view
@@ -48,3 +48,5 @@ let _MSG_FASTOPEN = 0x20000000 sent <- sendToWithFlagNoRetry sock xs addr _MSG_FASTOPEN when (sent < S.length xs) $ sendAll sock (S.drop sent xs)++
src/Network/MoeSocks/Modules/Resource.hs view
@@ -35,12 +35,16 @@ asList :: ([(Text, Value)] -> [(Text, Value)]) -> Value -> Value asList f = over _Object - H.fromList . f . H.toList - fromShadowSocksConfig :: Text -> Text- fromShadowSocksConfig x = + fixConfig:: Text -> Text+ fixConfig x = let fixes = Map.fromList [- ("server", "remoteAddress")+ ("server", "remoteHost") , ("server_port", "remotePort")+ , ("local_address", "localHost")++ , ("remoteAddress", "remoteHost")+ , ("localAddress", "localHost") ] in@@ -50,7 +54,7 @@ toParsableConfig = asList - each . _1 %~ ( T.cons '_' . toHaskellNamingConvention- . fromShadowSocksConfig+ . fixConfig ) toReadableConfig :: Value -> Value
src/Network/MoeSocks/Options.hs view
@@ -86,7 +86,7 @@ _remote = textParam - short 's' <> metavar "REMOTE"- <> defaultHelp (_c ^. remoteAddress)+ <> defaultHelp (_c ^. remoteHost) "remote address" _remotePort = intParam -@@ -100,7 +100,7 @@ _local = textParam - short 'b' <> metavar "LOCAL"- <> defaultHelp (_c ^. localAddress)+ <> defaultHelp (_c ^. localHost) "local address" _localPort = intParam -@@ -235,9 +235,9 @@ _params :: O.Parser [(Text, Value)] _params = - [ tag "_remote" _remote + [ tag "_remoteHost" _remote , tag "_remotePort" _remotePort- , tag "_local" _local + , tag "_localHost" _local , tag "_localPort" _localPort , tag "_password" _password , tag "_method" _method
src/Network/MoeSocks/Runtime.hs view
@@ -38,19 +38,19 @@ _remote_TCP_Relay = RemoteRelay Remote_TCP_Relay- (_c ^. remoteAddress)+ (_c ^. remoteHost) (_c ^. remotePort) _remote_UDP_Relay = RemoteRelay Remote_UDP_Relay- (_c ^. remoteAddress)+ (_c ^. remoteHost) (_c ^. remotePort) _localService :: LocalServiceType -> LocalService _localService = LocalService - (_c ^. localAddress)- (_c ^. remoteAddress)+ (_c ^. localHost)+ (_c ^. remoteHost) (_c ^. remotePort) _localService_TCP_Forwards =
src/Network/MoeSocks/TCP.hs view
@@ -57,7 +57,7 @@ let _clientRequest = ClientRequest TCP_IP_StreamConnection (DomainName - aForwarding ^. - forwardTargetAddress)+ forwardTargetHost) (aForwarding ^. forwardTargetPort) local_TCP_RequestHandler aEnv@@ -85,12 +85,12 @@ _flushBound = _c ^. obfuscationFlushBound _initSocket = - getSocket (_c ^. remoteAddress) (_c ^. remotePort) Stream + getSocket (_c ^. remoteHost) (_c ^. remotePort) Stream debug_ - "L: " <> show _clientRequest logSA "L remote socket" _initSocket - - \(_remoteSocket, _remoteAddress) -> do+ \(_remoteSocket, _remoteHost) -> do setSocketConfig _c _remoteSocket _remoteSocketName <- getSocketName _remoteSocket@@ -132,9 +132,9 @@ if _c ^. fastOpen then- sendFast _remoteSocket _initBytes _remoteAddress+ sendFast _remoteSocket _initBytes _remoteHost else do- connect _remoteSocket _remoteAddress+ connect _remoteSocket _remoteHost send_ _remoteSocket _initBytes let sendThread = do@@ -217,8 +217,8 @@ aSocket logSA "R target socket" (initTarget _clientRequest) - \_r -> do- let (_targetSocket, _targetAddress) = _r - (_addr, _) = sockAddr_To_Pair _targetAddress+ let (_targetSocket, _targetHost) = _r + (_addr, _) = sockAddr_To_Pair _targetHost _forbidden_IPs = _options ^. forbidden_IPs debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs@@ -234,9 +234,9 @@ if _c ^. fastOpen then- sendFast _targetSocket _initBytes _targetAddress+ sendFast _targetSocket _initBytes _targetHost else do- connect _targetSocket _targetAddress+ connect _targetSocket _targetHost send_ _targetSocket _initBytes let
src/Network/MoeSocks/Type.hs view
@@ -16,6 +16,7 @@ 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 @@ -48,7 +49,7 @@ (concat . L.intersperse ".") showAddressType (DomainName x) = x ^. _Text- showAddressType (IPv6_Address xs) = xs ^.. each . to show+ showAddressType (IPv6_Address xs) = xs ^.. each . to (flip showHex "") ^.. folding (concat . L.intersperse ":") type Port = Int@@ -66,9 +67,9 @@ data Config = Config {- _remoteAddress :: Text+ _remoteHost :: Text , _remotePort :: Int- , _localAddress :: Text+ , _localHost :: Text , _localPort :: Int , _password :: Text , _method :: Text@@ -96,7 +97,7 @@ data Forward = Forward { _forwardLocalPort :: Port- , _forwardTargetAddress :: Text+ , _forwardTargetHost :: Text , _forwardTargetPort :: Port } deriving (Show, Eq)@@ -152,7 +153,7 @@ data LocalService = LocalService {- _localServiceAddress :: Text+ _localServiceHost :: Text , _localServiceRemoteAddress :: Text , _localServiceRemotePort :: Int , _localServiceType :: LocalServiceType@@ -172,7 +173,7 @@ data RemoteRelay = RemoteRelay { _remoteRelayType :: RemoteRelayType- , _remoteRelayAddress :: Text+ , _remoteRelayHost :: Text , _remoteRelayPort :: Int } deriving (Show, Eq)
src/Network/MoeSocks/UDP.hs view
@@ -22,7 +22,7 @@ buildShadowSocksRequest :: ClientRequest -> ByteString -> ByteString buildShadowSocksRequest aClientRequest aMessage = let _header = shadowSocksRequestBuilder aClientRequest- in + in builder_To_ByteString _header <> aMessage parseShadowSocksRequest :: ByteString -> IO (ByteString, ClientRequest)@@ -34,17 +34,17 @@ processAll :: Cipher -> ByteString -> IO ByteString-processAll f x = +processAll f x = (<>) <$> f (S.Just x) <*> f S.Nothing local_UDP_ForwardRequestHandler :: Env- -> Forward - -> ByteString - -> (Socket,SockAddr) + -> Forward+ -> ByteString+ -> (Socket,SockAddr) -> IO ()-local_UDP_ForwardRequestHandler aEnv +local_UDP_ForwardRequestHandler aEnv aForwarding- aMessage + aMessage (aSocket, aSockAddr) = do let _c = aEnv ^. config@@ -52,25 +52,25 @@ let _clientRequest = ClientRequest UDP_Port- (DomainName - aForwarding ^. - forwardTargetAddress)+ (DomainName - aForwarding ^.+ forwardTargetHost) (aForwarding ^. forwardTargetPort)- + {-debug_ - "L UDP: " <> show _clientRequest-} let _addr = _clientRequest ^. addressType _forbidden_IPs = aEnv ^. options . forbidden_IPs debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs- + withCheckedForbidden_IP_List _addr _forbidden_IPs - do- _sa <- getSocket (_c ^. remoteAddress) (_c ^. remotePort) Datagram+ _sa <- getSocket (_c ^. remoteHost) (_c ^. remotePort) Datagram - logSA "L UDP -->:" (pure _sa) - + logSA "L UDP -->:" (pure _sa) - \(_remoteSocket, _remoteAddr) -> do connect _remoteSocket _remoteAddr - _encodeIV <- _cipherBox ^. generate_IV + _encodeIV <- _cipherBox ^. generate_IV _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV @@ -82,17 +82,17 @@ let _msg = showRelay aSockAddr _clientRequest info_ - "LU: " <> _msg- + _eMsg <- _encrypt (S.Just _bytes) send_ _remoteSocket - _encodeIV <> _eMsg - _response <- recv_ _remoteSocket + _response <- recv_ _remoteSocket - let (_decodeIV, _responseMsg) = S.splitAt (_cipherBox ^. ivLength) + let (_decodeIV, _responseMsg) = S.splitAt (_cipherBox ^. ivLength) _response _decrypt <- _cipherBox ^. decryptBuilder - _decodeIV- + (_r, _) <- processAll _decrypt _responseMsg >>= parseShadowSocksRequest @@ -101,30 +101,30 @@ remote_UDP_RequestHandler :: Env- -> ByteString - -> (Socket, SockAddr) + -> ByteString+ -> (Socket, SockAddr) -> IO ()-remote_UDP_RequestHandler aEnv - aMessage +remote_UDP_RequestHandler aEnv+ aMessage (aSocket, aSockAddr) = do let _cipherBox = aEnv ^. cipherBox _options = aEnv ^. options - let (_decodeIV, _eMsg) = S.splitAt (_cipherBox ^. ivLength) - aMessage + let (_decodeIV, _eMsg) = S.splitAt (_cipherBox ^. ivLength)+ aMessage _decrypt <- _cipherBox ^. decryptBuilder - _decodeIV _msg <- processAll _decrypt _eMsg (_decryptedMessage, _clientRequest) <- parseShadowSocksRequest _msg- + {-debug_ - "R UDP: " <> show _clientRequest-} {-debug_ - "R UDP: " <> show _decryptedMessage-}- + logSA "R UDP -->:" (initTarget _clientRequest) - \_r -> do {-debug_ - "R UDP targetSocket: " <> show _r-}- - let (_targetSocket, _targetSocketAddress) = _r ++ let (_targetSocket, _targetSocketAddress) = _r (_addr, _) = sockAddr_To_Pair _targetSocketAddress _forbidden_IPs = _options ^. forbidden_IPs @@ -134,7 +134,7 @@ info_ - "RU: " <> _msg connect _targetSocket _targetSocketAddress- + send_ _targetSocket _decryptedMessage _r <- buildShadowSocksRequest _clientRequest <$> recv_ _targetSocket@@ -142,8 +142,8 @@ {-debug_ - "R UDP <--: " <> show _r-} when (_r & isn't _Empty) - do- _encodeIV <- _cipherBox ^. generate_IV + _encodeIV <- _cipherBox ^. generate_IV _encrypt <- _cipherBox ^. encryptBuilder - _encodeIV- + _encryptedMessage <- processAll _encrypt _r sendAllTo aSocket (_encodeIV <> _encryptedMessage) aSockAddr