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