diff --git a/config.json b/config.json --- a/config.json +++ b/config.json @@ -4,6 +4,6 @@ "local_address":"localhost", "local_port":1090, "password":"birthday!", - "method":"aes-256-cfb" + "method":"aes-256-cfb" } 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.0.11 +version: 0.1.0.12 license: Apache-2.0 synopsis: A functional firewall killer description: A socks5 proxy using the client / server architecture. @@ -45,6 +45,7 @@ , mtl , stm , async + , time hs-source-dirs: src default-language: Haskell2010 diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -13,31 +13,34 @@ Features -------- -* GFW compatibility -* Can be used as a drop in replacement for shadowsocks (only client mode) * TCP port forwarding +* Per connection throttling (as a side effect of trying to find a bug in the +remote) +Not working +----------- +* Remote is flaky +* IPv6 +* Socks4 / Socks4a +* UDP over Socks5 + Planning features ------------------ -* UDP socks5 proxy -* UDP port forwarding -* Web based monitoring and profiling +* None Note ------ -You might want to use the python implementation of [shadowsocks] on the remote -server. - -The remote mode of moesocks is still buggy :( +There's a bug that prevents remote from working correctly. -There is an earlier implementation of [shadowsocks in Haskell] by rnons. +You should use the python implementation of [shadowsocks] on the remote +server. -The goal of moesocks is to provide extra configurability to standard -shadowsocks, for example: +There is an earlier implementation of [shadowsocks in Haskell] by rnons that +makes MoeSocks possible. -* load balancing (region based multi-server configuration) IP level request -* filters (like iptables) +The original goal of MoeSocks is to provide extra configurability to standard +shadowsocks, but it has been discarded since the remote is too flaky. [shadowsocks]:https://github.com/shadowsocks/shadowsocks [shadowsocks in Haskell]:https://github.com/rnons/shadowsocks-haskell 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 @@ -142,6 +142,10 @@ let _logId x = x <> " " <> _msg _timeout = aConfig ^. timeout * 1000 * 1000 + _throttle = + if aConfig ^. throttle + then Just - aConfig ^. throttleSpeed + else Nothing let sendThread = do sendBuilderEncrypted @@ -155,6 +159,7 @@ let _produce = do produceLoop (_logId "L --> + Loop") _timeout + Nothing aSocket sendChannel _encrypt @@ -162,6 +167,7 @@ let _consume = do consumeLoop (_logId "L --> - Loop") _timeout + _throttle __remoteSocket sendChannel finally @@ -174,6 +180,7 @@ let receiveThread = do let _produce = produceLoop (_logId "L <-- + Loop") _timeout + Nothing __remoteSocket receiveChannel _decrypt @@ -181,6 +188,7 @@ let _consume = do consumeLoop (_logId "L <-- - Loop") _timeout + Nothing aSocket receiveChannel finally @@ -258,6 +266,11 @@ let _logId x = x <> " " <> _msg _timeout = aConfig ^. timeout * 1000 * 1000 + + _throttle = + if aConfig ^. throttle + then Just - aConfig ^. throttleSpeed + else Nothing let sendThread = do when (_leftOverBytes & isn't _Empty) - @@ -266,12 +279,14 @@ let _produce = do produceLoop (_logId "R --> + Loop") _timeout + Nothing aSocket sendChannel _decrypt let _consume = consumeLoop (_logId "R --> - Loop") _timeout + Nothing __targetSocket sendChannel @@ -286,6 +301,7 @@ let _produce = do produceLoop (_logId "R --> + Loop") _timeout + Nothing __targetSocket receiveChannel _encrypt @@ -294,6 +310,7 @@ let _consume = do consumeLoop (_logId "R --> - Loop") _timeout + _throttle aSocket receiveChannel @@ -438,14 +455,15 @@ let _method = _config ^. method . _Text - _cipher <- io - withOpenSSL - getCipherByName _method + when (_method /= "none") - do + _cipher <- io - withOpenSSL - getCipherByName _method - case _cipher of - Nothing -> throwError - "Invalid method '" - <> _method - <> "' in " - <> _options ^. configFile . _Text - Just _ -> pure () + case _cipher of + Nothing -> throwError - "Invalid method '" + <> _method + <> "' in " + <> _options ^. configFile . _Text + Just _ -> pure () let localAppBuilder :: String -> (Socket -> IO ()) -> (Socket, SockAddr) -> IO () @@ -504,7 +522,7 @@ let remoteRun :: IO () - remoteRun = do + remoteRun = foreverRun - catchExceptAsyncLog "R main app" - do let _c = _config getSocket (_c ^. remote) (_c ^. remotePort) Stream >>= catchExceptAsyncLog "R app" . remoteApp @@ -516,15 +534,15 @@ let _forwardingApps = do forM_ _forwardings - \forwarding -> forkIO - do - getSocket (_c ^. local) - (forwarding ^. localForwardingPort) - Stream - >>= catchExceptAsyncLog "L Forwarding app" - . localForwardingApp forwarding + foreverRun - catchExceptAsyncLog "L Forwarding app" - do + getSocket (_c ^. local) + (forwarding ^. localForwardingPort) + Stream + >>= localForwardingApp forwarding - let _socks5App = + let _socks5App = foreverRun - catchExceptAsyncLog "L socks5 app" - do getSocket (_c ^. local) (_c ^. localPort) Stream - >>= catchExceptAsyncLog "L socks5 app" . localSocks5App + >>= localSocks5App _forwardingApps _socks5App 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 @@ -17,6 +17,8 @@ , _method = _DefaultMethod , _timeout = 300 , _tcpBufferSizeInPacket = 128 + , _throttle = False + , _throttleSpeed = 8000 -- in Kilobytes } diff --git a/src/Network/MoeSocks/Constant.hs b/src/Network/MoeSocks/Constant.hs --- a/src/Network/MoeSocks/Constant.hs +++ b/src/Network/MoeSocks/Constant.hs @@ -21,4 +21,3 @@ _DefaultMethod :: Text _DefaultMethod = "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 @@ -33,6 +33,8 @@ import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as LB +import Data.Time.Clock + -- BEGIN backports infixr 0 - @@ -82,7 +84,16 @@ showBytes :: ByteString -> String showBytes = show . S.unpack - +sleep :: Int -> IO () +sleep x = threadDelay - x * 1000 * 1000 + +foreverRun :: IO a -> IO () +foreverRun _io = do + forever - do + _io + puts "foreverRun delay 1 second" + sleep 1 + logClose :: String -> Socket -> IO () logClose aID aSocket = do pure aID @@ -281,40 +292,97 @@ Nothing -> throw - TimeoutException aID Just _r -> pure _r -produceLoop :: String -> Timeout -> Socket -> TBQueue (Maybe ByteString) -> +-- throttle speed in kilobytes per second +produceLoop :: String -> Timeout -> Maybe Double -> + Socket -> TBQueue (Maybe ByteString) -> (ByteString -> IO ByteString) -> IO () -produceLoop aID aTimeout aSocket aTBQueue f = do +produceLoop aID aTimeout aThrottle aSocket aTBQueue f = do + _startTime <- getCurrentTime + let _shutdown = do tryIO aID - shutdown aSocket ShutdownReceive {-tryIO aID - close aSocket-} - _produce = do + _produce :: Int -> IO () + _produce _bytesReceived = do _r <- timeoutFor aID aTimeout - recv_ aSocket if (_r & isn't _Empty) then do + forM_ aThrottle - \_throttle -> do + _currentTime <- getCurrentTime + let _timeDiff = realToFrac (diffUTCTime _currentTime + _startTime) :: Double + + _bytesK = fromIntegral _bytesReceived / 1000 :: Double + + let _speed = _bytesK / _timeDiff + + puts - "Produce speed is: " <> show (floor _speed :: Int) <> " K" + + when (_speed > _throttle) - do + let _sleepTime = ((_bytesK + (-_timeDiff * _throttle)) + / _throttle ) * 1000 * 1000 + + puts - "Produce sleeping for: " <> show _sleepTime + <> " miliseconds." + threadDelay - floor - _sleepTime + f _r >>= atomically . writeTBQueue aTBQueue . Just - _produce + yield + _produce (_bytesReceived + S.length _r) else do puts - "Half closed: " <> aID atomically - writeTBQueue aTBQueue Nothing - _produce `onException` _shutdown + _produce 0 `onException` _shutdown pure () -consumeLoop :: String -> Timeout -> Socket -> TBQueue (Maybe ByteString) -> IO () -consumeLoop aID aTimeout aSocket aTBQueue = do +consumeLoop :: String -> Timeout -> Maybe Double -> + Socket -> TBQueue (Maybe ByteString) -> IO () +consumeLoop aID aTimeout aThrottle aSocket aTBQueue = do + _startTime <- getCurrentTime + + let _shutdown = do tryIO aID - shutdown aSocket ShutdownSend {-tryIO aID - close aSocket-} - _consume = do - _r <- atomically - readAll aTBQueue + + _consume :: Int -> IO () + _consume _bytesSent = do + forM_ aThrottle - \_throttle -> do + _currentTime <- getCurrentTime + let _timeDiff = realToFrac (diffUTCTime _currentTime + _startTime) :: Double + + _bytesK = fromIntegral _bytesSent / 1000 :: Double + + let _speed = _bytesK / _timeDiff + + puts - "Consume speed is: " <> show (floor _speed :: Int) <> " K" + + when (_speed > _throttle) - do + let _sleepTime = ((_bytesK + (-_timeDiff * _throttle)) + / _throttle ) * 1000 * 1000 + + puts - "Consume sleeping for: " <> show _sleepTime + <> " miliseconds." + threadDelay - floor - _sleepTime + + _r <- atomically - readTBQueue aTBQueue case _r of - Nothing -> _shutdown + Nothing -> () <$ _shutdown Just _data -> do - timeoutFor aID aTimeout - - sendMany aSocket _data >> _consume + _len <- timeoutFor aID aTimeout - send aSocket _data + + when (_len < S.length _data) - do + atomically - unGetTBQueue aTBQueue - + Just - S.drop _len _data + + yield + _consume - + _bytesSent + _len - _consume `onException` _shutdown + _consume 0 `onException` _shutdown pure () 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 @@ -56,6 +56,8 @@ , _method :: Text , _timeout :: Int , _tcpBufferSizeInPacket :: Int + , _throttle :: Bool + , _throttleSpeed :: Double } deriving (Show, Eq, Generic)