hprox 0.1.1 → 0.1.2
raw patch · 4 files changed
+37/−37 lines, 4 files
Files
- README.md +1/−0
- hprox.cabal +3/−5
- src/HProx.hs +24/−23
- src/Main.hs +9/−9
README.md view
@@ -66,6 +66,7 @@ * Passwords are currently stored in plain text, please set permission accordingly and avoid using existing password.+* Wildcard certificates are NOT supported at this moment. ### License
hprox.cabal view
@@ -1,13 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack------ hash: 7b3965e17f09091c9d4a3bdedd075b5d746f3d7c24fc907dde01a2de3168dc85 name: hprox-version: 0.1.1+version: 0.1.2 synopsis: a lightweight HTTP proxy server, and more description: Please see the README on GitHub at <https://github.com/bjin/hprox#readme> category: Web@@ -59,6 +57,6 @@ , wai-extra >=3.0 , warp >=3.2.8 , warp-tls >=3.2.5+ default-language: Haskell2010 if flag(static) ghc-options: -optl-static- default-language: Haskell2010
src/HProx.hs view
@@ -2,6 +2,7 @@ -- -- Copyright (C) 2019 Bin Jin. All Rights Reserved. {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} module HProx ( ProxySettings(..)@@ -36,7 +37,6 @@ wpsUpgradeToRaw) import qualified Network.HTTP.Types as HT import qualified Network.HTTP.Types.Header as HT-import Network.Wai.Internal (getRequestBodyChunk) import Data.Conduit import Network.Wai@@ -62,10 +62,11 @@ httpProxy :: ProxySettings -> HC.Manager -> Middleware httpProxy set mgr = pacProvider . httpGetProxy set mgr . httpConnectProxy set -forceSSL :: Middleware-forceSSL app req respond- | isSecure req = app req respond- | otherwise = redirectToSSL req respond+forceSSL :: ProxySettings -> Middleware+forceSSL pset app req respond+ | isSecure req = app req respond+ | redirectWebsocket pset req = app req respond+ | otherwise = redirectToSSL req respond redirectToSSL :: Application redirectToSSL req respond@@ -102,23 +103,25 @@ isToStripHeader h = isProxyHeader h || isForwardedHeader h || h == "X-Real-IP" || h == "X-Scheme" checkAuth :: ProxySettings -> Request -> Bool-checkAuth pset req- | isNothing pauth = True- | isNothing authRsp = False- | otherwise = fromJust pauth decodedRsp+checkAuth ProxySettings{..} req+ | isNothing proxyAuth = True+ | isNothing authRsp = False+ | otherwise = fromJust proxyAuth decodedRsp where- pauth = proxyAuth pset authRsp = lookup HT.hProxyAuthorization (requestHeaders req) decodedRsp = decodeLenient $ snd $ BS8.spanEnd (/=' ') $ fromJust authRsp +redirectWebsocket :: ProxySettings -> Request -> Bool+redirectWebsocket ProxySettings{..} req = wpsUpgradeToRaw defaultWaiProxySettings req && isJust wsRemote+ proxyAuthRequiredResponse :: ProxySettings -> Response-proxyAuthRequiredResponse pset = responseLBS+proxyAuthRequiredResponse ProxySettings{..} = responseLBS HT.status407 [(HT.hProxyAuthenticate, "Basic realm=\"" `BS.append` prompt `BS.append` "\"")] "" where- prompt = fromMaybe "hprox" (passPrompt pset)+ prompt = fromMaybe "hprox" passPrompt pacProvider :: Middleware pacProvider fallback req respond@@ -141,14 +144,14 @@ | otherwise = fallback req respond reverseProxy :: ProxySettings -> HC.Manager -> Middleware-reverseProxy pset mgr fallback+reverseProxy ProxySettings{..} mgr fallback | isReverseProxy = waiProxyToSettings (return.proxyResponseFor) settings mgr | otherwise = fallback where settings = defaultWaiProxySettings { wpsSetIpHeader = SIHNone } - isReverseProxy = isJust (revRemote pset)- (revHost, revPort) = parseHostPortWithDefault 80 (fromJust (revRemote pset))+ isReverseProxy = isJust revRemote+ (revHost, revPort) = parseHostPortWithDefault 80 (fromJust revRemote) revWrapper = if revPort == 443 then WPRModifiedRequestSecure else WPRModifiedRequest proxyResponseFor req = revWrapper nreq (ProxyDest revHost revPort)@@ -164,19 +167,17 @@ ] httpGetProxy :: ProxySettings -> HC.Manager -> Middleware-httpGetProxy pset mgr fallback = waiProxyToSettings (return.proxyResponseFor) settings mgr+httpGetProxy pset@ProxySettings{..} mgr fallback = waiProxyToSettings (return.proxyResponseFor) settings mgr where settings = defaultWaiProxySettings { wpsSetIpHeader = SIHNone } proxyResponseFor req- | redirectWebsocket = wsWrapper (ProxyDest wsHost wsPort)- | not isGetProxy = WPRApplication fallback- | checkAuth pset req = WPRModifiedRequest nreq (ProxyDest host port)- | otherwise = WPRResponse (proxyAuthRequiredResponse pset)+ | redirectWebsocket pset req = wsWrapper (ProxyDest wsHost wsPort)+ | not isGetProxy = WPRApplication fallback+ | checkAuth pset req = WPRModifiedRequest nreq (ProxyDest host port)+ | otherwise = WPRResponse (proxyAuthRequiredResponse pset) where- isWebsocket = wpsUpgradeToRaw defaultWaiProxySettings req- redirectWebsocket = isWebsocket && isJust (wsRemote pset)- (wsHost, wsPort) = parseHostPortWithDefault 80 (fromJust (wsRemote pset))+ (wsHost, wsPort) = parseHostPortWithDefault 80 (fromJust wsRemote) wsWrapper = if wsPort == 443 then WPRProxyDestSecure else WPRProxyDest notCONNECT = requestMethod req /= "CONNECT"
src/Main.hs view
@@ -2,6 +2,7 @@ -- -- Copyright (C) 2019 Bin Jin. All Rights Reserved. {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} module Main where @@ -21,7 +22,6 @@ getUserEntryForName, setUserID) import Data.Maybe-import Data.Monoid ((<>)) import Data.Version (showVersion) import Options.Applicative @@ -117,9 +117,9 @@ main :: IO () main = do- opts <- execParser parser+ Opts{..} <- execParser parser - let certfiles = _ssl opts+ let certfiles = _ssl certs <- mapM (readCert.snd) certfiles let isSSL = not (null certfiles)@@ -128,7 +128,7 @@ settings = setNoParsePath True $ setServerName "Apache" $- maybe id (setBeforeMainLoop . setuid) (_user opts)+ maybe id (setBeforeMainLoop . setuid) _user defaultSettings tlsset' = tlsSettings (certfile primaryCert) (keyfile primaryCert)@@ -146,13 +146,13 @@ runner | isSSL = runTLS tlsset | otherwise = runSettings - pauth <- case _auth opts of+ pauth <- case _auth of Nothing -> return Nothing Just f -> Just . flip elem . filter (isJust . BS8.elemIndex ':') . BS8.lines <$> BS8.readFile f manager <- newTlsManager - let pset = ProxySettings pauth Nothing (BS8.pack <$> _ws opts) (BS8.pack <$> _rev opts)- proxy = (if isSSL then forceSSL else id) $ gzip def $ httpProxy pset manager $ reverseProxy pset manager dumbApp- port = _port opts+ let pset = ProxySettings pauth Nothing (BS8.pack <$> _ws) (BS8.pack <$> _rev)+ proxy = (if isSSL then forceSSL pset else id) $ gzip def $ httpProxy pset manager $ reverseProxy pset manager dumbApp+ port = _port - runner (setHost (fromMaybe "*6" (_bind opts)) $ setPort port settings) proxy+ runner (setHost (fromMaybe "*6" _bind) $ setPort port settings) proxy