summaryrefslogtreecommitdiff
path: root/Propellor/Property/Dns.hs
blob: 7c26f1d56b6f76ca15d087e6a1d27feca4d4405b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
module Propellor.Property.Dns (
	module Propellor.Types.Dns,
	primary,
	secondary,
	servingZones,
	mkSOA,
	rootAddressesFrom,
	writeZoneFile,
	nextSerialNumber,
	adjustSerialNumber,
	serialNumberOffset,
	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.
--
-- TODO: Does not yet add it to named.conf.local.
--
-- 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"
-- >   & aka "mail.exmaple.com"
--
-- Will cause that host and its cnames to appear in the zone file.
--
-- The [(Domain, Record)] list can be used for additional records
-- that cannot be configured elsewhere. For example, it might contain
-- CNAMEs pointing at hosts that propellor does not control.
primary :: [Host] -> Domain -> SOA -> [(BindDomain, Record)] -> Property
primary hosts domain soa rs = withwarnings (check needupdate baseprop)
	`requires` Apt.serviceInstalledRunning "bind9"
	`onChange` Service.reloaded "bind9"
  where
	(partialzone, warnings) = genZone hosts domain soa
	zone = partialzone { zHosts = zHosts partialzone ++ rs }
	zonefile = "/etc/bind/propellor/db." ++ domain
	needupdate = (/= Just zone) <$> readZonePropellorFile zonefile
	baseprop = property ("dns primary for " ++ domain) $ makeChange $ do
		writeZoneFile zone zonefile
	withwarnings p = adjustProperty p $ \satisfy -> do
		mapM_ warningMessage warnings
		satisfy

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 specified
-- 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.
--
-- 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.
--
-- Handy trick: You don't need to list IPAddrs in the [Record],
-- just make some Host sets its `aka` to the root of domain.
mkSOA :: Domain -> SerialNumber -> [Record] -> SOA
mkSOA d sn rs = SOA
	{ sDomain = AbsDomain d
	, sSerial = sn
	, sRefresh = hours 4
	, sRetry = hours 1
	, sExpire = 2419200 -- 4 weeks
	, sNegativeCacheTTL = hours 8
	, sRecord = rs
	}
  where
	hours n = n * 60 * 60

rootAddressesFrom :: [Host] -> HostName -> [Record]
rootAddressesFrom hosts hn = map Address (hostAddresses hn hosts)

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"
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.
-- * 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'

-- | 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 <$> readFile (zonePropellorFile f)

-- | Generating a zone file.
genZoneFile :: Zone -> String
genZoneFile (Zone zdomain soa rs) = unlines $
	header : genSOA zdomain soa ++ map genr rs
  where
	header = com $ "BIND zone file for " ++ zdomain ++ ". Generated by propellor, do not edit."

	genr (d, r) = genRecord zdomain (Just d, r)

genRecord :: Domain -> (Maybe BindDomain, Record) -> String
genRecord zdomain (mdomain, record) = intercalate "\t"
	[ hn
	, "IN"
	, rField record
	, rValue record
	]
  where
	hn = maybe "" (domainHost zdomain) mdomain

genSOA :: Domain -> SOA -> [String]
genSOA zdomain soa =
	header ++ map (genRecord zdomain) (zip (repeat Nothing) (sRecord soa))
  where
	header =
		-- "@ IN SOA ns1.example.com. root ("
		[ intercalate "\t"
			[ dValue SOADomain 
			, "IN"
			, "SOA"
			, dValue (sDomain soa)
			, "root"
			, "("
			]
		, headerline sSerial "Serial"
		, headerline sRefresh "Refresh"
		, headerline sRetry "Retry"
		, headerline sExpire "Expire"
		, headerline sNegativeCacheTTL "Negative Cache 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

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 _ SOADomain = "@"
domainHost base (AbsDomain d)
	| dotbase `isSuffixOf` d = take (length d - length dotbase) d
	| base == d = "@"
	| otherwise = d
  where
	dotbase = '.':base