wip reorg responsibilities
[pdns-pipe-nmc.git] / PowerDns.hs
1 module PowerDns ( RRType
2                 , PdnsRequest(..)
3                 , pdnsParse
4                 , pdnsOut
5                 ) where
6
7 import NmcJson
8
9 data RRType = RRTypeSRV   | RRTypeA   | RRTypeAAAA | RRTypeCNAME
10             | RRTypeDNAME | RRTypeSOA | RRTypeRP   | RRTypeLOC
11             | RRTypeNS    | RRTypeDS
12             | RRTypeANY   | RRTypeError String 
13         deriving (Show)
14
15 data PdnsRequest = PdnsRequestQ
16                    { qName              :: String
17                    , qType              :: RRType
18                    , iD                 :: String
19                    , remoteIpAddress    :: String
20                    , localIpAddress     :: Maybe String
21                    , ednsSubnetAddress  :: Maybe String
22                    }
23                  | PdnsRequestAXFR String
24                  | PdnsRequestPing
25         deriving (Show)
26
27 pdnsParse ver s =
28   let
29     getQt qt = case qt of
30       "SRV"     -> RRTypeSRV   
31       "A"       -> RRTypeA
32       "AAAA"    -> RRTypeAAAA
33       "CNAME"   -> RRTypeCNAME
34       "DNAME"   -> RRTypeDNAME 
35       "SOA"     -> RRTypeSOA 
36       "RP"      -> RRTypeRP   
37       "LOC"     -> RRTypeLOC
38       "NS"      -> RRTypeNS    
39       "DS"      -> RRTypeDS
40       "ANY"     -> RRTypeANY
41       _         -> RRTypeError qt
42     getLIp ver xs
43       | ver >= 2  = case xs of
44                       x:_       -> Just x
45                       _         -> Nothing
46       | otherwise = Nothing
47     getRIp ver xs
48       | ver >= 3  = case xs of
49                       _:x:_     -> Just x
50                       _         -> Nothing
51       | otherwise = Nothing
52   in
53     case words s of
54       "PING":[]                 -> Right PdnsRequestPing
55       "AXFR":x:[]               -> Right (PdnsRequestAXFR x)
56       "Q":qn:"IN":qt:id:rip:xs  -> Right (PdnsRequestQ
57                                             { qName = qn
58                                             , qType = getQt qt
59                                             , iD = id
60                                             , remoteIpAddress = rip
61                                             , localIpAddress = getLIp ver xs
62                                             , ednsSubnetAddress = getRIp ver xs
63                                             })
64       _                         -> Left $ "Unparseable PDNS Request: " ++ s
65
66 pdnsOut :: RRType -> NmcDom -> String
67 pdnsOut _ d = show d