1 module PowerDns ( RRType(..)
10 import Data.Text.Lazy (splitOn, pack)
14 data RRType = RRTypeSRV | RRTypeA | RRTypeAAAA | RRTypeCNAME
15 | RRTypeDNAME | RRTypeSOA | RRTypeRP | RRTypeLOC
16 | RRTypeNS | RRTypeDS | RRTypeMX
17 | RRTypeANY | RRTypeError String
19 instance Show RRType where
20 show RRTypeSRV = "SRV"
22 show RRTypeAAAA = "AAAA"
23 show RRTypeCNAME = "CNAME"
24 show RRTypeDNAME = "DNAME"
25 show RRTypeSOA = "SOA"
27 show RRTypeLOC = "LOC"
31 show RRTypeANY = "ANY"
32 show (RRTypeError s) = "Unknown RR type: " ++ (show s)
34 rrType qt = case qt of
38 "CNAME" -> RRTypeCNAME
39 "DNAME" -> RRTypeDNAME
49 data PdnsRequest = PdnsRequestQ
53 , remoteIpAddress :: String
54 , localIpAddress :: Maybe String
55 , ednsSubnetAddress :: Maybe String
61 -- | Parse request string read from the core PowerDNS process
62 pdnsParse :: Int -> String -> Either String PdnsRequest
65 getInt s = case reads s :: [(Int, String)] of
69 | ver >= 2 = case xs of
74 | ver >= 3 = case xs of
80 "PING":[] -> Right PdnsRequestPing
81 "AXFR":x:[] -> Right (PdnsRequestAXFR (getInt x))
82 "Q":qn:"IN":qt:id:rip:xs -> case rrType qt of
84 Left $ "PDNS Request: " ++ e
90 , remoteIpAddress = rip
91 , localIpAddress = getLIp ver xs
92 , ednsSubnetAddress = getRIp ver xs
94 _ -> Left $ "Unparseable PDNS Request: " ++ s
96 -- | Produce LOG entry followed by FAIL
97 pdnsReport :: String -> String
98 pdnsReport err = "LOG\tError: " ++ err ++ "\nFAIL\n"
100 -- | Produce answer to the Q request
101 pdnsOut :: Int -> Int -> String -> RRType -> Either String NmcDom -> String
102 pdnsOut ver id name rrtype edom = case edom of
104 pdnsReport $ err ++ " in a " ++ (show rrtype) ++ "query for " ++ name
107 RRTypeANY -> foldr (\x a -> (formatRR ver id name dom x) ++ a) "END\n"
108 [RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME, RRTypeDNAME,
109 RRTypeRP, RRTypeLOC, RRTypeNS, RRTypeDS, RRTypeMX]
110 _ -> (formatRR ver id name dom rrtype) ++ "END\n"
112 -- | Produce answer to the AXFR request
113 pdnsOutXfr :: Int -> Int -> String -> Either String NmcDom -> String
114 pdnsOutXfr ver id name edom = "" -- FIXME
116 formatRR ver id name dom rrtype =
117 foldr (\x a -> "DATA\t" ++ v3ext ++ name ++ "\tIN\t" ++ (show rrtype)
118 ++ "\t" ++ ttl ++ "\t" ++ (show id) ++ "\t" ++ x ++ "\n" ++ a)
119 "" $ dataRR rrtype name dom
126 justl accessor _ dom = case accessor dom of
130 justv accessor _ dom = case accessor dom of
135 let (aname, adom) = break (== '@') addr
138 _ -> aname ++ "." ++ (tail adom) ++ "."
140 dataRR RRTypeSRV = justl domSrv
141 dataRR RRTypeMX = justl domMx
142 dataRR RRTypeA = justl domIp
143 dataRR RRTypeAAAA = justl domIp6
144 dataRR RRTypeCNAME = justv domAlias
145 dataRR RRTypeDNAME = justv domTranslate
146 dataRR RRTypeSOA = \ name dom -> -- FIXME make realistic version field
148 ns = case domNs dom of
149 Just (x:_) -> x -- FIXME Terminate with a dot?
151 email = case domEmail dom of
152 Nothing -> "hostmaster." ++ name ++ "."
153 Just addr -> dotmail addr
155 if dom == emptyNmcDom then []
157 -- Follows a relatively ugly hack to figure if we are at the top
158 -- level domain ("something.bit"). Only in such case we provide
159 -- the synthetic SOA RR. Otherwise yield empty.
160 -- Alternative would be to carry "top-ness" as a parameter through
161 -- all the calls from the very top where we split the fqdn.
162 case splitOn (pack ".") (pack name) of
163 [_,_] -> [ns ++ " " ++ email ++ " 99999 10800 3600 604800 86400"]
165 dataRR RRTypeRP = \ _ dom ->
168 Just addr -> [(dotmail addr) ++ " ."]
169 dataRR RRTypeLOC = justv domLoc
170 dataRR RRTypeNS = justl domNs -- FIXME Terminate with a dot?
171 dataRR RRTypeDS = \ _ dom ->
174 Just dss -> map dsStr dss
176 dsStr x = (show (dsKeyTag x)) ++ " "
177 ++ (show (dsAlgo x)) ++ " "
178 ++ (show (dsHashType x)) ++ " "
180 -- This only comes into play when data arrived _not_ from a PDNS request:
181 dataRR (RRTypeError e) = \ _ _ ->
182 ["; No data for bad request type " ++ e]