diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 ------- diff --git a/config.json b/config.json --- a/config.json +++ b/config.json @@ -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, 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.10 +version: 0.1.2.20 license: Apache-2.0 synopsis: A functional firewall killer description: A SOCKS5 proxy using the client / server architecture. 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 @@ -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 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 @@ -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 diff --git a/src/Network/MoeSocks/Config.hs b/src/Network/MoeSocks/Config.hs --- a/src/Network/MoeSocks/Config.hs +++ b/src/Network/MoeSocks/Config.hs @@ -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" 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 @@ -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 diff --git a/src/Network/MoeSocks/Internal/Socket.hs b/src/Network/MoeSocks/Internal/Socket.hs --- a/src/Network/MoeSocks/Internal/Socket.hs +++ b/src/Network/MoeSocks/Internal/Socket.hs @@ -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) + + diff --git a/src/Network/MoeSocks/Modules/Resource.hs b/src/Network/MoeSocks/Modules/Resource.hs --- a/src/Network/MoeSocks/Modules/Resource.hs +++ b/src/Network/MoeSocks/Modules/Resource.hs @@ -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 diff --git a/src/Network/MoeSocks/Options.hs b/src/Network/MoeSocks/Options.hs --- a/src/Network/MoeSocks/Options.hs +++ b/src/Network/MoeSocks/Options.hs @@ -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 diff --git a/src/Network/MoeSocks/Runtime.hs b/src/Network/MoeSocks/Runtime.hs --- a/src/Network/MoeSocks/Runtime.hs +++ b/src/Network/MoeSocks/Runtime.hs @@ -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 = 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 @@ -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 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 @@ -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) 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 @@ -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