2014-04-10 05:46:33 +00:00
|
|
|
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
|
2014-04-18 18:29:25 +00:00
|
|
|
import Utility.Applicative
|
|
|
|
|
|
|
|
import Data.List
|
2014-04-18 20:33:06 +00:00
|
|
|
import Data.Time.Clock.POSIX
|
|
|
|
import Data.Time.Format
|
|
|
|
import Foreign.C.Types
|
2014-04-10 05:46:33 +00:00
|
|
|
|
|
|
|
namedconf :: FilePath
|
|
|
|
namedconf = "/etc/bind/named.conf.local"
|
|
|
|
|
2014-04-18 18:29:25 +00:00
|
|
|
data NamedConf = NamedConf
|
2014-04-10 05:46:33 +00:00
|
|
|
{ zdomain :: Domain
|
|
|
|
, ztype :: Type
|
|
|
|
, zfile :: FilePath
|
|
|
|
, zmasters :: [IPAddr]
|
|
|
|
, zconfiglines :: [String]
|
|
|
|
}
|
|
|
|
|
2014-04-18 18:29:25 +00:00
|
|
|
zoneDesc :: NamedConf -> String
|
2014-04-10 05:46:33 +00:00
|
|
|
zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"
|
|
|
|
|
|
|
|
type IPAddr = String
|
|
|
|
|
|
|
|
type Domain = String
|
|
|
|
|
|
|
|
data Type = Master | Secondary
|
|
|
|
deriving (Show, Eq)
|
|
|
|
|
2014-04-18 18:29:25 +00:00
|
|
|
secondary :: Domain -> [IPAddr] -> NamedConf
|
|
|
|
secondary domain masters = NamedConf
|
2014-04-10 05:46:33 +00:00
|
|
|
{ zdomain = domain
|
|
|
|
, ztype = Secondary
|
|
|
|
, zfile = "db." ++ domain
|
|
|
|
, zmasters = masters
|
|
|
|
, zconfiglines = ["allow-transfer { }"]
|
|
|
|
}
|
|
|
|
|
2014-04-18 18:29:25 +00:00
|
|
|
zoneStanza :: NamedConf -> [Line]
|
2014-04-10 05:46:33 +00:00
|
|
|
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.
|
2014-04-18 18:29:25 +00:00
|
|
|
zones :: [NamedConf] -> Property
|
2014-04-10 05:46:33 +00:00
|
|
|
zones zs = hasContent namedconf (concatMap zoneStanza zs)
|
|
|
|
`describe` ("dns server for zones: " ++ unwords (map zoneDesc zs))
|
|
|
|
`requires` Apt.serviceInstalledRunning "bind9"
|
|
|
|
`onChange` Service.reloaded "bind9"
|
2014-04-18 18:29:25 +00:00
|
|
|
|
|
|
|
-- | Represents a bind 9 zone file.
|
2014-04-18 20:33:06 +00:00
|
|
|
data Zone = Zone
|
|
|
|
{ zSOA :: SOA
|
|
|
|
, zHosts :: [(HostName, Record)]
|
|
|
|
}
|
|
|
|
deriving (Read, Show, Eq)
|
2014-04-18 18:29:25 +00:00
|
|
|
|
|
|
|
-- | 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
|
|
|
|
}
|
2014-04-18 20:33:06 +00:00
|
|
|
deriving (Read, Show, Eq)
|
2014-04-18 18:29:25 +00:00
|
|
|
|
|
|
|
-- | 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
|
2014-04-18 20:33:06 +00:00
|
|
|
deriving (Read, Show, Eq)
|
2014-04-18 18:29:25 +00:00
|
|
|
|
|
|
|
type Ipv4 = String
|
|
|
|
type Ipv6 = String
|
|
|
|
|
2014-04-18 20:33:06 +00:00
|
|
|
-- | Bind serial numbers are unsigned, 32 bit integers.
|
|
|
|
type SerialNumber = CInt
|
2014-04-18 18:29:25 +00:00
|
|
|
|
|
|
|
-- | 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
|
2014-04-18 20:33:06 +00:00
|
|
|
deriving (Read, Show, Eq)
|
2014-04-18 18:29:25 +00:00
|
|
|
|
|
|
|
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
|
2014-04-18 20:33:06 +00:00
|
|
|
q = '"'
|
2014-04-18 18:29:25 +00:00
|
|
|
|
|
|
|
-- | 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.
|
2014-04-18 18:44:46 +00:00
|
|
|
nextSerialNumber :: Zone -> SerialNumber -> Zone
|
|
|
|
nextSerialNumber (Zone soa l) oldserial = Zone soa' l
|
2014-04-18 18:29:25 +00:00
|
|
|
where
|
|
|
|
soa' = soa { sSerial = succ $ max (sSerial soa) oldserial }
|
|
|
|
|
2014-04-18 20:33:06 +00:00
|
|
|
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)
|
|
|
|
|
2014-04-18 18:29:25 +00:00
|
|
|
-- | 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
|
2014-04-18 20:33:06 +00:00
|
|
|
let z' = nextSerialNumber z oldserial
|
2014-04-18 18:29:25 +00:00
|
|
|
writeFile f (genZoneFile z')
|
2014-04-18 20:33:06 +00:00
|
|
|
writeZonePropellorFile f z'
|
2014-04-18 18:29:25 +00:00
|
|
|
|
2014-04-18 20:33:06 +00:00
|
|
|
-- | 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"
|
2014-04-18 18:29:25 +00:00
|
|
|
|
|
|
|
nextZoneFileSerialNumber :: FilePath -> IO SerialNumber
|
2014-04-18 20:33:06 +00:00
|
|
|
nextZoneFileSerialNumber = maybe 1 (sSerial . zSOA . incrSerialNumber)
|
|
|
|
<$$> readZonePropellorFile
|
|
|
|
|
|
|
|
writeZonePropellorFile :: FilePath -> Zone -> IO ()
|
|
|
|
writeZonePropellorFile f z = writeFile (zonePropellorFile f) (show z)
|
2014-04-18 18:29:25 +00:00
|
|
|
|
2014-04-18 20:33:06 +00:00
|
|
|
readZonePropellorFile :: FilePath -> IO (Maybe Zone)
|
|
|
|
readZonePropellorFile f = catchDefaultIO Nothing $
|
|
|
|
readish <$> readFile (zonePropellorFile f)
|
2014-04-18 18:29:25 +00:00
|
|
|
|
|
|
|
-- | 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
|
|
|
|
|