propellor/Propellor/Property/Dns.hs

219 lines
5.8 KiB
Haskell

module Propellor.Property.Dns where
import Propellor
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
import Utility.Applicative
import Data.List
namedconf :: FilePath
namedconf = "/etc/bind/named.conf.local"
data NamedConf = NamedConf
{ zdomain :: Domain
, ztype :: Type
, zfile :: FilePath
, zmasters :: [IPAddr]
, zconfiglines :: [String]
}
zoneDesc :: NamedConf -> String
zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"
type IPAddr = String
type Domain = String
data Type = Master | Secondary
deriving (Show, Eq)
secondary :: Domain -> [IPAddr] -> NamedConf
secondary domain masters = NamedConf
{ zdomain = domain
, ztype = Secondary
, zfile = "db." ++ domain
, zmasters = masters
, zconfiglines = ["allow-transfer { }"]
}
zoneStanza :: NamedConf -> [Line]
zoneStanza z =
[ "// automatically generated by propellor"
, "zone \"" ++ zdomain z ++ "\" {"
, cfgline "type" (if ztype z == Master then "master" else "slave")
, cfgline "file" ("\"" ++ zfile z ++ "\"")
] ++
(if null (zmasters z) then [] else mastersblock) ++
(map (\l -> "\t" ++ l ++ ";") (zconfiglines z)) ++
[ "};"
, ""
]
where
cfgline f v = "\t" ++ f ++ " " ++ v ++ ";"
mastersblock =
[ "\tmasters {" ] ++
(map (\ip -> "\t\t" ++ ip ++ ";") (zmasters z)) ++
[ "\t};" ]
-- | Rewrites the whole named.conf.local file to serve the specificed
-- zones.
zones :: [NamedConf] -> Property
zones zs = hasContent namedconf (concatMap zoneStanza zs)
`describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))
`requires` Apt.serviceInstalledRunning "bind9"
`onChange` Service.reloaded "bind9"
-- | Represents a bind 9 zone file.
data Zone = Zone SOA [(HostName, Record)]
-- | Every domain has a SOA record, which is big and complicated.
data SOA = SOA
{ sRoot :: BindDomain
, sSerial :: SerialNumber
-- ^ The most important parameter is the serial number,
-- which must increase after each change.
, sRefresh :: Integer
, sRetry :: Integer
, sExpire :: Integer
, sTTL :: Integer
, sRecord :: [Record]
-- ^ Records for the root of the domain. Typically NS, A, TXT
}
-- | Types of DNS records.
--
-- This is not a complete list, more can be added.
data Record
= A Ipv4
| AAAA Ipv6
| CNAME BindDomain
| MX Int BindDomain
| NS BindDomain
| TXT String
type Ipv4 = String
type Ipv6 = String
type SerialNumber = Integer
-- | Domains in the zone file must end with a period if they are absolute.
--
-- Let's use a type to keep absolute domains straight from relative
-- domains.
--
-- The SOADomain refers to the root SOA record.
data BindDomain = RelDomain Domain | AbsDomain Domain | SOADomain
dValue :: BindDomain -> String
dValue (RelDomain d) = d
dValue (AbsDomain d) = d ++ "."
dValue (SOADomain) = "@"
rField :: Record -> String
rField (A _) = "A"
rField (AAAA _) = "AAAA"
rField (CNAME _) = "CNAME"
rField (MX _ _) = "MX"
rField (NS _) = "NS"
rField (TXT _) = "TXT"
rValue :: Record -> String
rValue (A addr) = addr
rValue (AAAA addr) = addr
rValue (CNAME d) = dValue d
rValue (MX pri d) = show pri ++ " " ++ dValue d
rValue (NS d) = dValue d
rValue (TXT s) = [q] ++ filter (/= q) s ++ [q]
where
q = '\"'
-- | Adjusts the serial number of the zone to
--
-- * Always be larger than the passed SerialNumber
-- * Always be larger than the serial number in the Zone record.
nextSerialNumber :: Zone -> SerialNumber -> Zone
nextSerialNumber (Zone soa l) oldserial = Zone soa' l
where
soa' = soa { sSerial = succ $ max (sSerial soa) oldserial }
-- | Write a Zone out to a to a file.
--
-- The serial number that is written to the file comes from larger of the
-- Zone's SOA serial number, and the last serial number used in the file.
-- This ensures that serial number always increases, while also letting
-- a Zone contain an existing serial number, which may be quite large.
--
-- TODO: This increases the serial number when propellor is running on the
-- same host and generating its zone there, but what if the DNS host is
-- changed? We'd then want to remember the actual serial number and
-- propigate it to the new DNS host.
writeZoneFile :: Zone -> FilePath -> IO ()
writeZoneFile z f = do
oldserial <- nextZoneFileSerialNumber f
let z'@(Zone soa' _) = nextSerialNumber z oldserial
writeFile f (genZoneFile z')
writeFile (zoneSerialFile f) (show $ sSerial soa')
-- | Next to the zone file, is a ".serial" file, which contains
-- the SOA Serial number of that zone. This saves the bother of parsing
-- this horrible format.
zoneSerialFile :: FilePath -> FilePath
zoneSerialFile f = f ++ ".serial"
nextZoneFileSerialNumber :: FilePath -> IO SerialNumber
nextZoneFileSerialNumber = maybe 1 (+1) <$$> readZoneSerialFile
readZoneSerialFile :: FilePath -> IO (Maybe SerialNumber)
readZoneSerialFile f = catchDefaultIO Nothing $
readish <$> readFile (zoneSerialFile f)
-- | Generating a zone file.
genZoneFile :: Zone -> String
genZoneFile (Zone soa rs) = unlines $
header : genSOA soa : map genr rs
where
header = com "BIND zone file. Generated by propellor, do not edit."
genr (d, r) = genRecord (Just d, r)
genRecord :: (Maybe Domain, Record) -> String
genRecord (mdomain, record) = intercalate "\t"
[ dname
, "IN"
, rField record
, rValue record
]
where
dname = fromMaybe "" mdomain
genSOA :: SOA -> String
genSOA soa = unlines $
header : map genRecord (zip (repeat Nothing) (sRecord soa))
where
header = unlines
-- @ IN SOA root. root (
[ intercalate "\t"
[ dValue SOADomain
, "IN"
, "SOA"
, dValue (sRoot soa)
, "root"
, "("
]
, headerline sSerial "Serial"
, headerline sRefresh "Refresh"
, headerline sRetry "Retry"
, headerline sExpire "Expire"
, headerline sTTL "Default TTL"
, inheader ")"
]
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