summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2014-04-18 21:10:44 -0400
committerJoey Hess2014-04-18 21:10:44 -0400
commitc8a3653775892bd361091885c63113b6ca36ed5a (patch)
tree672624a10fc528b9e04ac2ab73db14ccad22e899
parent8e22065deff41c3e476763ebd939a63856e6d54b (diff)
genZone is working! complete DNS zone file generation from propellor config
-rw-r--r--Propellor/Attr.hs12
-rw-r--r--Propellor/Property/Dns.hs108
-rw-r--r--Propellor/Types/Dns.hs11
-rw-r--r--config-joey.hs4
4 files changed, 108 insertions, 27 deletions
diff --git a/Propellor/Attr.hs b/Propellor/Attr.hs
index f3e2e2e5..37ed1bad 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 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
+
diff --git a/Propellor/Types/Dns.hs b/Propellor/Types/Dns.hs
index b5cfcffd..0474ea96 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 8c61c325..289d3240 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