moesocks 0.1.0.4 → 0.1.0.5
raw patch · 7 files changed
+101/−63 lines, 7 filesdep +hslogger
Dependencies added: hslogger
Files
- moesocks.cabal +2/−2
- src/Network/MoeSocks/App.hs +26/−7
- src/Network/MoeSocks/BuilderAndParser.hs +44/−40
- src/Network/MoeSocks/Config.hs +2/−0
- src/Network/MoeSocks/Helper.hs +9/−10
- src/Network/MoeSocks/Options.hs +15/−3
- src/Network/MoeSocks/Type.hs +3/−1
moesocks.cabal view
@@ -3,7 +3,7 @@ name: moesocks category: Network-version: 0.1.0.4+version: 0.1.0.5 license: Apache-2.0 synopsis: moe for all description: A socks5 proxy using the client / server architecture.@@ -43,7 +43,7 @@ , containers , cryptohash , safe- --, hslogger+ , hslogger hs-source-dirs: src default-language: Haskell2010
src/Network/MoeSocks/App.hs view
@@ -29,6 +29,11 @@ import qualified Data.Text.IO as TIO import qualified System.IO.Streams as Stream +import qualified System.Log.Handler as LogHandler+import System.Log.Handler.Simple+import System.Log.Formatter+import System.Log.Logger+import qualified System.IO as IO showAddressType :: AddressType -> String showAddressType (IPv4_address xs) = concat - L.intersperse "." - @@ -73,9 +78,8 @@ _remoteSocketName <- getSocketName _remoteSocket - puts - "remoteSocketName: " <> show _remoteSocketName-- puts- "socket pair: " <> show (sockAddr_To_Pair _remoteSocketName)+ {-puts - "remoteSocketName: " <> show _remoteSocketName-}+ {-puts- "socket pair: " <> show (sockAddr_To_Pair _remoteSocketName)-} let _connectionReplyBuilder = connectionReplyBuilder _remoteSocketName @@ -87,7 +91,7 @@ showAddressType (_r ^. addressType) <> ":" <> show (_r ^. portNumber)- _log - "L " -- <> showConnectionType (_clientRequest ^. connectionType)+ _log - "L " <> showConnectionType (_clientRequest ^. connectionType) <> ": " <> ( concat - L.intersperse " -> " @@ -278,13 +282,28 @@ moeApp:: MoeOptions -> IO () moeApp options = do+ stdoutHandler <- streamHandler IO.stdout DEBUG++ {-puts - "stdoutHandler Level" <> -}+ {-show (LogHandler.getLevel stdoutHandler)-}++ let formattedHandler = + LogHandler.setFormatter stdoutHandler -+ simpleLogFormatter "[$time $prio] $msg"++ updateGlobalLogger rootLoggerName removeHandler+ updateGlobalLogger "moe" - addHandler formattedHandler++ updateGlobalLogger "moe" - setLevel (options ^. verbosity)+ + maybeConfig <- parseConfig - options ^. configFile - + forM_ maybeConfig - \config -> do let localApp :: (Socket, SockAddr) -> IO () localApp s = logSA "L loop" (pure s) - \(_localSocket, _localAddr) -> do- putStrLn "Moe local!"+ puts "Moe local!" setSocketOption _localSocket ReuseAddr 1 bindSocket _localSocket _localAddr@@ -302,7 +321,7 @@ let remoteApp :: (Socket, SockAddr) -> IO () remoteApp s = logSA "R loop" (pure s) - \(_remoteSocket, _remoteAddr) -> do- putStrLn "Moe remote!"+ puts "Moe remote!" setSocketOption _remoteSocket ReuseAddr 1 bindSocket _remoteSocket _remoteAddr
src/Network/MoeSocks/BuilderAndParser.hs view
@@ -75,50 +75,55 @@ requestParser 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 +sockAddr_To_Pair aSockAddr = case aSockAddr of+ SockAddrInet _port _host -> + let + _r@(_a, _b, _c, _d) = + decode . runPut . put - _host+ :: (Word8, Word8, Word8, Word8)+ in + ( IPv4_address - flip4 _r+ , fromIntegral _port+ ) + SockAddrInet6 _port _ _host _ ->+ let + _r@(_a, _b, _c, _d) = + decode . runPut . put - _host+ :: (Word32, Word32, Word32, Word32)+ in++ ( IPv6_address - flip4 _r+ , fromIntegral _port+ )++ SockAddrUnix x -> + let+ _host = P.takeWhile (/= ':') x+ _port = x & reverse + & P.takeWhile (/= ':') + & reverse+ in++ ( Domain_name - (_host & review _Text)+ , fromMaybe 0 - readMay _port+ )++ x -> + error - "SockAddrCan not implemented: " + <> show x ++ 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+ B.word8 socksVersion+ <> B.word8 _Request_Granted + <> B.word8 _ReservedByte+ <> addressTypeBuilder __addressType+ <> portBuilder _port addressTypeBuilder :: AddressType -> B.Builder addressTypeBuilder aAddressType = @@ -174,8 +179,7 @@ , Domain_name <$> do word8 3- let maxDomainNameLength = 32- _nameLength <- satisfy (<= maxDomainNameLength)+ _nameLength <- anyWord8 view utf8 <$> (take - fromIntegral _nameLength) , IPv6_address <$> do
src/Network/MoeSocks/Config.hs view
@@ -4,6 +4,7 @@ import Network.MoeSocks.Constant import Network.MoeSocks.Type+import System.Log.Logger defaultMoeConfig :: MoeConfig defaultMoeConfig = MoeConfig@@ -22,4 +23,5 @@ { _runningMode = DebugMode , _configFile = ""+ , _verbosity = DEBUG }
src/Network/MoeSocks/Helper.hs view
@@ -17,7 +17,6 @@ import Network.MoeSocks.Internal.ShadowSocks.Encrypt import Network.Socket import Prelude hiding (take, (-)) -import System.IO (hPutStrLn, stderr) import System.IO.Streams (InputStream, OutputStream) import System.IO.Unsafe (unsafePerformIO) import qualified Data.ByteString as S@@ -26,6 +25,8 @@ import qualified Data.ByteString.Lazy as LB import qualified System.IO.Streams as Stream +import System.Log.Logger+ -- BEGIN backports infixr 0 -@@ -38,7 +39,7 @@ 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)@@ -56,15 +57,13 @@ io <* takeMVar syncLock puts :: String -> IO ()-puts - | _Debug = sync . putStrLn- | otherwise = const - pure ()+puts = sync . debugM "moe" pute :: String -> IO ()-pute = sync . hPutStrLn stderr+pute = sync . errorM "moe" _log :: String -> IO ()-_log = sync . putStrLn+_log = sync . infoM "moe" puteT :: Text -> IO () puteT = pute . view _Text@@ -74,8 +73,8 @@ logClose :: String -> Socket -> IO ()-logClose aID aSocket = do- puts - "Closing socket " <> aID+logClose _ aSocket = do+ {-puts - "Closing socket " <> aID-} close aSocket logSocketWithAddress :: String -> IO (Socket, SockAddr) -> @@ -228,7 +227,7 @@ _socket <- socket family socketType protocol - puts - "Getting socket: " <> show address+ {-puts - "Getting socket: " <> show address-} pure (_socket, address)
src/Network/MoeSocks/Options.hs view
@@ -9,23 +9,34 @@ import Options.Applicative hiding (Parser) import Prelude hiding ((-)) import qualified Options.Applicative as O-+import System.Log.Logger optionParser :: O.Parser MoeOptions optionParser = - let _mode = strOption -+ let _mode = ( strOption - short 'm' <> long "mode" <> metavar "MODE" <> help "local | remote"+ ) <|> pure "local" in- let _config = strOption -+ let _config = ( strOption - short 'c' <> long "config" <> metavar "CONFIG" <> help "path to the configuration file"+ ) <|> pure "config.json"+ in + let __verbosity :: O.Parser Priority + __verbosity = ( option auto - + short 'v'+ <> long "verbose"+ <> metavar "PRIORITY"+ <> help "DEBUG|INFO|NOTICE|WARNING"+ ) <|> pure INFO + in let parseMode :: String -> RunningMode parseMode x | x `elem` ["server", "remote"] = RemoteMode@@ -37,6 +48,7 @@ MoeOptions <$> fmap parseMode _mode <*> fmap (view packed) _config+ <*> __verbosity opts :: ParserInfo MoeOptions opts = info (helper <*> optionParser) -
src/Network/MoeSocks/Type.hs view
@@ -9,6 +9,7 @@ import Data.Text (Text) import Data.Word import GHC.Generics+import System.Log.Logger data ClientGreeting = ClientGreeting {@@ -61,13 +62,14 @@ data RunningMode = RemoteMode | LocalMode | DebugMode deriving (Show, Eq) -data Socks5Header = Strict | Polipo+data Verbosity = Normal | Verbose deriving (Show, Eq) data MoeOptions = MoeOptions { _runningMode :: RunningMode , _configFile :: Text+ , _verbosity :: Priority } deriving (Show, Eq)