concurrent-dns-cache 0.1.3 → 0.1.4
raw patch · 6 files changed
+74/−22 lines, 6 filessetup-changedPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +10/−0
- Network/DNS/Cache.hs +16/−13
- Network/DNS/Cache/Utils.hs +13/−6
- Setup.hs +0/−2
- concurrent-dns-cache.cabal +3/−1
- test/CacheSpec.hs +32/−0
+ ChangeLog.md view
@@ -0,0 +1,10 @@+# ChangeLog for concurrent-dns-cache++## 0.1.4++* If `resolve` (or `lookup`) was interrupted by an asynchronous+ exception such as `timeout`, all later calls for the same domain+ blocked forever. Now waiting threads are woken up.+* Malformed numeric hosts such as `1..2.3` made `resolve`, `lookup`,+ `resolveCache` and `lookupCache` throw an error. Now only strict+ dotted-decimal IPv4 addresses are treated as numeric.
Network/DNS/Cache.hs view
@@ -24,9 +24,9 @@ import Control.Concurrent.Async (async, waitAnyCancel) import Control.Exception.Lifted (bracket) import Control.Monad (forever)+import qualified Control.Exception as E import Control.Monad.IO.Class import Control.Monad.Trans.Control-import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Short as B import Data.IP (toHostAddress) import Data.Time (getCurrentTime, addUTCTime, NominalDiffTime)@@ -123,9 +123,7 @@ -- | Lookup 'Domain' only in the cache. resolveCache :: DNSCache -> Domain -> IO (Maybe (Either DNSError Result)) resolveCache _ dom- | isIPAddr dom = Just . Right . Numeric <$> return (tov4 dom)- where- tov4 = toHostAddress . read . BS.unpack+ | Just addr <- parseIPv4 dom = return $ Just $ Right $ Numeric addr resolveCache cache dom = do (_, mx) <- lookupPSQ cache dom case mx of@@ -138,9 +136,7 @@ -- resolved IP addresses are cached. resolve :: DNSCache -> Domain -> IO (Either DNSError Result) resolve _ dom- | isIPAddr dom = return $ Right $ Numeric $ tov4 dom- where- tov4 = toHostAddress . read . BS.unpack+ | Just addr <- parseIPv4 dom = return $ Right $ Numeric addr resolve cache dom = do (key,mx) <- lookupPSQ cache dom case mx of@@ -153,19 +149,26 @@ ma <- S.lookupActiveRef key activeref case ma of Just avar -> S.listen avar- Nothing -> do+ Nothing -> E.mask $ \restore -> do avar <- S.newActiveVar S.insertActiveRef key avar activeref- x <- sendQuery cache dom- !res <- case x of- Left err -> insertNegative cache key err- Right [] -> insertNegative cache key UnexpectedRDATA- Right addrs -> insertPositive cache key addrs+ -- Waiters must be woken up even if this thread+ -- is interrupted, otherwise they block forever.+ let abort = do+ S.deleteActiveRef key activeref+ S.tell avar (Left UnknownDNSError)+ !res <- restore (query key) `E.onException` abort S.deleteActiveRef key activeref S.tell avar (toHit res) return res where activeref = cacheActiveRef cache+ query key = do+ x <- sendQuery cache dom+ case x of+ Left err -> insertNegative cache key err+ Right [] -> insertNegative cache key UnexpectedRDATA+ Right addrs -> insertPositive cache key addrs toHit (Right (Resolved addr)) = Right (Hit addr) toHit x = x
Network/DNS/Cache/Utils.hs view
@@ -2,15 +2,22 @@ import qualified Data.ByteString.Char8 as BS import Data.Char (isDigit)+import Data.IP (toHostAddress, toIPv4) import Network.DNS.Cache.Types -isIPAddr :: Domain -> Bool-isIPAddr hn = length groups == 4 && all ip groups+-- | Parsing a dotted-decimal IPv4 address strictly.+-- Groups with leading zeros are rejected since they may be octal.+parseIPv4 :: Domain -> Maybe HostAddress+parseIPv4 hn = case mapM octet (BS.split '.' hn) of+ Just [a, b, c, d] -> Just $ toHostAddress $ toIPv4 [a, b, c, d]+ _ -> Nothing where- groups = BS.split '.' hn- ip x = BS.length x <= 3- && BS.all isDigit x- && read (BS.unpack x) <= (255 :: Int)+ octet x+ | BS.null x || BS.length x > 3 = Nothing+ | not (BS.all isDigit x) = Nothing+ | BS.length x > 1 && BS.head x == '0' = Nothing+ | otherwise = let n = read (BS.unpack x)+ in if n <= 255 then Just n else Nothing fromResult :: Result -> HostAddress fromResult (Hit addr) = addr
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
concurrent-dns-cache.cabal view
@@ -1,5 +1,5 @@ Name: concurrent-dns-cache-Version: 0.1.3+Version: 0.1.4 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -9,6 +9,7 @@ Category: Network Cabal-Version: >= 1.10 Build-Type: Simple+Extra-Source-Files: ChangeLog.md Library Default-Language: Haskell2010@@ -66,6 +67,7 @@ , concurrent-dns-cache , dns >= 3 , hspec+ , network Source-Repository head Type: git
test/CacheSpec.hs view
@@ -6,6 +6,9 @@ import Network.DNS hiding (lookup) import Network.DNS.Cache import Prelude hiding (lookup)+import qualified Control.Exception as E+import qualified Network.Socket as N+import System.Timeout (timeout) import Test.Hspec cacheConf :: DNSCacheConf@@ -20,8 +23,37 @@ , negativeTTL = 300 } +-- A resolver which never answers.+silentConf :: N.PortNumber -> DNSCacheConf+silentConf port = cacheConf {+ resolvConfs = [ defaultResolvConf { resolvInfo = RCHostPort "127.0.0.1" port+ , resolvTimeout = 200000+ , resolvRetry = 1 } ]+ }++withSilentServer :: (N.PortNumber -> IO a) -> IO a+withSilentServer body = E.bracket open N.close $ \sk -> do+ N.SockAddrInet port _ <- N.getSocketName sk+ body port+ where+ open = do+ sk <- N.socket N.AF_INET N.Datagram N.defaultProtocol+ N.bind sk (N.SockAddrInet 0 (N.tupleToHostAddress (127,0,0,1)))+ return sk+ spec :: Spec spec = describe "withDnsCache" $ do+ it "parses numeric IPv4 addresses strictly" $ withDNSCache cacheConf $ \cache -> do+ resolveCache cache "1.2.3.4" `shouldReturn` Just (Right (Numeric 67305985))+ resolveCache cache "1..2.3" `shouldReturn` Nothing+ resolveCache cache "1.2.3." `shouldReturn` Nothing+ resolveCache cache "010.1.1.1" `shouldReturn` Nothing+ it "does not block after an interrupted resolution" $ withSilentServer $ \port ->+ withDNSCache (silentConf port) $ \cache -> do+ let dom = "www.example.com"+ _ <- timeout 50000 $ resolve cache dom+ r <- timeout 3000000 $ resolve cache dom+ r `shouldSatisfy` maybe False (const True) it "resolves domains and caches addresses" $ withDNSCache cacheConf $ \cache -> do let dom = "www.example.com" addr = 584628317