From d1db64b3bc4ef1c802344f666eb160d9a8c97cca Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 19 Apr 2014 01:26:38 -0400 Subject: Propellor can configure primary DNS servers, including generating zone files, which is done by looking at the properties of hosts in a domain. --- Propellor/Attr.hs | 6 ++++ Propellor/Property/Dns.hs | 82 ++++++++++++++++++++++++++++++----------------- Propellor/Types/Attr.hs | 9 ++++-- Propellor/Types/Dns.hs | 4 +-- 4 files changed, 66 insertions(+), 35 deletions(-) (limited to 'Propellor') diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs index 8c4a2add..a54d8833 100644 --- a/Propellor/Attr.hs +++ b/Propellor/Attr.hs @@ -49,6 +49,12 @@ aka domain = pureAttrProperty ("aka " ++ domain) addDNS :: Record -> SetAttr addDNS record d = d { _dns = S.insert record (_dns d) } +addNamedConf :: NamedConf -> SetAttr +addNamedConf conf d = d { _namedconf = S.insert conf (_namedconf d) } + +getNamedConf :: Propellor (S.Set NamedConf) +getNamedConf = asks _namedconf + sshPubKey :: String -> Property sshPubKey k = pureAttrProperty ("ssh pubkey known") $ \d -> d { _sshPubKey = Just k } diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs index 7c26f1d5..90556d2d 100644 --- a/Propellor/Property/Dns.hs +++ b/Propellor/Property/Dns.hs @@ -2,7 +2,6 @@ module Propellor.Property.Dns ( module Propellor.Types.Dns, primary, secondary, - servingZones, mkSOA, rootAddressesFrom, writeZoneFile, @@ -26,8 +25,6 @@ import Data.List -- | Primary dns server for a domain. -- --- TODO: Does not yet add it to named.conf.local. --- -- Most of the content of the zone file is configured by setting properties -- of hosts. For example, -- @@ -35,40 +32,70 @@ import Data.List -- > & ipv4 "192.168.1.1" -- > & aka "mail.exmaple.com" -- --- Will cause that host and its cnames to appear in the zone file. +-- Will cause that hostmame and its alias to appear in the zone file, +-- with the configured IP address. -- -- The [(Domain, Record)] list can be used for additional records -- that cannot be configured elsewhere. For example, it might contain -- CNAMEs pointing at hosts that propellor does not control. primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property primary hosts domain soa rs = withwarnings (check needupdate baseprop) - `requires` Apt.serviceInstalledRunning "bind9" + `requires` servingZones `onChange` Service.reloaded "bind9" where (partialzone, warnings) = genZone hosts domain soa zone = partialzone { zHosts = zHosts partialzone ++ rs } zonefile = "/etc/bind/propellor/db." ++ domain - needupdate = (/= Just zone) <$> readZonePropellorFile zonefile - baseprop = property ("dns primary for " ++ domain) $ makeChange $ do - writeZoneFile zone zonefile + baseprop = Property ("dns primary for " ++ domain) + (makeChange $ writeZoneFile zone zonefile) + (addNamedConf conf) withwarnings p = adjustProperty p $ \satisfy -> do mapM_ warningMessage warnings satisfy - -namedconf :: FilePath -namedconf = "/etc/bind/named.conf.local" - -zoneDesc :: NamedConf -> String -zoneDesc z = confDomain z ++ " (" ++ show (confType z) ++ ")" - -secondary :: Domain -> [IPAddr] -> NamedConf -secondary domain masters = NamedConf - { confDomain = domain - , confType = Secondary - , confFile = "db." ++ domain - , confMasters = masters - , confLines = ["allow-transfer { }"] - } + conf = NamedConf + { confDomain = domain + , confType = Master + , confFile = zonefile + , confMasters = [] + , confLines = [] + } + needupdate = do + v <- readZonePropellorFile zonefile + return $ case v of + Nothing -> True + Just oldzone -> + -- compare everything except serial + let oldserial = sSerialĀ (zSOA oldzone) + z = zone { zSOA = (zSOA zone) { sSerial = oldserial } } + in z /= oldzone || oldserial < sSerial (zSOA zone) + +-- | Secondary dns server for a domain. +secondary :: [Host] -> Domain -> HostName -> Property +secondary hosts domain master = pureAttrProperty desc (addNamedConf conf) + `requires` servingZones + where + desc = "dns secondary for " ++ domain + conf = NamedConf + { confDomain = domain + , confType = Secondary + , confFile = "db." ++ domain + , confMasters = hostAddresses master hosts + , confLines = ["allow-transfer { }"] + } + +-- | Rewrites the whole named.conf.local file to serve the zones +-- configured by `primary` and `secondary`, and ensures that bind9 is +-- running. +servingZones :: Property +servingZones = property "serving configured dns zones" go + `requires` Apt.serviceInstalledRunning "bind9" + `onChange` Service.reloaded "bind9" + where + go = do + zs <- getNamedConf + ensureProperty $ + hasContent namedConfFile $ + concatMap confStanza $ S.toList zs confStanza :: NamedConf -> [Line] confStanza c = @@ -89,13 +116,8 @@ confStanza c = (map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++ [ "\t};" ] --- | Rewrites the whole named.conf.local file to serve the specified --- zones. -servingZones :: [NamedConf] -> Property -servingZones zs = hasContent namedconf (concatMap confStanza zs) - `describe` ("dns server for zones: " ++ unwords (map zoneDesc zs)) - `requires` Apt.serviceInstalledRunning "bind9" - `onChange` Service.reloaded "bind9" +namedConfFile :: FilePath +namedConfFile = "/etc/bind/named.conf.local" -- | Generates a SOA with some fairly sane numbers in it. -- diff --git a/Propellor/Types/Attr.hs b/Propellor/Types/Attr.hs index cf8bdf1a..f64b0487 100644 --- a/Propellor/Types/Attr.hs +++ b/Propellor/Types/Attr.hs @@ -9,8 +9,9 @@ import qualified Data.Set as S data Attr = Attr { _hostname :: HostName , _os :: Maybe System - , _dns :: S.Set Dns.Record , _sshPubKey :: Maybe String + , _dns :: S.Set Dns.Record + , _namedconf :: S.Set Dns.NamedConf , _dockerImage :: Maybe String , _dockerRunParams :: [HostName -> String] @@ -21,6 +22,7 @@ instance Eq Attr where [ _hostname x == _hostname y , _os x == _os y , _dns x == _dns y + , _namedconf x == _namedconf y , _sshPubKey x == _sshPubKey y , _dockerImage x == _dockerImage y @@ -32,13 +34,14 @@ instance Show Attr where show a = unlines [ "hostname " ++ _hostname a , "OS " ++ show (_os a) - , "dns " ++ show (_dns a) , "sshPubKey " ++ show (_sshPubKey a) + , "dns " ++ show (_dns a) + , "namedconf " ++ show (_namedconf a) , "docker image " ++ show (_dockerImage a) , "docker run params " ++ show (map (\mk -> mk "") (_dockerRunParams a)) ] newAttr :: HostName -> Attr -newAttr hn = Attr hn Nothing S.empty Nothing Nothing [] +newAttr hn = Attr hn Nothing Nothing S.empty S.empty Nothing [] type SetAttr = Attr -> Attr diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs index 9d801ef6..e367202a 100644 --- a/Propellor/Types/Dns.hs +++ b/Propellor/Types/Dns.hs @@ -19,10 +19,10 @@ data NamedConf = NamedConf , confMasters :: [IPAddr] , confLines :: [String] } - deriving (Show, Eq) + deriving (Show, Eq, Ord) data Type = Master | Secondary - deriving (Show, Eq) + deriving (Show, Eq, Ord) -- | Represents a bind 9 zone file. data Zone = Zone -- cgit v1.2.3