import System.IO
-runNamed :: Config -> (DomainName -> IO (Maybe Zone)) -> IO ()
-runNamed cnf findZone
+runNamed :: ZoneFinder zf => Config -> zf -> IO ()
+runNamed cnf zf
= withSocketsDo $
do installHandler sigPIPE Ignore Nothing
udpListen :: AddrInfo -> IO ()
udpListen ai
= do so <- socket (addrFamily ai) Datagram defaultProtocol
+ setSocketOption so ReuseAddr 1
bindSocket so (addrAddress ai)
udpLoop so
tcpListen :: AddrInfo -> IO ()
tcpListen ai
= do so <- socket (addrFamily ai) Stream defaultProtocol
+ setSocketOption so ReuseAddr 1
bindSocket so (addrAddress ai)
listen so 255
tcpLoop so
handleQuestion :: SomeQ -> IO (Builder ())
handleQuestion (SomeQ q)
- = do zoneM <- findZone (qName q)
+ = do zoneM <- findZone zf (qName q)
case zoneM of
Nothing
-> return $ do unauthorise
Just name
-> do allRecords <- zoneResponder zone name
- let filtered = filterRecords (SomeQ q') allRecords
- q' = Question {
- qName = name
- , qType = A
- , qClass = IN
- }
- return filtered
+ let rA = filterRecords (SomeQ qA) allRecords
+ rB = filterRecords (SomeQ qB) allRecords
+ qA = Question {
+ qName = name
+ , qType = A
+ , qClass = IN
+ }
+ qB = Question {
+ qName = name
+ , qType = AAAA
+ , qClass = IN
+ }
+ return (rA ++ rB)
filterRecords :: SomeQ -> [SomeRR] -> [SomeRR]
- filterRecords (SomeQ q)
- | Just (qType q) == cast ANY &&
- Just (qClass q) == cast ANY = id
- | Just (qType q) == cast ANY = filter matchClass
- | Just (qClass q) == cast ANY = filter matchType
- | otherwise = filter matchBoth
+ filterRecords (SomeQ q) = filter predicate
where
- matchClass (SomeRR rr)
- = Just (qClass q) == cast (rrClass rr)
+ predicate rr
+ = predForType rr && predForClass rr
- matchType (SomeRR rr)
- = Just (qType q) == cast (rrType rr) ||
- Just CNAME == cast (rrType rr)
+ predForType (SomeRR rr)
+ | typeOf (qType q) == typeOf ANY
+ = True
- matchBoth rr
- = matchType rr && matchClass rr
+ | 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