hprox 0.5.4 → 0.6.0
raw patch · 6 files changed
+126/−36 lines, 6 filesdep +cryptondep +unordered-containersPVP ok
version bump matches the API change (PVP)
Dependencies added: crypton, unordered-containers
API changes (from Hackage documentation)
- Network.HProx: Config :: Maybe String -> Int -> [(String, CertFile)] -> Maybe FilePath -> Maybe String -> [(ByteString, ByteString)] -> Maybe String -> Bool -> Bool -> ByteString -> String -> LogLevel -> Config
+ Network.HProx: Config :: Maybe String -> Int -> [(String, CertFile)] -> Maybe FilePath -> Maybe String -> [(Maybe ByteString, ByteString, ByteString)] -> Maybe String -> Bool -> Bool -> ByteString -> String -> LogLevel -> Config
- Network.HProx: [_rev] :: Config -> [(ByteString, ByteString)]
+ Network.HProx: [_rev] :: Config -> [(Maybe ByteString, ByteString, ByteString)]
Files
- Changelog.md +6/−0
- README.md +0/−2
- hprox.cabal +5/−1
- src/Network/HProx.hs +55/−29
- src/Network/HProx/Impl.hs +8/−3
- src/Network/HProx/Util.hs +52/−1
Changelog.md view
@@ -1,3 +1,9 @@+## 0.6.0++- `--rev` now supports domain matching+- fix `Content-Length` header in HTTP/2 responses.+- passwords are now Argon2 salt-hashed+ ## 0.5.4 - routable `--rev` reverse proxy support
README.md view
@@ -75,8 +75,6 @@ ### Known Issue -* Passwords are currently stored in plain text, please set permission accordingly and- avoid using existing password. * HTTP/3 currently only works on the first domain as specified by `-s/--tls`, also SNI validation is unavailable as well.
hprox.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hprox-version: 0.5.4+version: 0.6.0 synopsis: a lightweight HTTP proxy server, and more description: Please see the README on GitHub at <https://github.com/bjin/hprox#readme> category: Web@@ -61,6 +61,7 @@ , case-insensitive >=1.2 , conduit >=1.3 , conduit-extra >=1.3+ , crypton , dns >=4.0 , fast-logger >=3.0 , http-client >=0.5@@ -72,6 +73,7 @@ , random >=1.2.1 , tls >=1.5 , tls-session-manager >=0.0.4+ , unordered-containers , wai >=3.2.2 , wai-extra >=3.0 , warp >=3.2.8@@ -104,6 +106,7 @@ , case-insensitive >=1.2 , conduit >=1.3 , conduit-extra >=1.3+ , crypton , dns >=4.0 , fast-logger >=3.0 , hprox@@ -116,6 +119,7 @@ , random >=1.2.1 , tls >=1.5 , tls-session-manager >=0.0.4+ , unordered-containers , wai >=3.2.2 , wai-extra >=3.0 , warp >=3.2.8
src/Network/HProx.hs view
@@ -19,6 +19,8 @@ ) where import Data.ByteString.Char8 qualified as BS8+import Data.HashMap.Strict qualified as HM+import Data.Ord (Down (..)) import Data.String (fromString) import Data.Version (showVersion) import Network.HTTP.Client.TLS (newTlsManager)@@ -42,7 +44,6 @@ #ifdef QUIC_ENABLED import Control.Concurrent.Async (mapConcurrently_)-import Data.List (find) import Network.QUIC qualified as Q import Network.QUIC.Internal qualified as Q import Network.Wai.Handler.Warp (setAltSvc)@@ -57,6 +58,7 @@ import Network.HProx.DoH import Network.HProx.Impl import Network.HProx.Log+import Network.HProx.Util import Paths_hprox -- | Configuration of HProx, see @hprox --help@ for details@@ -66,7 +68,7 @@ , _ssl :: [(String, CertFile)] , _auth :: Maybe FilePath , _ws :: Maybe String- , _rev :: [(BS8.ByteString, BS8.ByteString)]+ , _rev :: [(Maybe BS8.ByteString, BS8.ByteString, BS8.ByteString)] , _doh :: Maybe String , _hide :: Bool , _naive :: Bool@@ -94,12 +96,6 @@ readCert :: CertFile -> IO TLS.Credential readCert (CertFile c k) = either error id <$> TLS.credentialLoadX509 c k -splitBy :: Eq a => a -> [a] -> [[a]]-splitBy _ [] = [[]]-splitBy c (x:xs)- | c == x = [] : splitBy c xs- | otherwise = let y:ys = splitBy c xs in (x:y):ys- parser :: ParserInfo Config parser = info (helper <*> ver <*> config) (fullDesc <> progDesc desc) where@@ -107,14 +103,22 @@ [host, cert, key] -> Right (host, CertFile cert key) _ -> Left "invalid format for ssl certificates" - parseRev s@('/':_) = case elemIndices '/' s of+ parseRev0 s@('/':_) = case elemIndices '/' s of [] -> Nothing indices -> let (prefix, remote) = splitAt (last indices + 1) s- in Just (BS8.pack prefix, BS8.pack remote)- parseRev remote = Just ("/", BS8.pack remote)+ in Just (Nothing, BS8.pack prefix, BS8.pack remote)+ parseRev0 remote = Just (Nothing, "/", BS8.pack remote) + parseRev ('/':'/':s) = case elemIndex '/' s of+ Nothing -> Nothing+ Just ind -> let (domain, other) = splitAt ind s+ in do (_, prefix, remote) <- parseRev0 other+ return (Just (BS8.pack domain), prefix, remote)++ parseRev s = parseRev0 s+ desc = "a lightweight HTTP proxy server, and more"- ver = infoOption (showVersion version) (long "version" <> help "show version")+ ver = infoOption (showVersion version) (long "version" <> help "Display the version information") config = Config <$> bind <*> port@@ -136,7 +140,7 @@ ( long "bind" <> short 'b' <> metavar "bind_ip"- <> help "ip address to bind on (default: all interfaces)")+ <> help "Specify the IP address to bind to (default: all interfaces)") port = option auto ( long "port"@@ -144,69 +148,69 @@ <> metavar "port" <> value 3000 <> showDefault- <> help "port number")+ <> help "Specify the port number") ssl = many $ option (eitherReader parseSSL) ( long "tls" <> short 's' <> metavar "hostname:cerfile:keyfile"- <> help "enable TLS and specify a domain and associated TLS certificate (can be specified multiple times for multiple domains)")+ <> help "Enable TLS and specify a domain with its associated TLS certificate (can be specified multiple times for multiple domains)") auth = optional $ strOption ( long "auth" <> short 'a' <> metavar "userpass.txt"- <> help "password file for proxy authentication (plain text file with lines each containing a colon separated user/password pair)")+ <> help "Specify the password file for proxy authentication. Plaintext passwords should be in the format 'user:pass' and will be automatically Argon2-hashed by hprox. Ensure that the password file with plaintext password is writable") ws = optional $ strOption ( long "ws" <> metavar "remote-host:port"- <> help "remote host to handle websocket requests (port 443 indicates HTTPS remote server)")+ <> help "Specify the remote host to handle WebSocket requests (port 443 indicates an HTTPS remote server)") rev = many $ option (maybeReader parseRev) ( long "rev"- <> metavar "[/prefix/]remote-host:port"- <> help "remote host for reverse proxy (port 443 indicates HTTPS remote server), optional '/prefix/' can be specified as prefix to be matched (and stripped in proxied request)")+ <> metavar "[//domain/][/prefix/]remote-host:port"+ <> help "Specify the remote host for reverse proxy (port 443 indicates an HTTPS remote server). An optional '//domain/' will only process requests with the 'Host: domain' header, and an optional '/prefix/' can be specified as a prefix to be matched (and stripped in proxied request)") doh = optional $ strOption ( long "doh" <> metavar "dns-server:port"- <> help "enable DNS-over-HTTPS(DoH) support (53 will be used if port is not specified)")+ <> help "Enable DNS-over-HTTPS (DoH) support (port 53 will be used if not specified)") hide = switch ( long "hide"- <> help "never send 'proxy authentication required' response (however this might break the use of HTTPS proxy in browser)")+ <> help "Never send 'Proxy Authentication Required' response. Note that this might break the use of HTTPS proxy in browsers") naive = switch ( long "naive"- <> help "add naiveproxy compatible padding (requires TLS)")+ <> help "Add naiveproxy-compatible padding (requires TLS)") name = strOption ( long "name" <> metavar "server-name" <> value "hprox" <> showDefault- <> help "specify the server name for the 'Server' header")+ <> help "Specify the server name for the 'Server' header") logging = strOption ( long "log" <> metavar "<none|stdout|stderr|file>" <> value "stdout" <> showDefault- <> help "specify the logging type")+ <> help "Specify the logging type") loglevel = option (maybeReader logLevelReader) ( long "loglevel" <> metavar "<trace|debug|info|warn|error|none>" <> value INFO- <> help "specify the logging level (default: info)")+ <> help "Specify the logging level (default: info)") #ifdef QUIC_ENABLED quic = optional $ option auto ( long "quic" <> short 'q' <> metavar "port"- <> help "enable QUIC (HTTP/3) on UDP port")+ <> help "Enable QUIC (HTTP/3) on UDP port") #endif getLoggerType :: String -> LogType' LogStr@@ -334,17 +338,39 @@ Nothing -> return Nothing Just f -> do logger INFO $ "read username and passwords from " <> toLogStr f- Just . flip elem . filter (isJust . BS8.elemIndex ':') . BS8.lines <$> BS8.readFile f+ userList <- BS8.lines <$> BS8.readFile f+ let anyPlaintext = any (\line -> length (BS8.elemIndices ':' line) /= 2) userList+ processUser userpass = case passwordReader userpass of+ Nothing -> do+ logger WARN $ "unable to parse line from password file: " <> toLogStr userpass+ return Nothing+ Just (user, pass) -> do+ salted <- hashPasswordWithRandomSalt pass+ logger TRACE $ "parsed user (with salted password) from password file: " <> toLogStr (passwordWriter user salted)+ return $ Just (user, salted)+ passwordByUser <- HM.fromList . catMaybes <$> mapM processUser userList+ when anyPlaintext $ do+ logger INFO $ "writing back to password file " <> toLogStr f+ BS8.writeFile f (BS8.unlines [ passwordWriter u p | (u, p) <- HM.toList passwordByUser])+ let verify line = do+ idx <- BS8.elemIndex ':' line+ let user = BS8.take idx line+ pass = BS8.drop (idx + 1) line+ targetPass <- HM.lookup user passwordByUser+ return $ verifyPassword targetPass pass+ return $ Just (\line -> verify line == Just True)+ manager <- newTlsManager - let pset = ProxySettings pauth (Just _name) (BS8.pack <$> _ws) (sortOn (negate.BS8.length.fst) _rev) _hide (_naive && isSSL) logger+ let revSorted = sortOn (\(a,b,_) -> Down (isJust a, BS8.length b)) _rev+ pset = ProxySettings pauth (Just _name) (BS8.pack <$> _ws) revSorted _hide (_naive && isSSL) logger proxy = healthCheckProvider $ (if isSSL then forceSSL pset else id) $ httpProxy pset manager $ reverseProxy pset manager fallback when (isJust _ws) $ logger INFO $ "websocket redirect: " <> toLogStr (fromJust _ws)- unless (null _rev) $ logger INFO $ "reverse proxy: " <> toLogStr (show _rev)+ unless (null revSorted) $ logger INFO $ "reverse proxy: " <> toLogStr (show revSorted) when (isJust _doh) $ logger INFO $ "DNS-over-HTTPS redirect: " <> toLogStr (fromJust _doh) case _doh of
src/Network/HProx/Impl.hs view
@@ -49,7 +49,7 @@ { proxyAuth :: Maybe (BS.ByteString -> Bool) , passPrompt :: Maybe BS.ByteString , wsRemote :: Maybe BS.ByteString- , revRemoteMap :: [(BS.ByteString, BS.ByteString)]+ , revRemoteMap :: [(Maybe BS.ByteString, BS.ByteString, BS.ByteString)] , hideProxyAuth :: Bool , naivePadding :: Bool , logger :: Logger@@ -159,15 +159,20 @@ where settings = defaultWaiProxySettings { wpsSetIpHeader = SIHNone } + checkDomain Nothing _ = True+ checkDomain _ Nothing = False+ checkDomain (Just a) (Just b) = a == b+ proxyResponseFor req = go revRemoteMap where- go ((prefix, revRemote):left)- | prefix `BS.isPrefixOf` rawPathInfo req =+ go ((mTargetHost, prefix, revRemote):left)+ | checkDomain mTargetHost mReqHost && prefix `BS.isPrefixOf` rawPathInfo req = if revPort == 443 then WPRModifiedRequestSecure nreq (ProxyDest revHost revPort) else WPRModifiedRequest nreq (ProxyDest revHost revPort) | otherwise = go left where+ mReqHost = fmap (fst . parseHostPortWithDefault (error "unused port number")) (requestHeaderHost req) (revHost, revPort) = parseHostPortWithDefault 80 revRemote nreq = req { requestHeaders = hdrs
src/Network/HProx/Util.hs view
@@ -3,9 +3,16 @@ -- Copyright (C) 2023 Bin Jin. All Rights Reserved. module Network.HProx.Util- ( parseHostPort+ ( Password (..)+ , PasswordSalted (..)+ , hashPasswordWithRandomSalt+ , parseHostPort , parseHostPortWithDefault+ , passwordReader+ , passwordWriter , responseKnownLength+ , splitBy+ , verifyPassword ) where import Data.ByteString qualified as BS@@ -15,6 +22,50 @@ import Network.HTTP.Types (ResponseHeaders, Status) import Network.Wai++import Crypto.Error (CryptoFailable (..))+import Crypto.KDF.Argon2 qualified as Argon2+import Crypto.Random (MonadRandom (getRandomBytes))+import Data.ByteString.Base64 qualified as Base64++data Password = PlainText BS.ByteString+ | Salted BS.ByteString BS.ByteString+ deriving (Show, Eq)++data PasswordSalted = PasswordSalted BS.ByteString BS.ByteString+ deriving (Show, Eq)++splitBy :: Eq a => a -> [a] -> [[a]]+splitBy _ [] = [[]]+splitBy c (x:xs)+ | c == x = [] : splitBy c xs+ | otherwise = let y:ys = splitBy c xs in (x:y):ys++passwordReader :: BS.ByteString -> Maybe (BS.ByteString, Password)+passwordReader line = case BS8.split ':' line of+ [user, pass] -> Just (user, PlainText pass)+ [user, salt, hashed] -> case (Base64.decode salt, Base64.decode hashed) of+ (Right salt', Right hashed') -> Just (user, Salted salt' hashed')+ _ -> Nothing+ _ -> Nothing++passwordWriter :: BS.ByteString -> PasswordSalted -> BS.ByteString+passwordWriter user (PasswordSalted salt hash) =+ BS.concat [user , ":" , Base64.encode salt , ":" , Base64.encode hash]++hashPasswordWithRandomSalt :: Password -> IO PasswordSalted+hashPasswordWithRandomSalt (PlainText pass) = do+ salt <- getRandomBytes 24+ case Argon2.hash Argon2.defaultOptions pass salt 48 of+ CryptoFailed err -> error ("unable to hash password with salt: " ++ show err)+ CryptoPassed h -> return (PasswordSalted salt h)+hashPasswordWithRandomSalt (Salted salt h) = return (PasswordSalted salt h)++verifyPassword :: PasswordSalted -> BS8.ByteString -> Bool+verifyPassword (PasswordSalted salt hashed) pass =+ case Argon2.hash Argon2.defaultOptions pass salt 48 of+ CryptoFailed _ -> False+ CryptoPassed h -> h == hashed parseHostPort :: BS.ByteString -> Maybe (BS.ByteString, Int) parseHostPort hostPort = do