dprox 0.1.0 → 0.1.1
raw patch · 5 files changed
+93/−26 lines, 5 files
Files
- README.md +13/−2
- dprox.cabal +3/−2
- src/Config.hs +55/−18
- src/Main.hs +10/−4
- systemd/dprox.service +12/−0
README.md view
@@ -1,8 +1,15 @@ ## dprox +[](https://circleci.com/gh/bjin/dprox)+[](https://packdeps.haskellers.com/feed?needle=dprox)+[](https://github.com/bjin/dprox/releases)+[](https://hackage.haskell.org/package/dprox)+[](https://aur.archlinux.org/packages/dprox/)+[](https://github.com/bjin/dprox/blob/master/LICENSE)+ dprox is a lightweight DNS proxy server. It's written as a drop-in replacement of dnsmasq to work with [dnsmasq-china-list](https://github.com/felixonmars/dnsmasq-china-list),-while improving the lookup performance over large domain list.+while improving the overall lookup performance over large domain list. ### Installation @@ -14,10 +21,14 @@ ### Usage -Only a small subset of dnsmasq options are implemented, just barely enough to work with `dnsmasq-china-list`.+Only a small subset of dnsmasq options are implemented at the moment, just barely enough to work with `dnsmasq-china-list`. Use `dprox --help` to list those options. A [systemd unit file](https://github.com/bjin/dprox/blob/master/systemd/dprox.service) is also provided for Linux user. ### Known Issue * `dprox` has fairly large memory footprint at the moment. Over 100MB for current `dnsmasq-china-list`.++### License++`dprox` is licensed under the BSD3 license. See LICENSE file for details.
dprox.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 0f621c1a70a120599e9358ce5011984d7b1d62d9b9f16bd95f3c611c6dfa414c+-- hash: d262889761a247d0874e1aea677d066dce6b02883a49661fd85293dd83929b03 name: dprox-version: 0.1.0+version: 0.1.1 synopsis: a lightweight DNS proxy server description: Please see the README on GitHub at <https://github.com/bjin/dprox#readme> category: DNS@@ -21,6 +21,7 @@ build-type: Simple extra-source-files: README.md+ systemd/dprox.service source-repository head type: git
src/Config.hs view
@@ -34,19 +34,23 @@ data Config = Server (Maybe DNS.Domain) IP (Maybe PortNumber) | Address DNS.Domain IP+ | Hosts DNS.Domain IP | BogusNX IP deriving (Eq, Show) getConfig :: IO (GlobalConfig, [Config]) getConfig = do- (globalConfigs, configFiles, confs) <- execParser opts- confs' <- concat <$> mapM readConfigFromFile configFiles- return (globalConfigs, confs' ++ confs)+ (globalConfigs, configFiles, hostsFiles, confs) <- execParser opts+ confs1 <- concat <$> mapM readConfigFromFile configFiles+ confs2 <- concat <$> mapM readHostsFromFile hostsFiles+ return (globalConfigs, confs1 ++ confs2 ++ confs) where- opts = info ((,,) <$> globalOption <*> configFileOption <*> plainOption <**> helper)+ opts = info ((,,,) <$> globalOption <*> configFileOption+ <*> hostsFilesOption <*> plainOption <**> helper) ( fullDesc <> progDesc "a simple DNS proxy server") readConfigFromFile file = handle handler (parseConfigFile <$> BS.readFile file)+ readHostsFromFile file = handle handler (parseHostsFile <$> BS.readFile file) handler :: SomeException -> IO [Config] handler _ = return []@@ -56,15 +60,7 @@ Left msg -> error msg Right r -> r where- skipSpaceTab = P.skipWhile P8.isHorizontalSpace-- parseFile = catMaybes <$> P.many' parseLine-- parseLine = do- eof <- P.atEnd- when eof $ fail "eof reached"- skipSpaceTab- (Just <$> parseConfig) <|> skipLine+ parseFile = catMaybes <$> P.many' (parseLine parseConfig) parseConfig = parsePair "server" serverValue <|>@@ -77,14 +73,38 @@ _ <- P8.char '=' skipSpaceTab res <- optionValue- _ <- skipLine+ skipLine return res - skipLine = do- P.skipWhile (not . P8.isEndOfLine)- P.skipWhile P8.isEndOfLine- return Nothing+parseHostsFile :: BS.ByteString -> [Config]+parseHostsFile bs = case P.parseOnly parseFile bs of+ Left msg -> error msg+ Right r -> r+ where+ parseFile = catMaybes <$> P.many' (parseLine parseHosts) + parseHosts = do+ parsedIP <- ip+ skipSpaceTab+ parsedDomain <- domain+ skipLine+ return (Hosts parsedDomain parsedIP)++parseLine :: P.Parser a -> P.Parser (Maybe a)+parseLine parser = do+ eof <- P.atEnd+ when eof $ fail "eof reached"+ skipSpaceTab+ (Just <$> parser) <|> (skipLine >> return Nothing)++skipSpaceTab :: P.Parser ()+skipSpaceTab = P.skipWhile P8.isHorizontalSpace++skipLine :: P.Parser ()+skipLine = do+ P.skipWhile (not . P8.isEndOfLine)+ P.skipWhile P8.isEndOfLine+ domain :: P.Parser DNS.Domain domain = P8.takeWhile1 (P8.inClass "-.a-zA-Z0-9") <?> "domain name" @@ -127,6 +147,23 @@ <> short 'C' <> metavar "path/to/dprox.conf" <> help "configure file to read")++hostsFilesOption :: Parser [FilePath]+hostsFilesOption = combine <$> noHostsOption <*> many newHostsOption+ where+ combine False newHosts = "/etc/hosts" : newHosts+ combine True newHosts = newHosts++ newHostsOption = strOption+ ( long "addn-hosts"+ <> short 'H'+ <> metavar "path/to/hosts"+ <> help "additional hosts file to read (other than /etc/hosts)")++ noHostsOption = switch+ ( long "no-hosts"+ <> short 'h'+ <> help "Don't read /etc/hosts") plainOption :: Parser [Config] plainOption = (++) <$> many server <*> ((++) <$> many address <*> many bogusnx)
src/Main.hs view
@@ -72,11 +72,15 @@ where resolver = fromMaybe (error "handleServer: internal error") (getDomainRouteByPrefix route qd) -handleAddress :: DomainRoute [IP] -> Resolver -> Resolver-handleAddress route resolver qd qt =+handleAddressAndHosts :: DomainRoute [IP] -> DomainRoute [IP] -> Resolver -> Resolver+handleAddressAndHosts address hosts resolver qd qt = if null ips then resolver qd qt else return (Right userDefined) where- ips = fromMaybe [] $ getDomainRouteByPrefix route qd+ ips1 = fromMaybe [] $ getDomainRouteByPrefix address qd+ ips2 = fromMaybe [] $ getDomainRouteExact hosts qd+ ips | null ips2 = ips1+ | otherwise = ips2+ ipv4 = [DNS.RD_A ipv4addr | IPv4 ipv4addr <- ips] ipv6 = [DNS.RD_AAAA ipv6addr | IPv6 ipv6addr <- ips] @@ -105,12 +109,14 @@ | Server mDomain ip mPort <- fallbackServer : conf ] address = [(domain, [ip]) | Address domain ip <- conf]+ hosts = [(domain, [ip]) | Hosts domain ip <- conf] bogusnx = [ip | BogusNX ip <- conf] serverRoute = newDomainRoute (flip const) server serverAddressSet = S.fromList $ F.toList serverRoute addressRoute = newDomainRoute (++) address+ hostsRoute = newDomainRoute (++) hosts bogusnxSet = S.fromList bogusnx @@ -142,7 +148,7 @@ createResolvers xs (M.insert k (DNS.lookup rs) m) createResolvers [] m = let serverRoute' = fmap (m!) serverRoute resolver = handleBogusNX bogusnxSet $- handleAddress addressRoute $+ handleAddressAndHosts addressRoute hostsRoute $ handleServer serverRoute' in processWithResolver resolver createResolvers resolvSeeds M.empty
+ systemd/dprox.service view
@@ -0,0 +1,12 @@+[Unit]+Description=a simple DNS proxy server+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+Restart=on-failure++[Install]+WantedBy=multi-user.target