X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=PowerDns.hs;h=9e1da83513130309234647b8246914a09d7d02ce;hp=ece3ac79a5dadb4d96469bfcbb77ea2d776afdcc;hb=851c71d42654a1620ea98d2dfe751d2e7fbc961f;hpb=aa91db8940672a57169b1bb400fa3c1a1e9dd335 diff --git a/PowerDns.hs b/PowerDns.hs index ece3ac7..9e1da83 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -15,7 +15,7 @@ import NmcDom data RRType = RRTypeSRV | RRTypeA | RRTypeAAAA | RRTypeCNAME | RRTypeDNAME | RRTypeSOA | RRTypeRP | RRTypeLOC - | RRTypeNS | RRTypeDS | RRTypeMX + | RRTypeNS | RRTypeDS | RRTypeMX | RRTypeTLSA | RRTypeANY | RRTypeError String instance Show RRType where @@ -30,6 +30,7 @@ instance Show RRType where show RRTypeNS = "NS" show RRTypeDS = "DS" show RRTypeMX = "MX" + show RRTypeTLSA = "TLSA" show RRTypeANY = "ANY" show (RRTypeError s) = "Unknown RR type: " ++ (show s) @@ -45,6 +46,7 @@ rrType qt = case qt of "NS" -> RRTypeNS "DS" -> RRTypeDS "MX" -> RRTypeMX + "TLSA" -> RRTypeTLSA "ANY" -> RRTypeANY _ -> RRTypeError qt @@ -106,7 +108,7 @@ pdnsOutQ ver id gen name rrt edom = rrl = case rrt of RRTypeANY -> [ RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME , RRTypeDNAME, RRTypeRP, RRTypeLOC, RRTypeNS - , RRTypeDS, RRTypeMX -- SOA not included + , RRTypeDS, RRTypeMX, RRTypeTLSA -- SOA not included ] x -> [x] in @@ -122,10 +124,10 @@ pdnsOutXfr ver id gen name edom = let allrrs = [ RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME , RRTypeDNAME, RRTypeRP, RRTypeLOC, RRTypeNS - , RRTypeDS, RRTypeMX, RRTypeSOA + , RRTypeDS, RRTypeMX, RRTypeTLSA, RRTypeSOA ] walkDom f acc name dom = - f name dom $ case domMap dom of + f name dom $ case domSubmap dom of Nothing -> acc Just dm -> foldrWithKey (\n d a -> walkDom f a (n ++ "." ++ name) d) acc dm @@ -163,8 +165,27 @@ dotmail addr = "" -> aname ++ "." _ -> aname ++ "." ++ (tail adom) ++ "." -dataRR RRTypeSRV = justl domSrv +dataRR RRTypeSRV = \ _ _ dom -> + case domSrv dom of + Nothing -> [] + Just srvs -> map srvStr srvs + where + srvStr x = (show (srvPrio x)) ++ "\t" + ++ (show (srvWeight x)) ++ " " + ++ (show (srvPort x)) ++ " " + ++ (srvHost x) + dataRR RRTypeMX = justl domMx +dataRR RRTypeTLSA = \ _ _ dom -> + case domTlsa dom of + Nothing -> [] + Just tlsas -> map tlsaStr tlsas + where + tlsaStr x = "(3 0 " + ++ (show (tlsMatchType x)) ++ " " + ++ (tlsMatchValue x) ++ ")" + -- tlsIncSubdoms is not displayed, it is used for `propagate`. + dataRR RRTypeA = justl domIp dataRR RRTypeAAAA = justl domIp6 dataRR RRTypeCNAME = justv domAlias