HCoop / hcoop / zz_old / domtool.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Better checking of Block arguments
[hcoop/zz_old/domtool.git] / src / djbdns / djbdns.sml
CommitLineData
182a2654
AC		 1(*
2Domtool (http://hcoop.sf.net/)
3Copyright (C) 2004 Adam Chlipala
4
5This program is free software; you can redistribute it and/or
6modify it under the terms of the GNU General Public License
7as published by the Free Software Foundation; either version 2
8of the License, or (at your option) any later version.
9
10This program is distributed in the hope that it will be useful,
11but WITHOUT ANY WARRANTY; without even the implied warranty of
12MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13GNU General Public License for more details.
14
15You should have received a copy of the GNU General Public License
16along with this program; if not, write to the Free Software
17Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
18*)
19
20(* Djbdns DNS mapping config *)
21
22structure Djbdns :> DJBDNS =
23struct
24 open Config DjbdnsConfig Util
25
26 val ldHandler = ref (fn _ : string => ())
27 fun setLocalDomainHandler f = ldHandler := f
28
5958a619
AC		 29 val relayingHandler = ref (fn _ : string => ())
30 fun setRelayingDomainHandler f = relayingHandler := f
31
182a2654
AC		 32 val dns = ref (NONE : TextIO.outstream option)
33
d1c1f370
AC		 34 fun init () =
35 (dns := SOME (TextIO.openOut (scratchDir ^ "/data.shared"));
5958a619
AC		 36 ignore (OS.Process.system ("cd /tmp; " ^ rm ^ " -rf " ^ scratchDir ^ "/slaves/*"));
37 ignore (OS.Process.system ("cd /tmp; " ^ rm ^ " -rf " ^ afxrSlavesTemp));
38 ignore (OS.Process.system (mkdir ^ " " ^ afxrSlavesTemp)))
182a2654
AC		 39 fun finish () = (TextIO.closeOut (valOf (!dns));
40 dns := NONE)
41
c79bcdbc 42 fun handler (data : Domtool.handlerData) =
182a2654 43 let
c79bcdbc 44 val path = #path data
d1c1f370 45 val domain = String.extract (#domain data, 5, NONE)
c79bcdbc
AC		 46 val parent = #parent data
47 val vars = #vars data
48 val mxs = #mxs data
d1c1f370 49 val slaves = #slaves data
2869e20a 50 val nses = #nses data
c79bcdbc 51
182a2654
AC		 52 val _ = Domtool.dprint ("Reading dns " ^ path ^ " for " ^ parent ^ "....")
53
54 val dns = valOf (!dns)
55
56 val al = TextIO.openIn path
57
5b6173bf 58 val hasNs = ref false
182a2654 59 val hasEmail = ref false
5958a619
AC		 60 val hasRelaying = ref false
61 val isSlave = ref false
182a2654 62
5958a619 63 fun loop (line, (slaveDirs, mxnum, chans, ttl)) =
182a2654 64 let
d1c1f370 65 fun writeDns s =
5958a619
AC		 66 if !isSlave then
67 ()
68 else
69 app (fn ch => TextIO.output (ch, s)) chans
d1c1f370 70
182a2654 71 fun err () = (Domtool.error (path, "Invalid entry: " ^ trimLast line);
5958a619 72 (slaveDirs, mxnum, chans, ttl))
182a2654
AC		 73 in
74 case String.tokens Char.isSpace line of
5958a619
AC		 75 [] => (slaveDirs, mxnum, chans, ttl)
76 | ["Master", addr] =>
77 (case resolveAddr (vars, addr) of
78 "" => err ()
79 | addr =>
80 (isSlave := true;
81 app (fn slaveDir =>
82 ignore (OS.Process.system (echo ^ " " ^ addr ^ " >> " ^ slaveDir ^ "/slaves/" ^ parent)))
83 slaveDirs;
84 TextIO.output (dns, "# Master for " ^ parent ^ ": " ^ addr ^ "\n");
85 ignore (OS.Process.system (echo ^ " " ^ addr ^ " >> " ^ afxrSlavesTemp ^ "/" ^ parent));
86 (slaveDirs, mxnum, chans, ttl)))
87 | ["TTL", "default"] => (slaveDirs, mxnum, chans, "")
5ef1f511
AC		 88 | ["TTL", n] =>
89 (case Int.fromString n of
90 NONE => err ()
91 | SOME n' =>
92 if n' >= minTTL then
5958a619 93 (slaveDirs, mxnum, chans, ":" ^ n)
5ef1f511
AC		 94 else
95 err ())
182a2654
AC		 96 | ["Default", addr] =>
97 (case resolveAddr (vars, addr) of
98 "" => err ()
5ef1f511 99 | addr => (writeDns ("=" ^ parent ^ ":" ^ addr ^ ttl ^ "\n");
5958a619 100 (slaveDirs, mxnum, chans, ttl)))
874b616a 101 | ["Mail", host] =>
036701c8 102 (if validDomainUC host then
f6883eac 103 (writeDns ("@" ^ parent ^ "::" ^ host ^ ":" ^ Int.toString mxnum ^ ttl ^ "\n");
5958a619 104 (slaveDirs, mxnum+1, chans, ttl))
874b616a
AC		 105 else
106 err ())
5958a619
AC		 107 | ["BackupMail", host, addr] =>
108 (case resolveAddr (vars, addr) of
109 "" => err ()
110 | addr =>
111 (if not (!hasRelaying) andalso member (addr, localMailIps) then
112 (hasRelaying := true;
113 !relayingHandler parent)
114 else
115 ();
116 if validHost host then
117 (writeDns ("@" ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ ":" ^ Int.toString mxnum ^ ttl ^ "\n");
118 (slaveDirs, mxnum+1, chans, ttl))
119 else
120 err ()))
d1c1f370
AC		 121 | ["Slave", slave] =>
122 (case StringMap.find (slaves, slave) of
123 NONE => (Domtool.error ("Unknown slave " ^ slave ^ " in", path);
5958a619
AC		 124 (slaveDirs, mxnum, chans, ttl))
125 | SOME addrs =>
126 case String.fields (fn ch => ch = #";") addrs of
127 [addr, saddr] =>
128 let
129 val slaveDir = scratchDir ^ "/slaves/" ^ slave
130
131 val _ = if Posix.FileSys.access (slaveDir, []) then
132 ()
133 else
134 (Posix.FileSys.mkdir (slaveDir, Posix.FileSys.S.irwxu);
135 Posix.FileSys.mkdir (slaveDir ^ "/slaves", Posix.FileSys.S.irwxu))
136
137 val domFile = slaveDir ^ "/" ^ domain ^ ".dns"
138
139 val dest = TextIO.openOut (slaveDir ^ "/destination")
140 val _ = TextIO.output (dest, addr)
141 val _ = TextIO.closeOut dest
142
143 val dest = TextIO.openOut (slaveDir ^ "/slaves_destination")
144 val _ = TextIO.output (dest, saddr)
145 val _ = TextIO.closeOut dest
7259b84e 146
5958a619
AC		 147 val chan = TextIO.openOut domFile
148 in
149 writeDns ("# " ^ domain ^ " Slave " ^ slave ^ "\n");
150 (slaveDir :: slaveDirs, mxnum, chan :: chans, ttl)
151 end
152 | _ => (Domtool.error ("Bad slave format", path);
153 (slaveDirs, mxnum, chans, ttl)))
2869e20a
AC		 154 | ["Primary", host] =>
155 (case StringMap.find (nses, host) of
156 NONE => (Domtool.error ("Unknown outside name server: " ^ host, path);
157 (slaveDirs, mxnum, chans, ttl))
5b6173bf
AC		 158 | SOME addr => (hasNs := true;
159 writeDns ("." ^ parent ^ ":" ^ addr ^ ":" ^ host ^ ttl ^ "\n");
2869e20a
AC		 160 (slaveDirs, mxnum, chans, ttl)))
161 | ["Secondary", host] =>
162 (case StringMap.find (nses, host) of
163 NONE => (Domtool.error ("Unknown outside name server: " ^ host, path);
164 (slaveDirs, mxnum, chans, ttl))
5b6173bf
AC		 165 | SOME addr => (hasNs := true;
166 writeDns ("&" ^ parent ^ ":" ^ addr ^ ":" ^ host ^ ttl ^ "\n");
2869e20a 167 (slaveDirs, mxnum, chans, ttl)))
182a2654
AC		 168 | [ty, host, addr] =>
169 let
170 val pre =
171 (case ty of
5b6173bf
AC		 172 "Primary" => (hasNs := true; ".")
173 | "Secondary" => (hasNs := true; "&")
182a2654
AC		 174 | "Host" => "="
175 | "Alias" => "+"
176 | "Mail" => "@"
177 | "Redir" => "C"
178 | _ => "")
179 in
180 if pre = "C" then
181 (case resolveDomain (vars, addr) of
182 "" => err ()
183 | host' =>
184 if validHost host then
5ef1f511 185 (writeDns (pre ^ host ^ "." ^ parent ^ ":" ^ host' ^ ttl ^ "\n");
5958a619 186 (slaveDirs, mxnum, chans, ttl))
182a2654
AC		 187 else
188 err ())
189 else case (resolveAddr (vars, addr), pre) of
190 ("", _) => err ()
191 | (addr, ".") =>
192 if validHost host then
5ef1f511 193 (writeDns (pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ ttl ^ "\n");
5958a619 194 (slaveDirs, mxnum, chans, ttl))
182a2654
AC		 195 else
196 err ()
197 | (addr, "&") =>
198 if validHost host then
5ef1f511 199 (writeDns (pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ ttl ^ "\n");
5958a619 200 (slaveDirs, mxnum, chans, ttl))
182a2654
AC		 201 else
202 err ()
203 | (addr, "@") =>
5958a619 204 (if not (!hasEmail) andalso member (addr, localMailIps) then
182a2654
AC		 205 (hasEmail := true;
206 !ldHandler parent)
207 else
208 ();
874b616a 209 if validHost host then
5ef1f511 210 (writeDns (pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ ":" ^ Int.toString mxnum ^ ttl ^ "\n");
5958a619 211 (slaveDirs, mxnum+1, chans, ttl))
874b616a
AC		 212 else
213 err ())
182a2654
AC		 214 | (addr, "=") =>
215 if validHost host then
5ef1f511 216 (writeDns (pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ ttl ^ "\n");
5958a619 217 (slaveDirs, mxnum, chans, ttl))
182a2654
AC		 218 else
219 err ()
220 | (addr, "+") =>
221 if validHost host then
5ef1f511 222 (writeDns (pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ ttl ^ "\n");
5958a619 223 (slaveDirs, mxnum, chans, ttl))
182a2654
AC		 224 else
225 err ()
226 | _ => err ()
227 end
228 | _ => err ()
229 end
d1c1f370
AC		 230
231 fun closeChans chans =
232 case chans of
233 [] => raise Fail "closeChans should never reach an empty list!"
234 | [_] => ()
235 | chan::chans =>
236 (TextIO.closeOut chan;
237 closeChans chans)
238
5b6173bf
AC		 239 val (slaveDirs, _, chans, ttl) = ioOptLoopFold (fn () => Domtool.inputLine al) loop ([], 0, [dns], "")
240
241 fun writeDns s =
242 if !isSlave then
243 ()
244 else
245 app (fn ch => TextIO.output (ch, s)) chans
182a2654 246 in
5b6173bf
AC		 247 if !hasNs then
248 ()
249 else
250 (writeDns ("." ^ parent ^ "::ns.hcoop.net" ^ ttl ^ "\n");
251 writeDns ("&" ^ parent ^ "::ns2.hcoop.net" ^ ttl ^ "\n"));
d1c1f370 252 closeChans chans;
182a2654 253 TextIO.closeIn al
c79bcdbc 254 end handle ex => Domtool.handleException (#path data, ex)
182a2654
AC		 255
256 fun publish () =
257 if OS.Process.isSuccess (OS.Process.system
d1c1f370 258 (diff ^ " " ^ scratchDir ^ "/data.shared " ^ dataFile)) then
182a2654 259 OS.Process.success
5958a619
AC		 260 else if not (OS.Process.isSuccess (OS.Process.system
261 (rm ^ " -rf " ^ afxrSlaves ^ "; " ^ mv ^ " -f " ^ afxrSlavesTemp ^ " " ^ afxrSlaves))) then
262 (print "Error copying AFXR slaves\n";
263 OS.Process.failure)
7000a4d3 264 else if not (OS.Process.isSuccess (OS.Process.system
5958a619
AC		 265 (chown ^ " -R root.root " ^ afxrSlaves))) then
266 (print "Error chown'ing AFXR slaves\n";
7000a4d3 267 OS.Process.failure)
182a2654 268 else if not (OS.Process.isSuccess (OS.Process.system
d1c1f370 269 (cp ^ " " ^ scratchDir ^ "/data.shared " ^ dataFile))) then
182a2654
AC		 270 (print "Error copying data.shared\n";
271 OS.Process.failure)
d1c1f370 272 else if not (OS.Process.isSuccess (OS.Process.system pubCommand)) then
182a2654
AC		 273 (print "Error publishing data.shared\n";
274 OS.Process.failure)
d1c1f370
AC		 275 else
276 let
277 val slaveDir = scratchDir ^ "/slaves"
278 val dir = Posix.FileSys.opendir slaveDir
279
280 fun doEntry (name, ()) =
281 let
282 val fullName = slaveDir ^ "/" ^ name
283 val st = Posix.FileSys.stat fullName
284 in
285 if Posix.FileSys.ST.isDir st then
c6544086
AC		 286 ()
287 (*if OS.Process.isSuccess (OS.Process.system (rsync ^ " -az --delete " ^ fullName ^ "/*.dns `" ^ cat ^ " " ^ fullName ^ "/destination`")) then
5958a619
AC		 288 if OS.Process.isSuccess (OS.Process.system (rsync ^ " -az --delete " ^ fullName ^ "/slaves/* `" ^ cat ^ " " ^ fullName ^ "/slaves_destination`")) then
289 ()
290 else
291 print ("Error sending sub-slaves to slave " ^ name ^ "\n")
d1c1f370 292 else
c6544086 293 print ("Error sending to slave " ^ name ^ "\n")*)
d1c1f370
AC		 294 else
295 ()
296 end
297 in
298 ioOptLoop (fn () => Posix.FileSys.readdir dir) doEntry ();
299 Posix.FileSys.closedir dir;
300 OS.Process.success
301 end
302
182a2654
AC		 303 fun mkdom {path, ...} = OS.Process.system (cp ^ " " ^ defaultFile ^ " " ^ path ^ "/.dns")
304
305 val _ = Domtool.setHandler (".dns", {init = init,
306 file = handler,
307 finish = finish,
308 publish = publish,
309 mkdom = mkdom})
310end
Unnamed repository; edit this file to name it for gitweb.