From b2d6393bf40f73d25871c678309649e75c159f24 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 18 Apr 2014 14:29:25 -0400 Subject: added bind 9 zone file creation code --- Propellor/Property/Dns.hs | 167 ++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 161 insertions(+), 6 deletions(-) (limited to 'Propellor/Property') diff --git a/Propellor/Property/Dns.hs b/Propellor/Property/Dns.hs index 34e790d9..5b4b2622 100644 --- a/Propellor/Property/Dns.hs +++ b/Propellor/Property/Dns.hs @@ -4,11 +4,14 @@ 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 Zone = Zone +data NamedConf = NamedConf { zdomain :: Domain , ztype :: Type , zfile :: FilePath @@ -16,7 +19,7 @@ data Zone = Zone , zconfiglines :: [String] } -zoneDesc :: Zone -> String +zoneDesc :: NamedConf -> String zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")" type IPAddr = String @@ -26,8 +29,8 @@ type Domain = String data Type = Master | Secondary deriving (Show, Eq) -secondary :: Domain -> [IPAddr] -> Zone -secondary domain masters = Zone +secondary :: Domain -> [IPAddr] -> NamedConf +secondary domain masters = NamedConf { zdomain = domain , ztype = Secondary , zfile = "db." ++ domain @@ -35,7 +38,7 @@ secondary domain masters = Zone , zconfiglines = ["allow-transfer { }"] } -zoneStanza :: Zone -> [Line] +zoneStanza :: NamedConf -> [Line] zoneStanza z = [ "// automatically generated by propellor" , "zone \"" ++ zdomain z ++ "\" {" @@ -56,8 +59,160 @@ zoneStanza z = -- | Rewrites the whole named.conf.local file to serve the specificed -- zones. -zones :: [Zone] -> Property +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. +nextSerial :: Zone -> SerialNumber -> Zone +nextSerial (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' _) = nextSerial 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 + -- cgit v1.2.3