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