X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=haskell-dns.git;a=blobdiff_plain;f=Network%2FDNS%2FNamed%2FZone.hs;h=302fe661441f7d150f1597dcd5883a94d92e14c0;hp=f313beb3d1aab7c78f3b1fd1d0fdf4b920390719;hb=e4ee321871e4ffed54d1378db5080389d76032c1;hpb=f3ad40fd6916408dde9b9e6237b41828d90c1e34

diff --git a/Network/DNS/Named/Zone.hs b/Network/DNS/Named/Zone.hs
index f313beb..302fe66 100644
--- a/Network/DNS/Named/Zone.hs
+++ b/Network/DNS/Named/Zone.hs
@@ -2,72 +2,207 @@ module Network.DNS.Named.Zone
     ( ZoneFinder(..)
     , fromZones
 
-    , Zone(..)
+    , Zone(zoneName)
+    , SomeZone(..)
+    , ExternalZone(..)
+    , FunctionalZone(..)
+    , StaticZone(..)
+    , fromRecords
     , isInZone
+    , wrapZone
 
-    , zoneSOARecord
-    , zoneNSRecord
+    , isAuthoritativeZone
+    , getRecords
     )
     where
 
-import Data.Maybe
-import Network.DNS.Message
-import Network.DNS.DomainMap
+import           Control.Monad
+import           Data.List
+import qualified Data.Map as M
+import           Data.Map (Map)
+import           Data.Maybe
+import           Data.Typeable
+import           Network.DNS.Message
+import           Network.DNS.DomainMap
 
 
 class ZoneFinder a where
-    findZone :: a -> DomainName -> IO (Maybe Zone)
+    findZone :: a -> DomainName -> IO (Maybe SomeZone)
 
-instance ZoneFinder (DomainMap Zone) where
+instance ZoneFinder (DomainMap SomeZone) where
     findZone = (return .) . flip nearest
 
-instance ZoneFinder (IO (DomainMap Zone)) where
+instance ZoneFinder (IO (DomainMap SomeZone)) where
     findZone = flip (fmap . nearest)
 
-instance ZoneFinder (DomainName -> Maybe Zone) where
+instance ZoneFinder (DomainMap (IO SomeZone)) where
+    findZone m n
+        = do let getZoneM = nearest n m
+             case getZoneM of
+               Just getZone -> liftM Just getZone
+               Nothing      -> return Nothing
+
+instance ZoneFinder (DomainName -> Maybe SomeZone) where
     findZone = (return .)
 
-instance ZoneFinder (DomainName -> IO (Maybe Zone)) where
+instance ZoneFinder (DomainName -> IO (Maybe SomeZone)) where
     findZone = id
 
 
-fromZones :: [Zone] -> DomainMap Zone
+fromZones :: [SomeZone] -> DomainMap SomeZone
 fromZones = fromList . map toPair
     where
       toPair z = (zoneName z, z)
 
 
-data Zone
-    = Zone {
-        zoneName        :: !DomainName
-      , zoneSOA         :: !(Maybe SOAFields)
-      , zoneRecordNames :: !(IO [DomainName])
-      , zoneResponder   :: !(DomainName -> IO [SomeRR])
+class Zone a where
+    zoneName          :: a -> DomainName
+    getRecordNames    :: a -> IO [DomainName]
+    getRecordsForName :: a -> DomainName -> IO [SomeRR]
+
+
+data SomeZone = forall a. Zone a => SomeZone a
+
+instance Zone SomeZone where
+    zoneName          (SomeZone a) = zoneName a
+    getRecordNames    (SomeZone a) = getRecordNames a
+    getRecordsForName (SomeZone a) = getRecordsForName a
+
+
+data ExternalZone
+    = ExternalZone {
+        ezName           :: !DomainName
+      , ezRecordNames    :: !(IO [DomainName])
+      , ezRecordsForName :: !(DomainName -> IO [SomeRR])
+      }
+instance Zone ExternalZone where
+    zoneName          = ezName
+    getRecordNames    = ezRecordNames
+    getRecordsForName = ezRecordsForName
+
+
+data FunctionalZone
+    = FunctionalZone {
+        fzName           :: !DomainName
+      , fzRecordNames    :: ![DomainName]
+      , fzRecordsForName :: !(DomainName -> [SomeRR])
+      }
+instance Zone FunctionalZone where
+    zoneName          = fzName
+    getRecordNames    = return . fzRecordNames
+    getRecordsForName = (return .) . fzRecordsForName
+
+
+data StaticZone
+    = StaticZone {
+        szName    :: !DomainName
+      , szRecords :: !(Map DomainName [SomeRR])
       }
+    deriving (Show, Eq)
+
+instance Zone StaticZone where
+    zoneName          = szName
+    getRecordNames    = return . M.keys . szRecords
+    getRecordsForName = ((return . fromMaybe []) .) . flip M.lookup . szRecords
+
+
+fromRecords :: [SomeRR] -> Map DomainName [SomeRR]
+fromRecords = foldl ins M.empty
+    where
+      ins m (SomeRR rr)
+          = case M.lookup (rrName rr) m of
+              Just l
+                  -> M.insert (rrName rr) (l ++ [SomeRR rr]) m
+              Nothing
+                  -> M.insert (rrName rr) [SomeRR rr] m
 
-isInZone :: DomainName -> Zone -> Bool
+
+isInZone :: Zone z => DomainName -> z -> Bool
 isInZone name zone = zoneName zone `isZoneOf` name
 
-zoneSOARecord :: Zone -> Maybe SomeRR
-zoneSOARecord zone
-    = do soa <- zoneSOA zone
-         return $ wrapRecord
-                $ ResourceRecord {
-                        rrName  = zoneName zone
-                      , rrType  = SOA
-                      , rrClass = IN
-                      , rrTTL   = soaMinimumTTL soa
-                      , rrData  = soa
-                      }
-
-zoneNSRecord :: Zone -> Maybe SomeRR
-zoneNSRecord zone
-    = do soa <- zoneSOA zone
-         return $ wrapRecord
-                $ ResourceRecord {
-                        rrName  = zoneName zone
-                      , rrType  = NS
-                      , rrClass = IN
-                      , rrTTL   = soaMinimumTTL soa
-                      , rrData  = soaMasterNameServer soa
-                      }
+
+wrapZone :: Zone z => z -> SomeZone
+wrapZone = SomeZone
+
+
+isAuthoritativeZone :: Zone z => z -> IO Bool
+isAuthoritativeZone z
+    = do let q = Question {
+                   qName  = zoneName z
+                 , qType  = SOA
+                 , qClass = IN -- Should we consider any classes other than the Internet?
+                 }
+         rs <- getRecords z q
+         case rs of
+           [] -> return False
+           _  -> return True
+
+
+getRecords :: (QueryType qt, QueryClass qc, Zone z) =>
+              z
+           -> Question qt qc
+           -> IO [SomeRR]
+getRecords z q
+    | cast (qType q) == Just AXFR
+        = getRecordsForAXFR
+
+    | otherwise
+        = do rs <- getRecordsForName z (qName q)
+             return $ filterRecords q rs
+
+    where
+      getRecordsForAXFR
+          | qName q == zoneName z
+              = do names      <- getRecordNames z
+                   (soaM, rs) <- liftM (spitSOA . concat) $ mapM (getRecordsForName z) names
+                   case soaM of
+                     Just soa -> return ([soa] ++ rs ++ [soa])
+                     Nothing  -> return []
+          | otherwise
+              = return []
+
+      spitSOA :: [SomeRR] -> (Maybe SomeRR, [SomeRR])
+      spitSOA xs = (findSOA xs, collectNonSOA xs)
+
+      findSOA :: [SomeRR] -> Maybe SomeRR
+      findSOA []     = Nothing
+      findSOA (SomeRR x : xs)
+          | typeOf (rrType x) == typeOf SOA = Just (SomeRR x)
+          | otherwise                       = findSOA xs
+
+      collectNonSOA :: [SomeRR] -> [SomeRR]
+      collectNonSOA []     = []
+      collectNonSOA (SomeRR x : xs)
+          | typeOf (rrType x) == typeOf SOA = collectNonSOA xs
+          | otherwise                       = SomeRR x : collectNonSOA xs
+
+
+filterRecords :: (QueryType qt, QueryClass qc) =>
+                 Question qt qc
+              -> [SomeRR]
+              -> [SomeRR]
+filterRecords 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)