From: Eugene Crosser Date: Thu, 17 Apr 2014 11:44:57 +0000 (+0400) Subject: make the binary suitable as interactive query tool X-Git-Tag: 0.9.0.0~51 X-Git-Url: http://average.org/gitweb/?a=commitdiff_plain;h=a94698b56a0faf340c007fe11b6ac7bcb2c566e2;p=pdns-pipe-nmc.git make the binary suitable as interactive query tool --- diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs index f2669a2..737c9e7 100644 --- a/pdns-pipe-nmc.hs +++ b/pdns-pipe-nmc.hs @@ -58,21 +58,20 @@ qRsp rsp = -- NMC interface -queryNmc :: Manager -> Config -> String -> String - -> IO (Either String NmcDom) -queryNmc mgr cfg qid fqdn = +queryOpNmc cfg mgr qid key = + runResourceT (httpLbs (qReq cfg key qid) mgr) >>= return . qRsp + +queryOpFile key = catch (readFile key >>= return . Right) + (\e -> return (Left (show (e :: IOException)))) + +queryDom queryOp fqdn = case reverse (splitOn "." fqdn) of "bit":dn:xs -> descendNmcDom queryOp xs $ seedNmcDom dn _ -> return $ Left "Only \".bit\" domain is supported" - where - queryOp key = do - rsp <- runResourceT $ httpLbs (qReq cfg key qid) mgr - -- print $ qRsp rsp - return $ qRsp rsp --- Main entry +-- Main entries -mainNmc = do +mainPdnsNmc = do cfg <- readConfig confFile @@ -102,7 +101,7 @@ mainNmc = do Right preq -> do case preq of PdnsRequestQ qname qtype id _ _ _ -> - queryNmc mgr cfg id qname >>= putStr . (pdnsOut ver id qname qtype) + queryDom (queryOpNmc cfg mgr id) qname >>= putStr . (pdnsOut ver id qname qtype) PdnsRequestAXFR xfrreq -> putStr $ pdnsReport ("No support for AXFR " ++ xfrreq) PdnsRequestPing -> putStrLn "END" @@ -112,18 +111,14 @@ mainNmc = do mainOne key = do cfg <- readConfig confFile mgr <- newManager def - dom <- queryNmc mgr cfg "+" key + dom <- queryDom (queryOpNmc cfg mgr "_") key putStrLn $ ppShow dom - putStr $ pdnsOut 1 "+" key RRTypeANY dom + putStr $ pdnsOut 1 "_" key RRTypeANY dom -- using file backend for testing json domain data -queryFile :: String -> IO (Either String ByteString) -queryFile key = catch (readFile key >>= return . Right) - (\e -> return (Left (show (e :: IOException)))) - mainFile key = do - dom <- descendNmcDom queryFile [] (seedNmcDom key) + dom <- queryDom queryOpFile key putStrLn $ ppShow dom putStr $ pdnsOut 1 "+" key RRTypeANY dom @@ -132,7 +127,7 @@ mainFile key = do main = do args <- getArgs case args of - [] -> mainNmc + [] -> mainPdnsNmc [key] -> mainOne key ["-f",key] -> mainFile key - _ -> error $ "usage: empty args, or \"\", or \"-f \"" + _ -> error $ "usage: empty args, or \"[-f] \""