make SRV work again

[pdns-pipe-nmc.git] / PowerDns.hs

diff --git a/PowerDns.hs b/PowerDns.hs
index ece3ac79a5dadb4d96469bfcbb77ea2d776afdcc..606c5ca09f0e1644715810b4d259e528327e366b 100644 (file)
--- a/PowerDns.hs
+++ b/PowerDns.hs
@@ -15,7 +15,7 @@ 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
@@ -30,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)
 
@@ -45,6 +46,7 @@ rrType qt = case qt of
   "NS"      -> RRTypeNS
   "DS"      -> RRTypeDS
   "MX"      -> RRTypeMX
+  "TLSA"    -> RRTypeTLSA
   "ANY"     -> RRTypeANY
   _         -> RRTypeError qt
 
@@ -125,7 +127,7 @@ pdnsOutXfr ver id gen name edom =
              , RRTypeDS, RRTypeMX, 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
@@ -163,8 +165,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