diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -187,7 +187,7 @@ same "printed page" as the copyright notice for easier identification within third-party archives. - Copyright [yyyy] [name of copyright owner] + 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. diff --git a/moesocks.cabal b/moesocks.cabal --- a/moesocks.cabal +++ b/moesocks.cabal @@ -3,7 +3,7 @@ name: moesocks category: Network -version: 0.1.0.3 +version: 0.1.0.4 license: Apache-2.0 synopsis: moe for all description: A socks5 proxy using the client / server architecture. @@ -42,6 +42,8 @@ , HsOpenSSL , containers , cryptohash + , safe + --, hslogger hs-source-dirs: src default-language: Haskell2010 @@ -52,5 +54,5 @@ Network.MoeSocks.Constant Network.MoeSocks.Helper Network.MoeSocks.Internal.ShadowSocks.Encrypt - Network.MoeSocks.OptionParser + Network.MoeSocks.Options Network.MoeSocks.Type diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,7 +1,7 @@ module Main where import Network.MoeSocks.App -import Network.MoeSocks.OptionParser +import Network.MoeSocks.Options import Options.Applicative hiding (Parser) main :: IO () 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 @@ -31,8 +31,9 @@ showAddressType :: AddressType -> String -showAddressType (IPv4_address xs) = concat - L.intersperse "." - map show xs -showAddressType (Domain_name x) = view _Text - x ^. utf8 +showAddressType (IPv4_address xs) = concat - L.intersperse "." - + map show - xs ^.. each +showAddressType (Domain_name x) = x ^. _Text showAddressType x = error - "IPv6 target not supported:" <> show x @@ -55,13 +56,8 @@ pushStream outputStream - greetingReplyBuilder _clientRequest <- parseFromStream connectionParser inputStream - {-puts - "request: " <> show _clientRequest-} - {-Stream.write (Just - builder_To_ByteString --} - {-connectionReplyBuilder _clientRequest)-} - {-outputStream-} - - Stream.write (Just - builder_To_ByteString nonStandardReplyBuilder) - outputStream + puts - "L : " <> show _clientRequest + let _c = aConfig _initSocket = @@ -75,11 +71,22 @@ _localPeerAddr <- getPeerName aSocket + _remoteSocketName <- getSocketName _remoteSocket + + puts - "remoteSocketName: " <> show _remoteSocketName + + puts- "socket pair: " <> show (sockAddr_To_Pair _remoteSocketName) + + let _connectionReplyBuilder = connectionReplyBuilder _remoteSocketName + + Stream.write (Just - builder_To_ByteString _connectionReplyBuilder) + outputStream + let showRequest :: ClientRequest -> String showRequest _r = showAddressType (_r ^. addressType) <> ":" - <> show (_r ^. portNumber . to portNumber16) + <> show (_r ^. portNumber) _log - "L " -- <> showConnectionType (_clientRequest ^. connectionType) <> ": " <> ( @@ -166,7 +173,7 @@ _port = _clientRequest ^. portNumber - getSocket _hostName (portNumber16 _port) _socketType + getSocket _hostName _port _socketType logSA "R connect target" (initTarget _clientRequest) - \_r -> do let (_targetSocket, _targetSocketAddress) = _r @@ -286,7 +293,7 @@ let handleLocal _socket = do (_newSocket, _) <- accept _socket - forkIO - catchAll - + forkIO - catchAllLog "L thread" - logSocket "L handler" (pure _newSocket) - localRequestHandler config @@ -306,7 +313,7 @@ let handleRemote _socket = do (_newSocket, _) <- accept _socket - forkIO - catchAll - + forkIO - catchAllLog "R thread" - logSocket "R handler" (pure _newSocket) - remoteRequestHandler config @@ -327,7 +334,12 @@ debugRun :: IO () debugRun = do - catchAllLog "Debug app" - waitBoth localRun remoteRun + catchAllLog "Debug app" - do + {-puts "Waiting ..."-} + {-threadDelay 1000000 -- wait last instance terminate-} + {-puts "Done"-} + + runBoth localRun remoteRun case options ^. runningMode of 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 @@ -1,16 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} + module Network.MoeSocks.BuilderAndParser where import Control.Lens import Data.Attoparsec.ByteString +import Data.Binary +import Data.Binary.Put import Data.Monoid -import Data.Word +import Data.Maybe +import Data.Text.Lens +import Data.Text.Strict.Lens (utf8) +import Safe (readMay) import Network.MoeSocks.Constant import Network.MoeSocks.Helper import Network.MoeSocks.Type import Prelude hiding ((-), take) +import qualified Prelude as P import qualified Data.ByteString as S import qualified Data.ByteString.Builder as B - +import Network.Socket socksVersion :: Word8 socksVersion = 5 @@ -31,6 +39,18 @@ greetingReplyBuilder = B.word8 socksVersion <> B.word8 _No_authentication +portParser :: Parser Int +portParser = do + __portNumberPair <- (,) <$> anyWord8 <*> anyWord8 + pure - portPairToInt __portNumberPair + +portBuilder :: (Integral i) => i -> B.Builder +portBuilder i = + let _i = fromIntegral i :: Word16 + in + foldMapOf both B.word8 - + (decode - runPut - put _i :: (Word8, Word8)) + requestParser :: Parser ClientRequest requestParser = do __connectionType <- choice @@ -42,7 +62,7 @@ word8 _ReservedByte __addressType <- addressTypeParser - __portNumber <- (,) <$> anyWord8 <*> anyWord8 + __portNumber <- portParser pure - ClientRequest __connectionType @@ -54,45 +74,66 @@ socksHeader requestParser -{- Special hack for polipo - -0500 0001 0000 0000 1010 - -} +sockAddr_To_Pair :: SockAddr -> (AddressType, Port) +sockAddr_To_Pair (SockAddrInet _port _host) = + let + _r@(_a, _b, _c, _d) = decode . + runPut - put - _host + :: (Word8, Word8, Word8, Word8) + in + ( IPv4_address - flip4 _r + , fromIntegral _port + ) +sockAddr_To_Pair (SockAddrInet6 _port _ _host _) = + let + _r@(_a, _b, _c, _d) = decode . + runPut - put - _host + :: (Word32, Word32, Word32, Word32) + in + ( IPv6_address - flip4 _r + , fromIntegral _port + ) +sockAddr_To_Pair (SockAddrUnix x) = + let + _host = P.takeWhile (/= ':') x :: String + _port = x & reverse & P.takeWhile (/= ':') + & reverse + in + ( Domain_name - (_host & review _Text) + , fromMaybe 0 - readMay _port + ) +sockAddr_To_Pair sa = error - "SockAddrCan not implemented: " <> show sa -nonStandardReplyBuilder :: B.Builder -nonStandardReplyBuilder = - B.word8 socksVersion - <> B.word8 _Request_Granted - <> B.word8 _ReservedByte - <> B.word8 1 - <> B.word8 0 - <> B.word8 0 - <> B.word8 0 - <> B.word8 0 - <> B.word8 16 - <> B.word8 16 -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) +connectionReplyBuilder :: SockAddr -> B.Builder +connectionReplyBuilder aSockAddr = + let _r@(__addressType, _port) = sockAddr_To_Pair aSockAddr + in + + let _b = + B.word8 socksVersion + <> B.word8 _Request_Granted + <> B.word8 _ReservedByte + <> addressTypeBuilder __addressType + <> portBuilder _port + in + _b + addressTypeBuilder :: AddressType -> B.Builder addressTypeBuilder aAddressType = case aAddressType of IPv4_address _address -> B.word8 1 - <> foldMap B.word8 (_address) + <> foldMapOf each B.word8 _address Domain_name x -> B.word8 3 - <> B.word8 (fromIntegral (S.length x)) - <> B.byteString x + <> B.word8 (fromIntegral (S.length (review utf8 x))) + <> B.byteString (review utf8 x) - IPv6_address xs -> + IPv6_address _address -> B.word8 4 - <> B.byteString (S.pack - xs) + <> foldMapOf each B.word32BE _address @@ -101,44 +142,57 @@ connectionType_To_Word8 TCP_IP_port_binding = 2 connectionType_To_Word8 UDP_port = 3 + + 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) + <> portBuilder (aClientRequest ^. portNumber) shadowsocksRequestBuilder :: ClientRequest -> B.Builder shadowsocksRequestBuilder aClientRequest = addressTypeBuilder (aClientRequest ^. addressType) - <> foldMapOf each B.word8 (aClientRequest ^. portNumber) + <> portBuilder (aClientRequest ^. portNumber) +anyWord32be :: Parser Word32 +anyWord32be = do + _b <- count 4 anyWord8 + pure - decode - runPut - put _b + addressTypeParser :: Parser AddressType addressTypeParser = choice [ IPv4_address <$> do word8 1 - count 4 anyWord8 + _a <- anyWord8 + _b <- anyWord8 + _c <- anyWord8 + _d <- anyWord8 + pure - (_a, _b, _c, _d) , Domain_name <$> do word8 3 let maxDomainNameLength = 32 _nameLength <- satisfy (<= maxDomainNameLength) - take - fromIntegral _nameLength + view utf8 <$> (take - fromIntegral _nameLength) , IPv6_address <$> do word8 4 - count 16 anyWord8 + _a <- anyWord32be + _b <- anyWord32be + _c <- anyWord32be + _d <- anyWord32be + pure - (_a, _b, _c, _d) ] -portParser :: Parser (Word8, Word8) -portParser = (,) <$> anyWord8 <*> anyWord8 - shadowsocksRequestParser :: Parser ClientRequest shadowsocksRequestParser = do __addressType <- addressTypeParser - __portNumber <- (,) <$> anyWord8 <*> anyWord8 + __portNumber <- portParser + pure - ClientRequest TCP_IP_stream_connection 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 @@ -1,4 +1,5 @@ {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ScopedTypeVariables #-} module Network.MoeSocks.Helper where @@ -37,8 +38,11 @@ type OB = OutputStream ByteString _Debug :: Bool -_Debug = False +_Debug = False +flip4 :: (a, b, c, d) -> (d, c, b, a) +flip4 (_a, _b, _c, _d) = (_d, _c, _b, _a) + boolToMaybe :: Bool -> Maybe () boolToMaybe True = Just () boolToMaybe False = Nothing @@ -68,19 +72,18 @@ showBytes :: ByteString -> String showBytes = show . S.unpack -fromWord8 :: forall t. Binary t => [Word8] -> t -fromWord8 = decode . runPut . mapM_ put logClose :: String -> Socket -> IO () -logClose _ aSocket = do - {-puts - "Closing socket " <> aID-} +logClose aID aSocket = do + puts - "Closing socket " <> aID close aSocket logSocketWithAddress :: String -> IO (Socket, SockAddr) -> ((Socket, SockAddr) -> IO a) -> IO a logSocketWithAddress aID _init f = do - catch (bracket _init (logClose aID . fst) f) - \e -> do - pute - "Exception in " <> aID <> ": " <> show (e :: SomeException) + catch (bracket _init (logClose aID . fst) f) - + \(e :: SomeException) -> do + pute - "logSocket: Exception in " <> aID <> ": " <> show e throw e logSA:: String -> IO (Socket, SockAddr) -> @@ -94,24 +97,30 @@ throw e catchAllLog :: String -> IO a -> IO () -catchAllLog aID io = catch (() <$ io) - \e -> - pute - "CatcheAll in " <> aID <> ": " - <> show (e :: SomeException) - -catchAll :: IO a -> IO () -catchAll io = catch (() <$ io) - \e -> - pute - "CatcheAll: " <> show (e :: SomeException) +catchAllLog aID io = catches (() <$ io) + [ + Handler - \(e :: AsyncException) -> do + pute - "ASyncException in " + <> aID + <> " : " <> show e + throw e + , Handler - \(e :: SomeException) -> + pute - "CatcheAll in " + <> aID + <> " : " <> show e + ] catchIO:: IO a -> IO () catchIO io = catch (() <$ io) - \e -> pute - "Catch IO: " <> show (e :: IOException) -wrapIO :: (Maybe String, IO c) -> IO () +wrapIO :: (Maybe String, IO c) -> IO c wrapIO (s, _io) = do - forM_ s - puts . ("+ " <>) - _io - forM_ s - puts . ("- " <>) + pure s + {-forM_ s - puts . ("+ " <>)-} + _io + {-<* (forM_ s - puts . ("- " <>))-} waitOneDebug :: (Maybe String, IO ()) -> (Maybe String, IO ()) -> IO () -> IO () waitOneDebug x y doneX = do @@ -166,7 +175,35 @@ waitBoth x y = do waitBothDebug (Nothing, x) (Nothing, y) +runBoth :: IO a -> IO b -> IO () +runBoth x y = do + let _init = do + (xThreadID, xLock) <- do + _lock <- newEmptyMVar + _threadID <- + forkFinally x - + const - putMVar _lock () + return (_threadID, _lock) + + yThreadID <- + forkFinally y - const - killThread xThreadID + + return (xThreadID, xLock, yThreadID) + + let handleError (xThreadID, _, yThreadID) = do + killThread yThreadID + killThread xThreadID + + let action (_, xLock, yThreadID) = do + takeMVar xLock + killThread yThreadID + + bracket + _init + handleError + action + pushStream :: (OutputStream ByteString) -> B.Builder -> IO () pushStream s b = do _builderStream <- Stream.builderStream s @@ -191,6 +228,8 @@ _socket <- socket family socketType protocol + puts - "Getting socket: " <> show address + pure (_socket, address) where @@ -209,9 +248,15 @@ getEncDec method (review utf8 password) -portNumber16 :: (Word8, Word8) -> Word16 -portNumber16 pair = fromWord8 - toListOf both pair +fromWord8 :: forall t. Binary t => [Word8] -> t +fromWord8 = decode . runPut . mapM_ put +portPairToInt :: (Word8, Word8) -> Int +portPairToInt = fromIntegral . portPairToWord16 + where + portPairToWord16 :: (Word8, Word8) -> Word16 + portPairToWord16 = decode . runPut . put + duplicateKey :: (Eq a) => (a, a) -> [(a, b)] -> [(a, b)] duplicateKey (_from, _to) l = case lookup _from l of @@ -243,3 +288,4 @@ killThread _loopThreadID pure () + diff --git a/src/Network/MoeSocks/OptionParser.hs b/src/Network/MoeSocks/OptionParser.hs deleted file mode 100644 --- a/src/Network/MoeSocks/OptionParser.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Network.MoeSocks.OptionParser where - -import Control.Lens -import Data.Text.Lens -import Network.MoeSocks.Helper -import Network.MoeSocks.Type -import Options.Applicative hiding (Parser) -import Prelude hiding ((-)) -import qualified Options.Applicative as O - -optionParser :: O.Parser MoeOptions -optionParser = - let _mode = strOption - - short 'm' - <> long "mode" - <> metavar "MODE" - <> help "local | remote" - in - let _config = strOption - - short 'c' - <> long "config" - <> metavar "CONFIG" - <> help "path to the configuration file" - - in - - let parseMode :: String -> RunningMode - parseMode x - | x `elem` ["server", "remote"] = RemoteMode - | x `elem` ["client", "local"] = LocalMode - | x == "debug" = DebugMode - | otherwise = DebugMode - in - - MoeOptions <$> fmap parseMode _mode <*> fmap (view packed) _config - -opts :: ParserInfo MoeOptions -opts = info (helper <*> optionParser) - - fullDesc - <> progDesc "A socks5 proxy using the client / server architecture" - <> header "moesocks - moe for all" - - diff --git a/src/Network/MoeSocks/Options.hs b/src/Network/MoeSocks/Options.hs new file mode 100644 --- /dev/null +++ b/src/Network/MoeSocks/Options.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Network.MoeSocks.Options where + +import Control.Lens +import Data.Text.Lens +import Network.MoeSocks.Helper +import Network.MoeSocks.Type +import Options.Applicative hiding (Parser) +import Prelude hiding ((-)) +import qualified Options.Applicative as O + + +optionParser :: O.Parser MoeOptions +optionParser = + let _mode = strOption - + short 'm' + <> long "mode" + <> metavar "MODE" + <> help "local | remote" + in + let _config = strOption - + short 'c' + <> long "config" + <> metavar "CONFIG" + <> help "path to the configuration file" + in + + let parseMode :: String -> RunningMode + parseMode x + | x `elem` ["server", "remote"] = RemoteMode + | x `elem` ["client", "local"] = LocalMode + | x == "debug" = DebugMode + | otherwise = DebugMode + in + + MoeOptions + <$> fmap parseMode _mode + <*> fmap (view packed) _config + +opts :: ParserInfo MoeOptions +opts = info (helper <*> optionParser) - + fullDesc + <> progDesc "A socks5 proxy using the client / server architecture" + <> header "moesocks - moe for all" + + 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 @@ -25,19 +25,20 @@ deriving (Show, Eq) data AddressType = - IPv4_address [Word8] - | Domain_name ByteString - | IPv6_address [Word8] + IPv4_address (Word8, Word8, Word8, Word8) + | Domain_name Text + | IPv6_address (Word32, Word32, Word32, Word32) deriving (Show, Eq) +type Port = Int data ClientRequest = ClientRequest { _connectionType :: ConnectionType , _addressType :: AddressType - , _portNumber :: (Word8, Word8) + , _portNumber :: Port } - deriving (Show) + deriving (Show, Eq) makeLenses ''ClientRequest @@ -58,6 +59,9 @@ makeLenses ''MoeConfig data RunningMode = RemoteMode | LocalMode | DebugMode + deriving (Show, Eq) + +data Socks5Header = Strict | Polipo deriving (Show, Eq) data MoeOptions = MoeOptions