data NmcRRService = NmcRRService
{ srvName :: String
, srvProto :: String
- , srvW1 :: Int
- , srvW2 :: Int
+ , srvPrio :: Int
+ , srvWeight :: Int
, srvPort :: Int
, srvHost :: String
} deriving (Show, Eq)
-- imported objects are processed recursively until there are none.
mergeImport ::
(String -> IO (Either String ByteString)) -- ^ query operation action
+ -> Int -- ^ recursion counter
-> NmcDom -- ^ base domain
-> IO (Either String NmcDom) -- ^ result with merged import
-mergeImport queryOp base = do
+mergeImport queryOp depth base = do
let
mbase = mergeSelf base
base' = mbase {domImport = Nothing}
-- print base
- case domImport mbase of
+ if depth <= 0 then return $ Left "Nesting of imports is too deep"
+ else case domImport mbase of
Nothing -> return $ Right base'
Just key -> do
sub <- queryNmcDom queryOp key
case sub of
Left e -> return $ Left e
- Right sub' -> mergeImport queryOp $ sub' `merge` base'
+ Right sub' -> mergeImport queryOp (depth - 1) $ sub' `merge` base'
-- | If there is an element in the map with key "", merge the contents
-- and remove this element. Do this recursively.
case M.lookup "" map' of
Nothing -> base'
Just sub -> (mergeSelf sub) `merge` base'
+ -- recursion depth limited by the size of the record
+
+-- | SRV case - remove everyting and filter SRV records
+normalizeSrv :: String -> String -> NmcDom -> NmcDom
+normalizeSrv serv proto dom =
+ emptyNmcDom {domService = fmap (filter needed) (domService dom)}
+ where
+ needed r = srvName r == serv && srvProto r == proto
-- | Presence of some elements require removal of some others
normalizeDom :: NmcDom -> NmcDom
-normalizeDom dom = foldr id dom [ translateNormalizer
- -- , nsNormalizer -- FIXME retrun this
+normalizeDom dom = foldr id dom [ srvNormalizer
+ , translateNormalizer
+ , nsNormalizer
]
where
nsNormalizer dom = case domNs dom of
translateNormalizer dom = case domTranslate dom of
Nothing -> dom
Just tr -> dom { domMap = Nothing }
+ srvNormalizer dom = dom { domService = Nothing }
-- | Merge imports and Selfs and follow the maps tree to get dom
descendNmcDom ::
-> NmcDom -- ^ base domain
-> IO (Either String NmcDom) -- ^ fully processed result
descendNmcDom queryOp subdom base = do
- base' <- mergeImport queryOp base
+ base' <- mergeImport queryOp 10 base
case subdom of
[] -> return $ fmap normalizeDom base'
+ -- A hack to handle SRV records: don't descend if ["_prot","_serv"]
+ [('_':p),('_':s)] -> return $ fmap (normalizeSrv s p) base'
d:ds ->
case base' of
Left err -> return base'