diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/hprox.cabal b/hprox.cabal --- a/hprox.cabal +++ b/hprox.cabal @@ -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 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 diff --git a/src/Network/HProx.hs b/src/Network/HProx.hs --- a/src/Network/HProx.hs +++ b/src/Network/HProx.hs @@ -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 "" <> value "stdout" <> showDefault - <> help "specify the logging type") + <> help "Specify the logging type") loglevel = option (maybeReader logLevelReader) ( long "loglevel" <> metavar "" <> 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 diff --git a/src/Network/HProx/Impl.hs b/src/Network/HProx/Impl.hs --- a/src/Network/HProx/Impl.hs +++ b/src/Network/HProx/Impl.hs @@ -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 diff --git a/src/Network/HProx/Util.hs b/src/Network/HProx/Util.hs --- a/src/Network/HProx/Util.hs +++ b/src/Network/HProx/Util.hs @@ -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