HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Start of DBMS support
[hcoop/domtool2.git] / src / domain.sml
CommitLineData
a3698041
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.
dac62e84 17 *)
a3698041
AC		 18
19(* Domain-related primitive actions *)
20
21structure Domain :> DOMAIN = struct
22
36e42cb8
AC		 23open MsgTypes
24
2ed6d0e5 25structure SM = DataStructures.StringMap
12adf55a 26structure SS = DataStructures.StringSet
2ed6d0e5 27
36e42cb8
AC		 28val ssl_context = ref (NONE : OpenSSL.context option)
29fun set_context ctx = ssl_context := SOME ctx
30
12adf55a 31val nodes = map #1 Config.nodeIps
2ed6d0e5
AC		 32val nodeMap = foldl (fn ((node, ip), mp) => SM.insert (mp, node, ip))
33 SM.empty Config.nodeIps
8a7c40fa 34fun nodeIp node = valOf (SM.find (nodeMap, node))
2ed6d0e5 35
12adf55a 36val usr = ref ""
12adf55a
AC		 37fun getUser () = !usr
38
39val your_doms = ref SS.empty
40fun your_domains () = !your_doms
41
8a7c40fa
AC		 42val your_usrs = ref SS.empty
43fun your_users () = !your_usrs
44
45val your_grps = ref SS.empty
46fun your_groups () = !your_grps
47
48val your_pths = ref SS.empty
49fun your_paths () = !your_pths
50
aa56e112 51fun setUser user =
a088cea6 52 (usr := user;
aa56e112
AC		 53 your_doms := Acl.class {user = getUser (),
54 class = "domain"};
55 your_usrs := Acl.class {user = getUser (),
56 class = "user"};
57 your_grps := Acl.class {user = getUser (),
58 class = "group"};
59 your_pths := Acl.class {user = getUser (),
60 class = "path"})
61
6ae327f8
AC		 62fun validIp s =
63 case map Int.fromString (String.fields (fn ch => ch = #".") s) of
64 [SOME n1, SOME n2, SOME n3, SOME n4] =>
65 n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
66 | _ => false
67
629a34f6
AC		 68fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
69
70fun validHost s =
71 size s > 0 andalso size s < 20
72 andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
73
74fun validDomain s =
75 size s > 0 andalso size s < 100
76 andalso List.all validHost (String.fields (fn ch => ch = #".") s)
77
2ed6d0e5 78fun validNode s = List.exists (fn s' => s = s') nodes
e0b0abd2 79
12adf55a 80fun yourDomain s = SS.member (your_domains (), s)
8a7c40fa
AC		 81fun yourUser s = SS.member (your_users (), s)
82fun yourGroup s = SS.member (your_groups (), s)
83fun yourPath path =
84 List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path)
85 andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"/"
86 orelse ch = #"-" orelse ch = #"_") path
87 andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (your_paths ())
12adf55a 88
edd38024 89fun yourDomainHost s =
c98b57cf
AC		 90 yourDomain s
91 orelse let
edd38024
AC		 92 val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
93 in
edd38024
AC		 94 Substring.size suf > 0
95 andalso validHost (Substring.string pref)
96 andalso yourDomain (Substring.string
c98b57cf 97 (Substring.slice (suf, 1, NONE)))
edd38024
AC		 98 end
99
93c2f623
AC		 100val yourDomain = yourDomainHost
101
2aeb9eec
AC		 102fun validUser s = size s > 0 andalso size s < 20
103 andalso CharVector.all Char.isAlphaNum s
104
105val validGroup = validUser
106
f8dfbbcc
AC		 107val _ = Env.type_one "no_spaces"
108 Env.string
109 (CharVector.all (fn ch => not (Char.isSpace ch)))
d5754b53
AC		 110val _ = Env.type_one "no_newlines"
111 Env.string
112 (CharVector.all (fn ch => ch <> #"\n" andalso ch <> #"\r"))
f8dfbbcc 113
6ae327f8
AC		 114val _ = Env.type_one "ip"
115 Env.string
116 validIp
117
629a34f6
AC		 118val _ = Env.type_one "host"
119 Env.string
120 validHost
121
122val _ = Env.type_one "domain"
123 Env.string
124 validDomain
125
12adf55a
AC		 126val _ = Env.type_one "your_domain"
127 Env.string
128 yourDomain
129
edd38024
AC		 130val _ = Env.type_one "your_domain_host"
131 Env.string
132 yourDomainHost
133
2aeb9eec
AC		 134val _ = Env.type_one "user"
135 Env.string
136 validUser
137
138val _ = Env.type_one "group"
139 Env.string
140 validGroup
141
8a7c40fa
AC		 142val _ = Env.type_one "your_user"
143 Env.string
144 yourUser
145
146val _ = Env.type_one "your_group"
147 Env.string
148 yourGroup
149
150val _ = Env.type_one "your_path"
151 Env.string
152 yourPath
153
e0b0abd2
AC		 154val _ = Env.type_one "node"
155 Env.string
156 validNode
157
bbdf617f
AC		 158val _ = Env.registerFunction ("dns_node_to_node",
159 fn [e] => SOME e
160 | _ => NONE)
161
162val _ = Env.registerFunction ("mail_node_to_node",
be1bea4c
AC		 163 fn [e] => SOME e
164 | _ => NONE)
a3698041
AC		 165open Ast
166
6ae327f8
AC		 167val dl = ErrorMsg.dummyLoc
168
169val nsD = (EString Config.defaultNs, dl)
170val serialD = (EVar "serialAuto", dl)
171val refD = (EInt Config.defaultRefresh, dl)
172val retD = (EInt Config.defaultRetry, dl)
173val expD = (EInt Config.defaultExpiry, dl)
174val minD = (EInt Config.defaultMinimum, dl)
175
176val soaD = multiApp ((EVar "soa", dl),
177 dl,
178 [nsD, serialD, refD, retD, expD, minD])
179
e0b0abd2 180val masterD = (EApp ((EVar "internalMaster", dl),
8b84db5b 181 (EString Config.masterNode, dl)),
e0b0abd2
AC		 182 dl)
183
8b84db5b
AC		 184val slavesD = (EList (map (fn s => (EString s, dl)) Config.slaveNodes), dl)
185
6bb366c5
AC		 186val _ = Defaults.registerDefault ("Mailbox",
187 (TBase "email", dl),
188 (fn () => (EString (getUser ()), dl)))
189
aa56e112
AC		 190val _ = Defaults.registerDefault ("DNS",
191 (TBase "dnsKind", dl),
192 (fn () => multiApp ((EVar "useDns", dl),
193 dl,
8b84db5b 194 [soaD, masterD, slavesD])))
6ae327f8 195
aa56e112
AC		 196val _ = Defaults.registerDefault ("TTL",
197 (TBase "int", dl),
198 (fn () => (EInt Config.Bind.defaultTTL, dl)))
6ae327f8
AC		 199
200type soa = {ns : string,
201 serial : int option,
202 ref : int,
203 ret : int,
204 exp : int,
205 min : int}
206
207val serial = fn (EVar "serialAuto", _) => SOME NONE
208 | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
209 | _ => NONE
210
211val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp
212 ((EVar "soa", _), ns), _),
213 sl), _),
214 rf), _),
215 ret), _),
216 exp), _),
217 min), _) =>
218 (case (Env.string ns, serial sl, Env.int rf,
219 Env.int ret, Env.int exp, Env.int min) of
220 (SOME ns, SOME sl, SOME rf,
221 SOME ret, SOME exp, SOME min) =>
222 SOME {ns = ns,
223 serial = sl,
224 ref = rf,
225 ret = ret,
226 exp = exp,
227 min = min}
228 | _ => NONE)
229 | _ => NONE
230
e0b0abd2
AC		 231datatype master =
232 ExternalMaster of string
233 | InternalMaster of string
234
cf879b4f
AC		 235val ip = Env.string
236
237val _ = Env.registerFunction ("ip_of_node",
238 fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
239 | _ => NONE)
97665758
AC		 240
241val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
8b84db5b 242 | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
e0b0abd2
AC		 243 | _ => NONE
244
6ae327f8 245datatype dnsKind =
e0b0abd2
AC		 246 UseDns of {soa : soa,
247 master : master,
248 slaves : string list}
6ae327f8
AC		 249 | NoDns
250
e0b0abd2
AC		 251val dnsKind = fn (EApp ((EApp ((EApp
252 ((EVar "useDns", _), sa), _),
253 mstr), _),
254 slaves), _) =>
255 (case (soa sa, master mstr, Env.list Env.string slaves) of
256 (SOME sa, SOME mstr, SOME slaves) =>
257 SOME (UseDns {soa = sa,
258 master = mstr,
259 slaves = slaves})
260 | _ => NONE)
325285ab 261 | (EVar "noDns", _) => SOME NoDns
6ae327f8
AC		 262 | _ => NONE
263
a3698041
AC		 264val befores = ref (fn (_ : string) => ())
265val afters = ref (fn (_ : string) => ())
266
267fun registerBefore f =
268 let
269 val old = !befores
270 in
271 befores := (fn x => (old x; f x))
272 end
273
274fun registerAfter f =
275 let
276 val old = !afters
277 in
278 afters := (fn x => (old x; f x))
279 end
280
71420f8b
AC		 281val globals = ref (fn () => ())
282val locals = ref (fn () => ())
283
284fun registerResetGlobal f =
285 let
286 val old = !globals
287 in
288 globals := (fn x => (old x; f x))
289 end
290
291fun registerResetLocal f =
292 let
293 val old = !locals
294 in
295 locals := (fn x => (old x; f x))
296 end
297
298fun resetGlobal () = (!globals ();
299 ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
300fun resetLocal () = !locals ()
301
a3698041 302val current = ref ""
e0b0abd2 303val currentPath = ref (fn (_ : string) => "")
dac62e84 304
d612d62c
AC		 305val scratch = ref ""
306
dac62e84
AC		 307fun currentDomain () = !current
308
e0b0abd2
AC		 309fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
310 TextIO.openOut (!currentPath node ^ name))
dac62e84
AC		 311
312fun getPath domain =
313 let
314 val toks = String.fields (fn ch => ch = #".") domain
315
316 val elems = foldr (fn (piece, elems) =>
317 let
318 val elems = piece :: elems
d612d62c 319
e0b0abd2
AC		 320 fun doNode node =
321 let
322 val path = String.concatWith "/"
323 (Config.resultRoot :: node :: rev elems)
324 val tmpPath = String.concatWith "/"
325 (Config.tmpDir :: node :: rev elems)
326 in
327 (if Posix.FileSys.ST.isDir
328 (Posix.FileSys.stat path) then
329 ()
330 else
331 (OS.FileSys.remove path;
332 OS.FileSys.mkDir path))
333 handle OS.SysErr _ => OS.FileSys.mkDir path;
334
335 (if Posix.FileSys.ST.isDir
336 (Posix.FileSys.stat tmpPath) then
337 ()
338 else
339 (OS.FileSys.remove tmpPath;
340 OS.FileSys.mkDir tmpPath))
341 handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
342 end
343 in
2ed6d0e5 344 app doNode nodes;
dac62e84
AC		 345 elems
346 end) [] toks
347 in
e0b0abd2 348 fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
d612d62c
AC		 349 end
350
351datatype file_action' =
352 Add' of {src : string, dst : string}
353 | Delete' of string
354 | Modify' of {src : string, dst : string}
355
e0b0abd2 356fun findDiffs (site, dom, acts) =
d612d62c 357 let
e0b0abd2
AC		 358 val gp = getPath dom
359 val realPath = gp (Config.resultRoot, site)
360 val tmpPath = gp (Config.tmpDir, site)
361
362 (*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)
d612d62c
AC		 363
364 val dir = Posix.FileSys.opendir realPath
365
366 fun loopReal acts =
367 case Posix.FileSys.readdir dir of
368 NONE => (Posix.FileSys.closedir dir;
369 acts)
370 | SOME fname =>
371 let
372 val real = OS.Path.joinDirFile {dir = realPath,
373 file = fname}
374 val tmp = OS.Path.joinDirFile {dir = tmpPath,
375 file = fname}
376 in
377 if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
378 loopReal acts
379 else if Posix.FileSys.access (tmp, []) then
8df2e702 380 if Slave.shell [Config.diff, " ", real, " ", tmp] then
d612d62c
AC		 381 loopReal acts
382 else
e0b0abd2 383 loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
d612d62c 384 else
e0b0abd2 385 loopReal ((site, dom, realPath, Delete' real) :: acts)
d612d62c
AC		 386 end
387
e0b0abd2 388 val acts = loopReal acts
d612d62c 389
8df2e702 390 val dir = Posix.FileSys.opendir tmpPath
d612d62c
AC		 391
392 fun loopTmp acts =
393 case Posix.FileSys.readdir dir of
394 NONE => (Posix.FileSys.closedir dir;
395 acts)
396 | SOME fname =>
397 let
398 val real = OS.Path.joinDirFile {dir = realPath,
399 file = fname}
400 val tmp = OS.Path.joinDirFile {dir = tmpPath,
401 file = fname}
402 in
403 if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
404 loopTmp acts
405 else if Posix.FileSys.access (real, []) then
406 loopTmp acts
407 else
e0b0abd2 408 loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
d612d62c
AC		 409 end
410
411 val acts = loopTmp acts
412 in
413 acts
dac62e84 414 end
a3698041 415
e0b0abd2
AC		 416fun findAllDiffs () =
417 let
418 val dir = Posix.FileSys.opendir Config.tmpDir
419 val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
420
421 fun exploreSites diffs =
422 case Posix.FileSys.readdir dir of
423 NONE => diffs
424 | SOME site =>
425 let
426 fun explore (dname, diffs) =
427 let
428 val dir = Posix.FileSys.opendir dname
429
430 fun loop diffs =
431 case Posix.FileSys.readdir dir of
432 NONE => diffs
433 | SOME name =>
434 let
435 val fname = OS.Path.joinDirFile {dir = dname,
436 file = name}
437 in
438 loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
439 let
440 val dom = String.fields (fn ch => ch = #"/") fname
441 val dom = List.drop (dom, len)
442 val dom = String.concatWith "." (rev dom)
443
444 val dname' = OS.Path.joinDirFile {dir = dname,
445 file = name}
446 in
447 explore (dname',
448 findDiffs (site, dom, diffs))
449 end
450 else
451 diffs)
452 end
453 in
454 loop diffs
455 before Posix.FileSys.closedir dir
456 end
457 in
36e42cb8
AC		 458 exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
459 file = site}, diffs))
e0b0abd2
AC		 460 end
461 in
462 exploreSites []
463 before Posix.FileSys.closedir dir
464 end
465
466val masterNode : string option ref = ref NONE
467fun dnsMaster () = !masterNode
468
6ae327f8
AC		 469val _ = Env.containerV_one "domain"
470 ("domain", Env.string)
471 (fn (evs, dom) =>
472 let
473 val kind = Env.env dnsKind (evs, "DNS")
474 val ttl = Env.env Env.int (evs, "TTL")
475
e0b0abd2 476 val path = getPath dom
6ae327f8
AC		 477
478 val () = (current := dom;
e0b0abd2 479 currentPath := (fn site => path (Config.tmpDir, site)))
6ae327f8 480
e0b0abd2 481 fun saveSoa (kind, soa : soa) node =
6ae327f8 482 let
e0b0abd2 483 val outf = domainFile {node = node, name = "soa"}
6ae327f8
AC		 484 in
485 TextIO.output (outf, kind);
486 TextIO.output (outf, "\n");
487 TextIO.output (outf, Int.toString ttl);
488 TextIO.output (outf, "\n");
489 TextIO.output (outf, #ns soa);
490 TextIO.output (outf, "\n");
491 case #serial soa of
492 NONE => ()
493 | SOME n => TextIO.output (outf, Int.toString n);
494 TextIO.output (outf, "\n");
495 TextIO.output (outf, Int.toString (#ref soa));
496 TextIO.output (outf, "\n");
497 TextIO.output (outf, Int.toString (#ret soa));
498 TextIO.output (outf, "\n");
499 TextIO.output (outf, Int.toString (#exp soa));
500 TextIO.output (outf, "\n");
501 TextIO.output (outf, Int.toString (#min soa));
502 TextIO.output (outf, "\n");
503 TextIO.closeOut outf
504 end
505
2ed6d0e5 506 fun saveNamed (kind, soa : soa, masterIp) node =
6ae327f8 507 let
e0b0abd2 508 val outf = domainFile {node = node, name = "named.conf"}
6ae327f8
AC		 509 in
510 TextIO.output (outf, "\nzone \"");
511 TextIO.output (outf, dom);
512 TextIO.output (outf, "\" IN {\n\ttype ");
513 TextIO.output (outf, kind);
514 TextIO.output (outf, ";\n\tfile \"");
27e20924 515 TextIO.output (outf, Config.Bind.zonePath_real);
6ae327f8
AC		 516 TextIO.output (outf, "/");
517 TextIO.output (outf, dom);
518 TextIO.output (outf, ".zone\";\n");
519 case kind of
520 "master" => TextIO.output (outf, "\tallow-update { none; };\n")
2ed6d0e5
AC		 521 | _ => (TextIO.output (outf, "\tmasters { ");
522 TextIO.output (outf, masterIp);
7d042452 523 TextIO.output (outf, "; };\n"));
2ed6d0e5 524 TextIO.output (outf, "};\n");
6ae327f8
AC		 525 TextIO.closeOut outf
526 end
6ae327f8
AC		 527 in
528 case kind of
e0b0abd2
AC		 529 NoDns => masterNode := NONE
530 | UseDns dns =>
2ed6d0e5
AC		 531 let
532 val masterIp =
533 case #master dns of
534 InternalMaster node => valOf (SM.find (nodeMap, node))
535 | ExternalMaster ip => ip
536 in
537 app (saveSoa ("slave", #soa dns)) (#slaves dns);
538 app (saveNamed ("slave", #soa dns, masterIp)) (#slaves dns);
539 case #master dns of
540 InternalMaster node =>
541 (masterNode := SOME node;
542 saveSoa ("master", #soa dns) node;
543 saveNamed ("master", #soa dns, masterIp) node)
544 | _ => masterNode := NONE;
545 !befores dom
546 end
6ae327f8 547 end,
e0b0abd2
AC		 548 fn () => !afters (!current))
549
550val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
551 fn cl => "Temp file cleanup failed: " ^ cl));
552 OS.FileSys.mkDir Config.tmpDir;
553 app (fn node => OS.FileSys.mkDir
554 (OS.Path.joinDirFile {dir = Config.tmpDir,
555 file = node}))
2ed6d0e5 556 nodes;
e0b0abd2
AC		 557 app (fn node => OS.FileSys.mkDir
558 (OS.Path.joinDirFile {dir = Config.resultRoot,
559 file = node})
560 handle OS.SysErr _ => ())
2ed6d0e5 561 nodes))
e0b0abd2 562
c189cbe9
AC		 563fun handleSite (site, files) =
564 let
565
566 in
567 print ("New configuration for node " ^ site ^ "\n");
568 if site = Config.defaultNode then
569 Slave.handleChanges files
570 else let
571 val bio = OpenSSL.connect (valOf (!ssl_context),
572 nodeIp site
573 ^ ":"
574 ^ Int.toString Config.slavePort)
575 in
576 app (fn file => Msg.send (bio, MsgFile file)) files;
577 Msg.send (bio, MsgDoFiles);
578 case Msg.recv bio of
579 NONE => print "Slave closed connection unexpectedly\n"
580 | SOME m =>
581 case m of
582 MsgOk => print ("Slave " ^ site ^ " finished\n")
583 | MsgError s => print ("Slave " ^ site
584 ^ " returned error: " ^
585 s ^ "\n")
586 | _ => print ("Slave " ^ site
587 ^ " returned unexpected command\n");
588 OpenSSL.close bio
589 end
590 end
591
e0b0abd2
AC		 592val () = Env.registerPost (fn () =>
593 let
594 val diffs = findAllDiffs ()
6ae327f8 595
e0b0abd2
AC		 596 val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
597 (Slave.shellF ([Config.cp, " ", src, " ", dst],
598 fn cl => "Copy failed: " ^ cl);
599 (site,
6ae327f8
AC		 600 {action = Slave.Add,
601 domain = dom,
602 dir = dir,
e0b0abd2
AC		 603 file = dst}))
604 | (site, dom, dir, Delete' dst) =>
605 (OS.FileSys.remove dst
606 handle OS.SysErr _ =>
607 ErrorMsg.error NONE ("Delete failed for " ^ dst);
608 (site,
6ae327f8
AC		 609 {action = Slave.Delete,
610 domain = dom,
611 dir = dir,
e0b0abd2
AC		 612 file = dst}))
613 | (site, dom, dir, Modify' {src, dst}) =>
614 (Slave.shellF ([Config.cp, " ", src, " ", dst],
615 fn cl => "Copy failed: " ^ cl);
616 (site,
6ae327f8
AC		 617 {action = Slave.Modify,
618 domain = dom,
619 dir = dir,
e0b0abd2
AC		 620 file = dst}))) diffs
621 in
622 if !ErrorMsg.anyErrors then
623 ()
36e42cb8
AC		 624 else let
625 val changed = foldl (fn ((site, file), changed) =>
626 let
627 val ls = case SM.find (changed, site) of
628 NONE => []
629 | SOME ls => ls
630 in
631 SM.insert (changed, site, file :: ls)
632 end) SM.empty diffs
36e42cb8
AC		 633 in
634 SM.appi handleSite changed
635 end;
e0b0abd2 636 ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
559e89e9 637 fn cl => "Temp file cleanup failed: " ^ cl))
e0b0abd2 638 end)
6ae327f8 639
be1bea4c
AC		 640fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
641 orelse Acl.query {user = getUser (), class = "priv", value = priv}
642
643val _ = Env.type_one "dns_node"
644 Env.string
645 (fn node =>
646 List.exists (fn x => x = node) Config.dnsNodes_all
647 orelse (hasPriv "dns"
648 andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
60695e99 649
bbdf617f
AC		 650val _ = Env.type_one "mail_node"
651 Env.string
652 (fn node =>
653 List.exists (fn x => x = node) Config.mailNodes_all
654 orelse (hasPriv "mail"
655 andalso List.exists (fn x => x = node) Config.mailNodes_admin))
656
e69e60cc 657fun rmdom doms =
c189cbe9 658 let
c189cbe9
AC		 659 fun doNode (node, _) =
660 let
661 val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
662 file = node}
c189cbe9 663
e69e60cc 664 fun doDom (dom, actions) =
93c2f623 665 let
e69e60cc
AC		 666 val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
667 val dname = OS.Path.concat (dname, domPath)
668
669 fun visitDom (dom, dname, actions) =
670 let
671 val dir = Posix.FileSys.opendir dname
672
673 fun loop actions =
674 case Posix.FileSys.readdir dir of
675 NONE => actions
676 | SOME fname =>
677 let
678 val fnameFull = OS.Path.joinDirFile {dir = dname,
679 file = fname}
680 in
681 if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
682 loop (visitDom (fname ^ "." ^ dom,
683 fnameFull,
684 actions))
685 else
686 loop ({action = Slave.Delete,
687 domain = dom,
688 dir = dname,
689 file = fnameFull} :: actions)
690 end
691 in
692 loop actions
693 before Posix.FileSys.closedir dir
694 end
695 handle OS.SysErr _ =>
f208fe7e 696 (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ".\n");
e69e60cc 697 actions)
93c2f623 698 in
e69e60cc 699 visitDom (dom, dname, actions)
93c2f623
AC		 700 end
701
e69e60cc 702 val actions = foldl doDom [] doms
c189cbe9 703 in
c189cbe9
AC		 704 handleSite (node, actions)
705 end
e69e60cc 706 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
c189cbe9
AC		 707
708 fun cleanupNode (node, _) =
709 let
e69e60cc
AC		 710 fun doDom dom =
711 let
712 val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
713 val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
714 file = node}
715 val dname = OS.Path.concat (dname, domPath)
716 in
717 ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
718 end
c189cbe9 719 in
e69e60cc 720 app doDom doms
c189cbe9
AC		 721 end
722 in
723 app doNode Config.nodeIps;
724 app cleanupNode Config.nodeIps
725 end
726
a3698041 727end
Unnamed repository; edit this file to name it for gitweb.