ip_of_node support
[hcoop/domtool2.git] / src / plugins / bind.sml
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
21 structure Bind :> BIND = struct
22
23 open Ast
24
25 val namedChanged = ref false
26 val zoneChanged = ref false
27
28 val didDomain = ref ""
29
30 val () = Slave.registerPreHandler (fn () => (namedChanged := false;
31 zoneChanged := false;
32 didDomain := ""))
33
34 val dns : TextIO.outstream option ref = ref NONE
35
36 val _ = Domain.registerBefore
37 (fn _ => dns := Option.map (fn node => Domain.domainFile {node = node,
38 name = "dns"})
39 (Domain.dnsMaster ()))
40
41 val _ = Domain.registerAfter
42 (fn _ => (Option.app TextIO.closeOut (!dns);
43 dns := NONE))
44
45 val dl = ErrorMsg.dummyLoc
46
47 datatype dns_record =
48 A of string * string
49 | CNAME of string * string
50 | MX of int * string
51 | NS of string
52
53 val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
54 (case (Env.string e1, Domain.ip e2) of
55 (SOME v1, SOME v2) => SOME (A (v1, v2))
56 | _ => NONE)
57 | (EApp ((EApp ((EVar "dnsCNAME", _), e1), _), e2), _) =>
58 (case (Env.string e1, Env.string e2) of
59 (SOME v1, SOME v2) => SOME (CNAME (v1, v2))
60 | _ => NONE)
61 | (EApp ((EApp ((EVar "dnsMX", _), e1), _), e2), _) =>
62 (case (Env.int e1, Env.string e2) of
63 (SOME v1, SOME v2) => SOME (MX (v1, v2))
64 | _ => NONE)
65 | (EApp ((EVar "dnsNS", _), e), _) =>
66 Option.map NS (Env.string e)
67 | _ => NONE
68
69 fun writeRecord (evs, r) =
70 case !dns of
71 NONE => print "Warning: DNS directive ignored because no master DNS server is configured for this domain\n"
72 | SOME file =>
73 let
74 fun write s = TextIO.output (file, s)
75 val ttl = Env.env Env.int (evs, "TTL")
76 in
77 case r of
78 A (from, to) => (write from;
79 write ".";
80 write (Domain.currentDomain ());
81 write ".\t";
82 write (Int.toString ttl);
83 write "\tIN\tA\t";
84 write to;
85 write "\n")
86 | CNAME (from, to) => (write from;
87 write ".";
88 write (Domain.currentDomain ());
89 write ".\t";
90 write (Int.toString ttl);
91 write "\tIN\tCNAME\t";
92 write to;
93 write ".\n")
94 | MX (num, host) => (write "\t";
95 write (Int.toString ttl);
96 write "\tIN\tMX\t";
97 write (Int.toString num);
98 write "\t";
99 write host;
100 write ".\n")
101 | NS host => (write "\t";
102 write (Int.toString ttl);
103 write "\tIN\tNS\t";
104 write host;
105 write ".\n")
106 end
107
108 val () = Env.actionV_one "dns"
109 ("record", record)
110 writeRecord
111
112 fun readLine inf =
113 case TextIO.inputLine inf of
114 NONE => raise Fail "Expected a line for BIND"
115 | SOME s => String.substring (s, 0, size s - 1)
116
117 fun readILine inf = valOf (Int.fromString (readLine inf))
118
119 val () = Slave.registerFileHandler (fn fs =>
120 let
121 val {dir, file} = OS.Path.splitDirFile (#file fs)
122
123 fun dnsChanged () =
124 if #domain fs = !didDomain then
125 ()
126 else if #action fs = Slave.Delete then
127 let
128 val fname = OS.Path.joinBaseExt {base = #domain fs,
129 ext = SOME "zone"}
130 val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath,
131 file = fname}
132 in
133 Slave.shellF ([Config.rm, " -f ", fname],
134 fn cl => "Error deleting file: " ^ cl)
135 end
136 else
137 let
138 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = #dir fs,
139 file = "soa"})
140 val kind = readLine inf
141 val ttl = readILine inf
142 val ns = readLine inf
143 val serial = case readLine inf of
144 "" => NONE
145 | s => Int.fromString s
146 val rf = readILine inf
147 val ret = readILine inf
148 val exp = readILine inf
149 val min = readILine inf
150 val () = TextIO.closeIn inf
151
152 val dns = OS.Path.joinDirFile {dir = #dir fs,
153 file = "dns"}
154
155 val fname = OS.Path.joinBaseExt {base = #domain fs,
156 ext = SOME "zone"}
157 val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath,
158 file = fname}
159
160 val outf = TextIO.openOut fname
161 in
162 zoneChanged := true;
163 TextIO.output (outf, "$TTL ");
164 TextIO.output (outf, Int.toString ttl);
165 TextIO.output (outf, "\n\n@\tIN\tSOA\t");
166 TextIO.output (outf, ns);
167 TextIO.output (outf, ".\thostmaster.");
168 TextIO.output (outf, #domain fs);
169 TextIO.output (outf, ".\n( ");
170 TextIO.output (outf, Int.toString 123456789);
171 TextIO.output (outf, " ");
172 TextIO.output (outf, Int.toString rf);
173 TextIO.output (outf, " ");
174 TextIO.output (outf, Int.toString ret);
175 TextIO.output (outf, " ");
176 TextIO.output (outf, Int.toString exp);
177 TextIO.output (outf, " ");
178 TextIO.output (outf, Int.toString min);
179 TextIO.output (outf, " )\n\n");
180 TextIO.closeOut outf;
181 if Posix.FileSys.access (dns, []) then
182 Slave.shellF ([Config.cat, " ", dns, " >>", fname],
183 fn cl => "Error concatenating file: " ^ cl)
184 else
185 ();
186 didDomain := #domain fs
187 end
188 in
189 case file of
190 "soa" => dnsChanged ()
191 | "dns" => dnsChanged ()
192 | "named.conf" => namedChanged := true
193 | _ => ()
194 end)
195
196 val () = Slave.registerPostHandler
197 (fn () =>
198 (if !namedChanged then
199 Slave.concatTo (fn s => s = "named.conf") Config.Bind.namedConf
200 else
201 ();
202 if !namedChanged orelse !zoneChanged then
203 Slave.shellF ([Config.Bind.reload],
204 fn cl => "Error reloading bind with " ^ cl)
205 else
206 ()))
207 end