+ = do zoneM <- findZone (qName q)
+ case zoneM of
+ Nothing
+ -> return $ do unauthorise
+ setResponseCode Refused
+ Just zone
+ -> handleQuestionForZone (SomeQ q) zone
+
+ handleQuestionForZone :: SomeQ -> Zone -> IO (Builder ())
+ handleQuestionForZone (SomeQ q) zone
+ | Just (qType q) == cast AXFR
+ = handleAXFR (SomeQ q) zone
+ | otherwise
+ = do allRecords <- zoneResponder zone (qName q)
+ let filtered = filterRecords (SomeQ q) allRecords
+
+ additionals <- do xss <- mapM (getAdditionals zone) filtered
+ ys <- case zoneNSRecord zone of
+ Just rr -> getAdditionals zone rr
+ Nothing -> return []
+ return (concat xss ++ ys)
+
+ return $ do mapM_ addAnswer filtered
+
+ when (qName q == zoneName zone) $
+ do when (Just (qType q) == cast SOA ||
+ Just (qType q) == cast ANY )
+ $ case zoneSOARecord zone of
+ Just rr -> addAnswer rr
+ Nothing -> return ()
+
+ when (Just (qType q) == cast NS ||
+ Just (qType q) == cast ANY )
+ $ case zoneNSRecord zone of
+ Just rr -> addAnswer rr
+ Nothing -> return ()
+
+ mapM_ addAdditional additionals
+
+ case zoneNSRecord zone of
+ Just rr -> addAuthority rr
+ Nothing -> unauthorise
+
+ getAdditionals :: Zone -> SomeRR -> IO [SomeRR]
+ getAdditionals zone (SomeRR rr)
+ = case cast (rrData rr) :: Maybe DomainName of
+ Nothing
+ -> return []
+ Just name
+ -> do allRecords <- zoneResponder zone name
+
+ let rA = filterRecords (SomeQ qA) allRecords
+ rB = filterRecords (SomeQ qB) allRecords
+ qA = Question {
+ qName = name
+ , qType = A
+ , qClass = IN
+ }
+ qB = Question {
+ qName = name
+ , qType = AAAA
+ , qClass = IN
+ }
+ return (rA ++ rB)
+
+ filterRecords :: SomeQ -> [SomeRR] -> [SomeRR]
+ filterRecords (SomeQ q) = filter predicate
+ where
+ predicate rr
+ = predForType rr && predForClass rr
+
+ predForType (SomeRR rr)
+ | typeOf (qType q) == typeOf ANY
+ = True
+
+ | typeOf (qType q) == typeOf MAILB
+ = typeOf (rrType rr) == typeOf MR ||
+ typeOf (rrType rr) == typeOf MB ||
+ typeOf (rrType rr) == typeOf MG ||
+ typeOf (rrType rr) == typeOf MINFO
+
+ | otherwise
+ = typeOf (rrType rr) == typeOf (qType q) ||
+ typeOf (rrType rr) == typeOf CNAME
+
+ predForClass (SomeRR rr)
+ | typeOf (qClass q) == typeOf ANY
+ = True
+
+ | otherwise
+ = typeOf (rrClass rr) == typeOf (qClass q)
+
+ handleAXFR :: SomeQ -> Zone -> IO (Builder ())
+ handleAXFR (SomeQ q) zone
+ | qName q == zoneName zone &&
+ isJust (zoneSOA zone) &&
+ cnfAllowTransfer cnf
+ = do names <- zoneRecordNames zone
+ allRecords <- liftM concat $ mapM (zoneResponder zone) names
+ return $ do addAnswer $ fromJust $ zoneSOARecord zone
+ addAnswer $ fromJust $ zoneNSRecord zone
+ mapM_ addAnswer allRecords
+ addAnswerNonuniquely $ fromJust $ zoneSOARecord zone
+ | otherwise
+ = return $ return ()