Report when users' ~/.domtool directories are unreadable
[hcoop/domtool2.git] / src / plugins / bind.sml
CommitLineData
6ae327f8
AC
1(* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006, Adam Chlipala
3 *
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
17 *)
18
19(* BIND DNS *)
20
21structure Bind :> BIND = struct
22
23open Ast
24
25val namedChanged = ref false
26val zoneChanged = ref false
27
28val didDomain = ref ""
29
30val () = Slave.registerPreHandler (fn () => (namedChanged := false;
31 zoneChanged := false;
32 didDomain := ""))
33
fa3b6b87 34val dns : Domain.files option ref = ref NONE
6ae327f8
AC
35
36val _ = Domain.registerBefore
fa3b6b87
AC
37 (fn _ => dns := Option.map (fn node => Domain.domainsFile {node = node,
38 name = "dns"})
e0b0abd2 39 (Domain.dnsMaster ()))
6ae327f8
AC
40
41val _ = Domain.registerAfter
fa3b6b87 42 (fn _ => (Option.app (fn files => #close files ()) (!dns);
325285ab 43 dns := NONE))
6ae327f8
AC
44
45val dl = ErrorMsg.dummyLoc
46
47datatype dns_record =
48 A of string * string
49 | CNAME of string * string
50 | MX of int * string
51 | NS of string
6eeb3bf9 52 | DefaultA of string
090692f7
AC
53 | AAAA of string * string
54 | DefaultAAAA of string
f2cf641d 55 | TXT of string * string
6ae327f8
AC
56
57val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
97665758 58 (case (Env.string e1, Domain.ip e2) of
6ae327f8
AC
59 (SOME v1, SOME v2) => SOME (A (v1, v2))
60 | _ => NONE)
61 | (EApp ((EApp ((EVar "dnsCNAME", _), e1), _), e2), _) =>
62 (case (Env.string e1, Env.string e2) of
63 (SOME v1, SOME v2) => SOME (CNAME (v1, v2))
64 | _ => NONE)
65 | (EApp ((EApp ((EVar "dnsMX", _), e1), _), e2), _) =>
66 (case (Env.int e1, Env.string e2) of
67 (SOME v1, SOME v2) => SOME (MX (v1, v2))
68 | _ => NONE)
69 | (EApp ((EVar "dnsNS", _), e), _) =>
70 Option.map NS (Env.string e)
6eeb3bf9 71 | (EApp ((EVar "dnsDefaultA", _), e), _) =>
090692f7
AC
72 Option.map DefaultA (Domain.ip e)
73 | (EApp ((EApp ((EVar "dnsAAAA", _), e1), _), e2), _) =>
74 (case (Env.string e1, Env.string e2) of
75 (SOME v1, SOME v2) => SOME (AAAA (v1, v2))
76 | _ => NONE)
77 | (EApp ((EVar "dnsDefaultAAAA", _), e), _) =>
78 Option.map DefaultAAAA (Env.string e)
f2cf641d
AC
79 | (EApp ((EApp ((EVar "dnsTXT", _), e1), _), e2), _) =>
80 (case (Env.string e1, Env.string e2) of
81 (SOME v1, SOME v2) => SOME (TXT (v1, v2))
82 | _ => NONE)
6ae327f8
AC
83 | _ => NONE
84
85fun writeRecord (evs, r) =
e0b0abd2 86 case !dns of
cf283351
AC
87 NONE => print ("Warning: DNS directive for " ^ Domain.currentDomain ()
88 ^ " ignored because no master DNS server is configured for this domain\n")
fa3b6b87 89 | SOME files =>
e0b0abd2 90 let
fa3b6b87
AC
91 fun write s = #write files s
92 fun writeDom () = #writeDom files ()
e0b0abd2
AC
93 val ttl = Env.env Env.int (evs, "TTL")
94 in
95 case r of
96 A (from, to) => (write from;
6ae327f8 97 write ".";
fa3b6b87 98 writeDom ();
6ae327f8
AC
99 write ".\t";
100 write (Int.toString ttl);
e0b0abd2 101 write "\tIN\tA\t";
6ae327f8 102 write to;
e0b0abd2 103 write "\n")
6eeb3bf9
AC
104 | DefaultA to => (writeDom ();
105 write ".\t";
106 write (Int.toString ttl);
107 write "\tIN\tA\t";
108 write to;
109 write "\n")
e0b0abd2
AC
110 | CNAME (from, to) => (write from;
111 write ".";
fa3b6b87 112 writeDom ();
e0b0abd2
AC
113 write ".\t";
114 write (Int.toString ttl);
115 write "\tIN\tCNAME\t";
116 write to;
117 write ".\n")
ec554091
AC
118 | MX (num, host) => (writeDom ();
119 write ".\t";
e0b0abd2
AC
120 write (Int.toString ttl);
121 write "\tIN\tMX\t";
122 write (Int.toString num);
123 write "\t";
124 write host;
125 write ".\n")
ec554091
AC
126 | NS host => (writeDom ();
127 write ".\t";
e0b0abd2
AC
128 write (Int.toString ttl);
129 write "\tIN\tNS\t";
130 write host;
131 write ".\n")
090692f7
AC
132 | AAAA (from, to) => (write from;
133 write ".";
134 writeDom ();
135 write ".\t";
136 write (Int.toString ttl);
137 write "\tIN\tAAAA\t";
138 write to;
139 write "\n")
140 | DefaultAAAA to => (writeDom ();
141 write ".\t";
142 write (Int.toString ttl);
143 write "\tIN\tAAAA\t";
144 write to;
145 write "\n")
f2cf641d
AC
146 | TXT (from, to) => (write from;
147 write ".";
148 writeDom ();
149 write ".\t";
150 write (Int.toString ttl);
151 write "\tIN\tTXT\t\"";
152 write (String.translate (fn #"\"" => "\\\"" | ch => str ch) to);
153 write "\"\n")
e0b0abd2 154 end
6ae327f8
AC
155
156val () = Env.actionV_one "dns"
157 ("record", record)
158 writeRecord
159
160fun readLine inf =
161 case TextIO.inputLine inf of
162 NONE => raise Fail "Expected a line for BIND"
163 | SOME s => String.substring (s, 0, size s - 1)
164
165fun readILine inf = valOf (Int.fromString (readLine inf))
166
3f07a40e
AC
167val monthToInt = fn Date.Jan => 1
168 | Date.Feb => 2
169 | Date.Mar => 3
170 | Date.Apr => 4
171 | Date.May => 5
172 | Date.Jun => 6
173 | Date.Jul => 7
174 | Date.Aug => 8
175 | Date.Sep => 9
176 | Date.Oct => 10
177 | Date.Nov => 11
178 | Date.Dec => 12
179
180fun padBy ch amt s =
181 if size s < amt then
82a0d609 182 CharVector.tabulate (amt - size s, fn _ => ch) ^ s
3f07a40e
AC
183 else
184 s
185
186fun dateString () =
187 let
188 val date = Date.fromTimeUniv (Time.now ())
189 in
190 padBy #"0" 4 (Int.toString (Date.year date))
191 ^ padBy #"0" 2 (Int.toString (monthToInt (Date.month date)))
192 ^ padBy #"0" 2 (Int.toString (Date.day date))
193 end
194
6ae327f8
AC
195val () = Slave.registerFileHandler (fn fs =>
196 let
197 val {dir, file} = OS.Path.splitDirFile (#file fs)
198
199 fun dnsChanged () =
200 if #domain fs = !didDomain then
201 ()
1638d5a2 202 else if Slave.isDelete (#action fs) then
6ae327f8
AC
203 let
204 val fname = OS.Path.joinBaseExt {base = #domain fs,
205 ext = SOME "zone"}
206 val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath,
207 file = fname}
208 in
325285ab
AC
209 Slave.shellF ([Config.rm, " -f ", fname],
210 fn cl => "Error deleting file: " ^ cl)
6ae327f8
AC
211 end
212 else
213 let
214 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = #dir fs,
215 file = "soa"})
216 val kind = readLine inf
217 val ttl = readILine inf
218 val ns = readLine inf
219 val serial = case readLine inf of
220 "" => NONE
221 | s => Int.fromString s
222 val rf = readILine inf
223 val ret = readILine inf
224 val exp = readILine inf
225 val min = readILine inf
226 val () = TextIO.closeIn inf
227
82a0d609
AC
228 val serialPath = OS.Path.joinDirFile {dir = Config.serialDir,
229 file = #domain fs}
230
3f07a40e 231 val oldSerial = let
82a0d609 232 val inf = TextIO.openIn serialPath
3f07a40e
AC
233 in
234 SOME (readLine inf)
235 before TextIO.closeIn inf
82a0d609 236 end handle IO.Io {name, ...} => NONE
3f07a40e
AC
237
238 val newSerial =
239 case serial of
240 SOME n => Int.toString n
241 | NONE =>
242 let
243 val prefix = dateString ()
244 in
245 prefix
246 ^ (case oldSerial of
247 NONE => "00"
248 | SOME old =>
249 if size old >= 8 andalso
250 String.substring (old, 0, 8) = prefix then
251 case Int.fromString (String.extract (old, 8, NONE)) of
252 NONE => "00"
253 | SOME old => padBy #"0" 2 (Int.toString (old+1))
254 else
255 "00")
256 end
257
82a0d609 258 val outf = TextIO.openOut serialPath
3f07a40e
AC
259 val _ = TextIO.output (outf, newSerial)
260 val _ = TextIO.closeOut outf
261
6ae327f8
AC
262 val dns = OS.Path.joinDirFile {dir = #dir fs,
263 file = "dns"}
264
265 val fname = OS.Path.joinBaseExt {base = #domain fs,
266 ext = SOME "zone"}
267 val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath,
268 file = fname}
269
270 val outf = TextIO.openOut fname
271 in
272 zoneChanged := true;
273 TextIO.output (outf, "$TTL ");
274 TextIO.output (outf, Int.toString ttl);
275 TextIO.output (outf, "\n\n@\tIN\tSOA\t");
276 TextIO.output (outf, ns);
277 TextIO.output (outf, ".\thostmaster.");
278 TextIO.output (outf, #domain fs);
722e651b 279 TextIO.output (outf, ". ( ");
3f07a40e 280 TextIO.output (outf, newSerial);
6ae327f8
AC
281 TextIO.output (outf, " ");
282 TextIO.output (outf, Int.toString rf);
283 TextIO.output (outf, " ");
284 TextIO.output (outf, Int.toString ret);
285 TextIO.output (outf, " ");
286 TextIO.output (outf, Int.toString exp);
287 TextIO.output (outf, " ");
288 TextIO.output (outf, Int.toString min);
289 TextIO.output (outf, " )\n\n");
290 TextIO.closeOut outf;
325285ab
AC
291 if Posix.FileSys.access (dns, []) then
292 Slave.shellF ([Config.cat, " ", dns, " >>", fname],
293 fn cl => "Error concatenating file: " ^ cl)
294 else
295 ();
6ae327f8
AC
296 didDomain := #domain fs
297 end
298 in
299 case file of
300 "soa" => dnsChanged ()
301 | "dns" => dnsChanged ()
302 | "named.conf" => namedChanged := true
303 | _ => ()
304 end)
305
306val () = Slave.registerPostHandler
307 (fn () =>
308 (if !namedChanged then
309 Slave.concatTo (fn s => s = "named.conf") Config.Bind.namedConf
310 else
311 ();
312 if !namedChanged orelse !zoneChanged then
313 Slave.shellF ([Config.Bind.reload],
314 fn cl => "Error reloading bind with " ^ cl)
315 else
316 ()))
71420f8b
AC
317
318val () = Domain.registerResetLocal (fn () =>
319 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/zones/*")))
320
41c58daf
AC
321val () = Domain.registerDescriber (Domain.considerAll
322 [Domain.Filename {filename = "named.conf",
d936cf4d 323 heading = "named.conf addition:",
41c58daf
AC
324 showEmpty = false},
325 Domain.Filename {filename = "dns",
d936cf4d 326 heading = "DNS zonefile contents:",
41c58daf
AC
327 showEmpty = false}])
328
6ae327f8 329end