dns 2.0.9 → 2.0.10

raw patch · 6 files changed

+75/−31 lines, 6 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Changelog +2/−0
• Network/DNS/Decode.hs +3/−3
• Network/DNS/Encode.hs +3/−3
• Network/DNS/Internal.hs +5/−1
• Network/DNS/Resolver.hs +61/−23
• dns.cabal +1/−1

@@ -1,3 +1,5 @@+2.0.10+	- Cleaning up the code. [#47](https://github.com/kazu-yamamoto/dns/pull/47) 2.0.9 	- Implemented TCP fallback after a truncated UDP response. [#46](https://github.com/kazu-yamamoto/dns/pull/46) 2.0.8

@@ -256,9 +256,9 @@                                <*> decodeMType                                <*> decodeADF   where-    decodeUsage    = getInt8-    decodeSelector = getInt8-    decodeMType    = getInt8+    decodeUsage    = get8+    decodeSelector = get8+    decodeMType    = get8     decodeADF      = getNByteString (len - 3) decodeRData _  len = RD_OTH <$> getNByteString len 

@@ -176,9 +176,9 @@         , encodeDomain dom         ]     (RD_TLSA u s m d) -> mconcat-        [ putInt8 u-        , putInt8 s-        , putInt8 m+        [ put8 u+        , put8 s+        , put8 m         , putByteString d         ] 

@@ -10,12 +10,16 @@ import Data.IP (IP, IPv4, IPv6) import Data.Maybe (fromMaybe) import Data.Typeable (Typeable)+import Data.Word (Word8)  ----------------------------------------------------------------  -- | Type for domain. type Domain = ByteString +-- | Return type of composeQuery from Encode, needed in Resolver+type Query = L.ByteString+ ----------------------------------------------------------------  -- | Types for resource records.@@ -225,7 +229,7 @@            | RD_SRV Int Int Int Domain            | RD_OPT [OData]            | RD_OTH ByteString-           | RD_TLSA Int Int Int ByteString+           | RD_TLSA Word8 Word8 Word8 ByteString     deriving (Eq, Ord)  instance Show RData where

@@ -371,35 +371,73 @@                   let valid = checkSeqno res                   case valid of                       False  -> loop query checkSeqno (cnt + 1) False-                      True | False <- trunCation $ flags $ header res+                      True | not $ trunCation $ flags $ header res                              -> return $ Right res-                      _      -> tcpRetry query+                      _      -> tcpRetry query sock tm     sock = dnsSock rlv     tm = dnsTimeout rlv     retry = dnsRetry rlv     q = makeQuestion dom typ     check seqno res = identifier (header res) == seqno-    tcpRetry query = do-        peer <- getPeerName sock-        bracket (tcpOpen peer)-                (maybe (return ()) close)-                (tcpLookup query peer)-    tcpOpen peer = do-        case (peer) of-            SockAddrInet _ _ ->-                socket AF_INET Stream defaultProtocol >>= return . Just-            SockAddrInet6 _ _ _ _ ->-                socket AF_INET6 Stream defaultProtocol >>= return . Just-            _ -> return Nothing -- Only IPv4 and IPv6 are possible-    tcpLookup _ _ Nothing = return $ Left ServerFailure -- can't happen-    tcpLookup query peer (Just vc) = do-        response <- timeout tm $ do-            connect vc $ peer-            sendAll vc $ encodeVC query-            receiveVC vc-        case response of-            Nothing  -> return $ Left TimeoutExpired-            Just res -> return $ Right res++-- Create a TCP socket `just like` our UDP socket and retry the same+-- query over TCP.  Since TCP is a reliable transport, and we just+-- got a (truncated) reply from the server over UDP (so it has the+-- answer, but it is just too large for UDP), we expect to succeed+-- quickly on the first try.  There will be no further retries.++tcpRetry ::+    Query+    -> Socket+    -> Int+    -> IO (Either DNSError DNSMessage)+tcpRetry query sock tm = do+    peer <- getPeerName sock+    bracket (tcpOpen peer)+            (maybe (return ()) close)+            (tcpLookup query peer tm)++-- Create a TCP socket with the given socket address (taken from a+-- corresponding UDP socket).  This might throw an I/O Exception+-- if we run out of file descriptors.  Should this use tryIOError,+-- and return "Nothing" also in that case?  If so, perhaps similar+-- code is needed in openSocket, but that has to wait until we+-- refactor `withResolver` to not do "early" socket allocation, and+-- instead allocate a fresh UDP socket for each `lookupRawInternal`+-- invocation.  It would be bad to fail an entire `withResolver`+-- action, if the socket shortage is transient, and the user intends+-- to make many DNS queries with the same resolver handle.++tcpOpen :: SockAddr -> IO (Maybe Socket)+tcpOpen peer = do+    case (peer) of+        SockAddrInet _ _ ->+            socket AF_INET Stream defaultProtocol >>= return . Just+        SockAddrInet6 _ _ _ _ ->+            socket AF_INET6 Stream defaultProtocol >>= return . Just+        _ -> return Nothing -- Only IPv4 and IPv6 are possible++-- Perform a DNS query over TCP, if we were successful in creating+-- the TCP socket.  The socket creation can only fail if we run out+-- of file descriptors, we're not making connections here.  Failure+-- is reported as "server" failure, though it is really our stub+-- resolver that's failing.  This is likely good enough.++tcpLookup ::+    Query+    -> SockAddr+    -> Int+    -> Maybe Socket+    -> IO (Either DNSError DNSMessage)+tcpLookup _ _ _ Nothing = return $ Left ServerFailure+tcpLookup query peer tm (Just vc) = do+    response <- timeout tm $ do+        connect vc $ peer+        sendAll vc $ encodeVC query+        receiveVC vc+    case response of+        Nothing  -> return $ Left TimeoutExpired+        Just res -> return $ Right res  #if mingw32_HOST_OS == 1     -- Windows does not support sendAll in Network.ByteString.Lazy.

@@ -1,5 +1,5 @@ Name:                   dns-Version:                2.0.9+Version:                2.0.10 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3