summaryrefslogtreecommitdiff
path: root/Propellor/Property
diff options
context:
space:
mode:
authorJoey Hess2014-04-18 21:10:44 -0400
committerJoey Hess2014-04-18 21:10:44 -0400
commitc8a3653775892bd361091885c63113b6ca36ed5a (patch)
tree672624a10fc528b9e04ac2ab73db14ccad22e899 /Propellor/Property
parent8e22065deff41c3e476763ebd939a63856e6d54b (diff)
genZone is working! complete DNS zone file generation from propellor config
Diffstat (limited to 'Propellor/Property')
-rw-r--r--Propellor/Property/Dns.hs108
1 files changed, 89 insertions, 19 deletions
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
index cefbd712..131079ea 100644
--- a/Propellor/Property/Dns.hs
+++ b/Propellor/Property/Dns.hs
@@ -7,15 +7,19 @@ module Propellor.Property.Dns (
nextSerialNumber,
adjustSerialNumber,
serialNumberOffset,
+ genZone,
) where
import Propellor
import Propellor.Types.Dns
import Propellor.Property.File
+import Propellor.Types.Attr
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
import Utility.Applicative
+import qualified Data.Map as M
+import qualified Data.Set as S
import Data.List
namedconf :: FilePath
@@ -60,7 +64,7 @@ servingZones zs = hasContent namedconf (concatMap confStanza zs)
`requires` Apt.serviceInstalledRunning "bind9"
`onChange` Service.reloaded "bind9"
--- | Generates a SOA with some fairly sane numbers in it.
+-- | Generates a SOA with some fairly sane numbers in it.
--
-- The SerialNumber can be whatever serial number was used by the domain
-- before propellor started managing it. Or 0 if the domain has only ever
@@ -113,7 +117,7 @@ nextSerialNumber :: Zone -> SerialNumber -> Zone
nextSerialNumber z serial = adjustSerialNumber z $ \sn -> succ $ max sn serial
adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone
-adjustSerialNumber (Zone soa l) f = Zone soa' l
+adjustSerialNumber (Zone d soa l) f = Zone d soa' l
where
soa' = soa { sSerial = f (sSerial soa) }
@@ -141,7 +145,7 @@ writeZoneFile z f = do
-- the serialized Zone. This saves the bother of parsing
-- the horrible bind zone file format.
zonePropellorFile :: FilePath -> FilePath
-zonePropellorFile f = f ++ ".serial"
+zonePropellorFile f = f ++ ".propellor"
oldZoneFileSerialNumber :: FilePath -> IO SerialNumber
oldZoneFileSerialNumber = maybe 0 (sSerial . zSOA) <$$> readZonePropellorFile
@@ -155,29 +159,29 @@ readZonePropellorFile f = catchDefaultIO Nothing $
-- | Generating a zone file.
genZoneFile :: Zone -> String
-genZoneFile (Zone soa rs) = unlines $
- header : genSOA soa : map genr rs
+genZoneFile (Zone zdomain soa rs) = unlines $
+ header : genSOA zdomain soa ++ map genr rs
where
- header = com "BIND zone file. Generated by propellor, do not edit."
+ header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
- genr (d, r) = genRecord (Just d, r)
+ genr (d, r) = genRecord zdomain (Just d, r)
-genRecord :: (Maybe Domain, Record) -> String
-genRecord (mdomain, record) = intercalate "\t"
- [ dname
+genRecord :: Domain -> (Maybe BindDomain, Record) -> String
+genRecord zdomain (mdomain, record) = intercalate "\t"
+ [ hn
, "IN"
, rField record
, rValue record
]
where
- dname = fromMaybe "" mdomain
+ hn = maybe "" (domainHost zdomain) mdomain
-genSOA :: SOA -> String
-genSOA soa = unlines $
- header : map genRecord (zip (repeat Nothing) (sRecord soa))
+genSOA :: Domain -> SOA -> [String]
+genSOA zdomain soa =
+ header ++ map (genRecord zdomain) (zip (repeat Nothing) (sRecord soa))
where
- header = unlines
- -- @ IN SOA root. root (
+ header =
+ -- "@ IN SOA ns1.example.com. root ("
[ intercalate "\t"
[ dValue SOADomain
, "IN"
@@ -200,9 +204,75 @@ genSOA soa = unlines $
com :: String -> String
com s = "; " ++ s
+type WarningMessage = String
+
-- | Generates a Zone for a particular Domain from the DNS properies of all
-- hosts that propellor knows about that are in that Domain.
-genZone :: [Host] -> Domain -> SOA -> Zone
-genZone hosts domain soa = Zone soa zhosts
+genZone :: [Host] -> Domain -> SOA -> (Zone, [WarningMessage])
+genZone hosts zdomain soa =
+ let (warnings, zhosts) = partitionEithers $ concat $ map concat
+ [ map hostips inzdomain
+ , map hostrecords inzdomain
+ , map addcnames (M.elems m)
+ ]
+ in (Zone zdomain soa (nub zhosts), warnings)
where
- zhosts = undefined -- TODO
+ m = hostAttrMap hosts
+ -- Known hosts with hostname located in the zone's domain.
+ inzdomain = M.elems $ M.filterWithKey (\hn _ -> inDomain zdomain $ AbsDomain $ hn) m
+
+ -- Each host with a hostname located in the zdomain
+ -- should have 1 or more IPAddrs in its Attr.
+ --
+ -- If a host lacks any IPAddr, it's probably a misconfiguration,
+ -- so warn.
+ hostips :: Attr -> [Either WarningMessage (BindDomain, Record)]
+ hostips attr
+ | null l = [Left $ "no IP address defined for host " ++ _hostname attr]
+ | otherwise = map Right l
+ where
+ l = zip (repeat $ AbsDomain $ _hostname attr)
+ (map Address $ getAddresses attr)
+
+ -- Any host, whether its hostname is in the zdomain or not,
+ -- may have cnames which are in the zdomain.
+ --
+ -- Add Records for those.. But not actually, usually, cnames!
+ -- Why not? Well, using cnames doesn't allow doing some things,
+ -- including MX and round robin DNS.
+ --
+ -- We typically know the host's IPAddrs anyway.
+ -- So we can just use the IPAddrs.
+ addcnames :: Attr -> [Either WarningMessage (BindDomain, Record)]
+ addcnames attr = concatMap gen $ filter (inDomain zdomain) $
+ mapMaybe getCNAME $ S.toList (_dns attr)
+ where
+ gen c = case getAddresses attr of
+ [] -> [ret (CNAME c)]
+ l -> map (ret . Address) l
+ where
+ ret record = Right (c, record)
+
+ -- Adds any other DNS records for a host located in the zdomain.
+ hostrecords :: Attr -> [Either WarningMessage (BindDomain, Record)]
+ hostrecords attr = map Right l
+ where
+ l = zip (repeat $ AbsDomain $ _hostname attr)
+ (S.toList $ S.filter (\r -> isNothing (getIPAddr r) && isNothing (getCNAME r)) (_dns attr))
+
+inDomain :: Domain -> BindDomain -> Bool
+inDomain domain (AbsDomain d) = domain == d || ('.':domain) `isSuffixOf` d
+inDomain _ _ = False -- can't tell, so assume not
+
+-- | Gets the hostname of the second domain, relative to the first domain,
+-- suitable for using in a zone file.
+domainHost :: Domain -> BindDomain -> String
+domainHost _ (RelDomain d) = d
+domainHost _ SOADomain = "@"
+domainHost base (AbsDomain d)
+ | dotbase `isSuffixOf` d = take (length d - length dotbase) d
+ | base == d = "@"
+ | otherwise = d
+ where
+ dotbase = '.':base
+