1 module PowerDns ( RRType(..)
10 import Data.Text.Lazy (splitOn, pack)
11 import Data.Map.Lazy (foldrWithKey)
12 import Data.Default.Class (def)
16 data RRType = RRTypeSRV | RRTypeA | RRTypeAAAA | RRTypeCNAME
17 | RRTypeDNAME | RRTypeSOA | RRTypeRP | RRTypeLOC
18 | RRTypeNS | RRTypeDS | RRTypeMX
19 | RRTypeANY | RRTypeError String
21 instance Show RRType where
22 show RRTypeSRV = "SRV"
24 show RRTypeAAAA = "AAAA"
25 show RRTypeCNAME = "CNAME"
26 show RRTypeDNAME = "DNAME"
27 show RRTypeSOA = "SOA"
29 show RRTypeLOC = "LOC"
33 show RRTypeANY = "ANY"
34 show (RRTypeError s) = "Unknown RR type: " ++ (show s)
36 rrType qt = case qt of
40 "CNAME" -> RRTypeCNAME
41 "DNAME" -> RRTypeDNAME
51 data PdnsRequest = PdnsRequestQ
55 , remoteIpAddress :: String
56 , localIpAddress :: Maybe String
57 , ednsSubnetAddress :: Maybe String
63 -- | Parse request string read from the core PowerDNS process
64 pdnsParse :: Int -> String -> Either String PdnsRequest
67 getInt s = case reads s :: [(Int, String)] of
71 | ver >= 2 = case xs of
76 | ver >= 3 = case xs of
82 "PING":[] -> Right PdnsRequestPing
83 "AXFR":x:[] -> Right (PdnsRequestAXFR (getInt x))
84 "Q":qn:"IN":qt:id:rip:xs -> case rrType qt of
86 Left $ "Unrecognized RR type: " ++ e
92 , remoteIpAddress = rip
93 , localIpAddress = getLIp ver xs
94 , ednsSubnetAddress = getRIp ver xs
96 _ -> Left $ "Unparseable PDNS Request: " ++ s
98 -- | Produce LOG entry followed by FAIL
99 pdnsReport :: String -> String
100 pdnsReport err = "LOG\tError: " ++ err ++ "\nFAIL\n"
102 -- | Produce answer to the Q request
103 pdnsOutQ :: Int -> Int -> Int -> String -> RRType -> Either String NmcDom -> String
104 pdnsOutQ ver id gen name rrt edom =
107 RRTypeANY -> [ RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME
108 , RRTypeDNAME, RRTypeRP, RRTypeLOC, RRTypeNS
109 , RRTypeDS, RRTypeMX -- SOA not included
115 pdnsReport $ err ++ " in the " ++ (show rrt) ++ " query for " ++ name
117 formatDom ver id gen rrl name dom "END\n"
119 -- | Produce answer to the AXFR request
120 pdnsOutXfr :: Int -> Int -> Int -> String -> Either String NmcDom -> String
121 pdnsOutXfr ver id gen name edom =
123 allrrs = [ RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME
124 , RRTypeDNAME, RRTypeRP, RRTypeLOC, RRTypeNS
125 , RRTypeDS, RRTypeMX, RRTypeSOA
127 walkDom f acc name dom =
128 f name dom $ case domMap dom of
131 foldrWithKey (\n d a -> walkDom f a (n ++ "." ++ name) d) acc dm
135 pdnsReport $ err ++ " in the AXFR request for " ++ name
137 walkDom (formatDom ver id gen allrrs) "END\n" name dom
139 formatDom ver id gen rrl name dom acc =
140 foldr (\x a -> (formatRR ver id gen name dom x) ++ a) acc rrl
142 formatRR ver id gen name dom rrtype =
143 foldr (\x a -> "DATA\t" ++ v3ext ++ name ++ "\tIN\t" ++ (show rrtype)
144 ++ "\t" ++ ttl ++ "\t" ++ (show id) ++ "\t" ++ x ++ "\n" ++ a)
145 "" $ dataRR rrtype gen name dom
152 justl accessor _ _ dom = case accessor dom of
156 justv accessor _ _ dom = case accessor dom of
161 let (aname, adom) = break (== '@') addr
164 _ -> aname ++ "." ++ (tail adom) ++ "."
166 dataRR RRTypeSRV = justl domSrv
167 dataRR RRTypeMX = justl domMx
168 dataRR RRTypeA = justl domIp
169 dataRR RRTypeAAAA = justl domIp6
170 dataRR RRTypeCNAME = justv domAlias
171 dataRR RRTypeDNAME = justv domTranslate
172 dataRR RRTypeSOA = \ gen name dom ->
174 ns = case domNs dom of
177 email = case domEmail dom of
178 Nothing -> "hostmaster." ++ name ++ "."
179 Just addr -> dotmail addr
181 if dom == def then []
183 -- Follows a relatively ugly hack to figure if we are at the top
184 -- level domain ("something.bit"). Only in such case we provide
185 -- the synthetic SOA RR. Otherwise yield empty.
186 -- Alternative would be to carry "top-ness" as a parameter through
187 -- all the calls from the very top where we split the fqdn.
188 case splitOn (pack ".") (pack name) of
189 [_,_] -> [ns ++ " " ++ email ++ " " ++ (show gen)
190 ++ " 10800 3600 604800 86400"]
192 dataRR RRTypeRP = \ _ _ dom ->
195 Just addr -> [(dotmail addr) ++ " ."]
196 dataRR RRTypeLOC = justv domLoc
197 dataRR RRTypeNS = justl domNs
198 dataRR RRTypeDS = \ _ _ dom ->
201 Just dss -> map dsStr dss
203 dsStr x = (show (dsKeyTag x)) ++ " "
204 ++ (show (dsAlgo x)) ++ " "
205 ++ (show (dsHashType x)) ++ " "
207 -- This only comes into play when data arrived _not_ from a PDNS request:
208 dataRR (RRTypeError e) = \ _ _ _ ->
209 ["; No data for bad request type " ++ e]