dprox 0.3.0 → 0.4.0
raw patch · 9 files changed
+330/−117 lines, 9 filesdep +fast-logger
Dependencies added: fast-logger
Files
- README.md +11/−2
- dprox.cabal +15/−10
- src/Config.hs +113/−33
- src/DomainRoute.hs +10/−10
- src/LRU.hs +12/−13
- src/Log.hs +54/−0
- src/Main.hs +100/−41
- systemd/dprox.service +10/−3
- test/Test.hs +5/−5
README.md view
@@ -49,8 +49,7 @@ Use `dprox --help` or [dnsmasq manpage](http://www.thekelleys.org.uk/dnsmasq/docs/dnsmasq-man.html) for further details about these options. But be aware that there might be minor differences on some options like `--server`. -To use `dprox` with `dnsmasq-china-list`, with "8.8.4.4" as the remote DNS server-(systemd user can also use [this unit file](https://github.com/bjin/dprox/blob/master/systemd/dprox.service)):+To use `dprox` with `dnsmasq-china-list`, with "8.8.4.4" as the remote DNS server: ```sh dprox -C /etc/dnsmasq.d/accelerated-domains.china.conf -C /etc/dnsmasq.d/bogus-nxdomain.china.conf -S 8.8.4.4@@ -60,6 +59,16 @@ ```sh dprox -C /opt/hosts-blocklists/domains.txt -H /opt/hosts-blocklists/hostnames.txt -h+```++There is also a customized `--ipset` option (different from `dnsmasq`). If DNS response somehow matches `ipset`,+alternative DNS server `ipset-server` will be used instead. The exact matching policy can be set by `ipset-match`.++```+--ipset <ipmask>+--ipset-match <none|all|any|anynotmatch>+--ipset-server <ipaddr>[#port]+--ipset-file <file> ``` ### Known Issue
dprox.cabal view
@@ -1,21 +1,19 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack------ hash: 595c7426c43140ed95c8e5a736712c4e64ca373cca9ba084e938e04150a516cf name: dprox-version: 0.3.0-synopsis: a lightweight DNS proxy server+version: 0.4.0+synopsis: a lightweight DNS proxy server, compatible with dnsmasq-china-list description: Please see the README on GitHub at <https://github.com/bjin/dprox#readme> category: DNS homepage: https://github.com/bjin/dprox#readme bug-reports: https://github.com/bjin/dprox/issues author: Bin Jin maintainer: bjin@ctrl-d.org-copyright: 2019 Bin Jin+copyright: 2023 Bin Jin license: BSD3 license-file: LICENSE build-type: Simple@@ -38,10 +36,13 @@ Config DomainRoute LRU+ Log Paths_dprox hs-source-dirs: src- ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N+ default-extensions:+ ImportQualifiedPost+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: attoparsec >=0.13 , base >=4.12 && <5@@ -49,6 +50,7 @@ , bytestring-trie >=0.2.4 , containers >=0.6 , dns >=3.0.4+ , fast-logger >=3.0 , hashable >=1.2 , iproute >=1.7 , network >=2.8@@ -57,9 +59,9 @@ , streaming-commons >=0.2 , time >=1.8 , unix >=2.7+ default-language: Haskell2010 if flag(static) ghc-options: -optl-static- default-language: Haskell2010 test-suite dprox-test type: exitcode-stdio-1.0@@ -69,7 +71,9 @@ hs-source-dirs: src test- ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N+ default-extensions:+ ImportQualifiedPost+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N build-depends: attoparsec >=0.13 , base >=4.12 && <5@@ -77,6 +81,7 @@ , bytestring-trie >=0.2.4 , containers >=0.6 , dns >=3.0.4+ , fast-logger >=3.0 , hashable >=1.2 , hspec , iproute >=1.7@@ -86,6 +91,6 @@ , streaming-commons >=0.2 , time >=1.8 , unix >=2.7+ default-language: Haskell2010 if flag(static) ghc-options: -optl-static- default-language: Haskell2010
src/Config.hs view
@@ -3,33 +3,35 @@ -- Copyright (C) 2019 Bin Jin. All Rights Reserved. {-# LANGUAGE OverloadedStrings #-} module Config-( GlobalConfig(..)-, Config(..)-, getConfig-, IP(..)-, invalidIPAddress-, PortNumber-) where+ ( Config (..)+ , GlobalConfig (..)+ , IP (..)+ , IPMask+ , IPSetMatch (..)+ , PortNumber+ , getConfig+ , invalidIPAddress+ ) where -import Control.Exception (SomeException, handle)-import Control.Monad (when)-import Data.Attoparsec.ByteString ((<?>))-import qualified Data.Attoparsec.ByteString as P-import qualified Data.Attoparsec.ByteString.Char8 as P8-import qualified Data.ByteString as BS-import qualified Data.ByteString.Char8 as BS8-import Data.IP (IP (..))-import Data.Maybe (catMaybes, fromMaybe,- isNothing)-import Data.Streaming.Network (HostPreference)-import Data.String (fromString)-import Data.Version (showVersion)-import qualified Network.DNS as DNS-import Network.Socket (PortNumber)-import Options.Applicative-import Text.Read (readMaybe)+import Control.Exception (SomeException, handle)+import Control.Monad (when)+import Data.Attoparsec.ByteString ((<?>))+import Data.Attoparsec.ByteString qualified as P+import Data.Attoparsec.ByteString.Char8 qualified as P8+import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as BS8+import Data.IP (AddrRange, IP (..), IPv4)+import Data.Maybe (catMaybes, fromMaybe, isNothing)+import Data.Streaming.Network (HostPreference)+import Data.String (fromString)+import Data.Version (showVersion)+import Network.DNS qualified as DNS+import Network.Socket (PortNumber)+import Options.Applicative+import Text.Read (readMaybe) -import Paths_dprox (version)+import Log+import Paths_dprox data GlobalConfig = GlobalConfig { setUser :: Maybe String@@ -37,23 +39,36 @@ , listenAddress :: Maybe HostPreference , cacheSize :: Int , cacheTTL :: DNS.TTL+ , loglevel :: LogLevel+ , ipsetMatch :: IPSetMatch+ , ipsetServer :: Maybe (IP, Maybe PortNumber) } deriving (Eq, Show) +type IPMask = AddrRange IPv4+ data Config = Server (Maybe DNS.Domain) IP (Maybe PortNumber) | Address DNS.Domain IP | Hosts DNS.Domain IP | BogusNX IP+ | IPSet IPMask deriving (Eq, Show) +data IPSetMatch = NoneMatch+ | AllMatch+ | AnyMatch+ | AnyNotMatch+ deriving (Eq, Show)+ getConfig :: IO (GlobalConfig, [Config]) getConfig = do- (globalConfigs, configFiles, hostsFiles, confs) <- execParser opts+ (confs, globalConfigs, configFiles, hostsFiles, ipsetFiles) <- execParser opts confs1 <- concat <$> mapM readConfigFromFile configFiles confs2 <- concat <$> mapM readHostsFromFile hostsFiles- return (globalConfigs, confs1 ++ confs2 ++ confs)+ confs3 <- concat <$> mapM readIPSetFromFile ipsetFiles+ return (globalConfigs, confs1 ++ confs2 ++ confs3 ++ confs) where- opts = info ((,,,) <$> globalOption <*> configFileOption- <*> hostsFilesOption <*> plainOption <**> ver <**> helper)+ opts = info ((,,,,) <$> plainOption <*> globalOption <*> configFileOption+ <*> hostsFilesOption <*> ipsetFileOption <**> ver <**> helper) ( fullDesc <> progDesc desc ) desc = "a lightweight DNS proxy server, supports a small subset of dnsmasq options"@@ -61,6 +76,7 @@ readConfigFromFile file = handle handler (parseConfigFile <$> BS.readFile file) readHostsFromFile file = handle handler (parseHostsFile <$> BS.readFile file)+ readIPSetFromFile file = handle handler (parseIPSetFile <$> BS.readFile file) handler :: SomeException -> IO [Config] handler _ = return []@@ -101,6 +117,18 @@ skipLine return (Hosts parsedDomain parsedIP) +parseIPSetFile :: BS.ByteString -> [Config]+parseIPSetFile bs = case P.parseOnly parseFile bs of+ Left msg -> error msg+ Right r -> r+ where+ parseFile = catMaybes <$> P.many' (parseLine parseIPSet)++ parseIPSet = do+ parsedIPSet <- ip4mask+ skipLine+ return (IPSet parsedIPSet)+ parseLine :: P.Parser a -> P.Parser (Maybe a) parseLine parser = do eof <- P.atEnd@@ -126,18 +154,31 @@ Nothing -> fail ("invalid IP address: " ++ ipstr) Just ipaddr -> return ipaddr -invalidIPAddress :: IP-invalidIPAddress = "::"+ip4mask :: P.Parser IPMask+ip4mask = (<?> "IPv4 mask") $ do+ ipstr <- BS8.unpack <$> P8.takeWhile1 (P8.inClass "0-9./")+ case readMaybe ipstr of+ Nothing -> fail ("invalid IP mask: " ++ ipstr)+ Just ipmask -> return ipmask port :: P.Parser PortNumber port = read . BS8.unpack <$> P.takeWhile1 P8.isDigit_w8 <?> "Port Number" +ipport :: P.Parser (IP, Maybe PortNumber)+ipport = (,) <$> ip <*> optional (P8.char '#' *> port)++invalidIPAddress :: IP+invalidIPAddress = "::"+ globalOption :: Parser GlobalConfig globalOption = GlobalConfig <$> userOption <*> portOption <*> listenOption <*> cacheOption <*> ttlOption+ <*> loglevelOption+ <*> ipsetMatchOption+ <*> ipsetServerOption where userOption = optional $ strOption ( long "user"@@ -169,6 +210,30 @@ <> value 233 <> help "Cache TTL in seconds (default value: 233)") + loglevelOption = option (maybeReader logLevelReader)+ ( long "log-level"+ <> metavar "<trace|debug|info|warn|error|none>"+ <> value INFO+ <> help "specify the logging level (default: info)")++ ipsetMatchOption = option (maybeReader ipsetMatchReader)+ ( long "ipset-match"+ <> metavar "<none|all|any|anynotmatch>"+ <> value AnyMatch+ <> help ("matching policy for --ipset (default value: any). Note that the matching procedure will " +++ "be performed only on DNS response with at least one IPv4 address."))++ ipsetServerOption = optional $ option (attoparsecReader ipport)+ ( long "ipset-server"+ <> metavar "<ipaddr>[#port]"+ <> help "DNS server to use if ipset matches DNS response")++ ipsetMatchReader "none" = Just NoneMatch+ ipsetMatchReader "all" = Just AllMatch+ ipsetMatchReader "any" = Just AnyMatch+ ipsetMatchReader "anynotmatch" = Just AnyNotMatch+ ipsetMatchReader _ = Nothing+ configFileOption :: Parser [FilePath] configFileOption = many $ strOption ( long "conf-file"@@ -193,8 +258,14 @@ <> short 'h' <> help "Don't read /etc/hosts") +ipsetFileOption :: Parser [FilePath]+ipsetFileOption = many $ strOption+ ( long "ipset-file"+ <> metavar "<file>"+ <> help "Read ipset from files")+ plainOption :: Parser [Config]-plainOption = (++) <$> many server <*> ((++) <$> many address <*> many bogusnx)+plainOption = (++) <$> many server <*> ((++) <$> many address <*> ((++) <$> many bogusnx <*> many ipset)) where server = option (attoparsecReader serverValue) ( long "server"@@ -219,8 +290,17 @@ bogusnx = option (attoparsecReader bogusNXValue) ( long "bogus-nxdomain" <> short 'B'- <> metavar "ip"+ <> metavar "<ipaddr>" <> help "Transform replies which contain the IP address given into \"No such domain\" replies")++ ipset = option (attoparsecReader (IPSet <$> ip4mask))+ ( long "ipset"+ <> metavar "<ipmask>"+ <> help ipsetMsg)++ ipsetMsg = "Add an IPv4 address to ipset. If DNS responses matches ipset, DNS responses from " +++ "\"--ipset-server\" will be returned instead. Exact matching policy can be controlled " +++ "by \"--ipset-match\". Note that this option is different from the option with the same name from dnsmasq." attoparsecReader :: P.Parser a -> ReadM a attoparsecReader p = eitherReader (P.parseOnly (p <* P.endOfInput) . BS8.pack)
src/DomainRoute.hs view
@@ -3,17 +3,17 @@ -- Copyright (C) 2019 Bin Jin. All Rights Reserved. {-# LANGUAGE GeneralizedNewtypeDeriving #-} module DomainRoute-( DomainRoute-, newDomainRoute-, getDomainRouteExact-, getDomainRouteByPrefix-) where+ ( DomainRoute+ , getDomainRouteByPrefix+ , getDomainRouteExact+ , newDomainRoute+ ) where -import qualified Data.ByteString.Char8 as BS-import Data.Char (toLower)-import qualified Data.Trie as T-import qualified Data.Trie.Convenience as T-import qualified Network.DNS as DNS+import Data.ByteString.Char8 qualified as BS+import Data.Char (toLower)+import Data.Trie qualified as T+import Data.Trie.Convenience qualified as T+import Network.DNS qualified as DNS newtype DomainRoute a = DomainRoute (T.Trie a) deriving (Eq, Show, Functor, Foldable)
src/LRU.hs view
@@ -4,20 +4,19 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} module LRU-( LRUCache-, newCache-, lookupCache-, updateCache-, purgeCache-) where+ ( LRUCache+ , lookupCache+ , newCache+ , purgeCache+ , updateCache+ ) where -import qualified Data.HashPSQ as PQ-import Data.Hashable (Hashable)-import Data.IORef (IORef, atomicModifyIORef', newIORef,- readIORef)-import Data.Int (Int64)-import Data.Time.Clock.System (SystemTime (..), getSystemTime)-import Network.DNS (TTL)+import Data.Hashable (Hashable)+import Data.HashPSQ qualified as PQ+import Data.Int (Int64)+import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)+import Data.Time.Clock.System (SystemTime (..), getSystemTime)+import Network.DNS (TTL) type Time = Int64
+ src/Log.hs view
@@ -0,0 +1,54 @@+-- SPDX-License-Identifier: BSD-3-Clause+--+-- Copyright (C) 2023 Bin Jin. All Rights Reserved.+{-# LANGUAGE OverloadedStrings #-}++module Log+ ( LogLevel (..)+ , LogStr+ , LogType' (..)+ , Logger+ , ToLogStr (..)+ , logLevelReader+ , pureLogger+ , withLogger+ ) where++import System.IO.Unsafe (unsafePerformIO)++import System.Log.FastLogger++data LogLevel = TRACE+ | DEBUG+ | INFO+ | WARN+ | ERROR+ | NONE+ deriving (Show, Eq, Ord)++logLevelReader :: String -> Maybe LogLevel+logLevelReader "trace" = Just TRACE+logLevelReader "debug" = Just DEBUG+logLevelReader "info" = Just INFO+logLevelReader "warn" = Just WARN+logLevelReader "error" = Just ERROR+logLevelReader "none" = Just NONE+loglevelReader _ = Nothing++logWith :: TimedFastLogger -> LogLevel -> LogStr -> IO ()+logWith logger level logstr = logger (\time -> toLogStr time <> " [" <> toLogStr (show level) <> "] " <> logstr <> "\n")++type Logger = LogLevel -> LogStr -> IO ()++{-# NOINLINE pureLogger #-}+pureLogger :: Logger -> LogLevel -> LogStr -> a -> a+pureLogger logger level str a = unsafePerformIO $ logger level str >> return a++withLogger :: LogType -> LogLevel -> ((LogLevel -> LogStr -> IO ()) -> IO ()) -> IO ()+withLogger logType logLevel toRun = do+ timeCache <- newTimeCache "%Y/%m/%d %T %Z"+ withTimedFastLogger timeCache logType $ \timedLogger ->+ let logger level str+ | level < logLevel = return ()+ | otherwise = logWith timedLogger level str+ in toRun logger
src/Main.hs view
@@ -6,24 +6,29 @@ {-# LANGUAGE TupleSections #-} module Main where -import Control.Concurrent (forkIO, threadDelay)-import Control.Exception (SomeException, handle)-import Control.Monad (forM, forever, join)-import Data.ByteString (ByteString)-import qualified Data.Foldable as F-import Data.Hashable (Hashable (..))-import qualified Data.Map as M-import Data.Maybe (fromMaybe)-import qualified Data.Set as S-import Data.Streaming.Network (bindPortUDP)-import qualified Network.DNS as DNS-import Network.Socket.ByteString (recvFrom, sendTo)-import System.Posix.User (UserEntry (..), getUserEntryForName,- setUserID)+import Control.Concurrent (forkIO, threadDelay)+import Control.Exception (SomeException, handle)+import Control.Monad (forM, forever, join, void)+import Data.ByteString (ByteString)+import Data.Foldable qualified as F+import Data.Hashable (Hashable (..))+import Data.IP qualified as IP+import Data.IP.RouteTable qualified as IP+import Data.Map qualified as M+import Data.Maybe (fromMaybe, isJust, maybeToList)+import Data.Set qualified as S+import Data.Streaming.Network (bindPortUDP)+import Data.Version (showVersion)+import Network.DNS qualified as DNS+import Network.Socket.ByteString (recvFrom, sendTo)+import System.Posix.User+ (UserEntry (..), getUserEntryForName, setUserID) -import Config-import DomainRoute-import LRU+import Config+import DomainRoute+import Log+import LRU+import Paths_dprox instance Hashable DNS.TYPE where hashWithSalt s = hashWithSalt s . DNS.fromTYPE@@ -56,23 +61,24 @@ getType DNS.RD_AAAA{} = DNS.AAAA getType _ = qt -processDNS :: CachedResolver -> ByteString -> IO (Either DNS.DNSError ByteString)-processDNS resolver bs- | Left e <- parse = return (Left e)- | Right q <- parse = do- rrs <- mapM (processQuery resolver) (DNS.question q)- let hd = DNS.header DNS.defaultResponse- resp = DNS.defaultResponse {- DNS.header = hd { DNS.identifier = DNS.identifier (DNS.header q) },- DNS.question = DNS.question q,- DNS.answer = concat rrs- }- return (Right (DNS.encode resp))- where- parse = do- q <- DNS.decode bs- if DNS.qOrR (DNS.flags (DNS.header q)) == DNS.QR_Query then return q else Left DNS.FormatError+parseDNS :: ByteString -> Either DNS.DNSError DNS.DNSMessage+parseDNS bs = do+ q <- DNS.decode bs+ if DNS.qOrR (DNS.flags (DNS.header q)) == DNS.QR_Query+ then return q+ else Left DNS.FormatError +processDNS :: CachedResolver -> DNS.DNSMessage -> IO (Either DNS.DNSError ByteString)+processDNS resolver DNS.DNSMessage{ DNS.header = hd, DNS.question = q } = do+ rrs <- mapM (processQuery resolver) q+ let hd0 = DNS.header DNS.defaultResponse+ resp = DNS.defaultResponse {+ DNS.header = hd0 { DNS.identifier = DNS.identifier hd },+ DNS.question = q,+ DNS.answer = concat rrs+ }+ return (Right (DNS.encode resp))+ handleServer :: DomainRoute (Maybe Resolver) -> Resolver handleServer route qd qt = case resolver of Nothing -> return (Left DNS.NameError)@@ -104,6 +110,36 @@ isBlacklisted (DNS.RD_AAAA ipv6) = IPv6 ipv6 `S.member` blacklist isBlacklisted _ = False +handleIPSet :: [IPMask] -> IPSetMatch -> Maybe Resolver -> LRUCache DNS.Domain () -> CachedResolver -> CachedResolver+handleIPSet [] _ _ _ = id+handleIPSet _ _ Nothing _ = id+handleIPSet ipset match (Just ipsetResolver) cache = handleWithResolver+ where+ iproute = IP.fromList $ zip ipset $ repeat ()+ inIPSet ip = isJust $ IP.lookup (IP.makeAddrRange ip 32) iproute++ check NoneMatch = not . any inIPSet+ check AllMatch = all inIPSet+ check AnyMatch = any inIPSet+ check AnyNotMatch = any (not.inIPSet)++ handleWithResolver resolver qd qt@DNS.A = do+ cachedInIPSet <- isJust <$> lookupCache qd cache+ if cachedInIPSet+ then fmap (1,) <$> ipsetResolver qd qt+ else do+ res <- resolver qd qt+ case res of+ Left _ -> return res+ Right (_, rs) -> do+ let ipv4s = [ipv4 | DNS.RD_A ipv4 <- rs]+ if not (null ipv4s) && check match ipv4s+ then do+ updateCache qd () cache+ fmap (1,) <$> ipsetResolver qd qt+ else return res+ handleWithResolver resolver qd qt = resolver qd qt+ makeResolverCache :: Int -> DNS.TTL -> IO (Resolver -> CachedResolver) makeResolverCache sz ttl | sz <= 0 = return $ \r qd qt -> fmap (ttl,) <$> r qd qt makeResolverCache sz ttl = do@@ -129,8 +165,9 @@ setuid user = getUserEntryForName user >>= setUserID . userID main :: IO ()-main = do- (GlobalConfig{..}, conf) <- getConfig+main = getConfig >>= \(GlobalConfig{..}, conf) -> withLogger (LogStdout 4096) loglevel $ \logger -> do+ logger INFO $ "dprox " <> toLogStr (showVersion version) <> " started"+ let defaultPort = 53 fallbackServer = Server Nothing "8.8.8.8" Nothing @@ -140,6 +177,7 @@ address = [(domain, [ip]) | Address domain ip <- conf] hosts = [(domain, [ip]) | Hosts domain ip <- conf] bogusnx = [ip | BogusNX ip <- conf]+ ipset = [ipmask | IPSet ipmask <- conf] serverRoute = newDomainRoute (const id) server serverAddressSet = S.fromList $ F.toList serverRoute@@ -149,8 +187,10 @@ bogusnxSet = S.fromList bogusnx + ipsetServerPort = fmap (fromMaybe defaultPort) <$> ipsetServer+ resolvConfs = [ (addr, rc)- | addr@(host, port) <- S.toList serverAddressSet+ | addr@(host, port) <- S.toList serverAddressSet ++ maybeToList ipsetServerPort , host /= invalidIPAddress , let rsinfo = if port == defaultPort then DNS.RCHostName (show host)@@ -161,27 +201,46 @@ } ] - sock <- bindPortUDP (fromIntegral $ fromMaybe defaultPort localPort) (fromMaybe "*6" listenAddress)+ logger INFO $ "read " <> toLogStr (length server) <> " server configs"+ logger INFO $ "read " <> toLogStr (length hosts) <> " hosts configs"+ logger INFO $ "read " <> toLogStr (length bogusnx) <> " bogus-nxdomain configs"+ logger INFO $ "read " <> toLogStr (length ipset) <> " ipset configs"++ let (bport, bhost) = (fromIntegral $ fromMaybe defaultPort localPort, fromMaybe "*6" listenAddress)+ sock <- bindPortUDP bport bhost+ logger INFO $ "bind to " <> toLogStr (show bhost) <> ":" <> toLogStr bport+ resolvSeeds <- forM resolvConfs $ \(k, v) -> do+ logger INFO $ "creating resolver: " <> toLogStr (show $ fst k) <> ":" <> toLogStr (show $ snd k) rs <- DNS.makeResolvSeed v return (k, rs) F.mapM_ setuid setUser resolverCache <- makeResolverCache cacheSize cacheTTL+ ipsetCache <- newCache 4096 maxBound let processWithResolver resolver = forever $ do (bs, addr) <- recvFrom sock (fromIntegral DNS.maxUdpSize) forkIO $ do- resp <- processDNS resolver bs- F.forM_ resp $ \resp' -> sendTo sock resp' addr+ case parseDNS bs of+ Left err -> logger DEBUG $ "dns parse error: " <> toLogStr (show err) <> " from: " <> toLogStr (show addr)+ Right q -> do+ logger TRACE $ "dns request from " <> toLogStr (show addr) <> ": " <> toLogStr (show $ DNS.question q)+ resp <- processDNS resolver q+ case resp of+ Right resp' -> void $ sendTo sock resp' addr+ Left err -> do+ logger DEBUG $ "dns process error: " <> toLogStr (show err) <> " from: " <> toLogStr (show addr) createResolvers ((k,v):xs) m = DNS.withResolver v $ \rs -> createResolvers xs (M.insert k (DNS.lookup rs) m) createResolvers [] m = let serverRoute' = fmap (`M.lookup`m) serverRoute- resolver = resolverCache $- handleBogusNX bogusnxSet $+ ipsetResolver = join $ fmap (`M.lookup`m) ipsetServerPort+ resolver = handleIPSet ipset ipsetMatch ipsetResolver ipsetCache $+ resolverCache $ handleAddressAndHosts addressRoute hostsRoute $+ handleBogusNX bogusnxSet $ handleServer serverRoute' in processWithResolver resolver createResolvers resolvSeeds M.empty
systemd/dprox.service view
@@ -1,12 +1,19 @@ [Unit]-Description=a simple DNS proxy server+Description=a lightweight DNS proxy server, compatible with dnsmasq-china-list After=network.target [Service] Type=simple-CapabilityBoundingSet=CAP_NET_BIND_SERVICE CAP_SETUID-ExecStart=/usr/bin/dprox -C /etc/dnsmasq.d/accelerated-domains.china.conf -C /etc/dnsmasq.d/bogus-nxdomain.china.conf -S 8.8.4.4 -u nobody+DynamicUser=true+ProtectSystem=true+ProtectHome=true+PrivateTmp=true+CapabilityBoundingSet=CAP_NET_BIND_SERVICE+AmbientCapabilities=CAP_NET_BIND_SERVICE+ExecStart=/usr/bin/dprox -C /etc/dnsmasq.d/accelerated-domains.china.conf -C /etc/dnsmasq.d/bogus-nxdomain.china.conf -S 8.8.4.4 Restart=on-failure+RestartSec=30+StartLimitBurst=10 [Install] WantedBy=multi-user.target
test/Test.hs view
@@ -4,12 +4,12 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Control.Monad (forM_)-import qualified Data.ByteString.Char8 as BS8-import Data.Char (toUpper)-import Test.Hspec+import Control.Monad (forM_)+import Data.ByteString.Char8 qualified as BS8+import Data.Char (toUpper)+import Test.Hspec -import DomainRoute+import DomainRoute main :: IO () main = hspec $ do