diff --git a/config.json b/config.json --- a/config.json +++ b/config.json @@ -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" } diff --git a/moesocks.cabal b/moesocks.cabal --- a/moesocks.cabal +++ b/moesocks.cabal @@ -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 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 @@ -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 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 @@ -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 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 @@ -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 diff --git a/src/Network/MoeSocks/Internal/ShadowSocks/Encrypt.hs b/src/Network/MoeSocks/Internal/ShadowSocks/Encrypt.hs --- a/src/Network/MoeSocks/Internal/ShadowSocks/Encrypt.hs +++ b/src/Network/MoeSocks/Internal/ShadowSocks/Encrypt.hs @@ -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