PowerDns.hs

   1 module PowerDns where
   2
   3 data RRType = RRTypeSRV   | RRTypeA   | RRTypeAAAA | RRTypeCNAME
   4             | RRTypeDNAME | RRTypeSOA | RRTypeRP   | RRTypeLOC
   5             | RRTypeNS    | RRTypeDS
   6             | RRTypeANY   | RRTypeError String
   7         deriving (Show)
   8
   9 data PdnsRequest = PdnsRequestQ
  10                    { qName              :: String
  11                    , qType              :: RRType
  12                    , iD                 :: String
  13                    , remoteIpAddress    :: String
  14                    , localIpAddress     :: Maybe String
  15                    , ednsSubnetAddress  :: Maybe String
  16                    }
  17                  | PdnsRequestAXFR String
  18                  | PdnsRequestPing
  19         deriving (Show)
  20
  21 pdnsParse ver s =
  22   let
  23     getQt qt = case qt of
  24       "SRV"     -> RRTypeSRV
  25       "A"       -> RRTypeA
  26       "AAAA"    -> RRTypeAAAA
  27       "CNAME"   -> RRTypeCNAME
  28       "DNAME"   -> RRTypeDNAME
  29       "SOA"     -> RRTypeSOA
  30       "RP"      -> RRTypeRP
  31       "LOC"     -> RRTypeLOC
  32       "NS"      -> RRTypeNS
  33       "DS"      -> RRTypeDS
  34       "ANY"     -> RRTypeANY
  35       _         -> RRTypeError qt
  36     getLIp ver xs
  37       | ver >= 2  = case xs of
  38                       x:_       -> Just x
  39                       _         -> Nothing
  40       | otherwise = Nothing
  41     getRIp ver xs
  42       | ver >= 3  = case xs of
  43                       _:x:_     -> Just x
  44                       _         -> Nothing
  45       | otherwise = Nothing
  46   in
  47     case words s of
  48       "PING":[]                 -> Right PdnsRequestPing
  49       "AXFR":x:[]               -> Right (PdnsRequestAXFR x)
  50       "Q":qn:"IN":qt:id:rip:xs  -> Right (PdnsRequestQ
  51                                             { qName = qn
  52                                             , qType = getQt qt
  53                                             , iD = id
  54                                             , remoteIpAddress = rip
  55                                             , localIpAddress = getLIp ver xs
  56                                             , ednsSubnetAddress = getRIp ver xs
  57                                             })
  58       _                         -> Left s
  59
  60 {-
  61 pdnsOut :: String -> Either String PdnsRequest -> IO ()
  62 pdnsOut _   (Left e)   = putStrLn ("ERROR\tUnparseable request: " ++ e)
  63 pdnsOut uri (Right rq) = case rq of
  64     PdnsRequestQ qn qt id lip rip eip -> do
  65       dom <- queryNmc uri qn qt id
  66       case dom of
  67         Left  e      -> putStrLn ("ERROR\tNmc query error: " ++ e)
  68         Right result -> print result
  69     PdnsRequestAXFR xfrreq ->
  70       putStrLn ("ERROR\t No support for AXFR " ++ xfrreq)
  71     PdnsRequestPing -> putStrLn "OK"
  72 -}