From 34c7a1406018ce1566a09f8823a2aeee16f1505a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 23 Apr 2014 15:04:35 -0400 Subject: propellor spin --- Propellor/Property/Dns.hs | 56 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 42 insertions(+), 14 deletions(-) (limited to 'Propellor/Property') diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs index 40cadb6d..e07d3710 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 +-- property. primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty primary hosts domain soa rs = RevertableProperty setup cleanup where @@ -63,11 +74,17 @@ primary hosts domain soa rs = RevertableProperty setup cleanup satisfy conf = NamedConf { confDomain = domain - , confType = Master + , confDnsServerType = Master , confFile = zonefile , confMasters = [] + , confAllowTransfer = nub $ + concatMap (\m -> hostAddresses m hosts) $ + otherServers Secondary hosts domain ++ + mapMaybe (domainHostName <=< getNS) rootRecords , confLines = [] } + rootRecords = map snd $ + filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs needupdate = do v <- readZonePropellorFile zonefile return $ case v of @@ -86,12 +103,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 +117,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 +152,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" -- cgit v1.2.3