From 37084c2c7ca994c3690cc8729e7849a6c7177ea4 Mon Sep 17 00:00:00 2001
From: Eugene Crosser <crosser@average.org>
Date: Sun, 13 Apr 2014 20:48:35 +0400
Subject: [PATCH 1/1] 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.39.2