diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,7 @@ +0.1.1.32 +-------- +* Add a runtime type + 0.1.1.31 -------- * Fix hardcoded encryption method @@ -32,7 +36,7 @@ 0.1.0.25 -------- * Add `forbidden-ip` option, which defaults to `127.0.0.1`, to prevent misuse - of remote. This is again a feature ported from shadowsocks. + of remote. This is again a feature ported from ss. 0.1.0.24 -------- @@ -66,11 +70,11 @@ 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 ss for UDP port forwarding. 0.1.0.15 -------- diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,31 +1,14 @@ MoeSocks ======== -A socks5 proxy using the client / server architecture. +A SOCKS5 proxy using the client / server architecture. -MoeSocks is greatly inspired by [shadowsocks] and can be used in place of it. +MoeSocks is greatly inspired by [ss] and can be used in place of it. Installation ============ -* Need `GHC 7.10.2` and `cabal-install`. - - Installing [haskell-platform](https://www.haskell.org/platform/) should be - sufficient. (Linux users should pick the *Generic* distribution, since - it's the most up to date) - -* Repeat, you need `GHC 7.10.2` exactly, not `7.10.1` or anything else, since - remote only runs well in `7.10.2`. - -* Update packages - - cabal update - -* Install - - cabal install moesocks - -* Add `~/.cabal/bin` to your `$PATH`, if you haven't already. +* Need `GHC 7.10.2`. Usage ===== @@ -35,18 +18,18 @@ * Edit `config.json` to fit your setup (at least the `remote` and `password` fields) -* Start a remote node outside a firewall: - +* Start a remote node outside a firewall: + moesocks --role remote -c config.json -* Start a local node inside a firewall: - +* Start a local node inside a firewall: + moesocks --role local -c config.json -* Now you have a socks5 proxy running inside a firewall using port +* Now you have a SOCKS5 proxy running inside a firewall using port `localPort`. -* Shadowsocks compatible obfuscation can be turned on with the `-o` flag to make +* SS compatible obfuscation can be turned on with the `-o` flag to make statistical analysis on packet length a bit more confusing. * See more options: @@ -61,18 +44,18 @@ Features ======== -* Socks5 proxy service, obviously +* SOCKS5 proxy service, obviously * TCP port forwarding * UDP port forwarding, for example `-U 5300:8.8.8.8:53` * TCP per connection throttling (as a side effect of trying to find a bug in the remote) -* Socks5 service on local can be turned off -* Understand shadowsocks' configuration file +* SOCKS5 service on local can be turned off +* Understand ss' configuration file Drawbacks ========== -* UDP over Socks5 is not implemented +* UDP over SOCKS5 is not implemented * More then 2 times slower then the original Python implementation (measured at 20M/s vs 43M/s on an Intel P8800, using the AES-256-CFB method) @@ -86,7 +69,7 @@ the website to visit both support TFO, you can enjoy TFO all the way through. This could lead to a huge reduction of latency. -## Enable TFO in your OS runtime. +## Enable TFO in your OS runtime. On Linux 3.7+, to check the availability of TFO: @@ -112,12 +95,10 @@ Credits ======= -* [shadowsocks] greatly inspired MoeSocks. - Shadowsocks introduced a ground breaking design and implementation to bypass - Internet censorship in China. -* [shadowsocks-haskell] by rnons, another implementation of shadowsocks in - Haskell, also greatly inspired MoeSocks. Much of the understanding of - the internal of shadowsocks was gained by reading rnons's implementation. +* [ss] greatly inspired MoeSocks. +* [ss-haskell] another implementation of ss in Haskell, also greatly inspired + MoeSocks. Much of the understanding of the internal of ss was gained by + reading ss-haskell. License ======= @@ -136,9 +117,8 @@ See the License for the specific language governing permissions and limitations under the License. -[shadowsocks]:https://github.com/shadowsocks/shadowsocks -[shadowsocks-go]:https://github.com/shadowsocks/shadowsocks-go -[shadowsocks-haskell]:https://github.com/rnons/shadowsocks-haskell +[ss]:https://github.com/shadowsocks/shadowsocks +[ss-haskell]:https://github.com/rnons/shadowsocks-haskell [config.json]:https://raw.githubusercontent.com/nfjinjing/moesocks/master/config.json [#10590]:https://ghc.haskell.org/trac/ghc/ticket/10590 [TFO]:https://en.wikipedia.org/wiki/TCP_Fast_Open diff --git a/moesocks.cabal b/moesocks.cabal --- a/moesocks.cabal +++ b/moesocks.cabal @@ -1,9 +1,9 @@ name: moesocks category: Network -version: 0.1.1.31 +version: 0.1.1.32 license: Apache-2.0 synopsis: A functional firewall killer -description: A socks5 proxy using the client / server architecture. +description: A SOCKS5 proxy using the client / server architecture. homepage: https://github.com/nfjinjing/moesocks license-file: LICENSE author: Jinjing Wang @@ -23,7 +23,7 @@ executable moesocks main-is: Main.hs - ghc-options: -Wall -fno-warn-unused-do-bind -O2 + ghc-options: -Wall -fno-warn-unused-do-bind -O2 -threaded -- -rtsopts "-with-rtsopts=-N -c" build-depends: base > 4 && <= 5 @@ -37,7 +37,7 @@ , cryptohash , hslogger , iproute - , lens + , lens , lens-aeson , mtl , network @@ -53,7 +53,7 @@ hs-source-dirs: src default-language: Haskell2010 - other-modules: + other-modules: Network.MoeSocks.App Network.MoeSocks.BuilderAndParser Network.MoeSocks.Common @@ -66,4 +66,3 @@ Network.MoeSocks.TCP Network.MoeSocks.Type Network.MoeSocks.UDP - diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -3,7 +3,6 @@ import Control.Monad.Except import Control.Monad.Reader hiding (local) import Network.MoeSocks.App -import Network.MoeSocks.Encrypt import Network.MoeSocks.Helper import Network.MoeSocks.Options import Options.Applicative hiding (Parser) @@ -11,7 +10,7 @@ import System.Exit main :: IO () -main = ssl - do +main = do _options <- execParser opts withGateOptions _options - do 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 @@ -4,6 +4,7 @@ module Network.MoeSocks.App where import Control.Concurrent +import Control.Concurrent.Async hiding (waitBoth) import Control.Lens import Control.Monad import Control.Monad.Except @@ -36,7 +37,7 @@ import qualified System.Log.Handler as LogHandler -withGateOptions :: MoeOptions -> IO a -> IO () +withGateOptions :: Options -> IO a -> IO () withGateOptions aOption aIO = do if aOption ^. listMethods then do @@ -53,7 +54,7 @@ else () <$ aIO -parseConfig :: MoeOptions -> MoeMonadT MoeConfig +parseConfig :: Options -> MoeMonadT Config parseConfig aOption = do let _maybeFilePath = aOption ^. configFile @@ -71,9 +72,9 @@ fromShadowSocksConfig x = let fixes = Map.fromList [ - ("server", "remote") + ("server", "remoteAddress") , ("server_port", "remotePort") - , ("local_address", "local") + , ("local_address", "localAddress") ] in @@ -82,14 +83,14 @@ toParsableConfig :: Value -> Value toParsableConfig = asList - each . _1 %~ ( T.cons '_' - . toCamelCase + . toHaskellNamingConvention . fromShadowSocksConfig ) toReadableConfig :: Value -> Value toReadableConfig = asList - each . _1 %~ T.tail - showConfig :: MoeConfig -> Text + showConfig :: Config -> Text showConfig = review _JSON . toReadableConfig . review _JSON @@ -111,7 +112,7 @@ fallbackConfig :: Value -> Value -> Value fallbackConfig = flip insertConfig - optionalConfig = filterEssentialConfig - toJSON defaultMoeConfig + optionalConfig = filterEssentialConfig - toJSON defaultConfig _maybeConfig = _v >>= decode @@ -131,7 +132,7 @@ tell _filePath tell "\n" tell "Example: \n" - tell - showConfig defaultMoeConfig <> "\n" + tell - showConfig defaultConfig <> "\n" Nothing -> do tell "The password argument '-k' is required.\n" tell "Alternatively, use '-c' to provide a " @@ -158,7 +159,7 @@ updateGlobalLogger "moe" - addHandler formattedHandler updateGlobalLogger "moe" - setLevel aLevel -data AppType = TCP_App | UDP_App +data RelayType = TCP_Relay | UDP_Relay deriving (Show, Eq) moeApp:: MoeMonadT () @@ -180,19 +181,20 @@ let _env = Env _options _config _cipherBox - let localAppBuilder :: AppType + + let localRelay :: RelayType -> String -> (ByteString -> (Socket, SockAddr) -> IO ()) -> (Socket, SockAddr) -> IO () - localAppBuilder aAppType aID aHandler s = + localRelay aRelayType aID aHandler s = logSA "L loop" (pure s) - \(_localSocket, _localAddr) -> do setSocketOption _localSocket ReuseAddr 1 bindSocket _localSocket _localAddr - case aAppType of - TCP_App -> do + case aRelayType of + TCP_Relay -> do info_ - "LT: " <> aID <> " nyaa!" setSocket_TCP_FAST_OPEN _localSocket @@ -209,7 +211,7 @@ forever - handleLocal _localSocket - UDP_App -> do + UDP_Relay -> do info_ - "LU: " <> aID <> " nyaa!" let handleLocal = do (_msg, _sockAddr) <- @@ -228,10 +230,10 @@ showWrapped :: (Show a) => a -> String showWrapped x = "[" <> show x <> "]" - let localSocks5App :: (Socket, SockAddr) -> IO () - localSocks5App _s = localAppBuilder TCP_App - ("Socks5 proxy " <> showWrapped (_s ^. _2)) - (local_Socks5_RequestHandler _env) - _s + let local_SOCKS5 :: (Socket, SockAddr) -> IO () + local_SOCKS5 _s = localRelay TCP_Relay + ("SOCKS5 proxy " <> showWrapped (_s ^. _2)) + (local_SOCKS5_RequestHandler _env) - _s showForwarding :: Forward -> String showForwarding (Forward _localPort _remoteHost _remotePort) = @@ -244,22 +246,22 @@ <> "]" - forward_TCP_App :: Forward -> (Socket, SockAddr) -> IO () - forward_TCP_App _f _s = do + localForward_TCP :: Forward -> (Socket, SockAddr) -> IO () + localForward_TCP _f _s = do let _m = showForwarding _f - localAppBuilder TCP_App ("TCP port forwarding " <> _m) + localRelay TCP_Relay ("TCP port forwarding " <> _m) (local_TCP_ForwardRequestHandler _env _f) _s - forward_UDP_App :: Forward -> (Socket, SockAddr) -> IO () - forward_UDP_App _f _s = do + localForward_UDP :: Forward -> (Socket, SockAddr) -> IO () + localForward_UDP _f _s = do let _m = showForwarding _f - localAppBuilder UDP_App ("UDP port forwarding " <> _m) + localRelay UDP_Relay ("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) - + 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!" @@ -281,8 +283,8 @@ forever - handleRemote _remoteSocket - let remote_UDP_App :: (Socket, SockAddr) -> IO () - remote_UDP_App s = logSA "R loop" (pure s) - + 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!" @@ -302,66 +304,97 @@ forever handleRemote + let runRemoteRelay :: RemoteRelay -> IO RemoteRelay + runRemoteRelay _remoteRelay = do + let _address = _remoteRelay ^. remoteRelayAddress + _port = _remoteRelay ^. remoteRelayPort + + _relay_ID <- fmap Relay_ID - async - foreverRun - do + case _remoteRelay ^. remoteRelayType of + Remote_TCP_Relay -> catchExceptAsyncLog "R TCP Relay" - do + getSocket _address _port Stream + >>= remote_TCP_Relay + Remote_UDP_Relay -> catchExceptAsyncLog "R UDP Relay" - do + getSocket _address _port Datagram + >>= remote_UDP_Relay + + pure - _remoteRelay & relay_ID ?~ _relay_ID + let - remoteRun :: IO () - remoteRun = do - let __TCP_App = foreverRun - catchExceptAsyncLog "R TCP app" - do - getSocket (_c ^. remote) (_c ^. remotePort) Stream - >>= remote_TCP_App + runRemote :: IO () + runRemote = do + let config_To_Runtime :: Config -> Runtime -> Runtime + config_To_Runtime _config _runtime = + let _remote_TCP_Relay = + RemoteRelay + Remote_TCP_Relay + (_config ^. remoteAddress) + (_config ^. remotePort) + Nothing - let __UDP_App = foreverRun - catchExceptAsyncLog "R UDP app" - do - getSocket (_c ^. remote) (_c ^. remotePort) Datagram - >>= remote_UDP_App + _remote_UDP_Relay = + RemoteRelay + Remote_UDP_Relay + (_config ^. remoteAddress) + (_config ^. remotePort) + Nothing + in + _runtime & remoteRelays .~ [_remote_TCP_Relay, _remote_UDP_Relay] + + relays <- mapM runRemoteRelay - + config_To_Runtime _c mempty ^. remoteRelays - waitBoth __TCP_App __UDP_App + waitAnyCancel - relays ^.. each . relay_ID . _Just . unRelay_ID + pure () + - localRun :: IO () - localRun = do - let _forward_TCP_Apps = do - forM_ (_options ^. forward_TCP) - \forwarding -> forkIO - do - foreverRun - catchExceptAsyncLog "L TCPForwarding app" - do - getSocket (_c ^. local) + runLocal :: IO () + runLocal = do + let _localForward_TCPs = do + forM_ (_options ^. forward_TCPs) - \forwarding -> forkIO - do + foreverRun - catchExceptAsyncLog "L TCP_Forwarding" - do + getSocket (_c ^. localAddress) (forwarding ^. forwardLocalPort) Stream - >>= forward_TCP_App forwarding + >>= localForward_TCP forwarding - let _forward_UDP_Apps = do - forM_ (_options ^. forward_UDP) - \forwarding -> forkIO - do - foreverRun - catchExceptAsyncLog "L UDPForwarding app" - do - getSocket (_c ^. local) + let _localForward_UDPs = do + forM_ (_options ^. forward_UDPs) - \forwarding -> forkIO - do + foreverRun - catchExceptAsyncLog "L UDP_Forwarding" - do + getSocket (_c ^. localAddress) (forwarding ^. forwardLocalPort) Datagram - >>= forward_UDP_App forwarding + >>= localForward_UDP forwarding - let _socks5App = foreverRun - catchExceptAsyncLog "L socks5 app" - do - getSocket (_c ^. local) (_c ^. localPort) Stream - >>= localSocks5App + let _local_SOCKS5 = foreverRun - catchExceptAsyncLog "L SOCKS5" - do + getSocket (_c ^. localAddress) (_c ^. localPort) Stream + >>= local_SOCKS5 - _forward_TCP_Apps - _forward_UDP_Apps - if (_options ^. disableSocks5) + _localForward_TCPs + _localForward_UDPs + if (_options ^. disable_SOCKS5) then - if (_options ^. forward_TCP & isn't _Empty) - || (_options ^. forward_UDP & isn't _Empty) + if (_options ^. forward_TCPs & isn't _Empty) + || (_options ^. forward_UDPs & isn't _Empty) then forever - sleep 1000 else error_ "Nothing to run!" - else _socks5App + else _local_SOCKS5 - debugRun :: IO () - debugRun = do - catchExceptAsyncLog "Debug app" - do + runDebug :: IO () + runDebug = do + catchExceptAsyncLog "runDebug" - do waitBothDebug - (Just "localRun", localRun) - (Just "remoteRun", remoteRun) + (Just "runLocal", runLocal) + (Just "runRemote", runRemote) io - case _options ^. runningMode of - DebugMode -> debugRun - RemoteMode -> remoteRun - LocalMode -> localRun + DebugMode -> runDebug + RemoteMode -> runRemote + LocalMode -> runLocal diff --git a/src/Network/MoeSocks/BuilderAndParser.hs b/src/Network/MoeSocks/BuilderAndParser.hs --- a/src/Network/MoeSocks/BuilderAndParser.hs +++ b/src/Network/MoeSocks/BuilderAndParser.hs @@ -44,7 +44,7 @@ :: (Word8, Word8, Word8, Word8) in - ( IPv4_address - flip4 _r + ( IPv4_Address - flip4 _r , fromIntegral _port ) @@ -56,7 +56,7 @@ , Word16, Word16, Word16, Word16) in - ( IPv6_address - _r ^.. each + ( IPv6_Address - _r ^.. each , fromIntegral _port ) @@ -68,7 +68,7 @@ & reverse in - ( Domain_name - (_host & review _Text) + ( DomainName - (_host & review _Text) , fromMaybe 0 - _port ^? _Show ) @@ -97,24 +97,24 @@ addressTypeBuilder :: AddressType -> B.Builder addressTypeBuilder aAddressType = case aAddressType of - IPv4_address _address -> + IPv4_Address _address -> B.word8 1 <> foldMapOf each B.word8 _address - Domain_name x -> + DomainName x -> B.word8 3 <> B.word8 (fromIntegral (S.length (review utf8 x))) <> B.byteString (review utf8 x) - IPv6_address _address -> + IPv6_Address _address -> B.word8 4 <> foldMapOf each B.word16BE _address connectionType_To_Word8 :: ConnectionType -> Word8 -connectionType_To_Word8 TCP_IP_stream_connection = 1 -connectionType_To_Word8 TCP_IP_port_binding = 2 -connectionType_To_Word8 UDP_port = 3 +connectionType_To_Word8 TCP_IP_StreamConnection = 1 +connectionType_To_Word8 TCP_IP_PortBinding = 2 +connectionType_To_Word8 UDP_Port = 3 @@ -160,9 +160,9 @@ requestParser = do __connectionType <- choice [ - TCP_IP_stream_connection <$ word8 1 - , TCP_IP_port_binding <$ word8 2 - , UDP_port <$ word8 3 + TCP_IP_StreamConnection <$ word8 1 + , TCP_IP_PortBinding <$ word8 2 + , UDP_Port <$ word8 3 ] word8 _ReservedByte @@ -189,7 +189,7 @@ addressTypeParser :: Parser AddressType addressTypeParser = choice [ - IPv4_address <$> do + IPv4_Address <$> do word8 1 _a <- anyWord8 _b <- anyWord8 @@ -197,12 +197,12 @@ _d <- anyWord8 pure - (_a, _b, _c, _d) - , Domain_name <$> do + , DomainName <$> do word8 3 _nameLength <- anyWord8 view utf8 <$> (take - fromIntegral _nameLength) - , IPv6_address <$> do + , IPv6_Address <$> do word8 4 _r <- count 8 anyWord16 {-pure - trace ("parsed IPv6: " <> show _r) _r-} 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 @@ -16,12 +16,12 @@ import qualified Data.List as L showAddressType :: AddressType -> Text -showAddressType (IPv4_address xs) = xs ^.. each . to show +showAddressType (IPv4_Address xs) = xs ^.. each . to show ^.. folding (concat . L.intersperse ".") ^. from _Text -showAddressType (Domain_name x) = x -showAddressType (IPv6_address xs) = xs ^.. each . to show +showAddressType (DomainName x) = x +showAddressType (IPv6_Address xs) = xs ^.. each . to show ^.. folding (concat . L.intersperse ":") ^. from _Text @@ -29,17 +29,17 @@ makePrisms ''IPRange checkForbidden_IP_List :: AddressType -> [IPRange] -> Bool -checkForbidden_IP_List _address@(IPv4_address _) aForbidden_IP_List = +checkForbidden_IP_List _address@(IPv4_Address _) aForbidden_IP_List = isJust - do _ip <- showAddressType _address ^. _Text ^? _Show findOf (each . _IPv4Range) (isMatchedTo _ip) aForbidden_IP_List -checkForbidden_IP_List _address@(IPv6_address _) aForbidden_IP_List = +checkForbidden_IP_List _address@(IPv6_Address _) aForbidden_IP_List = isJust - do _ip <- showAddressType _address ^. _Text ^? _Show - findOf (each . _IPv6Range) (isMatchedTo _ip) - aForbidden_IP_List + findOf (each . _IPv6Range) (isMatchedTo _ip) aForbidden_IP_List checkForbidden_IP_List _ _ = False @@ -52,9 +52,9 @@ showConnectionType :: ConnectionType -> String -showConnectionType TCP_IP_stream_connection = "TCP_Stream" -showConnectionType TCP_IP_port_binding = "TCP_Bind " -showConnectionType UDP_port = "UDP " +showConnectionType TCP_IP_StreamConnection = "TCP_Stream" +showConnectionType TCP_IP_PortBinding = "TCP_Bind " +showConnectionType UDP_Port = "UDP " showRequest :: ClientRequest -> String showRequest _r = @@ -67,14 +67,14 @@ 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 (IPv4_Address _) = Just AF_INET +addressType_To_Family (IPv6_Address _) = Just AF_INET6 addressType_To_Family _ = Nothing connectionType_To_SocketType :: ConnectionType -> SocketType -connectionType_To_SocketType TCP_IP_stream_connection = Stream -connectionType_To_SocketType TCP_IP_port_binding = NoSocketType -connectionType_To_SocketType UDP_port = Datagram +connectionType_To_SocketType TCP_IP_StreamConnection = Stream +connectionType_To_SocketType TCP_IP_PortBinding = NoSocketType +connectionType_To_SocketType UDP_Port = Datagram initTarget :: ClientRequest -> IO (Socket, SockAddr) initTarget _clientRequest = do 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 @@ -5,12 +5,12 @@ import Network.MoeSocks.Type import System.Log.Logger -defaultMoeConfig :: MoeConfig -defaultMoeConfig = MoeConfig +defaultConfig :: Config +defaultConfig = Config { - _remote= "0.0.0.0" + _remoteAddress = "0.0.0.0" , _remotePort = 8388 - , _local = "127.0.0.1" + , _localAddress = "127.0.0.1" , _localPort = 1080 , _password = "moesocks" , _method = "aes-256-cfb" @@ -23,17 +23,17 @@ } -defaultMoeOptions :: MoeOptions -defaultMoeOptions = MoeOptions +defaultOptions :: Options +defaultOptions = Options { _runningMode = DebugMode , _configFile = Nothing , _verbosity = DEBUG - , _forward_TCP = [] - , _forward_UDP = [] - , _disableSocks5 = False + , _forward_TCPs = [] + , _forward_UDPs = [] + , _disable_SOCKS5 = False , _obfuscation = False - , _forbidden_IP = ["127.0.0.1", "0.0.0.0", "::1"] + , _forbidden_IPs = ["127.0.0.1", "0.0.0.0", "::1"] , _listMethods = False , _params = [] } diff --git a/src/Network/MoeSocks/Encrypt.hs b/src/Network/MoeSocks/Encrypt.hs --- a/src/Network/MoeSocks/Encrypt.hs +++ b/src/Network/MoeSocks/Encrypt.hs @@ -54,11 +54,11 @@ type CipherBox = (IV_Length, IO IV, EncryptBuilder, DecryptBuilder) -type MaybeT_IO = ExceptT () IO +type ExceptT_IO = ExceptT () IO -type Method = Map Text KeyLength +type Methods = Map Text KeyLength -safeMethods :: Method +safeMethods :: Methods safeMethods = fromList - [ ("aes-128-cfb" , 16) @@ -94,19 +94,19 @@ , ("camellia-256-cfb1" , 32) , ("cast5-cfb" , 16) , ("des-cfb" , 8 ) - {-, ("idea-cfb" , 16)-} + {-, ("idea-cfb" , 16)-} -- not supported in OpenSSL? , ("seed-cfb" , 16) ] -unsafeMethods :: Method +unsafeMethods :: Methods unsafeMethods = fromList - [ ("rc2-cfb" , 16) -- unsafe , ("rc4" , 16) -- unsafe ] -methods :: Method +methods :: Methods methods = safeMethods <> unsafeMethods hashKey :: ByteString -> KeyLength -> IV_Length -> ByteString @@ -126,15 +126,11 @@ ssl :: IO a -> IO a ssl = withOpenSSL -eitherToMaybe :: Either a b -> Maybe b -eitherToMaybe (Left _) = Nothing -eitherToMaybe (Right x) = Just x - -getMaybe :: Maybe a -> MaybeT_IO a +getMaybe :: Maybe a -> ExceptT_IO a getMaybe Nothing = throwError () getMaybe (Just x) = pure x -mio :: IO (Maybe a) -> MaybeT_IO a +mio :: IO (Maybe a) -> ExceptT_IO a mio = (>>= getMaybe) . liftIO identityCipher :: Cipher @@ -147,9 +143,9 @@ pure - Just (0, pure mempty, constCipher, constCipher) | otherwise = ssl - - fmap eitherToMaybe - runExceptT - initCipherBox' aMethod aPassword + fmap (preview _Right) - runExceptT - initCipherBox' aMethod aPassword -initCipherBox' :: Text -> Text -> MaybeT_IO CipherBox +initCipherBox' :: Text -> Text -> ExceptT_IO CipherBox initCipherBox' aMethod aPassword = do _method <- mio - getCipherByName - aMethod ^. _Text let _IV_Length = cipherIvLength _method 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 @@ -17,14 +17,12 @@ import Data.Maybe import Data.Monoid import Data.Text (Text) -import qualified Data.Text as T import Data.Text.Lens import Data.Time.Clock import Network.MoeSocks.Internal.Socket (sendAllToFastOpen) import Network.Socket hiding (send, recv) import Network.Socket.ByteString import Prelude hiding (take, (-)) -import System.IO.Unsafe (unsafePerformIO) import System.Log.Logger import System.Posix.IO (FdOption(CloseOnExec), setFdOption) import System.Random @@ -33,6 +31,7 @@ import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as LB import qualified Data.Strict as S +import qualified Data.Text as T -- BEGIN backports @@ -58,29 +57,29 @@ boolToMaybe True = Just () boolToMaybe False = Nothing -syncLock :: MVar () -syncLock = unsafePerformIO - newEmptyMVar +{-syncLock :: MVar ()-} +{-syncLock = unsafePerformIO - newEmptyMVar-} -sync :: IO a -> IO a -sync aIO = do - {-putMVar syncLock ()-} - {-aIO <* takeMVar syncLock-} - aIO +{-sync :: IO a -> IO a-} +{-sync aIO = do-} + {-[>putMVar syncLock ()<]-} + {-[>aIO <* takeMVar syncLock<]-} + {-aIO-} debug_ :: String -> IO () -debug_ = sync . debugM "moe" +debug_ = debugM "moe" error_ :: String -> IO () -error_ = sync . errorM "moe" +error_ = errorM "moe" warning_ :: String -> IO () -warning_ = sync . warningM "moe" +warning_ = warningM "moe" info_ :: String -> IO () -info_ = sync . infoM "moe" +info_ = infoM "moe" notice_ :: String -> IO () -notice_ = sync . noticeM "moe" +notice_ = noticeM "moe" error_T :: Text -> IO () error_T = error_ . view _Text @@ -245,22 +244,15 @@ portPairToWord16 :: (Word8, Word8) -> Word16 portPairToWord16 = decode . runPut . put -duplicateKey :: (Eq a) => (a, a) -> [(a, b)] -> [(a, b)] -duplicateKey (_from, _to) l = - case lookup _from l of - Nothing -> l - Just v -> (_to,v) : l - recv_ :: Socket -> IO ByteString recv_ = flip recv 4096 send_ :: Socket -> ByteString -> IO () send_ = sendAll - -sendFast_ :: Socket -> ByteString -> SockAddr -> IO () -sendFast_ = sendAllToFastOpen +sendFast :: Socket -> ByteString -> SockAddr -> IO () +sendFast = sendAllToFastOpen sendAllRandom :: Int -> Socket -> ByteString -> IO () @@ -457,8 +449,8 @@ tryIO :: String -> IO a -> IO (Either IOException a) tryIO _ = try -- . logException aID -toCamelCase :: Text -> Text -toCamelCase x = x - & T.split (`elem` ['_', '-']) - & over (_tail . traversed) T.toTitle - & T.concat +toHaskellNamingConvention :: Text -> Text +toHaskellNamingConvention x = x + & T.split (`elem` ['_', '-']) + & over (_tail . traversed) T.toTitle + & T.concat 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 @@ -38,9 +38,9 @@ boolParam :: O.Mod O.FlagFields Bool -> O.Parser (Maybe Value) boolParam = (fmap . fmap) toJSON . fmap bool_To_Maybe . switch -optionParser :: O.Parser MoeOptions +optionParser :: O.Parser Options optionParser = - let _c = defaultMoeConfig + let _c = defaultConfig _mode = ( textOption - short 'r' <> long "role" @@ -56,10 +56,10 @@ | x == "debug" = DebugMode | otherwise = DebugMode - _disableSocks5 :: O.Parser Bool - _disableSocks5 = switch - + _disable_SOCKS5 :: O.Parser Bool + _disable_SOCKS5 = switch - long "disable-socks5" - <> help ("Do not start a socks5 server on local. It can be " + <> help ("Do not start a SOCKS5 server on local. It can be " <> "useful to run moesocks only as a secure tunnel") _listMethods :: O.Parser Bool @@ -86,7 +86,7 @@ _remote = textParam - short 's' <> metavar "REMOTE" - <> defaultHelp (_c ^. remote) + <> defaultHelp (_c ^. remoteAddress) "remote address" _remotePort = intParam - @@ -100,7 +100,7 @@ _local = textParam - short 'b' <> metavar "LOCAL" - <> defaultHelp (_c ^. local) + <> defaultHelp (_c ^. localAddress) "local address" _localPort = intParam - @@ -207,11 +207,11 @@ & parseOnly forwardListParser & toListOf (traverse . traverse) - _forbidden_IP :: O.Parser (Maybe Text) - _forbidden_IP = optional - textOption - + _forbidden_IPs :: O.Parser (Maybe Text) + _forbidden_IPs = optional - textOption - long "forbidden-ip" <> metavar "IPLIST" - <> defaultHelp (defaultMoeOptions ^. forbidden_IP + <> defaultHelp (defaultOptions ^. forbidden_IPs & map show & map (view - from _Text) & T.intercalate ", ") @@ -221,7 +221,7 @@ ) parseForbidden_IP :: Maybe Text -> [IPRange] - parseForbidden_IP = maybe (defaultMoeOptions ^. forbidden_IP) - + parseForbidden_IP = maybe (defaultOptions ^. forbidden_IPs) - (toListOf - each . to T.strip . _Text @@ -251,21 +251,21 @@ in - MoeOptions + Options <$> fmap parseMode _mode <*> _config <*> _verbosity <*> fmap parseForwarding _forwardTCP <*> fmap parseForwarding _forwardUDP - <*> _disableSocks5 + <*> _disable_SOCKS5 <*> _obfuscation - <*> fmap parseForbidden_IP _forbidden_IP + <*> fmap parseForbidden_IP _forbidden_IPs <*> _listMethods <*> _params -opts :: ParserInfo MoeOptions +opts :: ParserInfo Options opts = info (helper <*> optionParser) - fullDesc - <> progDesc "A socks5 proxy using the client / server architecture" + <> progDesc "A SOCKS5 proxy using the client / server architecture" <> header "A functional firewall killer" 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 @@ -20,11 +20,11 @@ import qualified Data.ByteString as S import qualified Data.Strict as S -local_Socks5_RequestHandler :: Env +local_SOCKS5_RequestHandler :: Env -> ByteString -> (Socket, SockAddr) -> IO () -local_Socks5_RequestHandler aEnv _ (aSocket,_) = do +local_SOCKS5_RequestHandler aEnv _ (aSocket,_) = do (_partialBytesAfterGreeting, _r) <- parseSocket "clientGreeting" mempty identityCipher greetingParser aSocket @@ -53,8 +53,8 @@ -> IO () local_TCP_ForwardRequestHandler aEnv aForwarding _ (aSocket,_) = do let _clientRequest = ClientRequest - TCP_IP_stream_connection - (Domain_name - aForwarding ^. + TCP_IP_StreamConnection + (DomainName - aForwarding ^. forwardRemoteHost) (aForwarding ^. forwardRemotePort) @@ -72,10 +72,10 @@ (_partialBytesAfterClientRequest, _clientRequest) shouldReplyClient aSocket = do let _addr = _clientRequest ^. addressType - _forbidden_IP = aEnv ^. options . forbidden_IP + _forbidden_IPs = aEnv ^. options . forbidden_IPs - debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IP - withCheckedForbidden_IP_List _addr _forbidden_IP - do + debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs + withCheckedForbidden_IP_List _addr _forbidden_IPs - do let _c = aEnv ^. config _cipherBox = aEnv ^. cipherBox @@ -83,7 +83,7 @@ _flushBound = _c ^. obfuscationFlushBound _initSocket = - getSocket (_c ^. remote) (_c ^. remotePort) Stream + getSocket (_c ^. remoteAddress) (_c ^. remotePort) Stream debug_ - "L: " <> show _clientRequest @@ -130,7 +130,7 @@ if _c ^. fastOpen then - sendFast_ _remoteSocket _initBytes _remoteAddress + sendFast _remoteSocket _initBytes _remoteAddress else do connect _remoteSocket _remoteAddress send_ _remoteSocket _initBytes @@ -211,16 +211,16 @@ mempty _decrypt (shadowSocksRequestParser - TCP_IP_stream_connection) + TCP_IP_StreamConnection) aSocket logSA "R target socket" (initTarget _clientRequest) - \_r -> do let (_targetSocket, _targetAddress) = _r (_addr, _) = sockAddr_To_Pair _targetAddress - _forbidden_IP = _options ^. forbidden_IP + _forbidden_IPs = _options ^. forbidden_IPs - debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IP - withCheckedForbidden_IP_List _addr _forbidden_IP - do + debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs + withCheckedForbidden_IP_List _addr _forbidden_IPs - do setSocketSendFast _targetSocket _remotePeerAddr <- getPeerName aSocket @@ -232,7 +232,7 @@ if _c ^. fastOpen then - sendFast_ _targetSocket _initBytes _targetAddress + sendFast _targetSocket _initBytes _targetAddress else do connect _targetSocket _targetAddress send_ _targetSocket _initBytes 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 @@ -6,11 +6,13 @@ import Control.Lens import Control.Monad.Except import Control.Monad.Reader +import Control.Concurrent.Async import Data.Aeson import Data.ByteString (ByteString) import Data.Text (Text) import Data.IP import Data.Word +import Data.Monoid import GHC.Generics import System.Log.Logger import qualified Data.Strict as S @@ -24,15 +26,15 @@ makeLenses ''ClientGreeting data ConnectionType = - TCP_IP_stream_connection - | TCP_IP_port_binding - | UDP_port + TCP_IP_StreamConnection + | TCP_IP_PortBinding + | UDP_Port deriving (Show, Eq) data AddressType = - IPv4_address (Word8, Word8, Word8, Word8) - | Domain_name Text - | IPv6_address [Word16] + IPv4_Address (Word8, Word8, Word8, Word8) + | DomainName Text + | IPv6_Address [Word16] deriving (Show, Eq) type Port = Int @@ -48,11 +50,11 @@ makeLenses ''ClientRequest -data MoeConfig = MoeConfig +data Config = Config { - _remote :: Text + _remoteAddress :: Text , _remotePort :: Int - , _local :: Text + , _localAddress :: Text , _localPort :: Int , _password :: Text , _method :: Text @@ -65,10 +67,10 @@ } deriving (Show, Eq, Generic) -instance FromJSON MoeConfig -instance ToJSON MoeConfig +instance FromJSON Config +instance ToJSON Config -makeLenses ''MoeConfig +makeLenses ''Config data RunningMode = RemoteMode | LocalMode | DebugMode deriving (Show, Eq) @@ -87,22 +89,22 @@ makeLenses ''Forward -data MoeOptions = MoeOptions +data Options = Options { _runningMode :: RunningMode , _configFile :: Maybe Text , _verbosity :: Priority - , _forward_TCP :: [Forward] - , _forward_UDP :: [Forward] - , _disableSocks5 :: Bool + , _forward_TCPs :: [Forward] + , _forward_UDPs :: [Forward] + , _disable_SOCKS5 :: Bool , _obfuscation :: Bool - , _forbidden_IP :: [IPRange] + , _forbidden_IPs :: [IPRange] , _listMethods :: Bool , _params :: [(Text, Value)] } deriving (Show, Eq) -makeLenses ''MoeOptions +makeLenses ''Options type Cipher = S.Maybe ByteString -> IO ByteString type IV = ByteString @@ -116,18 +118,76 @@ , _decryptBuilder :: CipherBuilder } -makeLenses '' CipherBox +makeLenses ''CipherBox +data LocalRelayType = + Local_TCP_Relay Forward + | Local_UDP_Relay Forward + | Local_SOCKS_Relay Int + deriving (Show, Eq) +makePrisms ''LocalRelayType + +data LocalRelay = LocalRelay + { + _localRelayType :: LocalRelayType + , _localRelayAddress :: Text + , _localRelayRemoteAddress :: Text + , _localRelayRemotePort :: Int + } + deriving (Show, Eq) + +makeLenses ''LocalRelay + +data RemoteRelayType = + Remote_TCP_Relay + | Remote_UDP_Relay + deriving (Show, Eq) + +makePrisms ''RemoteRelayType + +newtype Relay_ID = Relay_ID { _unRelay_ID :: Async () } + deriving (Eq, Ord) + +makeLenses ''Relay_ID + +instance Show Relay_ID where + show _ = "Relay ID" + +data RemoteRelay = RemoteRelay + { + _remoteRelayType :: RemoteRelayType + , _remoteRelayAddress :: Text + , _remoteRelayPort :: Int + , _relay_ID :: Maybe Relay_ID + } + deriving (Show, Eq) + +makeLenses ''RemoteRelay + +data Runtime = Runtime + { + _localRelays :: [LocalRelay] + , _remoteRelays :: [RemoteRelay] + } + deriving (Show, Eq) + +makeLenses ''Runtime + +instance Monoid Runtime where + mempty = Runtime [] [] + Runtime x y `mappend` Runtime x' y' = Runtime (x <> x') (y <> y') + + data Env = Env { - _options :: MoeOptions - , _config :: MoeConfig + _options :: Options + , _config :: Config , _cipherBox :: CipherBox } makeLenses ''Env -type MoeMonadT = ReaderT MoeOptions (ExceptT String IO) +type MoeMonadT = ReaderT Options (ExceptT String IO) 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 @@ -27,7 +27,7 @@ parseShadowSocksRequest :: ByteString -> IO (ByteString, ClientRequest) parseShadowSocksRequest aMessage = - case parse (shadowSocksRequestParser UDP_port) aMessage of + case parse (shadowSocksRequestParser UDP_Port) aMessage of Done _i _r -> pure (_i, _r) _ -> throwIO - ParseException - "R Failed to parse UDP request" @@ -51,20 +51,20 @@ _cipherBox = _cipherBox let _clientRequest = ClientRequest - UDP_port - (Domain_name - aForwarding ^. + UDP_Port + (DomainName - aForwarding ^. forwardRemoteHost) (aForwarding ^. forwardRemotePort) {-debug_ - "L UDP: " <> show _clientRequest-} let _addr = _clientRequest ^. addressType - _forbidden_IP = aEnv ^. options . forbidden_IP + _forbidden_IPs = aEnv ^. options . forbidden_IPs - debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IP + debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs - withCheckedForbidden_IP_List _addr _forbidden_IP - do - _sa <- getSocket (_c ^. remote) (_c ^. remotePort) Datagram + withCheckedForbidden_IP_List _addr _forbidden_IPs - do + _sa <- getSocket (_c ^. remoteAddress) (_c ^. remotePort) Datagram logSA "L UDP -->:" (pure _sa) - \(_remoteSocket, _remoteAddr) -> do @@ -125,10 +125,10 @@ let (_targetSocket, _targetSocketAddress) = _r (_addr, _) = sockAddr_To_Pair _targetSocketAddress - _forbidden_IP = _options ^. forbidden_IP + _forbidden_IPs = _options ^. forbidden_IPs - debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IP - withCheckedForbidden_IP_List _addr _forbidden_IP - do + debug_ - "checking: " <> show _addr <> " ? " <> show _forbidden_IPs + withCheckedForbidden_IP_List _addr _forbidden_IPs - do let _msg = showRelay aSockAddr _clientRequest info_ - "RU: " <> _msg