packages feed

dprox 0.4.2 → 0.4.3

raw patch · 6 files changed

+135/−57 lines, 6 filesdep +unix

Dependencies added: unix

Files

README.md view
@@ -11,26 +11,27 @@ `dprox` is a lightweight DNS proxy server. It's created as a drop-in replacement of [dnsmasq](http://www.thekelleys.org.uk/dnsmasq/doc.html) to work with [dnsmasq-china-list](https://github.com/felixonmars/dnsmasq-china-list),-while improving the overall lookup performance over large domain list.+enhancing overall lookup performance over extensive domain lists.  ### Installation  `dprox` should build and work on all unix-like OS with [ghc](https://www.haskell.org/ghc/) support, as well as Windows. -While `dprox` can be built with [cabal](https://www.haskell.org/cabal/) like any other Hackage packages, for a-reliable compilation with pinned dependencies, [stack](https://docs.haskellstack.org/en/stable/README/#how-to-install) is generally recommended.+Although `dprox` can be built using [cabal](https://www.haskell.org/cabal/) like any other Hackage package,+we recommend using [stack](https://docs.haskellstack.org/en/stable/README/#how-to-install) for a more reliable compilation with pinned dependencies.  ```sh stack setup stack install ``` -For Arch Linux users, an [AUR package](https://aur.archlinux.org/packages/dprox/) is provided.-Alternatively, you also can use the statically linked binary for the [latest release](https://github.com/bjin/dprox/releases).+Arch Linux users can install provided [AUR package](https://aur.archlinux.org/packages/dprox/). +Alternatively, you can opt to use the statically linked binary available in the [latest release](https://github.com/bjin/dprox/releases).+ ### Usage -Only a small subset of dnsmasq options are implemented at the moment, just barely enough to work with `dnsmasq-china-list` and [hosts-blocklists](https://github.com/notracking/hosts-blocklists).+Currently, only a small subset of dnsmasq options is implemented: just enough to seamlessly work with `dnsmasq-china-list` and [hosts-blocklists](https://github.com/notracking/hosts-blocklists).  Here is the list of implemented dnsmasq options (with `server`, `local`, `address` and `bogus-nxdomain` options allowed in configuration file): @@ -45,35 +46,37 @@ -B, --bogus-nxdomain=<ipaddr> ``` -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`.+For more details about these options, use `dprox --help` or refer to the [dnsmasq manpage](http://www.thekelleys.org.uk/dnsmasq/docs/dnsmasq-man.html).+However, be aware that there might be minor differences in some options, such as `--server`. -To use `dprox` with `dnsmasq-china-list`, with "8.8.4.4" as the remote DNS server:+To use `dprox` with `dnsmasq-china-list` and set "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 ``` -To use `dprox` with `hosts-blocklists` and the default remote DNS server ("8.8.8.8"), without loading system hosts file:+To use `dprox` with `hosts-blocklists` and use the default remote DNS server ("8.8.8.8"), excluding the loading of the system hosts file:  ```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`.+Additionally, a customized `--ipset` option is available (distinct from `dnsmasq`).+With these options configured, in case a DNS request somehow matches with the specified `ipset`, `dprox` will switch to an alternative upstream+DNS server (with the [FakeDNS](https://www.v2fly.org/config/fakedns.html) feature, for example), specified by `ipset-server`.+The exact matching policy can be configured using the `ipset-match`. These options can be used to enable IP-based routing for DNS requests.  ``` --ipset <ipmask>---ipset-match <none|all|any|anynotmatch>+--ipset-match <none|all|any|notall> --ipset-server <ipaddr>[#port] --ipset-file <file> ```  ### Known Issue -* `dprox` has fairly large memory footprint at the moment. About 85MB for current `dnsmasq-china-list`.+* `dprox` currently has a relatively large memory footprint, approximately 85MB for the current `dnsmasq-china-list`.  ### License -`dprox` is licensed under the BSD3 license. See LICENSE file for details.+`dprox` is licensed under the BSD3 license. Refer to the LICENSE file for comprehensive details.
dprox.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           dprox-version:        0.4.2+version:        0.4.3 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@@ -42,7 +42,7 @@       src   default-extensions:       ImportQualifiedPost-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:       attoparsec >=0.13     , base >=4.12 && <5@@ -61,6 +61,10 @@   default-language: Haskell2010   if flag(static)     ghc-options: -optl-static+  if !os(windows)+    cpp-options: -DOS_UNIX+    build-depends:+        unix  test-suite dprox-test   type: exitcode-stdio-1.0@@ -72,7 +76,7 @@       test   default-extensions:       ImportQualifiedPost-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints   build-depends:       attoparsec >=0.13     , base >=4.12 && <5
src/Config.hs view
@@ -1,13 +1,14 @@ -- SPDX-License-Identifier: BSD-3-Clause -- -- Copyright (C) 2019 Bin Jin. All Rights Reserved.+{-# LANGUAGE CPP               #-} {-# LANGUAGE OverloadedStrings #-} module Config-  ( Config (..)-  , GlobalConfig (..)-  , IP (..)+  ( Config(..)+  , GlobalConfig(..)+  , IP(..)   , IPMask-  , IPSetMatch (..)+  , IPSetMatch(..)   , PortNumber   , getConfig   , invalidIPAddress@@ -20,7 +21,7 @@ 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.IP                          (AddrRange, IP(..), IPv4) import Data.Maybe                       (catMaybes, fromMaybe, isNothing) import Data.Streaming.Network           (HostPreference) import Data.String                      (fromString)@@ -34,28 +35,32 @@ import Paths_dprox  data GlobalConfig = GlobalConfig-    { localPort     :: Maybe PortNumber-    , listenAddress :: Maybe HostPreference-    , cacheSize     :: Int-    , cacheTTL      :: DNS.TTL-    , loglevel      :: LogLevel-    , ipsetMatch    :: IPSetMatch-    , ipsetServer   :: Maybe (IP, Maybe PortNumber)+    { localPort     :: !(Maybe PortNumber)+    , listenAddress :: !(Maybe HostPreference)+    , cacheSize     :: !Int+    , cacheTTL      :: !DNS.TTL+    , loglevel      :: !LogLevel+    , ipsetMatch    :: !IPSetMatch+    , ipsetServer   :: !(Maybe (IP, Maybe PortNumber))+#ifdef OS_UNIX+    , user          :: !(Maybe String)+    , group         :: !(Maybe String)+#endif     } 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+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+                | NotAllMatch     deriving (Eq, Show)  getConfig :: IO (GlobalConfig, [Config])@@ -177,6 +182,10 @@                             <*> loglevelOption                             <*> ipsetMatchOption                             <*> ipsetServerOption+#ifdef OS_UNIX+                            <*> userOption+                            <*> groupOption+#endif   where     portOption = optional $ option auto         ( long "port"@@ -210,7 +219,7 @@      ipsetMatchOption = option (maybeReader ipsetMatchReader)         ( long "ipset-match"-       <> metavar "<none|all|any|anynotmatch>"+       <> metavar "<none|all|any|notall>"        <> 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."))@@ -220,11 +229,25 @@        <> 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+    ipsetMatchReader "none"   = Just NoneMatch+    ipsetMatchReader "all"    = Just AllMatch+    ipsetMatchReader "any"    = Just AnyMatch+    ipsetMatchReader "notall" = Just NotAllMatch+    ipsetMatchReader _        = Nothing++#ifdef OS_UNIX+    userOption = optional $ strOption+        ( long "user"+       <> short 'u'+       <> metavar "nobody"+       <> help "drop root priviledge and setuid to the specified user (like nobody)")++    groupOption = optional $ strOption+        ( long "group"+       <> short 'g'+       <> metavar "nogroup"+       <> help "drop root priviledge and setgid to the specified group")+#endif  configFileOption :: Parser [FilePath] configFileOption = many $ strOption
src/LRU.hs view
@@ -15,7 +15,7 @@ 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 Data.Time.Clock.System (SystemTime(..), getSystemTime) import Network.DNS            (TTL)  type Time = Int64@@ -50,7 +50,7 @@ data LRUCache k v = LRUCache     { cacheSize  :: !Int     , timeToLive :: !TTL-    , cacheRef   :: IORef (LRUQueue k v)+    , cacheRef   :: !(IORef (LRUQueue k v))     }  newCache :: Int -> TTL -> IO (LRUCache k v)
src/Log.hs view
@@ -4,11 +4,11 @@ {-# LANGUAGE OverloadedStrings #-}  module Log-  ( LogLevel (..)+  ( LogLevel(..)   , LogStr-  , LogType' (..)+  , LogType'(..)   , Logger-  , ToLogStr (..)+  , ToLogStr(..)   , logLevelReader   , pureLogger   , withLogger@@ -33,7 +33,7 @@ logLevelReader "warn"  = Just WARN logLevelReader "error" = Just ERROR logLevelReader "none"  = Just NONE-loglevelReader _       = Nothing+logLevelReader _       = Nothing  logWith :: TimedFastLogger -> LogLevel -> LogStr -> IO () logWith logger level logstr = logger (\time -> toLogStr time <> " [" <> toLogStr (show level) <> "] " <> logstr <> "\n")
src/Main.hs view
@@ -1,17 +1,22 @@ -- SPDX-License-Identifier: BSD-3-Clause -- -- Copyright (C) 2019 Bin Jin. All Rights Reserved.-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TupleSections     #-}-module Main where+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-}+module Main+  ( main+  ) where  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.Hashable             (Hashable(..)) import Data.IP                   qualified as IP import Data.IP.RouteTable        qualified as IP import Data.Map                  qualified as M@@ -22,6 +27,14 @@ import Network.DNS               qualified as DNS import Network.Socket.ByteString (recvFrom, sendTo) +#ifdef OS_UNIX+import Control.Exception    (catch)+import Control.Monad        (forM_, when)+import System.Exit+import System.Posix.Process+import System.Posix.User+#endif+ import Config import DomainRoute import Log@@ -113,13 +126,13 @@ handleIPSet _ _ Nothing _ = id handleIPSet ipset match (Just ipsetResolver) cache = handleWithResolver   where-    iproute = IP.fromList $ zip ipset $ repeat ()+    iproute = IP.fromList $ map (, ()) ipset     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)+    check NotAllMatch = not.all inIPSet      handleWithResolver resolver qd qt@DNS.A = do         cachedInIPSet <- isJust <$> lookupCache qd cache@@ -159,6 +172,37 @@                             return (Right (ttl, v))     return process +#ifdef OS_UNIX+dropRootPriviledge :: Logger -> Maybe String -> Maybe String -> IO Bool+dropRootPriviledge _ Nothing Nothing = return False+dropRootPriviledge logger user group = do+    currentUser <- getRealUserID+    currentGroup <- getRealGroupID+    if currentUser /= 0 || currentGroup /= 0+      then do+        logger WARN $ "Unable to setuid/setgid without root priviledge" <>+                      ", userID=" <> toLogStr (show currentUser) <>+                      ", groupID=" <> toLogStr (show currentGroup)+        return False+      else do+        let abort msg = logger ERROR msg >> exitImmediately (ExitFailure 1)+        forM_ group $ \group' -> do+            logger INFO $ "setgid to " <> toLogStr group'+            getGroupEntryForName group' >>= setGroupID . groupID+            changedGroup <- getRealGroupID+            when (changedGroup == currentGroup) $ abort "failed to setgid, aborting"+        forM_ user $ \user' -> do+            logger INFO $ "setuid to " <> toLogStr user'+            getUserEntryForName user' >>= setUserID . userID+            changedUser <- getRealUserID+            when (changedUser == currentUser) $ abort "failed to setuid, aborting"+        logger DEBUG "testing setuid(0), verify that root priviledge can't be regranted"+        catch (setUserID 0) $ \(_ :: SomeException) -> logger DEBUG "setuid(0) failed as expected"+        changedUser <- getRealUserID+        when (changedUser == 0) $ abort "unable to drop root priviledge, aborting"+        return True+#endif+ main :: IO () main = getConfig >>= \(GlobalConfig{..}, conf) -> withLogger (LogStdout 4096) loglevel $ \logger -> do     logger INFO $ "dprox " <> toLogStr (showVersion version) <> " started"@@ -211,6 +255,10 @@         rs <- DNS.makeResolvSeed v         return (k, rs) +#ifdef OS_UNIX+    void $ dropRootPriviledge logger user group+#endif+     resolverCache <- makeResolverCache cacheSize cacheTTL     ipsetCache <- newCache 4096 maxBound @@ -230,7 +278,7 @@         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-                                   ipsetResolver = join $ fmap (`M.lookup`m) ipsetServerPort+                                   ipsetResolver = (`M.lookup` m) =<< ipsetServerPort                                    resolver = handleIPSet ipset ipsetMatch ipsetResolver ipsetCache $                                               resolverCache $                                               handleAddressAndHosts addressRoute hostsRoute $