paranoia (empty) → 0.1.0.0
raw patch · 7 files changed
+321/−0 lines, 7 filesdep +HsOpenSSLdep +basedep +bytestringsetup-changed
Dependencies added: HsOpenSSL, base, bytestring, directory, filepath, hdaemonize, http-client, http-client-openssl, http-types, network, optparse-applicative, paranoia, split, streaming-commons, text, time, unix, wai, warp
Files
- LICENSE +8/−0
- Setup.hs +2/−0
- app/Main.hs +46/−0
- paranoia.cabal +58/−0
- src/Logger.hs +43/−0
- src/Proxy.hs +162/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,8 @@+Copyright Dmitry "troydm" Geurkov (c) 2016+The MIT License (MIT)++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,46 @@+module Main where++import Logger (FileLogger(..))+import Proxy+import Control.Applicative+import Options.Applicative+import System.Posix.Daemonize (daemonize)++++data ProxyConfig = ProxyConfig {+ port :: Int,+ logPath :: String,+ logFormat :: String,+ daemon :: Bool+}++proxyConfigParser :: Parser ProxyConfig+proxyConfigParser = ProxyConfig+ <$> option auto+ ( long "port" <> short 'p'+ <> metavar "PORT" <> value 8080+ <> help "proxy port" )+ <*> strOption+ ( long "log-path" <> short 'l'+ <> metavar "PATH" <> value "./log"+ <> help "log directory path" )+ <*> strOption+ ( long "log-format" <> short 'f'+ <> metavar "FORMAT" <> value "%time %remote %method %host %path %query\n%headers\n"+ <> help "log format like '%time %remote %method %host %path %query %headers'" )+ <*> switch+ ( long "daemon" <> short 'd'+ <> help "run as daemon" )+++execProxy config = runProxy (port config) (FileLogger (logPath config) (Main.logFormat config))+exe config = if (daemon config) then daemonize $ execProxy config else execProxy config++main :: IO ()+main = execParser opts >>= exe+ where+ opts = info (helper <*> proxyConfigParser)+ ( fullDesc+ <> progDesc "HTTP Proxy server using Warp and http-client"+ <> header "paranoia - a HTTP Proxy server" )
+ paranoia.cabal view
@@ -0,0 +1,58 @@+name: paranoia+version: 0.1.0.0+synopsis: http proxy server+description: HTTP Proxy Server for stalking clients+homepage: https://github.com/troydm/paranoia#readme+license: MIT+license-file: LICENSE+author: Dmitry "troydm" Geurkov+maintainer: d.geurkov@gmail.com+copyright: 2016 Dmitry "troydm" Geurkov+category: Web+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Logger, Proxy+ build-depends: base >= 4.7 && < 5,+ time,+ directory,+ filepath,+ bytestring,+ text,+ network,+ split,+ streaming-commons,+ http-types,+ http-client,+ http-client-openssl,+ HsOpenSSL,+ unix,+ wai,+ warp+ default-language: Haskell2010++executable paranoia+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base >= 4.7 && < 5+ , paranoia+ , hdaemonize+ , optparse-applicative+ default-language: Haskell2010++test-suite paranoia-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , paranoia+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/troydm/paranoia
+ src/Logger.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+module Logger where++import Data.List+import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import Network.Wai+import Data.Time.LocalTime+import Data.Time.Format+import System.Directory+import System.FilePath+import Network.Socket++hostIp :: SockAddr -> String+hostIp saddr = T.unpack $ head (T.splitOn (T.pack ":") (T.pack $ show saddr))++unpackJust :: Maybe B.ByteString -> B.ByteString+unpackJust s = case s of+ Just i -> i+ Nothing -> ""++formatLog :: String -> LocalTime -> Request -> T.Text+formatLog fmt t r = foldl' (\t (r1,r2) -> T.replace r1 r2 t) (T.pack fmt) [+ ("%ip",(T.pack (hostIp $ remoteHost r))),+ ("%headers",(T.pack (show (requestHeaders r)))),+ ("%remote",(T.pack (show $ remoteHost r))), + ("%path",(T.pack (show $ rawPathInfo r))), + ("%query",(T.pack (show $ rawQueryString r))),+ ("%host",(T.pack (show $ unpackJust (requestHeaderHost r)))),+ ("%method",(T.pack (show (requestMethod r)))),+ ("%time",(T.pack (show t))) ]++class Logger a where+ log :: a -> LocalTime -> Request -> IO ()++data FileLogger = FileLogger { path :: FilePath, logFormat :: String }++instance Logger FileLogger where+ log f t r = mkdir >> B.appendFile fullPath (TE.encodeUtf8 $ formatLog (logFormat f) t r)+ where mkdir = createDirectoryIfMissing True (takeDirectory fullPath)+ fullPath = path f ++ "/" ++ (hostIp $ remoteHost r) ++ (formatTime defaultTimeLocale "/%Y/%m/%d.log" t)+
+ src/Proxy.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE OverloadedStrings #-}+module Proxy where++import qualified Logger as L+import qualified Data.ByteString.Char8 as B+import qualified Network.BSD as NBSD+import Network.Wai+import Network.HTTP.Types+import Network.HTTP.Types.Header+import Network.Wai.Handler.Warp (run)+import qualified Network.HTTP.Client as Client+import qualified Network.HTTP.Client.OpenSSL as ClientSSL+import Data.Time.LocalTime+import Control.Concurrent (ThreadId,forkIO)+import Control.Concurrent.Chan+import Data.ByteString.Lazy+import qualified Data.List.Split as Split+import Data.Streaming.Network+import Control.Exception (finally)+import Control.Monad (forever,when)+import Control.Concurrent (forkFinally)+import Control.Concurrent.MVar (MVar(..),takeMVar,putMVar,newEmptyMVar,isEmptyMVar)+import System.Posix.Unistd (usleep)+import Network.Socket (isConnected)+import Control.Exception (try)+import qualified OpenSSL.Session as SSL++splitHostAndPort :: String -> Maybe (String, Int)+splitHostAndPort hostport = case Split.splitOn ":" hostport of+ [host,port] -> Just (host, read port :: Int)+ _ -> Nothing++removeHeaders headers headersToRemove = Prelude.filter (\(h,_) -> not (inlist h headersToRemove)) headers+ where inlist h (x:l) = h == x || inlist h l + inlist h [] = False+ ++getRequest :: Client.Manager -> Request -> String -> IO (Client.Response ByteString)+getRequest man req url = do+ initialRequest <- Client.parseUrl url+ requestBody <- requestBody req+ let requestWithQS = Client.setQueryString (queryString req) initialRequest+ let request = requestWithQS { + Client.method=methodGet, + Client.redirectCount=0,+ Client.requestHeaders=(if url == paranoiaUrl then [] else (removeHeaders (requestHeaders req) [hContentLength])), + Client.requestBody=Client.RequestBodyBS requestBody+ } + Client.httpLbs request man++postRequest :: Client.Manager -> Request -> String -> IO (Client.Response ByteString)+postRequest man req url = do+ initialRequest <- Client.parseUrl url+ requestBody <- requestBody req+ let request = initialRequest { + Client.method=methodPost, + Client.redirectCount=0,+ Client.requestHeaders=(removeHeaders (requestHeaders req) [hContentLength]), + Client.requestBody = Client.RequestBodyBS requestBody + }+ Client.httpLbs request man++startLogger :: (L.Logger l) => l -> Chan (LocalTime,Request) -> IO ThreadId+startLogger l c = forkIO logData+ where logData = do (t,r) <- readChan c+ L.log l t r + logData++paranoiaUrl = "http://i.imgur.com/zXMBlV0.jpg"++isLocalHost :: String -> String -> Int -> Bool+isLocalHost host hostname port = host == (hostname ++ ":" ++ (show port)) || host == ("localhost:"++(show port)) || host == hostname || host == "localhost"++buildRequestUrl :: Request -> String -> Int -> String+buildRequestUrl request hostname port = + let unpackedpath = (B.unpack $ rawPathInfo request) in+ let path = if unpackedpath == "/" then "" else unpackedpath in+ case (requestHeaderHost request) of+ Just u -> let uu = (B.unpack u) in + if isLocalHost uu hostname port then paranoiaUrl else "http://"++uu++unpackedpath+ Nothing -> paranoiaUrl++forkThread :: IO () -> IO (MVar ())+forkThread proc = do handle <- newEmptyMVar+ _ <- forkFinally proc (\_ -> putMVar handle ())+ return handle++foreverUntil :: IO Bool -> IO a -> IO ()+foreverUntil cond act = do tf <- cond + if tf then act >> foreverUntil cond act else return ()++doUntil :: IO Bool -> IO a -> IO ()+doUntil cond act = do act+ tf <- cond + if tf then doUntil cond act else return ()++isAppDataSocketConnected appData = case appRawSocket appData of + Just s -> isConnected s+ Nothing -> return False++tunnel (Just host) = case (splitHostAndPort (B.unpack host)) of+ Just (host,port) -> flip responseRaw (tunnel Nothing) $ \clientBody response -> do+ runTCPClient (clientSettingsTCP port (B.pack host)) $ \remoteData -> do+ response "HTTP/1.1 200 Connection Established\r\nProxy-agent: paranoia\r\n\r\n"+ connClosed <- newEmptyMVar+ reader <- forkThread $ foreverUntil (isEmptyMVar connClosed) (do+ inp <- clientBody+ if (not $ B.null inp) then appWrite remoteData inp else usleep 100000+ )+ doUntil (isAppDataSocketConnected remoteData) (do + d <- appRead remoteData + if (B.null d) then usleep 100000 else response d) `finally` putMVar connClosed ()+ takeMVar reader+ Nothing -> (tunnel Nothing)+++tunnel Nothing = responseLBS status404 [("Content-Type", "text/plain")] "404 Not found"++fixResponseHeaders hs = ("Proxy-Agent","paranoia"):(removeHeaders hs [hContentEncoding,hContentLength])++processResponse respond req = do res <- try req + case res of + Left ex -> processResponseEx ex+ Right clientResponse -> respond $ responseLBS+ (Client.responseStatus clientResponse)+ (fixResponseHeaders (Client.responseHeaders clientResponse))+ (Client.responseBody clientResponse)+ where processResponseEx (Client.StatusCodeException s hs _) = + case lookup "X-Response-Body-Start" hs of+ Just body -> respond $ responseLBS s (fixResponseHeaders hs) (fromStrict body)+ Nothing -> respond $ responseLBS s (fixResponseHeaders hs) ""+ processResponseEx (Client.FailedConnectionException host port) = do + Prelude.putStrLn ("Timeout while connecting to " ++ host ++ ":" ++ (show port))+ respond $ responseLBS status502 [("Proxy-Agent","paranoia")] "Ohh nouz something went wrong"+ processResponseEx (Client.FailedConnectionException2 host port secure ex) = do + Prelude.putStrLn ("Failure while connecting to " ++ host ++ ":" ++ (show port) ++ " secure: "++(show secure) ++ " "++(show ex)) + respond $ responseLBS status502 [("Proxy-Agent","paranoia")] "Ohh nouz something went wrong"+ processResponseEx ex = do Prelude.putStrLn (show ex) + respond $ responseLBS status502 [("Proxy-Agent","paranoia")] "Ohh nouz something went wrong"++app :: Client.Manager -> Chan (LocalTime,Request) -> String -> Int -> Application+app man logChan hostname port = \request respond -> do+ t <- getZonedTime+ writeChan logChan (zonedTimeToLocalTime t, request)+ case requestMethod request of+ "GET" -> processResponse respond $ getRequest man request (buildRequestUrl request hostname port)+ "POST" -> processResponse respond $ postRequest man request (buildRequestUrl request hostname port)+ "CONNECT" -> respond $ tunnel (requestHeaderHost request)+ _ -> respond $ responseLBS+ status405+ [("Content-Type", "text/plain")]+ "405 Method not supported" +++runProxy :: (L.Logger l) => Int -> l -> IO ()+runProxy port logger = do+ man <- Client.newManager (ClientSSL.opensslManagerSettings SSL.context) --Client.defaultManagerSettings+ hostname <- NBSD.getHostName+ logChan <- newChan+ startLogger logger logChan+ Prelude.putStrLn $ "paranoia started on http://0.0.0.0:" ++ (show port) ++ "/"+ run port (app man logChan hostname port)
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"