From c8a3653775892bd361091885c63113b6ca36ed5a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 18 Apr 2014 21:10:44 -0400 Subject: [PATCH] genZone is working! complete DNS zone file generation from propellor config --- Propellor/Attr.hs | 12 ++++- Propellor/Property/Dns.hs | 108 +++++++++++++++++++++++++++++++------- Propellor/Types/Dns.hs | 11 ++-- config-joey.hs | 4 +- 4 files changed, 108 insertions(+), 27 deletions(-) diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs index f3e2e2e..37ed1ba 100644 --- a/Propellor/Attr.hs +++ b/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 hn hosts = case hostAttr <$> findHost hosts hn of +getAddresses :: Attr -> [IPAddr] +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 diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs index cefbd71..131079e 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 + diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs index b5cfcff..0474ea9 100644 --- a/Propellor/Types/Dns.hs +++ b/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 - , zHosts :: [(HostName, Record)] + { zDomain :: Domain + , 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 diff --git a/config-joey.hs b/config-joey.hs index 8c61c32..289d324 100644 --- a/config-joey.hs +++ b/config-joey.hs @@ -241,8 +241,8 @@ myDnsSecondary = , Dns.secondary "branchable.com" branchablemaster ] where - master = getAddresses "wren.kitenet.net" hosts - branchablemaster = getAddresses "pell.branchable.com" hosts + master = hostAddresses "wren.kitenet.net" hosts + branchablemaster = hostAddresses "pell.branchable.com" hosts main :: IO () main = defaultMain hosts