From 37084c2c7ca994c3690cc8729e7849a6c7177ea4 Mon Sep 17 00:00:00 2001 From: Eugene Crosser Date: Sun, 13 Apr 2014 20:48:35 +0400 Subject: [PATCH] prevent import loops --- NmcDom.hs | 11 +++++++---- PowerDns.hs | 2 +- d/extra2 | 2 +- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/NmcDom.hs b/NmcDom.hs index fe87270..6594b7d 100644 --- a/NmcDom.hs +++ b/NmcDom.hs @@ -186,20 +186,22 @@ queryNmcDom queryOp key = do -- 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. @@ -218,6 +220,7 @@ mergeSelf base = case M.lookup "" map' of Nothing -> base' Just sub -> (mergeSelf sub) `merge` base' + -- recursion depth limited by the size of the record -- | Presence of some elements require removal of some others normalizeDom :: NmcDom -> NmcDom @@ -239,7 +242,7 @@ 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' d:ds -> diff --git a/PowerDns.hs b/PowerDns.hs index e225b62..7e2d9cc 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -71,7 +71,7 @@ pdnsReport err = pdnsOut :: Int -> String -> String -> RRType -> Either String NmcDom -> String pdnsOut ver id name rrtype edom = case edom of - Left err -> pdnsReport err + 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 = diff --git a/d/extra2 b/d/extra2 index c899105..2978b78 100644 --- a/d/extra2 +++ b/d/extra2 @@ -1 +1 @@ -{"ip":["5.6.7.8"],"alias":"extra2alias","service":[["imap", "tcp", 0, 0, 143, "mail.host.com."]]} +{"import":"d/extra1","ip":["5.6.7.8"],"alias":"extra2alias","service":[["imap", "tcp", 0, 0, 143, "mail.host.com."]]} -- 2.43.0