summaryrefslogtreecommitdiff
path: root/Propellor/Property/Dns.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Propellor/Property/Dns.hs')
-rw-r--r--Propellor/Property/Dns.hs405
1 files changed, 0 insertions, 405 deletions
diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs
deleted file mode 100644
index 5c3162cb..00000000
--- a/Propellor/Property/Dns.hs
+++ /dev/null
@@ -1,405 +0,0 @@
-module Propellor.Property.Dns (
- module Propellor.Types.Dns,
- primary,
- secondary,
- secondaryFor,
- mkSOA,
- writeZoneFile,
- nextSerialNumber,
- adjustSerialNumber,
- serialNumberOffset,
- WarningMessage,
- 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
-
--- | Primary dns server for a domain.
---
--- 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"
--- > & alias "mail.exmaple.com"
---
--- Will cause that hostmame and its alias to appear in the zone file,
--- with the configured IP address.
---
--- The [(BindDomain, Record)] list can be used for additional records
--- that cannot be configured elsewhere. This often includes NS records,
--- TXT records and perhaps CNAMEs pointing at hosts that propellor does
--- not control.
---
--- 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.
---
--- In either case, the secondary dns server Host should have an ipv4 and/or
--- ipv6 property defined.
-primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> RevertableProperty
-primary hosts domain soa rs = RevertableProperty setup cleanup
- 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"
-
- (partialzone, zonewarnings) = genZone hosts domain soa
- zone = partialzone { zHosts = zHosts partialzone ++ rs }
- zonefile = "/etc/bind/propellor/db." ++ domain
- baseprop = Property ("dns primary for " ++ domain)
- (makeChange $ writeZoneFile zone zonefile)
- (addNamedConf conf)
- withwarnings p = adjustProperty p $ \satisfy -> do
- mapM_ warningMessage $ zonewarnings ++ secondarywarnings
- satisfy
- conf = NamedConf
- { confDomain = domain
- , confDnsServerType = Master
- , confFile = zonefile
- , confMasters = []
- , confAllowTransfer = nub $
- concatMap (\h -> hostAddresses h hosts) $
- secondaries ++ nssecondaries
- , confLines = []
- }
- secondaries = otherServers Secondary hosts domain
- secondarywarnings = map (\h -> "No IP address defined for DNS seconary " ++ h) $
- filter (\h -> null (hostAddresses h hosts)) secondaries
- nssecondaries = mapMaybe (domainHostName <=< getNS) rootRecords
- 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)
-
--- | Secondary dns server for a domain.
---
--- 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
-secondary hosts domain = secondaryFor (otherServers Master hosts domain) hosts domain
-
--- | 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
- , confDnsServerType = Secondary
- , confFile = "db." ++ domain
- , confMasters = concatMap (\m -> hostAddresses m hosts) masters
- , confAllowTransfer = []
- , confLines = []
- }
-
-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"
- `requires` Apt.serviceInstalledRunning "bind9"
-
-namedConfWritten :: Property
-namedConfWritten = property "named.conf configured" $ do
- zs <- getNamedConf
- ensureProperty $
- hasContent namedConfFile $
- concatMap confStanza $ M.elems zs
-
-confStanza :: NamedConf -> [Line]
-confStanza c =
- [ "// automatically generated by propellor"
- , "zone \"" ++ confDomain c ++ "\" {"
- , cfgline "type" (if confDnsServerType c == Master then "master" else "slave")
- , cfgline "file" ("\"" ++ confFile c ++ "\"")
- ] ++
- mastersblock ++
- allowtransferblock ++
- (map (\l -> "\t" ++ l ++ ";") (confLines c)) ++
- [ "};"
- , ""
- ]
- where
- cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
- ipblock name l =
- [ "\t" ++ name ++ " {" ] ++
- (map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") l) ++
- [ "\t};" ]
- mastersblock
- | null (confMasters c) = []
- | otherwise = ipblock "masters" (confMasters c)
- -- an empty block prohibits any transfers
- allowtransferblock = ipblock "allow-transfer" (confAllowTransfer c)
-
-namedConfFile :: FilePath
-namedConfFile = "/etc/bind/named.conf.local"
-
--- | Generates a SOA with some fairly sane numbers in it.
---
--- The Domain is the domain to use in the SOA record. Typically
--- something like ns1.example.com. So, not the domain that this is the SOA
--- record for.
---
--- 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
- { sDomain = AbsDomain d
- , sSerial = sn
- , sRefresh = hours 4
- , sRetry = hours 1
- , sExpire = 2419200 -- 4 weeks
- , sNegativeCacheTTL = hours 8
- }
- where
- hours n = n * 60 * 60
-
-dValue :: BindDomain -> String
-dValue (RelDomain d) = d
-dValue (AbsDomain d) = d ++ "."
-dValue (RootDomain) = "@"
-
-rField :: Record -> String
-rField (Address (IPv4 _)) = "A"
-rField (Address (IPv6 _)) = "AAAA"
-rField (CNAME _) = "CNAME"
-rField (MX _ _) = "MX"
-rField (NS _) = "NS"
-rField (TXT _) = "TXT"
-rField (SRV _ _ _ _) = "SRV"
-
-rValue :: Record -> String
-rValue (Address (IPv4 addr)) = addr
-rValue (Address (IPv6 addr)) = addr
-rValue (CNAME d) = dValue d
-rValue (MX pri d) = show pri ++ " " ++ dValue d
-rValue (NS d) = dValue d
-rValue (SRV priority weight port target) = unwords
- [ show priority
- , show weight
- , show port
- , dValue target
- ]
-rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
- where
- q = '"'
-
--- | 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.
-nextSerialNumber :: Zone -> SerialNumber -> Zone
-nextSerialNumber z serial = adjustSerialNumber z $ \sn -> succ $ max sn serial
-
-adjustSerialNumber :: Zone -> (SerialNumber -> SerialNumber) -> Zone
-adjustSerialNumber (Zone d soa l) f = Zone d soa' l
- where
- soa' = soa { sSerial = f (sSerial soa) }
-
--- | Count the number of git commits made to the current branch.
-serialNumberOffset :: IO SerialNumber
-serialNumberOffset = fromIntegral . length . lines
- <$> readProcess "git" ["log", "--pretty=%H"]
-
--- | Write a Zone out to a to a file.
---
--- 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.
-writeZoneFile :: Zone -> FilePath -> IO ()
-writeZoneFile z f = do
- oldserial <- oldZoneFileSerialNumber f
- offset <- serialNumberOffset
- let z' = nextSerialNumber
- (adjustSerialNumber z (+ offset))
- oldserial
- createDirectoryIfMissing True (takeDirectory f)
- writeFile f (genZoneFile z')
- writeZonePropellorFile f z'
-
-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"
-
-oldZoneFileSerialNumber :: FilePath -> IO SerialNumber
-oldZoneFileSerialNumber = maybe 0 (sSerial . zSOA) <$$> readZonePropellorFile
-
-writeZonePropellorFile :: FilePath -> Zone -> IO ()
-writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z)
-
-readZonePropellorFile :: FilePath -> IO (Maybe Zone)
-readZonePropellorFile f = catchDefaultIO Nothing $
- readish <$> readFileStrict (zonePropellorFile f)
-
--- | Generating a zone file.
-genZoneFile :: Zone -> String
-genZoneFile (Zone zdomain soa rs) = unlines $
- header : genSOA soa ++ map (genRecord zdomain) rs
- where
- header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."
-
-genRecord :: Domain -> (BindDomain, Record) -> String
-genRecord zdomain (domain, record) = intercalate "\t"
- [ domainHost zdomain domain
- , "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"
- , "("
- ]
- , headerline sSerial "Serial"
- , headerline sRefresh "Refresh"
- , headerline sRetry "Retry"
- , headerline sExpire "Expire"
- , headerline sNegativeCacheTTL "Negative Cache TTL"
- , inheader ")"
- ]
- where
- 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
-
--- | 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)
- 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,
- -- 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,
- -- 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
-