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