X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=pdns-pipe-nmc.hs;h=a3fc8c7c5b2a5a414388c4f4ede60d1f6c94e1a5;hp=ee5bd3771a900dd880f2add5c7dcacff6a100ae9;hb=b2f5f20509c12bb94783f7035042aed1e0d99c58;hpb=bae658dcd2084b5f5be71987c6eba23f4106818a diff --git a/pdns-pipe-nmc.hs b/pdns-pipe-nmc.hs index ee5bd37..a3fc8c7 100644 --- a/pdns-pipe-nmc.hs +++ b/pdns-pipe-nmc.hs @@ -41,11 +41,17 @@ qReq cf q id = applyBasicAuth (C.pack (rpcuser cf)) (C.pack (rpcpassword cf)) qRsp :: Response ByteString -> Either String NmcDom qRsp rsp = case parseJsonRpc (responseBody rsp) :: Either JsonRpcError NmcRes of - Left jerr -> Left $ "Unparseable response: " ++ (show (responseBody rsp)) + Left jerr -> + case (jrpcErrCode jerr) of + -4 -> Right emptyNmcDom + _ -> Left $ "JsonRpc error response: " ++ (show jerr) Right jrsp -> - case decode (resValue jrsp) :: Maybe NmcDom of - Nothing -> Left $ "Unparseable value: " ++ (show (resValue jrsp)) - Just dom -> Right dom + case resValue jrsp of + "" -> Right emptyNmcDom + vstr -> + case decode vstr :: Maybe NmcDom of + Nothing -> Left $ "Unparseable value: " ++ (show vstr) + Just dom -> Right dom -- NMC interface @@ -97,3 +103,13 @@ main = do PdnsRequestAXFR xfrreq -> putStrLn ("ERROR\tNo support for AXFR " ++ xfrreq) PdnsRequestPing -> putStrLn "OK" + +-- for testing + +ask str = do + cfg <- readConfig confFile + mgr <- newManager def + ncres <- queryNmc mgr cfg str "test-req-id" + case ncres of + Left e -> putStrLn $ "ERROR\t" ++ e + Right dom -> putStrLn $ pdnsOut RRTypeANY dom