moesocks 0.1.0.11 → 0.1.0.12
raw patch · 8 files changed
+139/−46 lines, 8 filesdep +time
Dependencies added: time
Files
- config.json +1/−1
- moesocks.cabal +2/−1
- readme.md +17/−14
- src/Network/MoeSocks/App.hs +33/−15
- src/Network/MoeSocks/Config.hs +2/−0
- src/Network/MoeSocks/Constant.hs +0/−1
- src/Network/MoeSocks/Helper.hs +82/−14
- src/Network/MoeSocks/Type.hs +2/−0
config.json view
@@ -4,6 +4,6 @@ "local_address":"localhost", "local_port":1090, "password":"birthday!",- "method":"aes-256-cfb"+ "method":"aes-256-cfb" }
moesocks.cabal view
@@ -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
readme.md view
@@ -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
src/Network/MoeSocks/App.hs view
@@ -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
src/Network/MoeSocks/Config.hs view
@@ -17,6 +17,8 @@ , _method = _DefaultMethod , _timeout = 300 , _tcpBufferSizeInPacket = 128+ , _throttle = False+ , _throttleSpeed = 8000 -- in Kilobytes }
src/Network/MoeSocks/Constant.hs view
@@ -21,4 +21,3 @@ _DefaultMethod :: Text _DefaultMethod = "aes-256-cfb" -
src/Network/MoeSocks/Helper.hs view
@@ -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 ()
src/Network/MoeSocks/Type.hs view
@@ -56,6 +56,8 @@ , _method :: Text , _timeout :: Int , _tcpBufferSizeInPacket :: Int+ , _throttle :: Bool+ , _throttleSpeed :: Double } deriving (Show, Eq, Generic)