1 {-# LANGUAGE OverloadedStrings #-}
5 import Control.Applicative
8 import Data.Either.Utils
10 import Data.Aeson (decode)
11 import Network.JsonRpc.Client
14 confFile = "/etc/namecoin.conf"
16 -- Config file handling
18 data Config = Config { rpcuser :: String
19 , rpcpassword :: String
24 readConfig :: String -> IO Config
26 cp <- return . forceEither =<< readfile emptyCP f
27 return (Config { rpcuser = getSetting cp "rpcuser" ""
28 , rpcpassword = getSetting cp "rpcpassword" ""
29 , rpchost = getSetting cp "rpchost" "localhost"
30 , rpcport = getSetting cp "rpcport" "8336"
33 getSetting cp x dfl = case get cp "DEFAULT" x of
39 queryNmc :: String -> String -> RRType -> String -> IO (Either String NmcDom)
40 queryNmc uri fqdn qtype qid = do
41 case reverse (splitOn "." fqdn) of
43 ans <- detailledRemote Version1 [] uri "name_show" $ "d/" ++ dn
44 let mdom = decode (resValue ans) :: Maybe NmcDom
46 Nothing -> return $ Left ("Unparseable: " ++ (show (resValue ans)))
47 Just dom -> return $ Right dom
49 return $ Left "Only \".bit\" domain is supported"
53 data RRType = RRTypeSRV | RRTypeA | RRTypeAAAA | RRTypeCNAME
54 | RRTypeDNAME | RRTypeSOA | RRTypeRP | RRTypeLOC
56 | RRTypeANY | RRTypeError String
59 data PdnsRequest = PdnsRequestQ
63 , remoteIpAddress :: String
64 , localIpAddress :: Maybe String
65 , ednsSubnetAddress :: Maybe String
67 | PdnsRequestAXFR String
77 "CNAME" -> RRTypeCNAME
78 "DNAME" -> RRTypeDNAME
87 | ver >= 2 = case xs of
92 | ver >= 3 = case xs of
98 "PING":[] -> Right PdnsRequestPing
99 "AXFR":x:[] -> Right (PdnsRequestAXFR x)
100 "Q":qn:"IN":qt:id:rip:xs -> Right (PdnsRequestQ
104 , remoteIpAddress = rip
105 , localIpAddress = getLIp ver xs
106 , ednsSubnetAddress = getRIp ver xs
110 pdnsOut :: String -> Either String PdnsRequest -> IO ()
111 pdnsOut _ (Left e) = putStrLn ("ERROR\tUnparseable request: " ++ e)
112 pdnsOut uri (Right rq) = case rq of
113 PdnsRequestQ qn qt id lip rip eip -> do
114 dom <- queryNmc uri qn qt id
116 Left e -> putStrLn ("ERROR\tNmc query error: " ++ e)
117 Right result -> print result
118 PdnsRequestAXFR xfrreq ->
119 putStrLn ("ERROR\t No support for AXFR " ++ xfrreq)
120 PdnsRequestPing -> putStrLn "OK"
125 cfg <- readConfig confFile
126 let uri = "http://" ++ rpcuser cfg ++ ":" ++ rpcpassword cfg ++
127 "@" ++ rpchost cfg ++ ":" ++ rpcport cfg ++ "/"
130 loopErr e = forever $ do
131 putStrLn $ "FAIL\t" ++ e
136 ["HELO", "1"] -> return 1
137 ["HELO", "2"] -> return 2
138 ["HELO", "3"] -> return 3
139 ["HELO", x ] -> loopErr $ "unsupported ABI version " ++ (show x)
140 _ -> loopErr $ "bad HELO " ++ (show s)
142 putStrLn $ "OK\tDnsNmc ready to serve, protocol v." ++ (show ver)
143 forever $ getLine >>= (pdnsOut uri) . (pdnsParse ver)