X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=haskell-dns.git;a=blobdiff_plain;f=ExampleDNSServer.hs;h=f590caab054b7d58240b9ae1c0e9d208682c42fc;hp=e1aaa22e1cf56b86d9c9ce38700073a6bfbadcae;hb=d24a461f09bd10e3fe148e3b6b86c8e861b09a43;hpb=5015e5caa39e015e6ffa28a87fc5f189e7ba3c71

diff --git a/ExampleDNSServer.hs b/ExampleDNSServer.hs
index e1aaa22..f590caa 100644
--- a/ExampleDNSServer.hs
+++ b/ExampleDNSServer.hs
@@ -1,8 +1,10 @@
 import           Network.DNS.Message
 import           Network.DNS.Named
 import           Network.DNS.Named.Config
+import           Network.DNS.Named.Responder
 import           Network.DNS.Named.Zone
 import           Network.Socket
+import           System.IO.Unsafe
 
 main :: IO ()
 main = runNamed cnf zoneFor
@@ -13,4 +15,32 @@ main = runNamed cnf zoneFor
             }
 
       zoneFor :: DomainName -> Maybe Zone
-      zoneFor = const Nothing -- FIXME
\ No newline at end of file
+      zoneFor name
+          | name `isInZone` zone = Just zone
+          | otherwise            = Nothing
+
+      zone :: Zone
+      zone = Zone {
+               zoneName       = mkDN "cielonegro.org."
+             , zoneResponders = [ wrapResponder' $
+                                  do name <- getQueryName
+                                     if name == mkDN "ns.cielonegro.org." then
+                                         respond ResourceRecord {
+                                                       rrName  = name
+                                                     , rrType  = A
+                                                     , rrClass = IN
+                                                     , rrTTL   = 9600
+                                                     , rrData  = inetAddr "127.0.0.1"
+                                                     }
+                                       else
+                                         fail "FIXME: we want to throw NameError but we can't for now"
+                                ]
+             , zoneIsAuthoritative = True
+             }
+
+      wrapResponder' :: Responder A IN () -> SomeResponder
+      wrapResponder' = wrapResponder
+
+
+inetAddr :: String -> HostAddress
+inetAddr = unsafePerformIO . inet_addr