From 2ad29ac97637f25aea0a7ac0ee31afa72221a938 Mon Sep 17 00:00:00 2001 From: Eugene Crosser Date: Sun, 13 Apr 2014 23:34:21 +0400 Subject: [PATCH] SRV hack part 3 and final - works now --- NmcDom.hs | 16 +++++++++++++++- PowerDns.hs | 19 +++++++++++++++---- d/extra1 | 2 +- 3 files changed, 31 insertions(+), 6 deletions(-) diff --git a/NmcDom.hs b/NmcDom.hs index 3f6c7bc..c94e8af 100644 --- a/NmcDom.hs +++ b/NmcDom.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module NmcDom ( NmcDom(..) + , NmcRRService(..) , emptyNmcDom , seedNmcDom , descendNmcDom @@ -97,6 +98,7 @@ data NmcDom = NmcDom { domService :: Maybe [NmcRRService] , domTls :: Maybe (Map String (Map String [[String]])) , domDs :: Maybe [[String]] + , domMx :: Maybe [String] -- Synthetic } deriving (Show, Eq) instance FromJSON NmcDom where @@ -132,6 +134,7 @@ instance FromJSON NmcDom where <*> o .:? "fingerprint" <*> o .:? "tls" <*> o .:? "ds" + <*> return Nothing -- domMx not parsed parseJSON _ = empty instance Mergeable NmcDom where @@ -153,6 +156,7 @@ instance Mergeable NmcDom where , domFingerprint = mergelm domFingerprint , domTls = mergelm domTls , domDs = mergelm domDs + , domMx = mergelm domMx } where mergelm x = merge (x sub) (x dom) @@ -167,6 +171,7 @@ instance Mergeable NmcDom where emptyNmcDom = NmcDom Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + Nothing -- | Perform query and return error string or parsed domain object queryNmcDom :: @@ -242,7 +247,16 @@ normalizeDom dom = foldr id dom [ srvNormalizer translateNormalizer dom = case domTranslate dom of Nothing -> dom Just tr -> dom { domMap = Nothing } - srvNormalizer dom = dom { domService = Nothing } + srvNormalizer dom = dom { domService = Nothing, domMx = makemx } + where + makemx = case domService dom of + Nothing -> Nothing + Just svl -> Just $ map makerec (filter needed svl) + where + needed sr = srvName sr == "smtp" + && srvProto sr == "tcp" + && srvPort sr == 25 + makerec sr = (show (srvPrio sr)) ++ " " ++ (srvHost sr) -- | Merge imports and Selfs and follow the maps tree to get dom descendNmcDom :: diff --git a/PowerDns.hs b/PowerDns.hs index 8962e94..77c5149 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -9,7 +9,7 @@ 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 @@ -85,9 +86,10 @@ pdnsOut ver id name rrtype edom = 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 + [RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME, RRTypeDNAME, + RRTypeSOA, RRTypeRP, RRTypeLOC, RRTypeNS, RRTypeDS, RRTypeMX] +nmc2pdns name RRTypeSRV dom = makesrv name "SRV" $ domService dom +nmc2pdns name RRTypeMX dom = mapto name "MX" $ domMx dom 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 @@ -116,3 +118,12 @@ mapto name rrstr maybel = case maybel of takejust name rrstr maybestr = case maybestr of Nothing -> [] Just str -> [(name, rrstr, str)] + +makesrv name 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) diff --git a/d/extra1 b/d/extra1 index ff6c7ef..b0fdcf5 100644 --- a/d/extra1 +++ b/d/extra1 @@ -1 +1 @@ -{"service":[["smtp", "tcp", 0, 0, 143, "mail.host.com."]],"import":"d/extra2","ip":["1.2.3.4"],"alias":"extra1alias"} +{"service":[["smtp", "tcp", 0, 0, 25, "mail.host.com."]],"import":"d/extra2","ip":["1.2.3.4"],"alias":"extra1alias"} -- 2.43.0