genZone is working! complete DNS zone file generation from propellor config

Propellor/Attr.hs

@@ -74,11 +74,19 @@ hostProperties (Host ps _) = ps
 hostMap :: [Host] -> M.Map HostName Host
 hostMap l = M.fromList $ zip (map (_hostname . hostAttr) l) l 
 
+hostAttrMap :: [Host] -> M.Map HostName Attr
+hostAttrMap l = M.fromList $ zip (map _hostname attrs) attrs
+  where
+	attrs = map hostAttr l
+
 findHost :: [Host] -> HostName -> Maybe Host
 findHost l hn = M.lookup hn (hostMap l)
 
-getAddresses :: HostName -> [Host] -> [IPAddr]
+getAddresses :: Attr -> [IPAddr]
-getAddresses hn hosts = case hostAttr <$> findHost hosts hn of
+getAddresses = mapMaybe getIPAddr . S.toList . _dns
+
+hostAddresses :: HostName -> [Host] -> [IPAddr]
+hostAddresses hn hosts = case hostAttr <$> findHost hosts hn of
 	Nothing -> []
 	Just attr -> mapMaybe getIPAddr $ S.toList $ _dns attr
 

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 $
+genZoneFile (Zone zdomain soa rs) = unlines $
-	header : genSOA soa : map genr rs
+	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 :: Domain -> (Maybe BindDomain, Record) -> String
-genRecord (mdomain, record) = intercalate "\t"
+genRecord zdomain (mdomain, record) = intercalate "\t"
-	[ dname
+	[ hn
 	, "IN"
 	, rField record
 	, rValue record
 	]
   where
-	dname = fromMaybe "" mdomain
+	hn = maybe "" (domainHost zdomain) mdomain
 
-genSOA :: SOA -> String
+genSOA :: Domain -> SOA -> [String]
-genSOA soa = unlines $
+genSOA zdomain soa =
-	header : map genRecord (zip (repeat Nothing) (sRecord soa))
+	header ++ map (genRecord zdomain) (zip (repeat Nothing) (sRecord soa))
   where
-	header = unlines
+	header =
-		-- @ IN SOA root. root (
+		-- "@ 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 :: [Host] -> Domain -> SOA -> (Zone, [WarningMessage])
-genZone hosts domain soa = Zone soa zhosts
+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
+

Propellor/Types/Dns.hs

@@ -1,7 +1,5 @@
 module Propellor.Types.Dns where
 
-import Propellor.Types.OS (HostName)
-
 import Data.Word
 
 type Domain = String
@@ -28,8 +26,9 @@ data Type = Master | Secondary
 
 -- | Represents a bind 9 zone file.
 data Zone = Zone
-	{ zSOA :: SOA
+	{ zDomain :: Domain
-	, zHosts :: [(HostName, Record)]
+	, zSOA :: SOA
+	, zHosts :: [(BindDomain, Record)]
 	}
 	deriving (Read, Show, Eq)
 
@@ -64,6 +63,10 @@ getIPAddr :: Record -> Maybe IPAddr
 getIPAddr (Address addr) = Just addr
 getIPAddr _ = Nothing
 
+getCNAME :: Record -> Maybe BindDomain
+getCNAME (CNAME d) = Just d
+getCNAME _ = Nothing
+
 -- | Bind serial numbers are unsigned, 32 bit integers.
 type SerialNumber = Word32
 

config-joey.hs

@@ -241,8 +241,8 @@ myDnsSecondary =
 	, Dns.secondary "branchable.com" branchablemaster
 	]
   where
-	master = getAddresses "wren.kitenet.net" hosts
+	master = hostAddresses "wren.kitenet.net" hosts
-	branchablemaster = getAddresses "pell.branchable.com" hosts
+	branchablemaster = hostAddresses "pell.branchable.com" hosts
 
 main :: IO ()
 main = defaultMain hosts