+ 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 ()
+
+
+validateQuery :: Message -> ResponseCode
+validateQuery = validateHeader . msgHeader
+ where
+ validateHeader :: Header -> ResponseCode
+ validateHeader hdr
+ | hdMessageType hdr /= Query = NotImplemented
+ | hdOpcode hdr /= StandardQuery = NotImplemented
+ | otherwise = NoError
+
+
+packMessage :: Maybe Int -> Message -> BS.ByteString
+packMessage limM = BS.concat . LBS.toChunks . truncateMsg
+ where
+ truncateMsg :: Message -> LBS.ByteString
+ truncateMsg msg
+ = let packet = encode msg
+ needTrunc = fromMaybe False $
+ do lim <- limM
+ return $ fromIntegral (LBS.length packet) > lim
+ in
+ if needTrunc then
+ truncateMsg $ trunc' msg
+ else
+ packet
+
+ trunc' :: Message -> Message
+ trunc' msg
+ | notNull $ msgAdditionals msg
+ = msg {
+ msgAdditionals = truncList $ msgAdditionals msg
+ }
+ | notNull $ msgAuthorities msg
+ = msg {
+ msgHeader = setTruncFlag $ msgHeader msg
+ , msgAuthorities = truncList $ msgAuthorities msg
+ }
+ | notNull $ msgAnswers msg
+ = msg {
+ msgHeader = setTruncFlag $ msgHeader msg
+ , msgAnswers = truncList $ msgAnswers msg
+ }
+ | notNull $ msgQuestions msg
+ = msg {
+ msgHeader = setTruncFlag $ msgHeader msg
+ , msgQuestions = truncList $ msgQuestions msg
+ }
+ | otherwise
+ = error ("packMessage: You are already skinny and need no diet: " ++ show msg)
+
+ setTruncFlag :: Header -> Header
+ setTruncFlag hdr = hdr { hdIsTruncated = True }
+
+ notNull :: [a] -> Bool
+ notNull = not . null
+
+ truncList :: [a] -> [a]
+ truncList xs = take (length xs - 1) xs
+
+unpackMessage :: BS.ByteString -> Message
+unpackMessage = decode . LBS.fromChunks . return
+
+mkErrorReply :: ResponseCode -> Message -> Message
+mkErrorReply err msg
+ = runBuilder msg $ do unauthorise
+ setResponseCode err