X-Git-Url: http://www.average.org/gitweb/?p=pdns-pipe-nmc.git;a=blobdiff_plain;f=PowerDns.hs;h=7036596fea1f324def3ae342fbbe63e967e01180;hp=457cdcae5b3be03b3160b0dc1f87e38b6b015bc6;hb=18e24a6fca605da574ba3add941ee9981e5396af;hpb=17e4165f2d7cd287e2d49ef2ceac494f9236fd61

diff --git a/PowerDns.hs b/PowerDns.hs
index 457cdca..7036596 100644
--- a/PowerDns.hs
+++ b/PowerDns.hs
@@ -9,12 +9,13 @@ module PowerDns ( RRType(..)
 
 import Data.Text.Lazy (splitOn, pack)
 import Data.Map.Lazy (foldrWithKey)
+import Data.Default.Class (def)
 
 import NmcDom
 
 data RRType = RRTypeSRV   | RRTypeA   | RRTypeAAAA | RRTypeCNAME
             | RRTypeDNAME | RRTypeSOA | RRTypeRP   | RRTypeLOC
-            | RRTypeNS    | RRTypeDS  | RRTypeMX
+            | RRTypeNS    | RRTypeDS  | RRTypeMX   | RRTypeTLSA
             | RRTypeANY   | RRTypeError String
 
 instance Show RRType where
@@ -29,6 +30,7 @@ instance Show RRType where
   show RRTypeNS        = "NS"
   show RRTypeDS        = "DS"
   show RRTypeMX        = "MX"
+  show RRTypeTLSA      = "TLSA"
   show RRTypeANY       = "ANY"
   show (RRTypeError s) = "Unknown RR type: " ++ (show s)
 
@@ -44,6 +46,7 @@ rrType qt = case qt of
   "NS"      -> RRTypeNS
   "DS"      -> RRTypeDS
   "MX"      -> RRTypeMX
+  "TLSA"    -> RRTypeTLSA
   "ANY"     -> RRTypeANY
   _         -> RRTypeError qt
 
@@ -55,7 +58,7 @@ data PdnsRequest = PdnsRequestQ
                    , localIpAddress     :: Maybe String
                    , ednsSubnetAddress  :: Maybe String
                    }
-                 | PdnsRequestAXFR Int
+                 | PdnsRequestAXFR Int (Maybe String)
                  | PdnsRequestPing
         deriving (Show)
 
@@ -79,7 +82,15 @@ pdnsParse ver s =
   in
     case words s of
       "PING":[]                 -> Right PdnsRequestPing
-      "AXFR":x:[]               -> Right (PdnsRequestAXFR (getInt x))
+      "AXFR":x:xs               ->
+        if ver < 4 then
+          case xs of
+            [] -> Right $ (PdnsRequestAXFR (getInt x)) Nothing
+            _  -> Left  $ "Extra arguments in AXFR (v 1-3): " ++ s
+        else
+          case xs of
+            [z] -> Right $ (PdnsRequestAXFR (getInt x)) (Just z)
+            _   -> Left  $ "Wrong arguments in AXFR (v 4+): " ++ s
       "Q":qn:"IN":qt:id:rip:xs  -> case rrType qt of
                                      RRTypeError e ->
                                        Left $ "Unrecognized RR type: " ++ e
@@ -105,7 +116,7 @@ pdnsOutQ ver id gen name rrt edom =
     rrl = case rrt of
       RRTypeANY -> [ RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME
                    , RRTypeDNAME, RRTypeRP, RRTypeLOC, RRTypeNS
-                   , RRTypeDS, RRTypeMX -- SOA not included
+                   , RRTypeDS, RRTypeMX, RRTypeTLSA -- SOA not included
                    ]
       x         -> [x]
   in
@@ -121,10 +132,10 @@ pdnsOutXfr ver id gen name edom =
   let
     allrrs = [ RRTypeSRV, RRTypeA, RRTypeAAAA, RRTypeCNAME
              , RRTypeDNAME, RRTypeRP, RRTypeLOC, RRTypeNS
-             , RRTypeDS, RRTypeMX, RRTypeSOA
+             , RRTypeDS, RRTypeMX, RRTypeTLSA, RRTypeSOA
              ]
     walkDom f acc name dom =
-      f name dom $ case domMap dom of
+      f name dom $ case domSubmap dom of
         Nothing -> acc
         Just dm ->
           foldrWithKey (\n d a -> walkDom f a (n ++ "." ++ name) d) acc dm
@@ -143,9 +154,7 @@ formatRR ver id gen name dom rrtype =
               ++ "\t" ++ ttl ++ "\t" ++ (show id) ++ "\t" ++ x ++ "\n" ++ a)
         "" $ dataRR rrtype gen name dom
     where
-      v3ext = case ver of
-        3 -> "0\t1\t"
-        _ -> ""
+      v3ext = if ver >= 3 then "0\t1\t" else ""
       ttl = show 3600
 
 justl accessor _ _ dom = case accessor dom of
@@ -162,8 +171,27 @@ dotmail addr =
     "" -> aname ++ "."
     _  -> aname ++ "." ++ (tail adom) ++ "."
 
-dataRR RRTypeSRV   = justl domSrv
+dataRR RRTypeSRV   = \ _ _ dom ->
+  case domSrv dom of
+    Nothing  -> []
+    Just srvs -> map srvStr srvs
+      where
+        srvStr x = (show (srvPrio x)) ++ "\t"
+                ++ (show (srvWeight x)) ++ " "
+                ++ (show (srvPort x)) ++ " "
+                ++ (srvHost x)
+    
 dataRR RRTypeMX    = justl domMx
+dataRR RRTypeTLSA  = \ _ _ dom ->
+  case domTlsa dom of
+    Nothing  -> []
+    Just tlsas -> map tlsaStr tlsas
+      where
+        tlsaStr x = "(3 0 "
+                 ++ (show (tlsMatchType x)) ++ " "
+                 ++ (tlsMatchValue x) ++ ")"
+        -- tlsIncSubdoms is not displayed, it is used for `propagate`.
+
 dataRR RRTypeA     = justl domIp
 dataRR RRTypeAAAA  = justl domIp6
 dataRR RRTypeCNAME = justv domAlias
@@ -177,7 +205,7 @@ dataRR RRTypeSOA   = \ gen name dom ->
       Nothing   -> "hostmaster." ++ name ++ "."
       Just addr -> dotmail addr
   in
-    if dom == emptyNmcDom then []
+    if dom == def then []
     else
     -- Follows a relatively ugly hack to figure if we are at the top
     -- level domain ("something.bit"). Only in such case we provide