X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=haskell-dns.git;a=blobdiff_plain;f=Network%2FDNS%2FNamed.hs;fp=Network%2FDNS%2FNamed.hs;h=57570cfffdc87a39de49cf065571198e08144f9e;hp=3d0a6dc7841096ca1803fac1bb0a5c4ef32d6273;hb=845dca95afa7e073e62520ef3c4840b3b078bdad;hpb=826401d22c87d6c5d77ad4f427d28d6b97a9d12f diff --git a/Network/DNS/Named.hs b/Network/DNS/Named.hs index 3d0a6dc..57570cf 100644 --- a/Network/DNS/Named.hs +++ b/Network/DNS/Named.hs @@ -42,6 +42,7 @@ runNamed cnf findZone udpListen :: AddrInfo -> IO () udpListen ai = do so <- socket (addrFamily ai) Datagram defaultProtocol + setSocketOption so ReuseAddr 1 bindSocket so (addrAddress ai) udpLoop so @@ -54,6 +55,7 @@ runNamed cnf findZone 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 @@ -167,31 +169,46 @@ runNamed cnf findZone 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