From: Eugene Crosser Date: Thu, 17 Apr 2014 20:34:49 +0000 (+0400) Subject: wip AXFR support X-Git-Tag: 0.9.0.0~48 X-Git-Url: http://average.org/gitweb/?a=commitdiff_plain;h=6bd856a8ffad4610f3c1632a337ad05e6277c898;p=pdns-pipe-nmc.git wip AXFR support --- diff --git a/PowerDns.hs b/PowerDns.hs index 76bcba7..61fdc21 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -3,6 +3,7 @@ module PowerDns ( RRType(..) , pdnsParse , pdnsReport , pdnsOut + , pdnsOutXfr ) where import NmcDom @@ -16,17 +17,20 @@ data RRType = RRTypeSRV | RRTypeA | RRTypeAAAA | RRTypeCNAME data PdnsRequest = PdnsRequestQ { qName :: String , qType :: RRType - , iD :: String + , iD :: Int , remoteIpAddress :: String , localIpAddress :: Maybe String , ednsSubnetAddress :: Maybe String } - | PdnsRequestAXFR String + | PdnsRequestAXFR Int | PdnsRequestPing deriving (Show) pdnsParse ver s = let + getInt s = case reads s :: [(Int, String)] of + [(x, _)] -> x + _ -> -1 getQt qt = case qt of "SRV" -> RRTypeSRV "A" -> RRTypeA @@ -54,11 +58,11 @@ pdnsParse ver s = in case words s of "PING":[] -> Right PdnsRequestPing - "AXFR":x:[] -> Right (PdnsRequestAXFR x) + "AXFR":x:[] -> Right (PdnsRequestAXFR (getInt x)) "Q":qn:"IN":qt:id:rip:xs -> Right (PdnsRequestQ { qName = qn , qType = getQt qt - , iD = id + , iD = getInt id , remoteIpAddress = rip , localIpAddress = getLIp ver xs , ednsSubnetAddress = getRIp ver xs @@ -69,14 +73,14 @@ pdnsReport :: String -> String pdnsReport err = "LOG\tError: " ++ err ++ "\nFAIL\n" -pdnsOut :: Int -> String -> String -> RRType -> Either String NmcDom -> String +pdnsOut :: Int -> Int -> String -> RRType -> Either String NmcDom -> String pdnsOut ver id name rrtype edom = case edom of Left err -> pdnsReport $ err ++ " in a query for " ++ name Right dom -> foldr addLine "END\n" $ n2p rrtype where addLine (nm, ty, dt) accum = "DATA\t" ++ v3ext ++ nm ++ "\tIN\t" ++ ty ++ "\t" ++ ttl ++ - "\t" ++ id ++ "\t" ++ dt ++ "\n" ++ accum + "\t" ++ (show id) ++ "\t" ++ dt ++ "\n" ++ accum v3ext = case ver of 3 -> "0\t1\t" _ -> "" @@ -127,3 +131,8 @@ pdnsOut ver id name rrtype edom = case edom of takejust rrstr maybestr = case maybestr of Nothing -> [] Just str -> [(name, rrstr, str)] + +pdnsOutXfr :: Int -> Int -> String -> Either String NmcDom -> String +pdnsOutXfr ver id name edom = case edom of + Left err -> pdnsReport $ err ++ " in a query for " ++ name + Right dom -> pdnsReport $ "AXFR unsupported in a query for " ++ name diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs index 4bd8758..a0d5fa2 100644 --- a/pdns-pipe-nmc.hs +++ b/pdns-pipe-nmc.hs @@ -2,7 +2,7 @@ module Main where -import Prelude hiding (readFile) +import Prelude hiding (lookup, readFile) import System.Environment import System.IO hiding (readFile) import System.IO.Error @@ -15,7 +15,7 @@ import qualified Data.ByteString.Char8 as C (pack) import qualified Data.ByteString.Lazy.Char8 as L (pack) import qualified Data.Text as T (pack) import Data.List.Split -import Data.Map.Lazy (Map, empty, insert, delete, size) +import Data.Map.Lazy (Map, empty, lookup, insert, delete, size) import Data.Aeson (encode, decode, Value(..)) import Network.HTTP.Types import Data.Conduit @@ -32,7 +32,7 @@ confFile = "/etc/namecoin.conf" -- HTTP/JsonRpc interface -qReq :: Config -> String -> String -> Request m +qReq :: Config -> String -> Int -> Request m qReq cf q id = applyBasicAuth (C.pack (rpcuser cf)) (C.pack (rpcpassword cf)) $ def { host = (C.pack (rpchost cf)) , port = (rpcport cf) @@ -45,7 +45,7 @@ qReq cf q id = applyBasicAuth (C.pack (rpcuser cf)) (C.pack (rpcpassword cf)) JsonRpcRequest JsonRpcV1 "name_show" [L.pack q] - (String (T.pack id)) + (String (T.pack (show id))) , checkStatus = \_ _ _ -> Nothing } @@ -97,7 +97,8 @@ mainPdnsNmc = do mgr <- newManager def let - newcache count name = (insert count name) . (delete (count - 10)) + newcache count name = (insert count name) + . (delete (if count >= 10 then count - 10 else count + 90)) io = liftIO mainloop = forever $ do l <- io getLine @@ -108,15 +109,22 @@ mainPdnsNmc = do case preq of PdnsRequestQ qname qtype id _ _ _ -> do io $ queryDom (queryOpNmc cfg mgr id) qname - >>= putStr . (pdnsOut ver (show count) qname qtype) + >>= putStr . (pdnsOut ver count qname qtype) io $ putStrLn $ "LOG\tRequest number " ++ (show count) - ++ " id: " ++ id + ++ " id: " ++ (show id) ++ " qname: " ++ qname ++ " qtype: " ++ (show qtype) ++ " cache size: " ++ (show (size cache)) - put (count + 1, newcache count qname cache) - PdnsRequestAXFR xfrreq -> - io $ putStr $ pdnsReport ("No support for AXFR " ++ xfrreq) + put (if count >= 99 then 0 else count + 1, + newcache count qname cache) + PdnsRequestAXFR xrq -> + case lookup xrq cache of + Nothing -> + io $ putStr $ + pdnsReport ("AXFR for unknown id: " ++ (show xrq)) + Just qname -> + io $ queryDom (queryOpNmc cfg mgr xrq) qname + >>= putStr . (pdnsOutXfr ver count qname) PdnsRequestPing -> io $ putStrLn "END" runStateT mainloop (0, empty) >> return () @@ -125,16 +133,16 @@ mainPdnsNmc = do mainOne key = do cfg <- readConfig confFile mgr <- newManager def - dom <- queryDom (queryOpNmc cfg mgr "_") key + dom <- queryDom (queryOpNmc cfg mgr (-1)) key putStrLn $ ppShow dom - putStr $ pdnsOut 1 "_" key RRTypeANY dom + putStr $ pdnsOut 1 (-1) key RRTypeANY dom -- using file backend for testing json domain data mainFile key = do dom <- queryDom queryOpFile key putStrLn $ ppShow dom - putStr $ pdnsOut 1 "+" key RRTypeANY dom + putStr $ pdnsOut 1 (-1) key RRTypeANY dom -- Entry point