01f79026aad2d7f70a0f0543ded2ed6408198b34
[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 => Char.isPrint ch andalso not (Char.isSpace ch)
118 andalso ch <> #"\"" andalso ch <> #"'"))
119 val _ = Env.type_one "no_newlines"
120 Env.string
121 (CharVector.all (fn ch => Char.isPrint ch andalso ch <> #"\n" andalso ch <> #"\r"
122 andalso ch <> #"\"" andalso ch <> #"'"))
123
124 val _ = Env.type_one "ip"
125 Env.string
126 validIp
127
128 val _ = Env.type_one "host"
129 Env.string
130 validHost
131
132 val _ = Env.type_one "domain"
133 Env.string
134 validDomain
135
136 val _ = Env.type_one "your_domain"
137 Env.string
138 yourDomain
139
140 val _ = Env.type_one "your_domain_host"
141 Env.string
142 yourDomainHost
143
144 val _ = Env.type_one "user"
145 Env.string
146 validUser
147
148 val _ = Env.type_one "group"
149 Env.string
150 validGroup
151
152 val _ = Env.type_one "your_user"
153 Env.string
154 yourUser
155
156 val _ = Env.type_one "your_group"
157 Env.string
158 yourGroup
159
160 val _ = Env.type_one "your_path"
161 Env.string
162 yourPath
163
164 val _ = Env.type_one "node"
165 Env.string
166 validNode
167
168 val _ = Env.registerFunction ("dns_node_to_node",
169 fn [e] => SOME e
170 | _ => NONE)
171
172 val _ = Env.registerFunction ("mail_node_to_node",
173 fn [e] => SOME e
174 | _ => NONE)
175 open Ast
176
177 val dl = ErrorMsg.dummyLoc
178
179 val nsD = (EString Config.defaultNs, dl)
180 val serialD = (EVar "serialAuto", dl)
181 val refD = (EInt Config.defaultRefresh, dl)
182 val retD = (EInt Config.defaultRetry, dl)
183 val expD = (EInt Config.defaultExpiry, dl)
184 val minD = (EInt Config.defaultMinimum, dl)
185
186 val soaD = multiApp ((EVar "soa", dl),
187 dl,
188 [nsD, serialD, refD, retD, expD, minD])
189
190 val masterD = (EApp ((EVar "internalMaster", dl),
191 (EString Config.masterNode, dl)),
192 dl)
193
194 val slavesD = (EList (map (fn s => (EString s, dl)) Config.slaveNodes), dl)
195
196 val _ = Defaults.registerDefault ("Aliases",
197 (TList (TBase "your_domain", dl), dl),
198 (fn () => (EList [], dl)))
199
200 val _ = Defaults.registerDefault ("Mailbox",
201 (TBase "email", dl),
202 (fn () => (EString (getUser ()), dl)))
203
204 val _ = Defaults.registerDefault ("DNS",
205 (TBase "dnsKind", dl),
206 (fn () => multiApp ((EVar "useDns", dl),
207 dl,
208 [soaD, masterD, slavesD])))
209
210 val _ = Defaults.registerDefault ("TTL",
211 (TBase "int", dl),
212 (fn () => (EInt Config.Bind.defaultTTL, dl)))
213
214 type soa = {ns : string,
215 serial : int option,
216 ref : int,
217 ret : int,
218 exp : int,
219 min : int}
220
221 val serial = fn (EVar "serialAuto", _) => SOME NONE
222 | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
223 | _ => NONE
224
225 val 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
245 datatype master =
246 ExternalMaster of string
247 | InternalMaster of string
248
249 val ip = Env.string
250
251 val _ = Env.registerFunction ("ip_of_node",
252 fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
253 | _ => NONE)
254
255 val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
256 | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
257 | _ => NONE
258
259 datatype dnsKind =
260 UseDns of {soa : soa,
261 master : master,
262 slaves : string list}
263 | NoDns
264
265 val 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)
275 | (EVar "noDns", _) => SOME NoDns
276 | _ => NONE
277
278 val befores = ref (fn (_ : string) => ())
279 val afters = ref (fn (_ : string) => ())
280
281 fun registerBefore f =
282 let
283 val old = !befores
284 in
285 befores := (fn x => (old x; f x))
286 end
287
288 fun registerAfter f =
289 let
290 val old = !afters
291 in
292 afters := (fn x => (old x; f x))
293 end
294
295 val globals = ref (fn () => ())
296 val locals = ref (fn () => ())
297
298 fun registerResetGlobal f =
299 let
300 val old = !globals
301 in
302 globals := (fn x => (old x; f x))
303 end
304
305 fun registerResetLocal f =
306 let
307 val old = !locals
308 in
309 locals := (fn x => (old x; f x))
310 end
311
312 fun resetGlobal () = (!globals ();
313 ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
314 fun resetLocal () = !locals ()
315
316 val current = ref ""
317 val currentPath = ref (fn (_ : string) => "")
318 val currentPathAli = ref (fn (_ : string, _ : string) => "")
319
320 val scratch = ref ""
321
322 fun currentDomain () = !current
323
324 val currentsAli = ref ([] : string list)
325
326 fun currentAliasDomains () = !currentsAli
327 fun currentDomains () = currentDomain () :: currentAliasDomains ()
328
329 fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
330 TextIO.openOut (!currentPath node ^ name))
331
332 type files = {write : string -> unit,
333 writeDom : unit -> unit,
334 close : unit -> unit}
335
336 fun 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
346 fun 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
353
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
378 app doNode nodes;
379 elems
380 end) [] toks
381 in
382 fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
383 end
384
385 datatype file_action' =
386 Add' of {src : string, dst : string}
387 | Delete' of string
388 | Modify' of {src : string, dst : string}
389
390 fun findDiffs (site, dom, acts) =
391 let
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")*)
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
414 if Slave.shell [Config.diff, " ", real, " ", tmp] then
415 loopReal acts
416 else
417 loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
418 else
419 loopReal ((site, dom, realPath, Delete' real) :: acts)
420 end
421
422 val acts = loopReal acts
423
424 val dir = Posix.FileSys.opendir tmpPath
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
442 loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
443 end
444
445 val acts = loopTmp acts
446 in
447 acts
448 end
449
450 fun 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
492 exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
493 file = site}, diffs))
494 end
495 in
496 exploreSites []
497 before Posix.FileSys.closedir dir
498 end
499
500 val masterNode : string option ref = ref NONE
501 fun dnsMaster () = !masterNode
502
503 val _ = 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")
509 val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
510
511 val path = getPath dom
512
513 val () = (current := dom;
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)))
517
518 fun saveSoa (kind, soa : soa) node =
519 let
520 val {write, writeDom, close} = domainsFile {node = node, name = "soa"}
521 in
522 write kind;
523 write "\n";
524 write (Int.toString ttl);
525 write "\n";
526 write (#ns soa);
527 write "\n";
528 case #serial soa of
529 NONE => ()
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 ()
541 end
542
543 fun saveNamed (kind, soa : soa, masterIp, slaveIps) node =
544 if dom = "localhost" then
545 ()
546 else let
547 val {write, writeDom, close} = domainsFile {node = node, name = "named.conf"}
548 in
549 write "\nzone \"";
550 writeDom ();
551 write "\" {\n\ttype ";
552 write kind;
553 write ";\n\tfile \"";
554 write Config.Bind.zonePath_real;
555 write "/";
556 writeDom ();
557 write ".zone\";\n";
558 case kind of
559 "master" => (write "\tallow-transfer {\n";
560 app (fn ip => (write "\t\t";
561 write ip;
562 write ";\n")) slaveIps;
563 write "\t};\n")
564 | _ => (write "\tmasters { ";
565 write masterIp;
566 write "; };\n");
567 write "};\n";
568 close ()
569 end
570 in
571 case kind of
572 NoDns => masterNode := NONE
573 | UseDns dns =>
574 let
575 val masterIp =
576 case #master dns of
577 InternalMaster node => nodeIp node
578 | ExternalMaster ip => ip
579
580 val slaveIps = map nodeIp (#slaves dns)
581 in
582 app (saveSoa ("slave", #soa dns)) (#slaves dns);
583 app (saveNamed ("slave", #soa dns, masterIp, slaveIps)) (#slaves dns);
584 case #master dns of
585 InternalMaster node =>
586 (masterNode := SOME node;
587 saveSoa ("master", #soa dns) node;
588 saveNamed ("master", #soa dns, masterIp, slaveIps) node)
589 | _ => masterNode := NONE
590 end;
591 !befores dom
592 end,
593 fn () => !afters (!current))
594
595 val () = 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}))
601 nodes;
602 app (fn node => OS.FileSys.mkDir
603 (OS.Path.joinDirFile {dir = Config.resultRoot,
604 file = node})
605 handle OS.SysErr _ => ())
606 nodes))
607
608 fun 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
637 val () = Env.registerPost (fn () =>
638 let
639 val diffs = findAllDiffs ()
640
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,
645 {action = Slave.Add,
646 domain = dom,
647 dir = dir,
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,
654 {action = Slave.Delete,
655 domain = dom,
656 dir = dir,
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,
662 {action = Slave.Modify,
663 domain = dom,
664 dir = dir,
665 file = dst}))) diffs
666 in
667 if !ErrorMsg.anyErrors then
668 ()
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
678 in
679 SM.appi handleSite changed
680 end;
681 ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
682 fn cl => "Temp file cleanup failed: " ^ cl))
683 end)
684
685 fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
686 orelse Acl.query {user = getUser (), class = "priv", value = priv}
687
688 val _ = 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))
694
695 val _ = 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
702 fun rmdom doms =
703 let
704 fun doNode (node, _) =
705 let
706 val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
707 file = node}
708
709 fun doDom (dom, actions) =
710 let
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 _ =>
741 (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ".\n");
742 actions)
743 in
744 visitDom (dom, dname, actions)
745 end
746
747 val actions = foldl doDom [] doms
748 in
749 handleSite (node, actions)
750 end
751 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
752
753 fun cleanupNode (node, _) =
754 let
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
764 in
765 app doDom doms
766 end
767 in
768 app doNode Config.nodeIps;
769 app cleanupNode Config.nodeIps
770 end
771
772 fun homedirOf uname =
773 Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
774
775 fun homedir () = homedirOf (getUser ())
776
777 end