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/Attr.hs | 2 +- Propellor/Property/Dns.hs | 56 +++++++++++++++++++++++++++++++++++------------ Propellor/Types/Dns.hs | 16 ++++++++++++-- 3 files changed, 57 insertions(+), 17 deletions(-) (limited to 'Propellor') diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs index acaf28db..98cfc64d 100644 --- a/Propellor/Attr.hs +++ b/Propellor/Attr.hs @@ -59,7 +59,7 @@ addNamedConf conf d = d { _namedconf = new } where m = _namedconf d domain = confDomain conf - new = case (confType conf, confType <$> M.lookup domain m) of + new = case (confDnsServerType conf, confDnsServerType <$> M.lookup domain m) of (Secondary, Just Master) -> m _ -> M.insert domain conf m 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" diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs index 9b2ad1e7..ba6a92dd 100644 --- a/Propellor/Types/Dns.hs +++ b/Propellor/Types/Dns.hs @@ -1,5 +1,7 @@ module Propellor.Types.Dns where +import Propellor.Types.OS (HostName) + import Data.Word type Domain = String @@ -14,14 +16,15 @@ fromIPAddr (IPv6 addr) = addr -- | Represents a bind 9 named.conf file. data NamedConf = NamedConf { confDomain :: Domain - , confType :: Type + , confDnsServerType :: DnsServerType , confFile :: FilePath , confMasters :: [IPAddr] + , confAllowTransfer :: [IPAddr] , confLines :: [String] } deriving (Show, Eq, Ord) -data Type = Master | Secondary +data DnsServerType = Master | Secondary deriving (Show, Eq, Ord) -- | Represents a bind 9 zone file. @@ -66,6 +69,10 @@ getCNAME :: Record -> Maybe BindDomain getCNAME (CNAME d) = Just d getCNAME _ = Nothing +getNS :: Record -> Maybe BindDomain +getNS (NS d) = Just d +getNS _ = Nothing + -- | Bind serial numbers are unsigned, 32 bit integers. type SerialNumber = Word32 @@ -78,3 +85,8 @@ type SerialNumber = Word32 -- to add nameservers, MX's, etc to a domain. data BindDomain = RelDomain Domain | AbsDomain Domain | RootDomain deriving (Read, Show, Eq, Ord) + +domainHostName :: BindDomain -> Maybe HostName +domainHostName (RelDomain d) = Just d +domainHostName (AbsDomain d) = Just d +domainHostName RootDomain = Nothing -- cgit v1.2.3