X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=pdns-pipe-nmc.hs;h=1f5a8918675d40f34ce66b49d59ae88c2e2df90c;hp=49cce861d6140d489c6541cb02d02cfe62f6f4e9;hb=b8ee8aa86f0fa6575653ccdf8c985fa0e33211c2;hpb=c83bf5437e85fe671f6e113cfc6f0b4961f543c7 diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs index 49cce86..1f5a891 100644 --- a/pdns-pipe-nmc.hs +++ b/pdns-pipe-nmc.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Main where @@ -21,7 +22,11 @@ import Data.Map.Lazy (Map, empty, lookup, insert, delete, size) import Data.Aeson (encode, decode, Value(..)) import Network.HTTP.Types import Network.HTTP.Client +#if MIN_VERSION_http_client(0,3,0) import Data.Default.Class (def) +#else +import Data.Default (def) +#endif import JsonRpcClient import Config @@ -99,6 +104,7 @@ mainPdnsNmc = do ["HELO", "1"] -> return 1 ["HELO", "2"] -> return 2 ["HELO", "3"] -> return 3 + ["HELO", "4"] -> return 4 ["HELO", x ] -> loopErr $ "unsupported ABI version " ++ (show x) _ -> loopErr $ "bad HELO " ++ (show s) @@ -138,14 +144,26 @@ mainPdnsNmc = do -- end debug -} put $ stow qname (count, cache) - PdnsRequestAXFR xrq -> - case fetch xrq cache of - Nothing -> - io $ putStr $ - pdnsReport ("AXFR for unknown id: " ++ (show xrq)) + PdnsRequestAXFR xrq zid -> do + {- + -- debug + io $ putStrLn $ "LOG\tAXFR request id=" ++ (show xrq) + ++ ", zone name: " ++ (show zid) + -- end debug + -} + let + czone = fetch xrq cache + zone = case zid of + Nothing -> czone + Just qname -> Just qname + -- if zid == czone then zid else Nothing -- paranoid + case zone of Just qname -> io $ queryDom (queryOpNmc cfg mgr xrq) qname - >>= putStr . (pdnsOutXfr ver count gen qname) + >>= putStr . (pdnsOutXfr ver count gen qname) + Nothing -> + io $ putStr $ pdnsReport $ "AXFR cannot determine zone: " + ++ (show xrq) ++ ", " ++ (show zid) PdnsRequestPing -> io $ putStrLn "END" runStateT mainloop (0, empty) >> return ()