moesocks 0.1.0.18 → 0.1.0.19
raw patch · 11 files changed
+151/−92 lines, 11 filesdep +strict
Dependencies added: strict
Files
- CHANGELOG.md +4/−0
- LICENSE +1/−1
- README.md +16/−0
- moesocks.cabal +3/−2
- src/Network/MoeSocks/App.hs +16/−18
- src/Network/MoeSocks/Common.hs +7/−2
- src/Network/MoeSocks/Helper.hs +25/−16
- src/Network/MoeSocks/Internal/ShadowSocks/Encrypt.hs +55/−39
- src/Network/MoeSocks/TCP.hs +7/−5
- src/Network/MoeSocks/Type.hs +4/−2
- src/Network/MoeSocks/UDP.hs +13/−7
CHANGELOG.md view
@@ -1,3 +1,7 @@+0.1.0.19+--------+* Fix a memory leak+ 0.1.0.18 -------- * Add complete command line arguments
LICENSE view
@@ -187,7 +187,7 @@ same "printed page" as the copyright notice for easier identification within third-party archives. - Copyright 2015 Jinjing Wang+ Copyright [yyyy] [name of copyright owner] Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.
README.md view
@@ -63,6 +63,22 @@ The original goal of MoeSocks is to provide extra configurability to standard shadowsocks, but it has been discarded since remote is too flaky. +License+--------+Copyright 2015 Jinjing Wang++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+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
moesocks.cabal view
@@ -1,6 +1,6 @@ name: moesocks category: Network-version: 0.1.0.18+version: 0.1.0.19 license: Apache-2.0 synopsis: A functional firewall killer description: A socks5 proxy using the client / server architecture.@@ -24,7 +24,7 @@ executable moesocks main-is: Main.hs ghc-options: -Wall -fno-warn-unused-do-bind -threaded - -rtsopts "-with-rtsopts=-N"+ -rtsopts "-with-rtsopts=-N -c" build-depends: base > 4 && <= 5 , HsOpenSSL , aeson@@ -42,6 +42,7 @@ , random , safe , stm+ , strict , text , time , transformers
src/Network/MoeSocks/App.hs view
@@ -17,8 +17,8 @@ import Network.MoeSocks.Config import Network.MoeSocks.Constant import Network.MoeSocks.Helper-import Network.MoeSocks.Type import Network.MoeSocks.TCP+import Network.MoeSocks.Type import Network.MoeSocks.UDP import Network.Socket hiding (send, recv, recvFrom, sendTo) import Network.Socket.ByteString@@ -37,23 +37,6 @@ parseConfig :: MoeOptions -> MoeMonadT MoeConfig parseConfig aOption = do- let- formatConfig :: Value -> Value- formatConfig (Object _obj) =- Object -- _obj- & H.toList - & over (mapped . _1) T.tail - & H.fromList- formatConfig _ = Null-- showConfig :: MoeConfig -> Text- showConfig = view utf8 - . toStrict - . encode - . formatConfig - . toJSON - let _maybeFilePath = aOption ^. configFile _v <- case _maybeFilePath of@@ -94,6 +77,21 @@ fixConfig _ = Null + formatConfig :: Value -> Value+ formatConfig (Object _obj) =+ Object -+ _obj+ & H.toList + & over (mapped . _1) T.tail + & H.fromList+ formatConfig _ = Null++ showConfig :: MoeConfig -> Text+ showConfig = view utf8 + . toStrict + . encode + . formatConfig + . toJSON
src/Network/MoeSocks/Common.hs view
@@ -4,15 +4,20 @@ import Control.Lens import Control.Monad.Writer hiding (listen)+import Data.ByteString (ByteString) import Data.Text (Text)-import Data.Text.Strict.Lens (utf8) import Data.Text.Lens+import Data.Text.Strict.Lens (utf8) import Network.MoeSocks.Helper+import Network.MoeSocks.Internal.ShadowSocks.Encrypt as E import Network.MoeSocks.Type import Network.Socket hiding (send, recv, recvFrom, sendTo) import Prelude hiding ((-), take) import qualified Data.List as L-import Network.MoeSocks.Internal.ShadowSocks.Encrypt+import qualified Data.Strict as S++plainCipher :: (S.Maybe ByteString) -> IO ByteString+plainCipher = E.plainCipher getCipher :: Text -> Text -> IO (Cipher, Cipher) getCipher aMethod aPassword =
src/Network/MoeSocks/Helper.hs view
@@ -29,7 +29,9 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Lazy as LB+import qualified Data.Strict as S + -- BEGIN backports infixr 0 -@@ -39,6 +41,9 @@ -- END backports +type HCipher = S.Maybe ByteString -> IO ByteString +type HQueue = TBQueue (S.Maybe ByteString)+ io :: (MonadIO m) => IO a -> m a io = liftIO @@ -95,6 +100,7 @@ puts - "Closing socket " <> aID close aSocket + logSocketWithAddress :: String -> IO (Socket, SockAddr) -> ((Socket, SockAddr) -> IO a) -> IO a logSocketWithAddress aID _init f = do@@ -172,6 +178,7 @@ pure () connectTunnel :: (Maybe String, IO ()) -> (Maybe String, IO ()) -> IO ()+-- connectTunnel x y = finally (waitBothDebug x y) performGC connectTunnel = waitBothDebug {-connectTunnel :: (Maybe String, IO ()) -> (Maybe String, IO ()) -> IO ()-}@@ -247,15 +254,16 @@ send_ :: Socket -> ByteString -> IO () send_ = sendAll -sendBuilder :: TBQueue (Maybe ByteString) -> B.Builder -> IO ()+sendBuilder :: HQueue -> B.Builder -> IO () sendBuilder _queue = - atomically . writeTBQueue _queue . Just . builder_To_ByteString+ atomically . writeTBQueue _queue . S.Just . builder_To_ByteString -sendBuilderEncrypted :: TBQueue (Maybe ByteString) -> - (ByteString -> IO ByteString) -> B.Builder -> IO ()+sendBuilderEncrypted :: HQueue -> + HCipher -> + B.Builder -> IO () sendBuilderEncrypted _queue _encrypt x = - atomically . writeTBQueue _queue . Just =<< - _encrypt (builder_To_ByteString x)+ atomically . writeTBQueue _queue . S.Just =<< + _encrypt (S.Just - builder_To_ByteString x) -- | An exception raised when parsing fails. data ParseException = ParseException String@@ -265,7 +273,7 @@ instance Exception ParseException -parseSocket :: String -> ByteString -> (ByteString -> IO ByteString) ->+parseSocket :: String -> ByteString -> HCipher -> Parser a -> Socket -> IO (ByteString, a) parseSocket aID _partial _decrypt aParser = parseSocketWith aID - parse aParser where@@ -274,7 +282,7 @@ parseSocketWith _id _parser _socket = do _rawBytes <- recv_ _socket {-puts - "rawBytes: " <> show _rawBytes-}- _bytes <- _decrypt _rawBytes+ _bytes <- _decrypt (S.Just _rawBytes) case _parser - _partial <> _bytes of Done i _r -> pure (i, _r)@@ -292,8 +300,8 @@ -- throttle speed in kilobytes per second produceLoop :: String -> Timeout -> Maybe Double ->- Socket -> TBQueue (Maybe ByteString) -> - (ByteString -> IO ByteString) -> IO ()+ Socket -> HQueue -> + HCipher -> IO () produceLoop aID aTimeout aThrottle aSocket aTBQueue f = do _startTime <- getCurrentTime @@ -302,7 +310,7 @@ {-tryIO aID - close aSocket-} _produce :: Int -> IO ()- _produce _bytesReceived = do+ _produce _bytesReceived = flip onException (f S.Nothing) - do _r <- timeoutFor aID aTimeout - recv_ aSocket {-pute - "Get chunk: " <> (show - S.length _r) -- <> " " <> aID-} if (_r & isn't _Empty) @@ -326,12 +334,13 @@ <> " miliseconds." threadDelay - floor - _sleepTime - f _r >>= atomically . writeTBQueue aTBQueue . Just+ f (S.Just _r) >>= atomically . writeTBQueue aTBQueue . S.Just yield _produce (_bytesReceived + S.length _r) else do puts - "Half closed: " <> aID - atomically - writeTBQueue aTBQueue Nothing+ f S.Nothing >>= atomically . writeTBQueue aTBQueue . S.Just+ atomically - writeTBQueue aTBQueue S.Nothing _produce 0 `onException` _shutdown pure ()@@ -339,7 +348,7 @@ consumeLoop :: String -> Timeout -> Maybe Double ->- Socket -> TBQueue (Maybe ByteString) -> IO ()+ Socket -> HQueue -> IO () consumeLoop aID aTimeout aThrottle aSocket aTBQueue = do _startTime <- getCurrentTime @@ -374,8 +383,8 @@ _newPacket <- atomically - readTBQueue aTBQueue case _newPacket of- Nothing -> () <$ _shutdown- Just _data -> do+ S.Nothing -> () <$ _shutdown+ S.Just _data -> do timeoutFor aID aTimeout - sendAll aSocket _data yield
src/Network/MoeSocks/Internal/ShadowSocks/Encrypt.hs view
@@ -2,7 +2,7 @@ - https://hackage.haskell.org/package/shadowsocks - Copyright: rnons - Licence: MIT- - Slightly modified to work better with moesocks+ - Heavily modified here -} @@ -33,9 +33,12 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}+ module Network.MoeSocks.Internal.ShadowSocks.Encrypt ( getEncDec , iv_len+ , plainCipher ) where import Control.Concurrent.MVar ( newEmptyMVar, isEmptyMVar@@ -48,11 +51,13 @@ import Data.Monoid ((<>)) import OpenSSL (withOpenSSL) import OpenSSL.EVP.Cipher (getCipherByName, CryptoMode(..))-import OpenSSL.EVP.Internal (cipherInitBS, cipherUpdateBS)+import OpenSSL.EVP.Internal (cipherInitBS, cipherUpdateBS,+ cipherFinalBS) import OpenSSL.Random (randBytes) import Data.Text (Text) import Control.Lens import Data.Text.Lens+import qualified Data.Strict as S method_supported :: HM.HashMap Text (Int, Int)@@ -92,7 +97,8 @@ | otherwise = m getSSLEncDec :: Text -> ByteString- -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString)+ -> IO (S.Maybe ByteString -> IO ByteString+ , S.Maybe ByteString -> IO ByteString) getSSLEncDec method password = do let (m0, m1) = fromJust $ HM.lookup method method_supported random_iv <- withOpenSSL $ randBytes 32@@ -105,46 +111,56 @@ method ^. _Text ctx <- withOpenSSL $ cipherInitBS cipherMethod key cipher_iv Encrypt let- encrypt buf = - if S.null buf- then return $! S.empty- else do- empty <- isEmptyMVar cipherCtx- if empty- then do- putMVar cipherCtx $! ()- ciphered <- withOpenSSL $ cipherUpdateBS ctx buf- return $! cipher_iv <> ciphered- else do- r <- withOpenSSL $ cipherUpdateBS ctx buf- return $! r+ encrypt :: (S.Maybe ByteString) -> IO ByteString+ encrypt = \case+ S.Nothing -> cipherFinalBS ctx+ S.Just buf -> do+ if S.null buf+ then return $! mempty+ else do+ empty <- isEmptyMVar cipherCtx+ if empty+ then do+ putMVar cipherCtx $! ()+ ciphered <- withOpenSSL $ cipherUpdateBS ctx buf+ return $! cipher_iv <> ciphered+ else do+ r <- withOpenSSL $ cipherUpdateBS ctx buf+ return $! r - decrypt buf =- if S.null buf- then return $! S.empty- else do- empty <- isEmptyMVar decipherCtx- if empty- then do- let decipher_iv = S.take m1 buf- dctx <- withOpenSSL $ - cipherInitBS cipherMethod key decipher_iv Decrypt- putMVar decipherCtx $! dctx- if S.null (S.drop m1 buf)- then return ""- else do- r <- withOpenSSL $- cipherUpdateBS dctx (S.drop m1 buf)- return $! r- else do- dctx <- readMVar decipherCtx- r <- withOpenSSL $ cipherUpdateBS dctx buf- return $! r+ decrypt :: (S.Maybe ByteString) -> IO ByteString+ decrypt = \case+ S.Nothing -> cipherFinalBS ctx+ S.Just buf -> do + if S.null buf+ then return $! S.empty+ else do+ empty <- isEmptyMVar decipherCtx+ if empty+ then do+ let decipher_iv = S.take m1 buf+ dctx <- withOpenSSL $ + cipherInitBS cipherMethod key decipher_iv Decrypt+ putMVar decipherCtx $! dctx+ if S.null (S.drop m1 buf)+ then return ""+ else do+ r <- withOpenSSL $+ cipherUpdateBS dctx (S.drop m1 buf)+ return $! r+ else do+ dctx <- readMVar decipherCtx+ r <- withOpenSSL $ cipherUpdateBS dctx buf+ return $! r return (encrypt, decrypt) +plainCipher :: (S.Maybe ByteString -> IO ByteString)+plainCipher = pure . S.fromMaybe mempty+ getEncDec :: Text -> ByteString - -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString)+ -> IO (S.Maybe ByteString -> IO ByteString+ , S.Maybe ByteString -> IO ByteString) getEncDec t- | t == "none" = const $ pure (pure, pure)+ | t == "none" = const $ pure (plainCipher, plainCipher) | otherwise = getSSLEncDec t
src/Network/MoeSocks/TCP.hs view
@@ -15,12 +15,14 @@ import Network.MoeSocks.Type import Network.Socket hiding (send, recv, recvFrom, sendTo) import Prelude hiding ((-), take)+import qualified Data.Strict as S local_Socks5_RequestHandler :: MoeConfig -> ByteString -> (Socket, SockAddr) -> IO () local_Socks5_RequestHandler aConfig _ (aSocket,_) = do (_partialBytesAfterGreeting, _r) <- - parseSocket "clientGreeting" mempty pure greetingParser aSocket+ parseSocket "clientGreeting" mempty plainCipher+ greetingParser aSocket when (not - _No_authentication `elem` (_r ^. authenticationMethods)) - throwIO - ParseException@@ -31,7 +33,7 @@ _parsedRequest <- parseSocket "clientRequest" _partialBytesAfterGreeting- pure+ plainCipher connectionParser aSocket @@ -105,8 +107,8 @@ sendChannel _encrypt _header when (_partialBytesAfterClientRequest & isn't _Empty) -- atomically . writeTBQueue sendChannel . Just =<< - _encrypt _partialBytesAfterClientRequest+ atomically . writeTBQueue sendChannel . S.Just =<< + _encrypt (S.Just _partialBytesAfterClientRequest) let _produce = do@@ -203,7 +205,7 @@ let sendThread = do when (_leftOverBytes & isn't _Empty) -- atomically - writeTBQueue sendChannel - Just _leftOverBytes+ atomically - writeTBQueue sendChannel - S.Just _leftOverBytes let _produce = do produceLoop (_logId "R --> + Loop")
src/Network/MoeSocks/Type.hs view
@@ -3,6 +3,7 @@ module Network.MoeSocks.Type where +import Control.Concurrent.STM import Control.Lens import Control.Monad.Except import Control.Monad.Reader@@ -12,6 +13,7 @@ import Data.Word import GHC.Generics import System.Log.Logger+import qualified Data.Strict as S data ClientGreeting = ClientGreeting {@@ -106,7 +108,7 @@ makeLenses ''Env -type Cipher = ByteString -> IO ByteString -+type Cipher = S.Maybe ByteString -> IO ByteString +type Queue = TBQueue (Maybe ByteString) type MoeMonadT = ReaderT MoeOptions (ExceptT String IO)
src/Network/MoeSocks/UDP.hs view
@@ -2,19 +2,20 @@ module Network.MoeSocks.UDP where +import Control.Exception import Control.Lens import Control.Monad-import Data.Attoparsec.ByteString import Control.Monad.Writer hiding (listen)-import Control.Exception+import Data.Attoparsec.ByteString import Data.ByteString (ByteString)-import Network.MoeSocks.Helper import Network.MoeSocks.BuilderAndParser import Network.MoeSocks.Common+import Network.MoeSocks.Helper import Network.MoeSocks.Type import Network.Socket hiding (send, recv, recvFrom, sendTo) import Network.Socket.ByteString import Prelude hiding ((-), take)+import qualified Data.Strict as S buildShadowSocksRequest :: ClientRequest -> ByteString -> ByteString@@ -31,6 +32,10 @@ "R Failed to parse UDP request" +processAll :: Cipher -> ByteString -> IO ByteString+processAll f x = + (<>) <$> f (S.Just x) <*> f S.Nothing+ local_UDP_ForwardRequestHandler :: MoeConfig -> Forward -> ByteString -> (Socket,SockAddr) -> IO () local_UDP_ForwardRequestHandler aConfig aForwarding aMessage @@ -65,9 +70,10 @@ let _msg = show aSockAddr <> " -> " <> showRequest _clientRequest _log - "L U: " <> _msg - send_ _remoteSocket =<< _encrypt _bytes+ send_ _remoteSocket =<< _encrypt (S.Just _bytes) - (_r, _) <- recv_ _remoteSocket >>= _decrypt >>= parseShadowSocksRequest+ (_r, _) <- recv_ _remoteSocket >>= processAll _decrypt + >>= parseShadowSocksRequest {-puts - "L UDP <--: " <> show _r-} when (_r & isn't _Empty) - do@@ -84,7 +90,7 @@ {-let (_encrypt, _decrypt) = (pure, pure)-} - _msg <- _decrypt aMessage+ _msg <- processAll _decrypt aMessage (_decryptedMessage, _clientRequest) <- parseShadowSocksRequest _msg @@ -108,5 +114,5 @@ {-puts - "R UDP <--: " <> show _r-} when (_r & isn't _Empty) - do- _encryptedMessage <- _encrypt _r+ _encryptedMessage <- processAll _encrypt _r sendAllTo aSocket _encryptedMessage aSockAddr