X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=pdns-pipe-nmc.hs;h=bbe89ab1ccea7025bcf06b7a5ab3cfb426dd2673;hp=8f26fa72864557e48b0bf04c16af4dd54068bfaf;hb=01954d976644a4fdd078ddd109b18ed89013079d;hpb=17e4165f2d7cd287e2d49ef2ceac494f9236fd61

diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs
index 8f26fa7..bbe89ab 100644
--- a/pdns-pipe-nmc.hs
+++ b/pdns-pipe-nmc.hs
@@ -1,9 +1,11 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Main where
 
 import Prelude hiding (lookup, readFile)
 import System.Environment
+import System.Console.GetOpt
 import System.IO hiding (readFile)
 import System.IO.Error
 import Data.Time.Clock.POSIX
@@ -20,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
@@ -78,7 +84,7 @@ queryDom queryOp fqdn =
 -- Yet another - to use (const - expires_in) from the lookup.
 nmcAge = fmap (\x -> floor ((x - 1303070400) / 600)) getPOSIXTime
 
--- Main entries
+-- run a PowerDNS coprocess. Negotiate ABI version and execute requests.
 
 mainPdnsNmc = do
 
@@ -127,6 +133,7 @@ mainPdnsNmc = do
             PdnsRequestQ qname qtype id _ _ _ -> do
               io $ queryDom (queryOpNmc cfg mgr id) qname
                      >>= putStr . (pdnsOutQ ver count gen qname qtype)
+  {-
   -- debug
               io $ putStrLn $ "LOG\tRequest number " ++ (show count)
                            ++ " id: " ++ (show id)
@@ -134,6 +141,7 @@ mainPdnsNmc = do
                            ++ " qtype: " ++ (show qtype)
                            ++ " cache size: " ++ (show (size cache))
   -- end debug
+  -}
               put $ stow qname (count, cache)
             PdnsRequestAXFR xrq ->
               case fetch xrq cache of
@@ -154,7 +162,7 @@ pdnsOut gen key qt dom =
     "AXFR" -> pdnsOutXfr 1 (-1) gen key dom
     _      -> pdnsOutQ 1 (-1) gen key (rrType qt) dom
 
--- query by key from Namecoin
+-- run one query by key from Namecoin, print domain object and answer
 
 mainOne gen key qt = do
   cfg <- readConfig confFile
@@ -163,7 +171,7 @@ mainOne gen key qt = do
   putStrLn $ ppShow dom
   putStr $ pdnsOut gen key qt dom
 
--- using file backend for testing json domain data
+-- get data from the file, print domain object and answer
 
 mainFile gen key qt = do
   dom <- queryDom queryOpFile key
@@ -175,8 +183,12 @@ mainFile gen key qt = do
 main = do
   args <- getArgs
   gen <- nmcAge
+  let
+    with f xs = case xs of
+      [qfqdn, qtype]       -> f gen qfqdn qtype
+      _ -> error $ "usage: empty args, or \"[-f] <fqdn> {<TYPE>|ANY|AXFR}\""
+                ++ " (type in caps)"
   case args of
-    []                 -> mainPdnsNmc
-    [key, qtype]       -> mainOne gen key qtype
-    ["-f" ,key, qtype] -> mainFile gen key qtype
-    _ -> error $ "usage: empty args, or \"[-f] <fqdn> {<TYPE>|ANY|AXFR}\" (type in caps)"
+    []      -> mainPdnsNmc
+    "-f":xs -> with mainFile xs
+    _       -> with mainOne args