moesocks 0.1.0.1 → 0.1.0.2
raw patch · 6 files changed
+156/−145 lines, 6 files
Files
- config.json +5/−5
- moesocks.cabal +2/−2
- src/Network/MoeSocks/App.hs +50/−50
- src/Network/MoeSocks/BuilderAndParser.hs +56/−24
- src/Network/MoeSocks/Helper.hs +19/−18
- src/Network/MoeSocks/Internal/ShadowSocks/Encrypt.hs +24/−46
config.json view
@@ -1,9 +1,9 @@ {- "server":"127.0.0.1",- "server_port":1190,- "local_address":"localhost",- "local_port":1090,- "password":"birthday!",+ "server":"127.0.0.1",+ "server_port":1190,+ "local_address":"localhost",+ "local_port":1090,+ "password":"birthday!", "method":"aes-256-cfb" }
moesocks.cabal view
@@ -3,10 +3,10 @@ name: moesocks category: Network-version: 0.1.0.1+version: 0.1.0.2 license: Apache-2.0 synopsis: moe for all-description: A socks5 proxy server+description: A socks5 proxy using the client / server architecture. homepage: https://github.com/nfjinjing/moesocks license-file: LICENSE author: Jinjing Wang
src/Network/MoeSocks/App.hs view
@@ -7,7 +7,8 @@ import Control.Lens import Control.Monad import Data.Aeson-import Data.Attoparsec.ByteString+import Data.ByteString (ByteString)+import Data.ByteString.Lazy (toStrict) import Data.Monoid import Data.Text (Text) import Data.Text.Lens@@ -20,57 +21,42 @@ import Prelude hiding ((-), take) import System.IO.Streams.Attoparsec import System.IO.Streams.Network-import qualified Data.ByteString as S import qualified Data.ByteString.Builder as B import qualified Data.HashMap.Strict as H import qualified Data.List as L import qualified Data.Text as T import qualified Data.Text.IO as TIO-import qualified Data.Text.Strict.Lens as TS+import Data.Text.Strict.Lens (utf8) import qualified System.IO.Streams as Stream showAddressType :: AddressType -> String showAddressType (IPv4_address xs) = concat - L.intersperse "." - map show xs-showAddressType (Domain_name x) = view _Text - x ^. TS.utf8+showAddressType (Domain_name x) = view _Text - x ^. utf8 showAddressType x = error - "IPv6 target not supported:" <> show x +showConnectionType :: ConnectionType -> String+showConnectionType TCP_IP_stream_connection = "TCP_Stream"+showConnectionType TCP_IP_port_binding = "TCP_Bind "+showConnectionType UDP_port = "UDP "+ localRequestHandler:: MoeConfig -> Socket -> IO () localRequestHandler aConfig aSocket = do (inputStream, outputStream) <- socketToStreams aSocket - let socksVersion = 5- socksHeader = word8 socksVersion- - let greetingParser = do- socksHeader- let maxNoOfMethods = 5- _numberOfAuthenticationMethods <- satisfy (<= maxNoOfMethods)-- ClientGreeting <$>- count (fromIntegral _numberOfAuthenticationMethods) anyWord8-- let connectionParser = do- socksHeader- requestParser- r <- parseFromStream greetingParser inputStream {-puts - "greetings: " <> show r-} forM_ (boolToMaybe - _No_authentication `elem` (r ^. authenticationMethods)) - const - do- pushStream outputStream - B.word8 socksVersion- <> B.word8 _No_authentication-+ pushStream outputStream - greetingReplyBuilder _clientRequest <- parseFromStream connectionParser inputStream {-puts - "request: " <> show _clientRequest-} - let conn = _clientRequest- let _c = aConfig _initSocket = @@ -86,7 +72,8 @@ showAddressType (_r ^. addressType) <> ":" <> show (_r ^. portNumber . to portNumber16)- puts - "L: " <> + puts - "L " -- <> showConnectionType (_clientRequest ^. connectionType)+ <> ": " <> ( concat - L.intersperse " -> " [ @@ -96,29 +83,21 @@ ) let handleLocal __remoteSocket = do- let- write x = Stream.write (Just - x) outputStream- push = write . S.singleton-- push socksVersion- push _Request_Granted - push _ReservedByte-- write - builder_To_ByteString -- addressTypeBuilder (conn ^. addressType)-- traverseOf both push - conn ^. portNumber+ Stream.write (Just - builder_To_ByteString -+ connectionReplyBuilder _clientRequest)+ outputStream+ (remoteInputStream, remoteOutputStream) <- socketToStreams _remoteSocket (_encrypt, _decrypt) <- getCipher- _DefaultMethod+ (aConfig ^. method) (aConfig ^. password) let - _header = shadowsocksRequestBuilder conn+ _header = shadowsocksRequestBuilder _clientRequest remoteOutputEncryptedStream <- Stream.contramapM _encrypt remoteOutputStream @@ -142,7 +121,7 @@ (remoteInputStream, remoteOutputStream) <- socketToStreams aSocket (_encrypt, _decrypt) <- getCipher- _DefaultMethod+ (aConfig ^. method) (aConfig ^. password) remoteInputDecryptedStream <- Stream.mapM _decrypt remoteInputStream@@ -173,7 +152,7 @@ getSocket _hostName (portNumber16 _port) _socketType - logSocketWithAddress "Connect target" (initTarget _clientRequest) - \_r -> do+ logSA "Connect target" (initTarget _clientRequest) - \_r -> do let (_targetSocket, _targetSocketAddress) = _r connect _targetSocket _targetSocketAddress@@ -181,7 +160,8 @@ _remotePeerAddr <- getPeerName aSocket _targetPeerAddr <- getPeerName _targetSocket - puts - "R: " <> + puts - "R " -- <> showConnectionType (_clientRequest ^. connectionType)+ <> ": " <> ( concat - L.intersperse " -> " - map show [ @@ -225,21 +205,39 @@ fromSS :: [(Text, Value)] -> [(Text, Value)] fromSS = fromShadowSocksConfig - let _v = decodeStrict - review TS.utf8 _configFile :: Maybe Value- let fixConfig :: Value -> Value++ let _v = decodeStrict - review utf8 _configFile :: Maybe Value++ fixConfig :: Value -> Value fixConfig (Object _obj) = Object - - _obj & H.toList & fromSS & over (mapped . _1) (T.cons '_') & H.fromList+ _obj & H.toList & fromSS & + over (mapped . _1) (T.cons '_') & H.fromList fixConfig _ = Null- let - _maybeConfig = (_v >>= decode . encode . fixConfig)+ + _maybeConfig = _v >>= decode . encode . fixConfig ++ formatConfig :: Value -> Value+ formatConfig (Object _obj) =+ Object -+ _obj & H.toList &+ over (mapped . _1) T.tail & H.fromList+ formatConfig _ = Null+++ case _maybeConfig of Nothing -> do pute "Failed to parse configuration file" pute "Example: "- pute - show - encode defaultMoeConfig++ let configBS :: ByteString + configBS = toStrict .encode . formatConfig . toJSON - + defaultMoeConfig + puteT - configBS ^. utf8+ pure Nothing _config -> do pure - _config @@ -272,10 +270,12 @@ \(_remoteSocket, _remoteAddr) -> do putStrLn "Moe remote!" - setSocketOption _remoteSocket ReuseAddr 1 bindSocket _remoteSocket _remoteAddr- listen _remoteSocket 1++ let _maximum_number_of_queued_connection = 1++ listen _remoteSocket _maximum_number_of_queued_connection let handleRemote _socket = do (_newSocket, _) <- accept _socket
src/Network/MoeSocks/BuilderAndParser.hs view
@@ -12,6 +12,56 @@ import qualified Data.ByteString.Builder as B +socksVersion :: Word8+socksVersion = 5++socksHeader :: Parser Word8+socksHeader = word8 socksVersion++greetingParser :: Parser ClientGreeting+greetingParser = do+ socksHeader+ let maxNoOfMethods = 5+ _numberOfAuthenticationMethods <- satisfy (<= maxNoOfMethods)++ ClientGreeting <$>+ count (fromIntegral _numberOfAuthenticationMethods) anyWord8++greetingReplyBuilder :: B.Builder+greetingReplyBuilder = B.word8 socksVersion+ <> B.word8 _No_authentication++requestParser :: Parser ClientRequest+requestParser = do+ __connectionType <- choice+ [+ TCP_IP_stream_connection <$ word8 1 + , TCP_IP_port_binding <$ word8 2+ , UDP_port <$ word8 3+ ]++ word8 _ReservedByte+ __addressType <- addressTypeParser+ __portNumber <- (,) <$> anyWord8 <*> anyWord8+ pure - + ClientRequest+ __connectionType+ __addressType + __portNumber++connectionParser :: Parser ClientRequest +connectionParser = do+ socksHeader+ requestParser++connectionReplyBuilder :: ClientRequest -> B.Builder+connectionReplyBuilder _clientRequest = + B.word8 socksVersion+ <> B.word8 _Request_Granted + <> B.word8 _ReservedByte+ <> addressTypeBuilder (_clientRequest ^. addressType)+ <> foldMapOf each B.word8 (_clientRequest ^. portNumber)+ addressTypeBuilder :: AddressType -> B.Builder addressTypeBuilder aAddressType = case aAddressType of@@ -36,15 +86,15 @@ requestBuilder :: ClientRequest -> B.Builder requestBuilder aClientRequest = - B.word8 (connectionType_To_Word8 - aClientRequest ^. connectionType)- <> B.word8 _ReservedByte- <> addressTypeBuilder (aClientRequest ^. addressType)- <> foldMapOf each B.word8 (aClientRequest ^. portNumber)+ B.word8 (connectionType_To_Word8 - aClientRequest ^. connectionType)+ <> B.word8 _ReservedByte+ <> addressTypeBuilder (aClientRequest ^. addressType)+ <> foldMapOf each B.word8 (aClientRequest ^. portNumber) shadowsocksRequestBuilder :: ClientRequest -> B.Builder shadowsocksRequestBuilder aClientRequest =- addressTypeBuilder (aClientRequest ^. addressType)- <> foldMapOf each B.word8 (aClientRequest ^. portNumber)+ addressTypeBuilder (aClientRequest ^. addressType)+ <> foldMapOf each B.word8 (aClientRequest ^. portNumber) addressTypeParser :: Parser AddressType addressTypeParser = choice@@ -67,24 +117,6 @@ portParser :: Parser (Word8, Word8) portParser = (,) <$> anyWord8 <*> anyWord8 --requestParser :: Parser ClientRequest-requestParser = do- __connectionType <- choice- [- TCP_IP_stream_connection <$ word8 1 - , TCP_IP_port_binding <$ word8 2- , UDP_port <$ word8 3- ]-- word8 _ReservedByte- __addressType <- addressTypeParser- __portNumber <- (,) <$> anyWord8 <*> anyWord8- pure - - ClientRequest- __connectionType- __addressType - __portNumber shadowsocksRequestParser :: Parser ClientRequest shadowsocksRequestParser = do
src/Network/MoeSocks/Helper.hs view
@@ -5,23 +5,22 @@ import Control.Concurrent import Control.Exception import Control.Lens-import Data.Aeson (Value()) import Data.Binary import Data.Binary.Put import Data.ByteString (ByteString) import Data.Monoid import Data.Text (Text) import Data.Text.Lens+import Data.Text.Strict.Lens (utf8) import Network.MoeSocks.Internal.ShadowSocks.Encrypt import Network.Socket import Prelude hiding (take, (-)) -import System.IO-import System.IO.Unsafe+import System.IO (hPutStrLn, stderr)+import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString as S import qualified Data.ByteString.Builder as B import qualified Data.ByteString.Builder.Extra as BE import qualified Data.ByteString.Lazy as LB-import qualified Data.Text.Strict.Lens as TS import qualified System.IO.Streams as Stream -- BEGIN backports@@ -55,6 +54,9 @@ pute :: String -> IO () pute = sync . hPutStrLn stderr +puteT :: Text -> IO ()+puteT = pute . view _Text+ showBytes :: ByteString -> String showBytes = show . S.unpack @@ -95,26 +97,25 @@ waitBoth :: IO a -> IO b -> IO () waitBoth x y = do let _init = do- (xThreadID, xLock) <- do- _lock <- newEmptyMVar- _threadID <- + _xLock <- newEmptyMVar+ _xThreadID <- forkFinally x -- const - putMVar _lock ()-- return (_threadID, _lock)+ const - putMVar _xLock () - yThreadID <- - forkFinally y - const - killThread xThreadID + _yLock <- newEmptyMVar+ _yThreadID <- + forkFinally y -+ const - putMVar _yLock () - return (xThreadID, xLock, yThreadID)+ return (_xThreadID, _xLock, _yThreadID, _yLock) - let handleError (xThreadID, _, yThreadID) = do+ let handleError (xThreadID, _, yThreadID, _) = do killThread yThreadID killThread xThreadID - let action (_, xLock, yThreadID) = do+ let action (_, xLock, _, yLock) = do takeMVar xLock - killThread yThreadID+ takeMVar yLock bracket _init@@ -162,13 +163,13 @@ getCipher :: Text -> Text -> IO (Cipher, Cipher) getCipher method password =- getEncDec (method ^. _Text) (review TS.utf8 password)+ getEncDec method (review utf8 password) portNumber16 :: (Word8, Word8) -> Word16 portNumber16 pair = fromWord8 - toListOf both pair -duplicateKey :: (Text, Text) -> [(Text, Value)] -> [(Text, Value)]+duplicateKey :: (Eq a) => (a, a) -> [(a, b)] -> [(a, b)] duplicateKey (_from, _to) l = case lookup _from l of Nothing -> l
src/Network/MoeSocks/Internal/ShadowSocks/Encrypt.hs view
@@ -2,6 +2,7 @@ - https://hackage.haskell.org/package/shadowsocks - Copyright: rnons - Licence: MIT+ - Slightly modified to work better with moesocks -} @@ -40,23 +41,21 @@ import Control.Concurrent.MVar ( newEmptyMVar, isEmptyMVar , putMVar, readMVar) import Crypto.Hash.MD5 (hash)-import Data.Binary.Get (runGet, getWord64le) import Data.ByteString (ByteString) import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L import qualified Data.HashMap.Strict as HM-import Data.IntMap.Strict (fromList, (!))-import Data.List (sortBy) import Data.Maybe (fromJust) import Data.Monoid ((<>))-import Data.Word (Word8, Word64) import OpenSSL (withOpenSSL) import OpenSSL.EVP.Cipher (getCipherByName, CryptoMode(..)) import OpenSSL.EVP.Internal (cipherInitBS, cipherUpdateBS) import OpenSSL.Random (randBytes)+import Data.Text (Text)+import Control.Lens+import Data.Text.Lens -method_supported :: HM.HashMap String (Int, Int)+method_supported :: HM.HashMap Text (Int, Int) method_supported = HM.fromList [ ("aes-128-cfb", (16, 16)) , ("aes-192-cfb", (24, 16))@@ -73,25 +72,11 @@ , ("seed-cfb", (16, 16)) ] -iv_len :: String -> Int+iv_len :: Text -> Int iv_len method = m1 where (_, m1) = method_supported HM.! method -getTable :: ByteString -> [Word8]-getTable key = do- let s = L.fromStrict $ hash key- a = runGet getWord64le s- table = [0..255]-- map fromIntegral $ sortTable 1 a table--sortTable :: Word64 -> Word64 -> [Word64] -> [Word64]-sortTable 1024 _ table = table-sortTable i a table = sortTable (i+1) a $ sortBy cmp table- where- cmp x y = compare (a `mod` (x + i)) (a `mod` (y + i))- evpBytesToKey :: ByteString -> Int -> Int -> (ByteString, ByteString) evpBytesToKey password keyLen ivLen = let ms' = S.concat $ ms 0 []@@ -106,7 +91,7 @@ ms (i+1) (m ++ [hash (last m <> password)]) | otherwise = m -getSSLEncDec :: String -> ByteString+getSSLEncDec :: Text -> ByteString -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString) getSSLEncDec method password = do let (m0, m1) = fromJust $ HM.lookup method method_supported@@ -116,7 +101,8 @@ cipherCtx <- newEmptyMVar decipherCtx <- newEmptyMVar - cipherMethod <- fmap fromJust $ withOpenSSL $ getCipherByName method+ cipherMethod <- fmap fromJust $ withOpenSSL $ getCipherByName $ + method ^. _Text ctx <- cipherInitBS cipherMethod key cipher_iv Encrypt let encrypt "" = return ""@@ -124,10 +110,13 @@ empty <- isEmptyMVar cipherCtx if empty then do- putMVar cipherCtx ()+ putMVar cipherCtx $! () ciphered <- withOpenSSL $ cipherUpdateBS ctx buf- return $ cipher_iv <> ciphered- else withOpenSSL $ cipherUpdateBS ctx buf+ return $! cipher_iv <> ciphered+ else do+ r <- withOpenSSL $ cipherUpdateBS ctx buf+ return $! r+ decrypt "" = return "" decrypt buf = do empty <- isEmptyMVar decipherCtx@@ -135,31 +124,20 @@ then do let decipher_iv = S.take m1 buf dctx <- cipherInitBS cipherMethod key decipher_iv Decrypt- putMVar decipherCtx dctx+ putMVar decipherCtx $! dctx if S.null (S.drop m1 buf) then return ""- else withOpenSSL $ cipherUpdateBS dctx (S.drop m1 buf)+ else do+ r <- withOpenSSL $+ cipherUpdateBS dctx (S.drop m1 buf)+ return $! r else do dctx <- readMVar decipherCtx- withOpenSSL $ cipherUpdateBS dctx buf+ r <- withOpenSSL $ cipherUpdateBS dctx buf+ return $! r return (encrypt, decrypt) -getTableEncDec :: ByteString- -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString)-getTableEncDec key = return (encrypt, decrypt)- where- table = getTable key- encryptTable = fromList $ zip [0..255] table- decryptTable = fromList $ zip (map fromIntegral table) [0..255]- encrypt :: ByteString -> IO ByteString- encrypt buf = return $- S.pack $ map (\b -> encryptTable ! fromIntegral b) $ S.unpack buf- decrypt :: ByteString -> IO ByteString- decrypt buf = return $- S.pack $ map (\b -> decryptTable ! fromIntegral b) $ S.unpack buf--getEncDec :: String -> ByteString +getEncDec :: Text -> ByteString -> IO (ByteString -> IO ByteString, ByteString -> IO ByteString)-getEncDec "table" key = getTableEncDec key-getEncDec method key = getSSLEncDec method key+getEncDec = getSSLEncDec