module Propellor.Property.Dns ( module Propellor.Types.Dns, secondary, servingZones, mkSOA, nextSerialNumber, incrSerialNumber, currentSerialNumber, writeZoneFile, genZoneFile, genSOA, ) where import Propellor import Propellor.Types.Dns import Propellor.Property.File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service import Utility.Applicative import Data.List import Data.Time.Clock.POSIX namedconf :: FilePath namedconf = "/etc/bind/named.conf.local" zoneDesc :: NamedConf -> String zoneDesc z = confDomain z ++ " (" ++ show (confType z) ++ ")" secondary :: Domain -> [IPAddr] -> NamedConf secondary domain masters = NamedConf { confDomain = domain , confType = Secondary , confFile = "db." ++ domain , confMasters = masters , confLines = ["allow-transfer { }"] } confStanza :: NamedConf -> [Line] confStanza c = [ "// automatically generated by propellor" , "zone \"" ++ confDomain c ++ "\" {" , cfgline "type" (if confType c == Master then "master" else "slave") , cfgline "file" ("\"" ++ confFile c ++ "\"") ] ++ (if null (confMasters c) then [] else mastersblock) ++ (map (\l -> "\t" ++ l ++ ";") (confLines c)) ++ [ "};" , "" ] where cfgline f v = "\t" ++ f ++ " " ++ v ++ ";" mastersblock = [ "\tmasters {" ] ++ (map (\ip -> "\t\t" ++ fromIPAddr ip ++ ";") (confMasters c)) ++ [ "\t};" ] -- | Rewrites the whole named.conf.local file to serve the specificed -- zones. servingZones :: [NamedConf] -> Property servingZones zs = hasContent namedconf (concatMap confStanza zs) `describe` ("dns server for zones: " ++ unwords (map zoneDesc zs)) `requires` Apt.serviceInstalledRunning "bind9" `onChange` Service.reloaded "bind9" -- | Generates a SOA with some fairly sane numbers in it. mkSOA :: Domain -> [Record] -> SOA mkSOA d rs = SOA { sDomain = AbsDomain d , sSerial = 1 , sRefresh = hours 4 , sRetry = hours 1 , sExpire = 2419200 -- 4 weeks , sTTL = hours 8 , sRecord = rs } where hours n = n * 60 * 60 dValue :: BindDomain -> String dValue (RelDomain d) = d dValue (AbsDomain d) = d ++ "." dValue (SOADomain) = "@" rField :: Record -> String rField (Address (IPv4 _)) = "A" rField (Address (IPv6 _)) = "AAAA" rField (CNAME _) = "CNAME" rField (MX _ _) = "MX" rField (NS _) = "NS" rField (TXT _) = "TXT" 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 (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 } incrSerialNumber :: Zone -> Zone incrSerialNumber (Zone soa l) = Zone soa' l where soa' = soa { sSerial = succ (sSerial soa) } -- | Propellor uses a serial number derived from the current date and time. -- -- This ensures that, even if zone files are being generated on -- multiple hosts, the serial numbers will not get out of sync between -- them. -- -- Since serial numbers are limited to 32 bits, the number of seconds -- since the epoch is divided by 5. This will work until the year 2650, -- at which point this stupid limit had better have been increased to -- 128 bits. If we didn't divide by 5, it would only work up to 2106! -- -- Dividing by 5 means that this number only changes once every 5 seconds. -- If propellor is running more often than once every 5 seconds, you're -- doing something wrong. currentSerialNumber :: IO SerialNumber currentSerialNumber = calc <$> getPOSIXTime where calc t = floor (t / 5) -- | 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. writeZoneFile :: Zone -> FilePath -> IO () writeZoneFile z f = do oldserial <- nextZoneFileSerialNumber f let z' = nextSerialNumber z oldserial writeFile f (genZoneFile z') writeZonePropellorFile f z' -- | 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 ++ ".serial" nextZoneFileSerialNumber :: FilePath -> IO SerialNumber nextZoneFileSerialNumber = maybe 1 (sSerial . zSOA . incrSerialNumber) <$$> readZonePropellorFile writeZonePropellorFile :: FilePath -> Zone -> IO () writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z) readZonePropellorFile :: FilePath -> IO (Maybe Zone) readZonePropellorFile f = catchDefaultIO Nothing $ readish <$> readFile (zonePropellorFile 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 (sDomain 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