Permalink
Browse files

new error handling.

  • Loading branch information...
1 parent a58f19b commit 8d9ff9cca89a45f835f424f08e568d7bb6ec70b0 @kazu-yamamoto committed Feb 18, 2014
Showing with 54 additions and 9 deletions.
  1. +26 −6 Network/DNS/Internal.hs
  2. +28 −3 Network/DNS/Resolver.hs
View
32 Network/DNS/Internal.hs
@@ -53,14 +53,34 @@ toType = read . map toUpper
-- | An enumeration of all possible DNS errors that can occur.
data DNSError =
- -- | The sequence number of the answer doesn't match our query. This
- -- could indicate foul play.
- SequenceNumberMismatch
- -- | The request simply timed out.
+ -- | The sequence number of the answer doesn't match our query. This
+ -- could indicate foul play.
+ SequenceNumberMismatch
+ -- | The request simply timed out.
| TimeoutExpired
- -- | The answer has the correct sequence number, but returned an
- -- unexpected RDATA format.
+ -- | The answer has the correct sequence number, but returned an
+ -- unexpected RDATA format.
| UnexpectedRDATA
+ -- | The domain for query is illegal.
+ | IllegalDomain
+ -- | The name server was unable to interpret the query.
+ | FormatError
+ -- | The name server was unable to process this query due to a
+ -- problem with the name server.
+ | ServerFailure
+ -- | Meaningful only for responses from an authoritative name
+ -- server, this code signifies that the
+ -- domain name referenced in the query does not exist.
+ | NameError
+ -- | The name server does not support the requested kind of query.
+ | NotImplemented
+ -- | The name server refuses to perform the specified operation for
+ -- policy reasons. For example, a name
+ -- server may not wish to provide the
+ -- information to the particular requester,
+ -- or a name server may not wish to perform
+ -- a particular operation (e.g., zone transfer) for particular data.
+ | OperationRefused
deriving (Eq, Show, Typeable)
instance Exception DNSError
View
31 Network/DNS/Resolver.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, OverloadedStrings #-}
-- | DNS Resolver and generic (lower-level) lookup functions.
module Network.DNS.Resolver (
@@ -15,6 +15,7 @@ module Network.DNS.Resolver (
import Control.Applicative
import Control.Exception
+import qualified Data.ByteString.Char8 as BS
import Data.Char
import Data.Int
import Data.List hiding (find, lookup)
@@ -194,14 +195,25 @@ lookupSection :: (DNSFormat -> [ResourceRecord])
-> Domain
-> TYPE
-> IO (Either DNSError [RDATA])
-lookupSection section rlv dom typ = (>>= toRDATA) <$> lookupRaw rlv dom typ
+lookupSection section rlv dom typ = do
+ eans <- lookupRaw rlv dom typ
+ case eans of
+ Left err -> return $ Left err
+ Right ans -> return $ case errcode ans of
+ NoErr -> Right $ toRDATA ans
+ FormatErr -> Left FormatError
+ ServFail -> Left ServerFailure
+ NameErr -> Left NameError
+ NotImpl -> Left NotImplemented
+ Refused -> Left OperationRefused
where
{- CNAME hack
dom' = if "." `isSuffixOf` dom then dom else dom ++ "."
correct r = rrname r == dom' && rrtype r == typ
-}
correct r = rrtype r == typ
- toRDATA = Right . map rdata . filter correct . section
+ toRDATA = map rdata . filter correct . section
+ errcode = rcode . flags . header
-- | Look up resource records for a domain, collecting the results
-- from the ANSWER section of the response.
@@ -264,6 +276,8 @@ lookupAuth = lookupSection authority
-- @
--
lookupRaw :: Resolver -> Domain -> TYPE -> IO (Either DNSError DNSFormat)
+lookupRaw _ dom _
+ | isIllegal dom = return $ Left IllegalDomain
lookupRaw rlv dom typ = do
seqno <- genId rlv
let query = composeQuery seqno [q]
@@ -299,3 +313,14 @@ lookupRaw rlv dom typ = do
sent <- send sock (LB.unpack bs)
when (sent < fromIntegral (LB.length bs)) $ sendAll sock (LB.drop (fromIntegral sent) bs)
#endif
+
+isIllegal :: Domain -> Bool
+isIllegal "" = True
+isIllegal dom
+ | '.' `BS.notElem` dom = True
+ | ':' `BS.elem` dom = True
+ | '/' `BS.elem` dom = True
+ | BS.length dom > 253 = True
+ | any (\x -> BS.length x > 63)
+ (BS.split '.' dom) = True
+isIllegal _ = False

0 comments on commit 8d9ff9c

Please sign in to comment.