1 module PowerDns ( RRType(..)
9 import Data.Text.Lazy (splitOn, pack)
13 data RRType = RRTypeSRV | RRTypeA | RRTypeAAAA | RRTypeCNAME
14 | RRTypeDNAME | RRTypeSOA | RRTypeRP | RRTypeLOC
15 | RRTypeNS | RRTypeDS | RRTypeMX
16 | RRTypeANY | RRTypeError String
18 instance Show RRType where
19 show RRTypeSRV = "SRV"
21 show RRTypeAAAA = "AAAA"
22 show RRTypeCNAME = "CNAME"
23 show RRTypeDNAME = "DNAME"
24 show RRTypeSOA = "SOA"
26 show RRTypeLOC = "LOC"
30 show RRTypeANY = "ANY"
31 show (RRTypeError s) = "RR type error: " ++ (show s)
33 data PdnsRequest = PdnsRequestQ
37 , remoteIpAddress :: String
38 , localIpAddress :: Maybe String
39 , ednsSubnetAddress :: Maybe String
45 -- | Parse request string read from the core PowerDNS process
46 pdnsParse :: Int -> String -> Either String PdnsRequest
49 getInt s = case reads s :: [(Int, String)] of
56 "CNAME" -> RRTypeCNAME
57 "DNAME" -> RRTypeDNAME
67 | ver >= 2 = case xs of
72 | ver >= 3 = case xs of
78 "PING":[] -> Right PdnsRequestPing
79 "AXFR":x:[] -> Right (PdnsRequestAXFR (getInt x))
80 "Q":qn:"IN":qt:id:rip:xs -> Right (PdnsRequestQ
84 , remoteIpAddress = rip
85 , localIpAddress = getLIp ver xs
86 , ednsSubnetAddress = getRIp ver xs
88 _ -> Left $ "Unparseable PDNS Request: " ++ s
90 -- | Produce LOG entry followed by FAIL
91 pdnsReport :: String -> String
92 pdnsReport err = "LOG\tError: " ++ err ++ "\nFAIL\n"
94 -- | Produce answer to the Q request
95 pdnsOut :: Int -> Int -> String -> RRType -> Either String NmcDom -> String
96 pdnsOut ver id name rrtype edom = case edom of
98 pdnsReport $ err ++ " in a " ++ (show rrtype) ++ "query for " ++ name
101 RRTypeANY -> foldr (\x a -> (formatRR ver id name dom x) ++ a) "END\n"
102 [RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME, RRTypeDNAME,
103 RRTypeRP, RRTypeLOC, RRTypeNS, RRTypeDS, RRTypeMX]
104 _ -> (formatRR ver id name dom rrtype) ++ "END\n"
106 -- | Produce answer to the AXFR request
107 pdnsOutXfr :: Int -> Int -> String -> Either String NmcDom -> String
108 pdnsOutXfr ver id name edom = "" -- FIXME
110 justl accessor _ dom = case accessor dom of
114 justv accessor _ dom = case accessor dom of
119 let (aname, adom) = break (== '@') addr
122 _ -> aname ++ "." ++ (tail adom)
124 dataRR RRTypeSRV = justl domSrv
125 dataRR RRTypeMX = justl domMx
126 dataRR RRTypeA = justl domIp
127 dataRR RRTypeAAAA = justl domIp6
128 dataRR RRTypeCNAME = justv domAlias
129 dataRR RRTypeDNAME = justv domTranslate
130 dataRR RRTypeSOA = soa
132 soa name dom = -- FIXME generate only for top domain
133 -- FIXME make realistic version field
134 -- FIXME make realistic nameserver field
135 -- Follows a relatively ugly hack to figure if we are at the top
136 -- level domain ("something.bit"). Only in such case we provide
137 -- the synthetic SOA RR. Otherwise yield empty.
138 case splitOn (pack ".") (pack name) of
140 if dom == emptyNmcDom then []
141 else ["ns " ++ email ++ " 99999 10800 3600 604800 86400"]
143 email = case domEmail dom of
144 Nothing -> "hostmaster." ++ name
145 Just addr -> dotmail addr
149 rp _ dom = case domEmail dom of
151 Just addr -> [(dotmail addr) ++ " ."]
152 dataRR RRTypeLOC = justv domLoc
153 dataRR RRTypeNS = justl domNs
156 ds _ dom = case domDs dom of
158 Just dss -> map dsStr dss
160 dsStr x = (show (dsKeyTag x)) ++ " "
161 ++ (show (dsAlgo x)) ++ " "
162 ++ (show (dsHashType x)) ++ " "
165 formatRR ver id name dom rrtype =
166 foldr (\x a -> "DATA\t" ++ v3ext ++ name ++ "\tIN\t" ++ (show rrtype)
167 ++ "\t" ++ ttl ++ "\t" ++ (show id) ++ "\t" ++ x ++ "\n" ++ a)
168 "" $ dataRR rrtype name dom