summaryrefslogtreecommitdiff
path: root/Propellor/Property/Dns.hs
blob: cefbd712dd61656c9332c029258ac0bbc6edd4a3 (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
module Propellor.Property.Dns (
	module Propellor.Types.Dns,
	secondary,
	servingZones,
	mkSOA,
	writeZoneFile,
	nextSerialNumber,
	adjustSerialNumber,
	serialNumberOffset,
) 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

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.
--
-- 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.
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
	, 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 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 soa l) f = Zone 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))
		(succ 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"

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 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

-- | 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
genZone hosts domain soa = Zone soa zhosts
  where
	zhosts = undefined -- TODO