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 $ "Unrecognized RR type: " ++ 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 =
105 RRTypeANY -> [RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME
106 , RRTypeDNAME, RRTypeRP, RRTypeLOC, RRTypeNS
107 , RRTypeDS, RRTypeMX]
110 (formatDom ver id name rrl edom) ++ "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 formatDom ver id name rrl edom = case edom of
118 pdnsReport $ err ++ " in the " ++ (show rrl) ++ " query for " ++ name
120 foldr (\x a -> (formatRR ver id name dom x) ++ a) "" rrl
122 formatRR ver id name dom rrtype =
123 foldr (\x a -> "DATA\t" ++ v3ext ++ name ++ "\tIN\t" ++ (show rrtype)
124 ++ "\t" ++ ttl ++ "\t" ++ (show id) ++ "\t" ++ x ++ "\n" ++ a)
125 "" $ dataRR rrtype name dom
132 justl accessor _ dom = case accessor dom of
136 justv accessor _ dom = case accessor dom of
141 let (aname, adom) = break (== '@') addr
144 _ -> aname ++ "." ++ (tail adom) ++ "."
146 dataRR RRTypeSRV = justl domSrv
147 dataRR RRTypeMX = justl domMx
148 dataRR RRTypeA = justl domIp
149 dataRR RRTypeAAAA = justl domIp6
150 dataRR RRTypeCNAME = justv domAlias
151 dataRR RRTypeDNAME = justv domTranslate
152 dataRR RRTypeSOA = \ name dom -> -- FIXME make realistic version field
154 ns = case domNs dom of
155 Just (x:_) -> x -- FIXME Terminate with a dot?
157 email = case domEmail dom of
158 Nothing -> "hostmaster." ++ name ++ "."
159 Just addr -> dotmail addr
161 if dom == emptyNmcDom then []
163 -- Follows a relatively ugly hack to figure if we are at the top
164 -- level domain ("something.bit"). Only in such case we provide
165 -- the synthetic SOA RR. Otherwise yield empty.
166 -- Alternative would be to carry "top-ness" as a parameter through
167 -- all the calls from the very top where we split the fqdn.
168 case splitOn (pack ".") (pack name) of
169 [_,_] -> [ns ++ " " ++ email ++ " 99999 10800 3600 604800 86400"]
171 dataRR RRTypeRP = \ _ dom ->
174 Just addr -> [(dotmail addr) ++ " ."]
175 dataRR RRTypeLOC = justv domLoc
176 dataRR RRTypeNS = justl domNs -- FIXME Terminate with a dot?
177 dataRR RRTypeDS = \ _ dom ->
180 Just dss -> map dsStr dss
182 dsStr x = (show (dsKeyTag x)) ++ " "
183 ++ (show (dsAlgo x)) ++ " "
184 ++ (show (dsHashType x)) ++ " "
186 -- This only comes into play when data arrived _not_ from a PDNS request:
187 dataRR (RRTypeError e) = \ _ _ ->
188 ["; No data for bad request type " ++ e]