X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=PowerDns.hs;h=c465a16a3017f7fc3c43876953d81d048b8234b4;hp=696b9b57af6c06fd3bd4d85349f4185a65af3a04;hb=5f990bd3b8df23bc4c304092cb0375625835b132;hpb=6970cec92480e5b3ab3d82d120f5877181fa8589 diff --git a/PowerDns.hs b/PowerDns.hs index 696b9b5..c465a16 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -5,11 +5,11 @@ module PowerDns ( RRType(..) , pdnsOut ) where -import NmcJson +import NmcDom data RRType = RRTypeSRV | RRTypeA | RRTypeAAAA | RRTypeCNAME | RRTypeDNAME | RRTypeSOA | RRTypeRP | RRTypeLOC - | RRTypeNS | RRTypeDS + | RRTypeNS | RRTypeDS | RRTypeMX | RRTypeANY | RRTypeError String deriving (Show) @@ -38,6 +38,7 @@ pdnsParse ver s = "LOC" -> RRTypeLOC "NS" -> RRTypeNS "DS" -> RRTypeDS + "MX" -> RRTypeMX "ANY" -> RRTypeANY _ -> RRTypeError qt getLIp ver xs @@ -69,50 +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 - 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 name r dom) ++ accum) [] - [RRTypeA, RRTypeAAAA, RRTypeCNAME, RRTypeDNAME, -- no SRV here! - RRTypeSOA, RRTypeRP, RRTypeLOC, RRTypeNS, RRTypeDS] -nmc2pdns name RRTypeSRV dom = [] -- FIXME -nmc2pdns name RRTypeA dom = mapto name "A" $ domIp dom -nmc2pdns name RRTypeAAAA dom = mapto name "AAAA" $ domIp6 dom -nmc2pdns name RRTypeCNAME dom = takejust name "CNAME" $ domAlias dom -nmc2pdns name RRTypeDNAME dom = takejust name "DNAME" $ domTranslate dom -nmc2pdns name RRTypeSOA dom = - 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 name RRTypeRP dom = [] --FIXME -nmc2pdns name RRTypeLOC dom = takejust name "LOC" $ domLoc dom -nmc2pdns name RRTypeNS dom = mapto name "NS" $ domNs dom -nmc2pdns name RRTypeDS dom = [] --FIXME - -mapto name rrstr maybel = case maybel of - Nothing -> [] - Just l -> map (\x -> (name, rrstr, x)) l - -takejust name rrstr maybestr = case maybestr of - Nothing -> [] - Just str -> [(name, rrstr, str)] + 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)