From: Eugene Crosser Date: Thu, 27 Mar 2014 22:45:18 +0000 (+0400) Subject: wip main cycle X-Git-Tag: 0.9.0.0~115 X-Git-Url: http://average.org/gitweb/?a=commitdiff_plain;h=26b23d266b588ea4b5bc4d53cbf479f9b40d26a0;p=pdns-pipe-nmc.git wip main cycle --- diff --git a/NmcJson.hs b/NmcJson.hs index b744929..978fb04 100644 --- a/NmcJson.hs +++ b/NmcJson.hs @@ -98,14 +98,3 @@ instance FromJSON NmcRes where <*> o .: "address" <*> o .: "expires_in" parseJSON _ = empty - -main = do - let l = "{\"name\":\"d/dot-bit\",\"value\":\"{\\\"info\\\":{\\\"description\\\":\\\"Dot-BIT Project - Official Website\\\",\\\"registrar\\\":\\\"http://register.dot-bit.org\\\"},\\\"fingerprint\\\":[\\\"30:B0:60:94:32:08:EC:F5:BE:DF:F4:BB:EE:52:90:2C:5D:47:62:46\\\"],\\\"ns\\\":[\\\"ns0.web-sweet-web.net\\\",\\\"ns1.web-sweet-web.net\\\"],\\\"map\\\":{\\\"\\\":{\\\"ns\\\":[\\\"ns0.web-sweet-web.net\\\",\\\"ns1.web-sweet-web.net\\\"]}},\\\"email\\\":\\\"register@dot-bit.org\\\"}\",\"txid\":\"7412603f2e6c3459be56accc6e1f3646b603f3d4a4188119a4072f125c1340d5\",\"address\":\"Mw3KCQcqC44nm75w7r79ZifZbEqT8RetWn\",\"expires_in\":18915}" - let r = decode l :: Maybe NmcRes - case r of - Just resp -> do - let value = (resValue resp) - let dom = decode value :: Maybe NmcDom - print dom - Nothing -> - print "Unparseable NMC response" diff --git a/PowerDns.hs b/PowerDns.hs index 7ed76e8..d93214f 100644 --- a/PowerDns.hs +++ b/PowerDns.hs @@ -1,4 +1,10 @@ -module PowerDns where +module PowerDns ( RRType + , PdnsRequest(..) + , pdnsParse + , pdnsOut + ) where + +import NmcJson data RRType = RRTypeSRV | RRTypeA | RRTypeAAAA | RRTypeCNAME | RRTypeDNAME | RRTypeSOA | RRTypeRP | RRTypeLOC @@ -57,16 +63,5 @@ pdnsParse ver s = }) _ -> Left s -{- -pdnsOut :: String -> Either String PdnsRequest -> IO () -pdnsOut _ (Left e) = putStrLn ("ERROR\tUnparseable request: " ++ e) -pdnsOut uri (Right rq) = case rq of - PdnsRequestQ qn qt id lip rip eip -> do - dom <- queryNmc uri qn qt id - case dom of - Left e -> putStrLn ("ERROR\tNmc query error: " ++ e) - Right result -> print result - PdnsRequestAXFR xfrreq -> - putStrLn ("ERROR\t No support for AXFR " ++ xfrreq) - PdnsRequestPing -> putStrLn "OK" --} +pdnsOut :: NmcDom -> String +pdnsOut d = show d diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs index f61d7ba..a933c9c 100644 --- a/pdns-pipe-nmc.hs +++ b/pdns-pipe-nmc.hs @@ -83,18 +83,17 @@ main = do putStrLn $ "OK\tDnsNmc ready to serve, protocol v." ++ (show ver) mgr <- newManager def - - print $ qReq cfg "d/nosuchdomain" "query-nmc" - rsp <- runResourceT $ httpLbs (qReq cfg "d/nosuchdomain" "query-nmc") mgr - print $ (statusCode . responseStatus) rsp - putStrLn "===== complete response is:" - print rsp - let rbody = responseBody rsp - putStrLn "===== response body is:" - print rbody - let result = parseJsonRpc rbody :: Either JsonRpcError NmcRes - putStrLn "===== parsed response is:" - print result --- print $ parseJsonRpc (responseBody rsp) - - --forever $ getLine >>= (pdnsOut uri) . (pdnsParse ver) + forever $ do + l <- getLine + case pdnsParse ver l of + Left e -> putStrLn $ "ERROR\t" ++ e + Right preq -> do + case preq of + PdnsRequestQ qn qt id lip rip eip -> do + ncres <- queryNmc mgr cfg (qName preq) (qType preq) (iD preq) + case ncres of + Left e -> putStrLn $ "ERROR\t" ++ e + Right dom -> putStrLn $ pdnsOut dom + PdnsRequestAXFR xfrreq -> + putStrLn ("ERROR\t No support for AXFR " ++ xfrreq) + PdnsRequestPing -> putStrLn "OK"