summaryrefslogtreecommitdiff
path: root/Propellor
diff options
context:
space:
mode:
authorJoey Hess2014-04-19 01:26:38 -0400
committerJoey Hess2014-04-19 01:26:38 -0400
commitd1db64b3bc4ef1c802344f666eb160d9a8c97cca (patch)
treeaf3abdb2c4f026c39e5f7c64c62e7cdeb5e34e0e /Propellor
parent7e9853520b5b7233ce9a9c8153f6c366cab0ee39 (diff)
Propellor can configure primary DNS servers, including generating zone files, which is done by looking at the properties of hosts in a domain.
Diffstat (limited to 'Propellor')
-rw-r--r--Propellor/Attr.hs6
-rw-r--r--Propellor/Property/Dns.hs82
-rw-r--r--Propellor/Types/Attr.hs9
-rw-r--r--Propellor/Types/Dns.hs4
4 files changed, 66 insertions, 35 deletions
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