propellor/Propellor/Property/Dns.hs

406 lines
13 KiB
Haskell
Raw Normal View History

2014-04-18 21:19:28 +00:00
module Propellor.Property.Dns (
module Propellor.Types.Dns,
2014-04-19 01:58:23 +00:00
primary,
2014-04-18 21:19:28 +00:00
secondary,
2014-04-19 05:55:32 +00:00
secondaryFor,
2014-04-18 21:19:28 +00:00
mkSOA,
writeZoneFile,
2014-04-18 23:06:55 +00:00
nextSerialNumber,
adjustSerialNumber,
serialNumberOffset,
2014-04-19 07:14:26 +00:00
WarningMessage,
genZone,
2014-04-18 21:19:28 +00:00
) where
2014-04-10 05:46:33 +00:00
import Propellor
2014-04-18 21:19:28 +00:00
import Propellor.Types.Dns
2014-04-10 05:46:33 +00:00
import Propellor.Property.File
import Propellor.Types.Attr
2014-04-10 05:46:33 +00:00
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
2014-04-18 18:29:25 +00:00
import Utility.Applicative
import qualified Data.Map as M
import qualified Data.Set as S
2014-04-18 18:29:25 +00:00
import Data.List
2014-04-10 05:46:33 +00:00
2014-04-19 01:58:23 +00:00
-- | Primary dns server for a domain.
--
2014-04-19 03:20:07 +00:00
-- Most of the content of the zone file is configured by setting properties
-- of hosts. For example,
--
-- > host "foo.example.com"
-- > & ipv4 "192.168.1.1"
2014-04-19 05:28:46 +00:00
-- > & alias "mail.exmaple.com"
2014-04-19 03:20:07 +00:00
--
-- Will cause that hostmame and its alias to appear in the zone file,
-- with the configured IP address.
2014-04-19 03:20:07 +00:00
--
2014-04-19 07:11:34 +00:00
-- The [(BindDomain, Record)] list can be used for additional records
2014-04-19 15:42:31 +00:00
-- that cannot be configured elsewhere. This often includes NS records,
-- TXT records and perhaps CNAMEs pointing at hosts that propellor does
-- not control.
2014-04-23 19:04:35 +00:00
--
-- The primary server is configured to only allow zone transfers to
-- secondary dns servers. These are determined in two ways:
--
-- 1. By looking at the properties of other hosts, to find hosts that
-- are configured as the secondary dns server.
--
-- 2. By looking for NS Records in the passed list of records.
--
2014-04-23 20:03:17 +00:00
-- In either case, the secondary dns server Host should have an ipv4 and/or
2014-04-23 20:21:38 +00:00
-- ipv6 property defined.
primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
primary hosts domain soa rs = RevertableProperty setup cleanup
2014-04-19 01:58:23 +00:00
where
setup = withwarnings (check needupdate baseprop)
`requires` servingZones
`onChange` Service.reloaded "bind9"
cleanup = check (doesFileExist zonefile) $
property ("removed dns primary for " ++ domain)
(makeChange $ removeZoneFile zonefile)
`requires` namedConfWritten
`onChange` Service.reloaded "bind9"
2014-04-23 20:03:17 +00:00
(partialzone, zonewarnings) = genZone hosts domain soa
2014-04-19 03:20:07 +00:00
zone = partialzone { zHosts = zHosts partialzone ++ rs }
2014-04-19 01:58:23 +00:00
zonefile = "/etc/bind/propellor/db." ++ domain
baseprop = Property ("dns primary for " ++ domain)
(makeChange $ writeZoneFile zone zonefile)
(addNamedConf conf)
2014-04-19 01:58:23 +00:00
withwarnings p = adjustProperty p $ \satisfy -> do
2014-04-23 20:03:17 +00:00
mapM_ warningMessage $ zonewarnings ++ secondarywarnings
2014-04-19 01:58:23 +00:00
satisfy
conf = NamedConf
{ confDomain = domain
2014-04-23 19:04:35 +00:00
, confDnsServerType = Master
, confFile = zonefile
, confMasters = []
2014-04-23 19:04:35 +00:00
, confAllowTransfer = nub $
2014-04-23 20:21:38 +00:00
concatMap (\h -> hostAddresses h hosts) $
secondaries ++ nssecondaries
, confLines = []
}
2014-04-23 20:21:38 +00:00
secondaries = otherServers Secondary hosts domain
2014-04-23 20:03:17 +00:00
secondarywarnings = map (\h -> "No IP address defined for DNS seconary " ++ h) $
filter (\h -> null (hostAddresses h hosts)) secondaries
2014-04-23 20:21:38 +00:00
nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
2014-04-23 19:04:35 +00:00
rootRecords = map snd $
filter (\(d, _r) -> d == RootDomain || d == AbsDomain domain) rs
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)
2014-04-19 01:58:23 +00:00
-- | Secondary dns server for a domain.
--
2014-04-19 05:55:32 +00:00
-- The primary server is determined by looking at the properties of other
-- hosts to find which one is configured as the primary.
--
-- Note that if a host is declared to be a primary and a secondary dns
-- server for the same domain, the primary server config always wins.
secondary :: [Host] -> Domain -> RevertableProperty
2014-04-23 19:04:35 +00:00
secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain
2014-04-19 05:55:32 +00:00
-- | This variant is useful if the primary server does not have its DNS
-- configured via propellor.
secondaryFor :: [HostName] -> [Host] -> Domain -> RevertableProperty
secondaryFor masters hosts domain = RevertableProperty setup cleanup
where
setup = pureAttrProperty desc (addNamedConf conf)
`requires` servingZones
cleanup = namedConfWritten
desc = "dns secondary for " ++ domain
conf = NamedConf
{ confDomain = domain
2014-04-23 19:04:35 +00:00
, confDnsServerType = Secondary
, confFile = "db." ++ domain
2014-04-19 05:55:32 +00:00
, confMasters = concatMap (\m -> hostAddresses m hosts) masters
2014-04-23 19:04:35 +00:00
, confAllowTransfer = []
, confLines = []
}
2014-04-10 05:46:33 +00:00
2014-04-23 19:04:35 +00:00
otherServers :: DnsServerType -> [Host] -> Domain -> [HostName]
otherServers wantedtype hosts domain =
M.keys $ M.filter wanted $ hostAttrMap hosts
where
wanted attr = case M.lookup domain (_namedconf attr) of
Nothing -> False
Just conf -> confDnsServerType conf == wantedtype
&& confDomain conf == domain
-- | 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 = namedConfWritten
`onChange` Service.reloaded "bind9"
2014-04-21 02:54:31 +00:00
`requires` Apt.serviceInstalledRunning "bind9"
namedConfWritten :: Property
namedConfWritten = property "named.conf configured" $ do
zs <- getNamedConf
ensureProperty $
hasContent namedConfFile $
concatMap confStanza $ M.elems zs
2014-04-10 05:46:33 +00:00
2014-04-18 21:19:28 +00:00
confStanza :: NamedConf -> [Line]
confStanza c =
2014-04-10 05:46:33 +00:00
[ "// automatically generated by propellor"
2014-04-18 21:19:28 +00:00
, "zone \"" ++ confDomain c ++ "\" {"
2014-04-23 19:04:35 +00:00
, cfgline "type" (if confDnsServerType c == Master then "master" else "slave")
2014-04-18 21:19:28 +00:00
, cfgline "file" ("\"" ++ confFile c ++ "\"")
2014-04-10 05:46:33 +00:00
] ++
2014-04-23 19:04:35 +00:00
mastersblock ++
allowtransferblock ++
2014-04-18 21:19:28 +00:00
(map (\l -> "\t" ++ l ++ ";") (confLines c)) ++
2014-04-10 05:46:33 +00:00
[ "};"
, ""
]
where
cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
2014-04-23 19:04:35 +00:00
ipblock name l =
[ "\t" ++ name ++ " {" ] ++
(map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) ++
2014-04-10 05:46:33 +00:00
[ "\t};" ]
2014-04-23 19:04:35 +00:00
mastersblock
| null (confMasters c) = []
| otherwise = ipblock "masters" (confMasters c)
-- an empty block prohibits any transfers
allowtransferblock = ipblock "allow-transfer" (confAllowTransfer c)
2014-04-10 05:46:33 +00:00
namedConfFile :: FilePath
namedConfFile = "/etc/bind/named.conf.local"
2014-04-18 18:29:25 +00:00
-- | Generates a SOA with some fairly sane numbers in it.
2014-04-18 23:06:55 +00:00
--
2014-04-19 01:58:23 +00:00
-- The Domain is the domain to use in the SOA record. Typically
2014-04-19 02:57:51 +00:00
-- something like ns1.example.com. So, not the domain that this is the SOA
2014-04-19 01:58:23 +00:00
-- record for.
--
2014-04-18 23:06:55 +00:00
-- 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
-- been managed by propellor.
--
-- You do not need to increment the SerialNumber when making changes!
-- Propellor will automatically add the number of commits in the git
-- repository to the SerialNumber.
mkSOA :: Domain -> SerialNumber -> SOA
mkSOA d sn = SOA
2014-04-18 20:49:36 +00:00
{ sDomain = AbsDomain d
2014-04-18 23:06:55 +00:00
, sSerial = sn
2014-04-18 20:49:36 +00:00
, sRefresh = hours 4
, sRetry = hours 1
, sExpire = 2419200 -- 4 weeks
2014-04-19 02:57:51 +00:00
, sNegativeCacheTTL = hours 8
2014-04-18 20:49:36 +00:00
}
where
hours n = n * 60 * 60
2014-04-18 18:29:25 +00:00
dValue :: BindDomain -> String
dValue (RelDomain d) = d
dValue (AbsDomain d) = d ++ "."
dValue (RootDomain) = "@"
2014-04-18 18:29:25 +00:00
rField :: Record -> String
2014-04-18 21:19:28 +00:00
rField (Address (IPv4 _)) = "A"
rField (Address (IPv6 _)) = "AAAA"
2014-04-18 18:29:25 +00:00
rField (CNAME _) = "CNAME"
rField (MX _ _) = "MX"
rField (NS _) = "NS"
rField (TXT _) = "TXT"
2014-04-19 03:29:01 +00:00
rField (SRV _ _ _ _) = "SRV"
2014-04-18 18:29:25 +00:00
rValue :: Record -> String
2014-04-18 21:19:28 +00:00
rValue (Address (IPv4 addr)) = addr
rValue (Address (IPv6 addr)) = addr
2014-04-18 18:29:25 +00:00
rValue (CNAME d) = dValue d
rValue (MX pri d) = show pri ++ " " ++ dValue d
rValue (NS d) = dValue d
2014-04-19 03:29:01 +00:00
rValue (SRV priority weight port target) = unwords
[ show priority
, show weight
, show port
, dValue target
]
2014-04-18 18:29:25 +00:00
rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
where
q = '"'
2014-04-18 18:29:25 +00:00
2014-04-19 07:13:42 +00:00
-- | Adjusts the serial number of the zone to always be larger
-- than the serial number in the Zone record,
-- and always be larger than the passed SerialNumber.
2014-04-18 18:44:46 +00:00
nextSerialNumber :: Zone -> SerialNumber -> Zone
2014-04-18 23:06:55 +00:00
nextSerialNumber z serial = adjustSerialNumber z $ \sn -> succ $ max sn serial
2014-04-18 18:29:25 +00:00
2014-04-18 23:06:55 +00:00
adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone
adjustSerialNumber (Zone d soa l) f = Zone d soa' l
where
2014-04-18 23:06:55 +00:00
soa' = soa { sSerial = f (sSerial soa) }
2014-04-18 23:06:55 +00:00
-- | Count the number of git commits made to the current branch.
serialNumberOffset :: IO SerialNumber
serialNumberOffset = fromIntegral . length . lines
<$> readProcess "git" ["log", "--pretty=%H"]
2014-04-18 18:29:25 +00:00
-- | Write a Zone out to a to a file.
--
2014-04-18 23:06:55 +00:00
-- The serial number in the Zone automatically has the serialNumberOffset
-- added to it. Also, just in case, the old serial number used in the zone
-- file is checked, and if it is somehow larger, its succ is used.
2014-04-18 18:29:25 +00:00
writeZoneFile :: Zone -> FilePath -> IO ()
writeZoneFile z f = do
2014-04-18 23:06:55 +00:00
oldserial <- oldZoneFileSerialNumber f
offset <- serialNumberOffset
let z' = nextSerialNumber
(adjustSerialNumber z (+ offset))
2014-04-19 01:58:23 +00:00
oldserial
createDirectoryIfMissing True (takeDirectory f)
2014-04-18 18:29:25 +00:00
writeFile f (genZoneFile z')
writeZonePropellorFile f z'
2014-04-18 18:29:25 +00:00
removeZoneFile :: FilePath -> IO ()
removeZoneFile f = do
nukeFile f
nukeFile (zonePropellorFile f)
-- | Next to the zone file, is a ".propellor" file, which contains
-- the serialized Zone. This saves the bother of parsing
-- the horrible bind zone file format.
zonePropellorFile :: FilePath -> FilePath
zonePropellorFile f = f ++ ".propellor"
2014-04-18 18:29:25 +00:00
2014-04-18 23:06:55 +00:00
oldZoneFileSerialNumber :: FilePath -> IO SerialNumber
oldZoneFileSerialNumber = maybe 0 (sSerial . zSOA) <$$> readZonePropellorFile
writeZonePropellorFile :: FilePath -> Zone -> IO ()
writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z)
2014-04-18 18:29:25 +00:00
readZonePropellorFile :: FilePath -> IO (Maybe Zone)
readZonePropellorFile f = catchDefaultIO Nothing $
2014-04-19 06:08:38 +00:00
readish <$> readFileStrict (zonePropellorFile f)
2014-04-18 18:29:25 +00:00
-- | Generating a zone file.
genZoneFile :: Zone -> String
genZoneFile (Zone zdomain soa rs) = unlines $
header : genSOA soa ++ map (genRecord zdomain) rs
2014-04-18 18:29:25 +00:00
where
header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
2014-04-18 18:29:25 +00:00
genRecord :: Domain -> (BindDomain, Record) -> String
genRecord zdomain (domain, record) = intercalate "\t"
[ domainHost zdomain domain
2014-04-18 18:29:25 +00:00
, "IN"
, rField record
, rValue record
]
genSOA :: SOA -> [String]
genSOA soa =
-- "@ IN SOA ns1.example.com. root ("
[ intercalate "\t"
[ dValue RootDomain
, "IN"
, "SOA"
, dValue (sDomain soa)
, "root"
, "("
2014-04-18 18:29:25 +00:00
]
, headerline sSerial "Serial"
, headerline sRefresh "Refresh"
, headerline sRetry "Retry"
, headerline sExpire "Expire"
, headerline sNegativeCacheTTL "Negative Cache TTL"
, inheader ")"
]
where
2014-04-18 18:29:25 +00:00
headerline r comment = inheader $ show (r soa) ++ "\t\t" ++ com comment
inheader l = "\t\t\t" ++ l
-- | Comment line in a zone file.
com :: String -> String
com s = "; " ++ s
type WarningMessage = String
2014-04-18 23:06:55 +00:00
-- | 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, [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)
2014-04-18 23:06:55 +00:00
where
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,
2014-04-19 02:57:51 +00:00
-- may have cnames which are in the zdomain. The cname may even be
-- the same as the root of the zdomain, which is a nice way to
-- specify IP addresses for a SOA record.
--
-- Add Records for those.. But not actually, usually, cnames!
-- Why not? Well, using cnames doesn't allow doing some things,
2014-04-19 02:57:51 +00:00
-- including MX and round robin DNS, and certianly CNAMES
-- shouldn't be used in SOA records.
--
-- 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 _ RootDomain = "@"
domainHost base (AbsDomain d)
| dotbase `isSuffixOf` d = take (length d - length dotbase) d
| base == d = "@"
| otherwise = d
where
dotbase = '.':base