Implemented AXFR protocol.

[haskell-dns.git] / Network / DNS / Named / ResponseBuilder.hs

diff --git a/Network/DNS/Named/ResponseBuilder.hs b/Network/DNS/Named/ResponseBuilder.hs
index 487a6786bd7240c9c933e8e1dcc309366f4b9781..5201ce3e22ff4ba4e87edbf99d3dff1c66fc6f5b 100644 (file)
--- a/Network/DNS/Named/ResponseBuilder.hs
+++ b/Network/DNS/Named/ResponseBuilder.hs
@@ -4,7 +4,9 @@ module Network.DNS.Named.ResponseBuilder
     , runBuilder
 
     , unauthorise
+    , setResponseCode
     , addAnswer
+    , addAnswerNonuniquely
     , addAuthority
     , addAdditional
     )
@@ -39,7 +41,14 @@ runBuilder query builder
                                 , hdIsRecursionAvailable  = False
                                 , hdResponseCode          = NoError
                                 }
-          (_, result)  = unB (modHeader' >> builder) initialReply
+          setNameError = do aa   <- get (hdIsRecursionAvailable . msgHeader)
+                            rc   <- get (hdResponseCode . msgHeader)
+                            anss <- get msgAnswers
+
+                            when (aa && rc == NoError && null anss)
+                                $ setResponseCode NameError
+
+          (_, result)  = unB (modHeader' >> builder >> setNameError) initialReply
       in
         result
 
@@ -60,6 +69,11 @@ addAnswer rr
              $ modify $ \ s ->
                  s { msgAnswers = msgAnswers s ++ [rr] }
 
+addAnswerNonuniquely :: SomeRR -> Builder ()
+addAnswerNonuniquely rr
+    = modify $ \ s ->
+      s { msgAnswers = msgAnswers s ++ [rr] }
+
 addAuthority :: SomeRR -> Builder ()
 addAuthority rr
     = do anss <- get msgAnswers
@@ -79,3 +93,7 @@ addAdditional rr
 
 unauthorise :: Builder ()
 unauthorise = modifyHeader (\ h -> h { hdIsAuthoritativeAnswer = False })
+
+setResponseCode :: ResponseCode -> Builder ()
+setResponseCode code
+    = modifyHeader (\ h -> h { hdResponseCode = code })