moesocks 0.1.0.3 → 0.1.0.4
raw patch · 9 files changed
+247/−127 lines, 9 filesdep +safe
Dependencies added: safe
Files
- LICENSE +1/−1
- moesocks.cabal +4/−2
- src/Main.hs +1/−1
- src/Network/MoeSocks/App.hs +26/−14
- src/Network/MoeSocks/BuilderAndParser.hs +93/−39
- src/Network/MoeSocks/Helper.hs +66/−20
- src/Network/MoeSocks/OptionParser.hs +0/−45
- src/Network/MoeSocks/Options.hs +47/−0
- src/Network/MoeSocks/Type.hs +9/−5
LICENSE view
@@ -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.
moesocks.cabal view
@@ -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
src/Main.hs view
@@ -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 ()
src/Network/MoeSocks/App.hs view
@@ -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
src/Network/MoeSocks/BuilderAndParser.hs view
@@ -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
src/Network/MoeSocks/Helper.hs view
@@ -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 ()+
− src/Network/MoeSocks/OptionParser.hs
@@ -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"--
+ src/Network/MoeSocks/Options.hs view
@@ -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"++
src/Network/MoeSocks/Type.hs view
@@ -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