Merge branch 'joeyconfig'

1 files changed, 47 insertions, 16 deletions

diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index 40cadb6d..5c3162cb 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -40,6 +40,17 @@ import Data.List
 -- that cannot be configured elsewhere. This often includes NS records,
 -- TXT records and perhaps CNAMEs pointing at hosts that propellor does
 -- not control.
+--
+-- The primary server is configured to only allow zone transfers to
+-- secondary dns servers. These are determined in two ways:
+--
+-- 1. By looking at the properties of other hosts, to find hosts that
+-- are configured as the secondary dns server.
+--
+-- 2. By looking for NS Records in the passed list of records.
+--
+-- In either case, the secondary dns server Host should have an ipv4 and/or
+-- ipv6 property defined.
 primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
 primary hosts domain soa rs = RevertableProperty setup cleanup
   where
@@ -52,22 +63,31 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
 			`requires` namedConfWritten
 			`onChange` Service.reloaded "bind9"
 
-	(partialzone, warnings) = genZone hosts domain soa
+	(partialzone, zonewarnings) = genZone hosts domain soa
 	zone = partialzone { zHosts = zHosts partialzone ++ rs }
 	zonefile = "/etc/bind/propellor/db." ++ domain
 	baseprop = Property ("dns primary for " ++ domain)
 		(makeChange $ writeZoneFile zone zonefile)
 		(addNamedConf conf)
 	withwarnings p = adjustProperty p $ \satisfy -> do
-		mapM_ warningMessage warnings
+		mapM_ warningMessage $ zonewarnings ++ secondarywarnings
 		satisfy
 	conf = NamedConf
 		{ confDomain = domain
-		, confType = Master
+		, confDnsServerType = Master
 		, confFile = zonefile
 		, confMasters = []
+		, confAllowTransfer = nub $
+			concatMap (\h -> hostAddresses h hosts) $
+				secondaries ++ nssecondaries
 		, confLines = []
 		}
+	secondaries = otherServers Secondary hosts domain
+	secondarywarnings = map (\h -> "No IP address defined for DNS seconary " ++ h) $
+		filter (\h -> null (hostAddresses h hosts)) secondaries
+	nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
+	rootRecords = map snd $
+		filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs
 	needupdate = do
 		v <- readZonePropellorFile zonefile
 		return $ case v of
@@ -86,12 +106,7 @@ primary hosts domain soa rs = RevertableProperty setup cleanup
 -- Note that if a host is declared to be a primary and a secondary dns
 -- server for the same domain, the primary server config always wins.
 secondary :: [Host] -> Domain -> RevertableProperty
-secondary hosts domain = secondaryFor masters hosts domain
-  where
-	masters = M.keys $ M.filter ismaster $ hostAttrMap hosts
-	ismaster attr = case M.lookup domain (_namedconf attr) of
-		Nothing -> False
-		Just conf -> confType conf == Master && confDomain conf == domain
+secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain
 
 -- | This variant is useful if the primary server does not have its DNS
 -- configured via propellor.
@@ -105,12 +120,22 @@ secondaryFor masters hosts domain = RevertableProperty setup cleanup
  	desc = "dns secondary for " ++ domain
 	conf = NamedConf
 		{ confDomain = domain
-		, confType = Secondary
+		, confDnsServerType = Secondary
 		, confFile = "db." ++ domain
 		, confMasters = concatMap (\m -> hostAddresses m hosts) masters
-		, confLines = ["allow-transfer { }"]
+		, confAllowTransfer = []
+		, confLines = []
 		}
 
+otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
+otherServers wantedtype hosts domain =
+	M.keys $ M.filter wanted $ hostAttrMap hosts
+  where
+	wanted attr = case M.lookup domain (_namedconf attr) of
+		Nothing -> False
+		Just conf -> confDnsServerType conf == wantedtype
+			&& confDomain conf == domain
+
 -- | Rewrites the whole named.conf.local file to serve the zones
 -- configured by `primary` and `secondary`, and ensures that bind9 is
 -- running.
@@ -130,20 +155,26 @@ confStanza :: NamedConf -> [Line]
 confStanza c =
 	[ "// automatically generated by propellor"
 	, "zone \"" ++ confDomain c ++ "\" {"
-	, cfgline "type" (if confType c == Master then "master" else "slave")
+	, cfgline "type" (if confDnsServerType c == Master then "master" else "slave")
 	, cfgline "file" ("\"" ++ confFile c ++ "\"")
 	] ++
-	(if null (confMasters c) then [] else mastersblock) ++
+	mastersblock ++
+	allowtransferblock ++
 	(map (\l -> "\t" ++ l ++ ";") (confLines c)) ++
 	[ "};"
 	, ""
 	]
   where
 	cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
-	mastersblock =
-		[ "\tmasters {" ] ++
-		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++
+	ipblock name l = 
+		[ "\t" ++ name ++ " {" ] ++
+		(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) ++
 		[ "\t};" ]
+	mastersblock
+		| null (confMasters c) = []
+		| otherwise = ipblock "masters" (confMasters c)
+	-- an empty block prohibits any transfers
+	allowtransferblock = ipblock "allow-transfer" (confAllowTransfer c)
 
 namedConfFile :: FilePath
 namedConfFile = "/etc/bind/named.conf.local"