summaryrefslogtreecommitdiff
path: root/Propellor/Property/Dns.hs
blob: 5b4b26227d72ebab40c98d04eac285b80bc8c8b0 (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
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
import Utility.Applicative

import Data.List

namedconf :: FilePath
namedconf = "/etc/bind/named.conf.local"

data NamedConf = NamedConf
	{ zdomain :: Domain
	, ztype :: Type
	, zfile :: FilePath
	, zmasters :: [IPAddr]
	, zconfiglines :: [String]
	}

zoneDesc :: NamedConf -> String
zoneDesc z = zdomain z ++ " (" ++ show (ztype z) ++ ")"

type IPAddr = String

type Domain = String

data Type = Master | Secondary
	deriving (Show, Eq)

secondary :: Domain -> [IPAddr] -> NamedConf
secondary domain masters = NamedConf
	{ zdomain = domain
	, ztype = Secondary
	, zfile = "db." ++ domain
	, zmasters = masters
	, zconfiglines = ["allow-transfer { }"]
	}

zoneStanza :: NamedConf -> [Line]
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.
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