1 module Network.DNS.Named.Zone
21 import qualified Data.Map as M
25 import Network.DNS.Message
26 import Network.DNS.DomainMap
29 class ZoneFinder a where
30 findZone :: a -> DomainName -> IO (Maybe SomeZone)
32 instance ZoneFinder (DomainMap SomeZone) where
33 findZone = (return .) . flip nearest
35 instance ZoneFinder (IO (DomainMap SomeZone)) where
36 findZone = flip (fmap . nearest)
38 instance ZoneFinder (DomainMap (IO SomeZone)) where
40 = do let getZoneM = nearest n m
42 Just getZone -> liftM Just getZone
43 Nothing -> return Nothing
45 instance ZoneFinder (DomainName -> Maybe SomeZone) where
48 instance ZoneFinder (DomainName -> IO (Maybe SomeZone)) where
52 fromZones :: [SomeZone] -> DomainMap SomeZone
53 fromZones = fromList . map toPair
55 toPair z = (zoneName z, z)
59 zoneName :: a -> DomainName
60 getRecordNames :: a -> IO [DomainName]
61 getRecordsForName :: a -> DomainName -> IO [SomeRR]
64 data SomeZone = forall a. Zone a => SomeZone a
66 instance Zone SomeZone where
67 zoneName (SomeZone a) = zoneName a
68 getRecordNames (SomeZone a) = getRecordNames a
69 getRecordsForName (SomeZone a) = getRecordsForName a
75 , ezRecordNames :: !(IO [DomainName])
76 , ezRecordsForName :: !(DomainName -> IO [SomeRR])
78 instance Zone ExternalZone where
80 getRecordNames = ezRecordNames
81 getRecordsForName = ezRecordsForName
87 , fzRecordNames :: ![DomainName]
88 , fzRecordsForName :: !(DomainName -> [SomeRR])
90 instance Zone FunctionalZone where
92 getRecordNames = return . fzRecordNames
93 getRecordsForName = (return .) . fzRecordsForName
99 , szRecords :: !(Map DomainName [SomeRR])
103 instance Zone StaticZone where
105 getRecordNames = return . M.keys . szRecords
106 getRecordsForName = ((return . fromMaybe []) .) . flip M.lookup . szRecords
109 fromRecords :: [SomeRR] -> Map DomainName [SomeRR]
110 fromRecords = foldl ins M.empty
113 = case M.lookup (rrName rr) m of
115 -> M.insert (rrName rr) (l ++ [SomeRR rr]) m
117 -> M.insert (rrName rr) [SomeRR rr] m
120 isInZone :: Zone z => DomainName -> z -> Bool
121 isInZone name zone = zoneName zone `isZoneOf` name
124 wrapZone :: Zone z => z -> SomeZone
128 isAuthoritativeZone :: Zone z => z -> IO Bool
129 isAuthoritativeZone z
130 = do let q = Question {
133 , qClass = IN -- Should we consider any classes other than the Internet?
141 getRecords :: (QueryType qt, QueryClass qc, Zone z) =>
146 | cast (qType q) == Just AXFR
150 = do rs <- getRecordsForName z (qName q)
151 return $ filterRecords q rs
155 | qName q == zoneName z
156 = do names <- getRecordNames z
157 (soaM, rs) <- liftM (spitSOA . concat) $ mapM (getRecordsForName z) names
159 Just soa -> return ([soa] ++ rs ++ [soa])
164 spitSOA :: [SomeRR] -> (Maybe SomeRR, [SomeRR])
165 spitSOA xs = (findSOA xs, collectNonSOA xs)
167 findSOA :: [SomeRR] -> Maybe SomeRR
169 findSOA (SomeRR x : xs)
170 | typeOf (rrType x) == typeOf SOA = Just (SomeRR x)
171 | otherwise = findSOA xs
173 collectNonSOA :: [SomeRR] -> [SomeRR]
174 collectNonSOA [] = []
175 collectNonSOA (SomeRR x : xs)
176 | typeOf (rrType x) == typeOf SOA = collectNonSOA xs
177 | otherwise = SomeRR x : collectNonSOA xs
180 filterRecords :: (QueryType qt, QueryClass qc) =>
184 filterRecords q = filter predicate
187 = predForType rr && predForClass rr
189 predForType (SomeRR rr)
190 | typeOf (qType q) == typeOf ANY
193 | typeOf (qType q) == typeOf MAILB
194 = typeOf (rrType rr) == typeOf MR ||
195 typeOf (rrType rr) == typeOf MB ||
196 typeOf (rrType rr) == typeOf MG ||
197 typeOf (rrType rr) == typeOf MINFO
200 = typeOf (rrType rr) == typeOf (qType q) ||
201 typeOf (rrType rr) == typeOf CNAME
203 predForClass (SomeRR rr)
204 | typeOf (qClass q) == typeOf ANY
208 = typeOf (rrClass rr) == typeOf (qClass q)