From: Eugene Crosser Date: Mon, 14 Apr 2014 16:51:45 +0000 (+0400) Subject: fix for cleanup pdns response generator X-Git-Tag: 0.9.0.0~65 X-Git-Url: http://average.org/gitweb/?a=commitdiff_plain;h=5f990bd3b8df23bc4c304092cb0375625835b132;p=pdns-pipe-nmc.git fix for cleanup pdns response generator --- diff --git a/PowerDns.hs b/PowerDns.hs index 796d97c..c465a16 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -70,61 +70,56 @@ pdnsReport err = "LOG\tError: " ++ err ++ "\nFAIL\n" pdnsOut :: Int -> String -> String -> RRType -> Either String NmcDom -> String -pdnsOut ver id name rrtype edom = - case edom of - Left err -> pdnsReport $ err ++ " in a query for " ++ name - Right dom -> foldr addLine "END\n" $ nmc2pdns name rrtype dom - where - addLine (nm, ty, dt) accum = - "DATA\t" ++ v3ext ++ nm ++ "\tIN\t" ++ ty ++ "\t" ++ ttl ++ - "\t" ++ id ++ "\t" ++ dt ++ "\n" ++ accum - v3ext = case ver of - 3 -> "0\t1\t" - _ -> "" - ttl = show 3600 +pdnsOut ver id name rrtype edom = case edom of + Left err -> pdnsReport $ err ++ " in a query for " ++ name + Right dom -> foldr addLine "END\n" $ n2p rrtype + where + addLine (nm, ty, dt) accum = + "DATA\t" ++ v3ext ++ nm ++ "\tIN\t" ++ ty ++ "\t" ++ ttl ++ + "\t" ++ id ++ "\t" ++ dt ++ "\n" ++ accum + v3ext = case ver of + 3 -> "0\t1\t" + _ -> "" + ttl = show 3600 -nmc2pdns :: String -> RRType -> NmcDom -> [(String, String, String)] -nmc2pdns name RRTypeANY dom = - foldr (\r accum -> (nmc2pdns r) ++ accum) [] - [RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME, RRTypeDNAME, - RRTypeSOA, RRTypeRP, RRTypeLOC, RRTypeNS, RRTypeDS, RRTypeMX] - where - nmc2pdns RRTypeSRV = makesrv "SRV" $ domService dom - nmc2pdns RRTypeMX = mapto "MX" $ domMx dom - nmc2pdns RRTypeA = mapto "A" $ domIp dom - nmc2pdns RRTypeAAAA = mapto "AAAA" $ domIp6 dom - nmc2pdns RRTypeCNAME = takejust "CNAME" $ domAlias dom - nmc2pdns RRTypeDNAME = takejust "DNAME" $ domTranslate dom - nmc2pdns RRTypeSOA = -- FIXME generate only for top domain - if dom == emptyNmcDom then [] - else - let - email = case domEmail dom of - Nothing -> "hostmaster." ++ name - Just addr -> - let (aname, adom) = break (== '@') addr - in case adom of - "" -> aname - _ -> aname ++ "." ++ (tail adom) - in [(name, "SOA", email ++ " 99999999 10800 3600 604800 86400")] - nmc2pdns RRTypeRP = [] --FIXME - nmc2pdns RRTypeLOC = takejust "LOC" $ domLoc dom - nmc2pdns RRTypeNS = mapto "NS" $ domNs dom - nmc2pdns RRTypeDS = [] --FIXME - - mapto rrstr maybel = case maybel of - Nothing -> [] - Just l -> map (\x -> (name, rrstr, x)) l - - takejust rrstr maybestr = case maybestr of - Nothing -> [] - Just str -> [(name, rrstr, str)] - - makesrv rrstr mayberl = case mayberl of - Nothing -> [] - Just srl -> map (\x -> (name, rrstr, fmtsrv x)) srl - where - fmtsrv rl = (show (srvPrio rl)) ++ " " - ++ (show (srvWeight rl)) ++ " " - ++ (show (srvPort rl)) ++ " " - ++ (srvHost rl) + n2p RRTypeANY = + foldr (\r accum -> (n2p r) ++ accum) [] + [RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME, RRTypeDNAME, + RRTypeSOA, RRTypeRP, RRTypeLOC, RRTypeNS, RRTypeDS, RRTypeMX] + n2p RRTypeSRV = makesrv "SRV" $ domService dom + n2p RRTypeMX = mapto "MX" $ domMx dom + n2p RRTypeA = mapto "A" $ domIp dom + n2p RRTypeAAAA = mapto "AAAA" $ domIp6 dom + n2p RRTypeCNAME = takejust "CNAME" $ domAlias dom + n2p RRTypeDNAME = takejust "DNAME" $ domTranslate dom + n2p RRTypeSOA = -- FIXME generate only for top domain + if dom == emptyNmcDom then [] + else + let + email = case domEmail dom of + Nothing -> "hostmaster." ++ name + Just addr -> + let (aname, adom) = break (== '@') addr + in case adom of + "" -> aname + _ -> aname ++ "." ++ (tail adom) + in [(name, "SOA", email ++ " 99999999 10800 3600 604800 86400")] + n2p RRTypeRP = [] --FIXME + n2p RRTypeLOC = takejust "LOC" $ domLoc dom + n2p RRTypeNS = mapto "NS" $ domNs dom + n2p RRTypeDS = [] --FIXME + + mapto rrstr maybel = case maybel of + Nothing -> [] + Just l -> map (\x -> (name, rrstr, x)) l + takejust rrstr maybestr = case maybestr of + Nothing -> [] + Just str -> [(name, rrstr, str)] + makesrv rrstr mayberl = case mayberl of + Nothing -> [] + Just srl -> map (\x -> (name, rrstr, fmtsrv x)) srl + where + fmtsrv rl = (show (srvPrio rl)) ++ " " + ++ (show (srvWeight rl)) ++ " " + ++ (show (srvPort rl)) ++ " " + ++ (srvHost rl)