X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=NmcTransform.hs;h=c461274acdae54ab4eb091f2c3cc9f35bd8ee737;hp=858acf7de0e6c58229ad7a357e8bb273d66386f4;hb=444411783cdc992b99a6d9fe0e0a5922686d1931;hpb=f5e9870ed6d3307c08e583a7874d8c35e0ea6978;ds=sidebyside diff --git a/NmcTransform.hs b/NmcTransform.hs index 858acf7..c461274 100644 --- a/NmcTransform.hs +++ b/NmcTransform.hs @@ -4,7 +4,6 @@ module NmcTransform ( seedNmcDom import Prelude hiding (lookup) import Data.ByteString.Lazy (ByteString) -import Data.Text.Lazy (splitOn, pack, unpack) import Data.Map.Lazy (empty, lookup, delete, size, singleton , foldrWithKey, insert, insertWith) import Control.Monad (foldM) @@ -39,7 +38,7 @@ mergeIncl :: -> IO (Either String NmcDom) -- ^ result with merged import mergeIncl queryOp depth base = do let - mbase = ({-expandSrv .-} splitSubdoms . mergeSelf) base + mbase = mergeSelf base base' = mbase {domDelegate = Nothing, domImport = Nothing} -- print base if depth <= 0 then return $ Left "Nesting of imports is too deep" @@ -73,57 +72,6 @@ mergeSelf base = Nothing -> base' Just sub -> (mergeSelf sub) `merge` base' -- recursion depth limited by the size of the record -{- --- | replace Service with Srv down in the Map -expandSrv :: NmcDom -> NmcDom -expandSrv base = - let - base' = base { domService = Nothing } - in - case domService base of - Nothing -> base' - Just sl -> foldr addSrvMx base' sl - where - addSrvMx sr acc = sub1 `merge` acc - where - sub1 = def { domSubmap = Just (singleton proto sub2) - , domMx = maybemx} - sub2 = def { domSubmap = Just (singleton srvid sub3) } - sub3 = def { domSrv = Just [srvStr] } - proto = "_" ++ (srvProto sr) - srvid = "_" ++ (srvName sr) - srvStr = (show (srvPrio sr)) ++ "\t" - ++ (show (srvWeight sr)) ++ " " - ++ (show (srvPort sr)) ++ " " - ++ (srvHost sr) - maybemx = - if srvName sr == "smtp" - && srvProto sr == "tcp" - && srvPort sr == 25 - then Just [(show (srvPrio sr)) ++ "\t" ++ (srvHost sr)] - else Nothing --} --- | Convert map elements of the form "subN...sub2.sub1.dom.bit" --- into nested map and merge it -splitSubdoms :: NmcDom -> NmcDom -splitSubdoms base = - let - base' = base { domSubmap = Nothing } - in - case domSubmap base of - Nothing -> base' - Just sdmap -> (def { domSubmap = Just sdmap' }) `merge` base' - where - sdmap' = foldrWithKey stow empty sdmap - stow fqdn sdom acc = insertWith merge fqdn' sdom' acc - where - (fqdn', sdom') = - nest (filter (/= "") (splitOnDots fqdn), sdom) - splitOnDots s = map unpack (splitOn (pack ".") (pack s)) - nest ([], v) = (fqdn, v) -- can split result be empty? - nest ([k], v) = (k, v) - nest (k:ks, v) = - nest (ks, def { domSubmap = Just (singleton k v) }) -- | transfer some elements of `base` into `sub`, notably TLSA propagate :: NmcDom -> NmcDom -> NmcDom