hprox 0.1.2 → 0.2.0
raw patch · 7 files changed
+122/−26 lines, 7 filesdep +dnsdep ~base64-bytestring
Dependencies added: dns
Dependency ranges changed: base64-bytestring
Files
- LICENSE +1/−1
- README.md +1/−0
- hprox.cabal +6/−3
- src/DoH.hs +66/−0
- src/HProx.hs +3/−14
- src/Main.hs +20/−8
- src/Util.hs +25/−0
LICENSE view
@@ -187,7 +187,7 @@ same "printed page" as the copyright notice for easier identification within third-party archives. - Copyright 2019 Bin Jin+ Copyright 2023 Bin Jin Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.
README.md view
@@ -17,6 +17,7 @@ * Provide PAC file for easy client side configuration (supports Chrome and Firefox). * Websocket redirection (compatible with [v2ray-plugin](https://github.com/shadowsocks/v2ray-plugin)). * Reverse proxy support (redirect requests to a fallback server).+* DNS-over-HTTPS (DoH) support. * Implemented as a middleware, compatible with any Haskell Web Application built with `wai` interface. Defaults to fallback to a dumb application which simulate the default empty page from Apache.
hprox.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hprox-version: 0.1.2+version: 0.2.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@@ -13,7 +13,7 @@ bug-reports: https://github.com/bjin/hprox/issues author: Bin Jin maintainer: bjin@ctrl-d.org-copyright: 2019 Bin Jin+copyright: 2023 Bin Jin license: Apache-2.0 license-file: LICENSE build-type: Simple@@ -32,20 +32,23 @@ executable hprox main-is: Main.hs other-modules:+ DoH HProx Paths_hprox+ Util hs-source-dirs: src ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N build-depends: async >=2.2 , base >=4.12 && <5- , base64-bytestring >=1.0+ , base64-bytestring >=1.1 , binary >=0.8 , bytestring >=0.10 , case-insensitive >=1.2 , conduit >=1.3 , conduit-extra >=1.3+ , dns >=4.0 , http-client >=0.5 , http-client-tls >=0.3.4 , http-reverse-proxy >=0.4.0
+ src/DoH.hs view
@@ -0,0 +1,66 @@+-- SPDX-License-Identifier: Apache-2.0+--+-- Copyright (C) 2023 Bin Jin. All Rights Reserved.+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module DoH (+ createResolver,+ dnsOverHTTPS+) where++import qualified Data.ByteString.Base64.URL as Base64+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as LBS+import Network.DNS (DNSHeader (..), DNSMessage (..),+ Question (..), ResolvConf (..),+ Resolver)+import qualified Network.DNS as DNS+import qualified Network.HTTP.Types as HT++import Network.Wai+import Util++createResolver :: String -> (Resolver -> IO a) -> IO a+createResolver remote handle = do+ seed <- DNS.makeResolvSeed conf+ DNS.withResolver seed handle+ where+ (h, p) = parseHostPortWithDefault 53 (BS8.pack remote)+ info = DNS.RCHostPort (BS8.unpack h) (fromIntegral p)++ conf = DNS.defaultResolvConf { resolvInfo = info }++dnsOverHTTPS :: Resolver -> Middleware+dnsOverHTTPS resolver fallback req respond+ | pathInfo req == ["dns-query"] && isSecure req = handleDoH resolver req respond+ | otherwise = fallback req respond++handleDoH :: Resolver -> Application+handleDoH resolver req respond+ | requestMethod req == "GET",+ [("dns", Just dnsStr)] <- queryString req,+ Right dnsQuery <- Base64.decodeUnpadded dnsStr,+ Right (DNSMessage { question = [q], header = DNSHeader {..} }) <- DNS.decode dnsQuery =+ handleQuery identifier q+ | requestMethod req == "POST",+ KnownLength len <- requestBodyLength req,+ len <= 4096 = do+ dnsQuery <- getRequestBodyChunk req+ case DNS.decode dnsQuery of+ Right (DNSMessage { question = [q], header = DNSHeader {..} }) -> handleQuery identifier q+ _ -> respond errorResp+ | otherwise = respond errorResp+ where+ errorResp = responseLBS HT.status400 [("Content-Type", "text/plain")] "invalid dns-over-https request"++ handleQuery ident Question{..} = do+ resp <- DNS.lookupRaw resolver qname qtype+ respond $ case resp of+ Left _ -> errorResp+ Right dnsResp@DNSMessage{header = header} ->+ let encoded = DNS.encode (dnsResp {header = header {identifier = ident} }) in+ responseLBS HT.status200+ [("Content-Type", "application/dns-message"),+ ("Content-Length", BS8.pack $ show (BS8.length encoded))]+ (LBS.fromStrict encoded)
src/HProx.hs view
@@ -1,6 +1,6 @@ -- SPDX-License-Identifier: Apache-2.0 ----- Copyright (C) 2019 Bin Jin. All Rights Reserved.+-- Copyright (C) 2023 Bin Jin. All Rights Reserved. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -41,6 +41,8 @@ import Data.Conduit import Network.Wai +import Util+ data ProxySettings = ProxySettings { proxyAuth :: Maybe (BS.ByteString -> Bool) , passPrompt :: Maybe BS.ByteString@@ -79,19 +81,6 @@ [("Upgrade", "TLS/1.0, HTTP/1.1"), ("Connection", "Upgrade")] "" -parseHostPort :: BS.ByteString -> Maybe (BS.ByteString, Int)-parseHostPort hostPort = do- lastColon <- BS8.elemIndexEnd ':' hostPort- port <- BS8.readInt (BS.drop (lastColon+1) hostPort) >>= checkPort- return (BS.take lastColon hostPort, port)- where- checkPort (p, bs)- | BS.null bs && 1 <= p && p <= 65535 = Just p- | otherwise = Nothing--parseHostPortWithDefault :: Int -> BS.ByteString -> (BS.ByteString, Int)-parseHostPortWithDefault defaultPort hostPort =- fromMaybe (hostPort, defaultPort) $ parseHostPort hostPort isProxyHeader :: HT.HeaderName -> Bool isProxyHeader k = "proxy" `BS.isPrefixOf` CI.foldedCase k
src/Main.hs view
@@ -1,6 +1,6 @@ -- SPDX-License-Identifier: Apache-2.0 ----- Copyright (C) 2019 Bin Jin. All Rights Reserved.+-- Copyright (C) 2023 Bin Jin. All Rights Reserved. {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -12,7 +12,8 @@ import Network.TLS as TLS import Network.Wai.Handler.Warp (HostPreference, defaultSettings, runSettings, setBeforeMainLoop,- setHost, setNoParsePath, setPort,+ setHost, setNoParsePath,+ setOnException, setPort, setServerName) import Network.Wai.Handler.WarpTLS (OnInsecure (..), onInsecure, runTLS, tlsServerHooks,@@ -25,6 +26,7 @@ import Data.Version (showVersion) import Options.Applicative +import DoH import HProx (ProxySettings (..), dumbApp, forceSSL, httpProxy, reverseProxy) import Paths_hprox (version)@@ -37,6 +39,7 @@ , _auth :: Maybe FilePath , _ws :: Maybe String , _rev :: Maybe String+ , _doh :: Maybe String } data CertFile = CertFile@@ -70,6 +73,7 @@ <*> auth <*> ws <*> rev+ <*> doh bind = optional $ fromString <$> strOption ( long "bind"@@ -111,7 +115,12 @@ <> metavar "remote-host:port" <> help "remote host for reverse proxy (port 443 indicates HTTPS remote server)") + 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)") + setuid :: String -> IO () setuid user = getUserEntryForName user >>= setUserID . userID @@ -126,7 +135,10 @@ (primaryHost, primaryCert) = head certfiles otherCerts = tail $ zip (map fst certfiles) certs - settings = setNoParsePath True $+ settings = setHost (fromMaybe "*6" _bind) $+ setPort _port $+ setOnException (\_ _ -> return ()) $+ setNoParsePath True $ setServerName "Apache" $ maybe id (setBeforeMainLoop . setuid) _user defaultSettings@@ -135,12 +147,11 @@ hooks = (tlsServerHooks tlsset') { onServerNameIndication = onSNI } tlsset = tlsset' { tlsServerHooks = hooks, onInsecure = AllowInsecure } - failSNI = fail "SNI" >> return mempty- onSNI Nothing = failSNI+ onSNI Nothing = fail "SNI: unspecified" onSNI (Just host) | host == primaryHost = return mempty | otherwise = case lookup host otherCerts of- Nothing -> failSNI+ Nothing -> fail ("SNI: unknown hostname (" ++ show host ++ ")") Just cert -> return (TLS.Credentials [cert]) runner | isSSL = runTLS tlsset@@ -153,6 +164,7 @@ 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) $ setPort port settings) proxy+ case _doh of+ Nothing -> runner settings proxy+ Just doh -> createResolver doh (\resolver -> runner settings (dnsOverHTTPS resolver proxy))
+ src/Util.hs view
@@ -0,0 +1,25 @@+-- SPDX-License-Identifier: Apache-2.0+--+-- Copyright (C) 2023 Bin Jin. All Rights Reserved.+module Util (+ parseHostPort,+ parseHostPortWithDefault+) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import Data.Maybe (fromMaybe)++parseHostPort :: BS.ByteString -> Maybe (BS.ByteString, Int)+parseHostPort hostPort = do+ lastColon <- BS8.elemIndexEnd ':' hostPort+ port <- BS8.readInt (BS.drop (lastColon+1) hostPort) >>= checkPort+ return (BS.take lastColon hostPort, port)+ where+ checkPort (p, bs)+ | BS.null bs && 1 <= p && p <= 65535 = Just p+ | otherwise = Nothing++parseHostPortWithDefault :: Int -> BS.ByteString -> (BS.ByteString, Int)+parseHostPortWithDefault defaultPort hostPort =+ fromMaybe (hostPort, defaultPort) $ parseHostPort hostPort