HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Don't generate BIND data for localhost
[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
2e96b9d4
AC		 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
2aeb9eec
AC		 113val validGroup = validUser
114
f8dfbbcc
AC		 115val _ = Env.type_one "no_spaces"
116 Env.string
117 (CharVector.all (fn ch => not (Char.isSpace ch)))
d5754b53
AC		 118val _ = Env.type_one "no_newlines"
119 Env.string
120 (CharVector.all (fn ch => ch <> #"\n" andalso ch <> #"\r"))
f8dfbbcc 121
6ae327f8
AC		 122val _ = Env.type_one "ip"
123 Env.string
124 validIp
125
629a34f6
AC		 126val _ = Env.type_one "host"
127 Env.string
128 validHost
129
130val _ = Env.type_one "domain"
131 Env.string
132 validDomain
133
12adf55a
AC		 134val _ = Env.type_one "your_domain"
135 Env.string
136 yourDomain
137
edd38024
AC		 138val _ = Env.type_one "your_domain_host"
139 Env.string
140 yourDomainHost
141
2aeb9eec
AC		 142val _ = Env.type_one "user"
143 Env.string
144 validUser
145
146val _ = Env.type_one "group"
147 Env.string
148 validGroup
149
8a7c40fa
AC		 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
e0b0abd2
AC		 162val _ = Env.type_one "node"
163 Env.string
164 validNode
165
bbdf617f
AC		 166val _ = Env.registerFunction ("dns_node_to_node",
167 fn [e] => SOME e
168 | _ => NONE)
169
170val _ = Env.registerFunction ("mail_node_to_node",
be1bea4c
AC		 171 fn [e] => SOME e
172 | _ => NONE)
a3698041
AC		 173open Ast
174
6ae327f8
AC		 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
e0b0abd2 188val masterD = (EApp ((EVar "internalMaster", dl),
8b84db5b 189 (EString Config.masterNode, dl)),
e0b0abd2
AC		 190 dl)
191
8b84db5b
AC		 192val slavesD = (EList (map (fn s => (EString s, dl)) Config.slaveNodes), dl)
193
6bb366c5
AC		 194val _ = Defaults.registerDefault ("Mailbox",
195 (TBase "email", dl),
196 (fn () => (EString (getUser ()), dl)))
197
aa56e112
AC		 198val _ = Defaults.registerDefault ("DNS",
199 (TBase "dnsKind", dl),
200 (fn () => multiApp ((EVar "useDns", dl),
201 dl,
8b84db5b 202 [soaD, masterD, slavesD])))
6ae327f8 203
aa56e112
AC		 204val _ = Defaults.registerDefault ("TTL",
205 (TBase "int", dl),
206 (fn () => (EInt Config.Bind.defaultTTL, dl)))
6ae327f8
AC		 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
e0b0abd2
AC		 239datatype master =
240 ExternalMaster of string
241 | InternalMaster of string
242
cf879b4f
AC		 243val ip = Env.string
244
245val _ = Env.registerFunction ("ip_of_node",
246 fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
247 | _ => NONE)
97665758
AC		 248
249val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
8b84db5b 250 | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
e0b0abd2
AC		 251 | _ => NONE
252
6ae327f8 253datatype dnsKind =
e0b0abd2
AC		 254 UseDns of {soa : soa,
255 master : master,
256 slaves : string list}
6ae327f8
AC		 257 | NoDns
258
e0b0abd2
AC		 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)
325285ab 269 | (EVar "noDns", _) => SOME NoDns
6ae327f8
AC		 270 | _ => NONE
271
a3698041
AC		 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
71420f8b
AC		 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
a3698041 310val current = ref ""
e0b0abd2 311val currentPath = ref (fn (_ : string) => "")
dac62e84 312
d612d62c
AC		 313val scratch = ref ""
314
dac62e84
AC		 315fun currentDomain () = !current
316
e0b0abd2
AC		 317fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
318 TextIO.openOut (!currentPath node ^ name))
dac62e84
AC		 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
d612d62c 327
e0b0abd2
AC		 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
2ed6d0e5 352 app doNode nodes;
dac62e84
AC		 353 elems
354 end) [] toks
355 in
e0b0abd2 356 fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
d612d62c
AC		 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
e0b0abd2 364fun findDiffs (site, dom, acts) =
d612d62c 365 let
e0b0abd2
AC		 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")*)
d612d62c
AC		 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
8df2e702 388 if Slave.shell [Config.diff, " ", real, " ", tmp] then
d612d62c
AC		 389 loopReal acts
390 else
e0b0abd2 391 loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
d612d62c 392 else
e0b0abd2 393 loopReal ((site, dom, realPath, Delete' real) :: acts)
d612d62c
AC		 394 end
395
e0b0abd2 396 val acts = loopReal acts
d612d62c 397
8df2e702 398 val dir = Posix.FileSys.opendir tmpPath
d612d62c
AC		 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
e0b0abd2 416 loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
d612d62c
AC		 417 end
418
419 val acts = loopTmp acts
420 in
421 acts
dac62e84 422 end
a3698041 423
e0b0abd2
AC		 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
36e42cb8
AC		 466 exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
467 file = site}, diffs))
e0b0abd2
AC		 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
6ae327f8
AC		 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
e0b0abd2 484 val path = getPath dom
6ae327f8
AC		 485
486 val () = (current := dom;
e0b0abd2 487 currentPath := (fn site => path (Config.tmpDir, site)))
6ae327f8 488
e0b0abd2 489 fun saveSoa (kind, soa : soa) node =
b341fd6d
AC		 490 if dom = "localhost" then
491 ()
492 else let
493 val outf = domainFile {node = node, name = "soa"}
494 in
495 TextIO.output (outf, kind);
496 TextIO.output (outf, "\n");
497 TextIO.output (outf, Int.toString ttl);
498 TextIO.output (outf, "\n");
499 TextIO.output (outf, #ns soa);
500 TextIO.output (outf, "\n");
501 case #serial soa of
502 NONE => ()
503 | SOME n => TextIO.output (outf, Int.toString n);
504 TextIO.output (outf, "\n");
505 TextIO.output (outf, Int.toString (#ref soa));
506 TextIO.output (outf, "\n");
507 TextIO.output (outf, Int.toString (#ret soa));
508 TextIO.output (outf, "\n");
509 TextIO.output (outf, Int.toString (#exp soa));
510 TextIO.output (outf, "\n");
511 TextIO.output (outf, Int.toString (#min soa));
512 TextIO.output (outf, "\n");
513 TextIO.closeOut outf
514 end
6ae327f8 515
2ed6d0e5 516 fun saveNamed (kind, soa : soa, masterIp) node =
b341fd6d
AC		 517 if dom = "localhost" then
518 ()
519 else let
520 val outf = domainFile {node = node, name = "named.conf"}
521 in
522 TextIO.output (outf, "\nzone \"");
523 TextIO.output (outf, dom);
524 TextIO.output (outf, "\" IN {\n\ttype ");
525 TextIO.output (outf, kind);
526 TextIO.output (outf, ";\n\tfile \"");
527 TextIO.output (outf, Config.Bind.zonePath_real);
528 TextIO.output (outf, "/");
529 TextIO.output (outf, dom);
530 TextIO.output (outf, ".zone\";\n");
531 case kind of
532 "master" => TextIO.output (outf, "\tallow-update { none; };\n")
533 | _ => (TextIO.output (outf, "\tmasters { ");
534 TextIO.output (outf, masterIp);
535 TextIO.output (outf, "; };\n"));
536 TextIO.output (outf, "};\n");
537 TextIO.closeOut outf
538 end
6ae327f8
AC		 539 in
540 case kind of
e0b0abd2
AC		 541 NoDns => masterNode := NONE
542 | UseDns dns =>
2ed6d0e5
AC		 543 let
544 val masterIp =
545 case #master dns of
546 InternalMaster node => valOf (SM.find (nodeMap, node))
547 | ExternalMaster ip => ip
548 in
549 app (saveSoa ("slave", #soa dns)) (#slaves dns);
550 app (saveNamed ("slave", #soa dns, masterIp)) (#slaves dns);
551 case #master dns of
552 InternalMaster node =>
553 (masterNode := SOME node;
554 saveSoa ("master", #soa dns) node;
555 saveNamed ("master", #soa dns, masterIp) node)
556 | _ => masterNode := NONE;
557 !befores dom
558 end
6ae327f8 559 end,
e0b0abd2
AC		 560 fn () => !afters (!current))
561
562val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
563 fn cl => "Temp file cleanup failed: " ^ cl));
564 OS.FileSys.mkDir Config.tmpDir;
565 app (fn node => OS.FileSys.mkDir
566 (OS.Path.joinDirFile {dir = Config.tmpDir,
567 file = node}))
2ed6d0e5 568 nodes;
e0b0abd2
AC		 569 app (fn node => OS.FileSys.mkDir
570 (OS.Path.joinDirFile {dir = Config.resultRoot,
571 file = node})
572 handle OS.SysErr _ => ())
2ed6d0e5 573 nodes))
e0b0abd2 574
c189cbe9
AC		 575fun handleSite (site, files) =
576 let
577
578 in
579 print ("New configuration for node " ^ site ^ "\n");
580 if site = Config.defaultNode then
581 Slave.handleChanges files
582 else let
583 val bio = OpenSSL.connect (valOf (!ssl_context),
584 nodeIp site
585 ^ ":"
586 ^ Int.toString Config.slavePort)
587 in
588 app (fn file => Msg.send (bio, MsgFile file)) files;
589 Msg.send (bio, MsgDoFiles);
590 case Msg.recv bio of
591 NONE => print "Slave closed connection unexpectedly\n"
592 | SOME m =>
593 case m of
594 MsgOk => print ("Slave " ^ site ^ " finished\n")
595 | MsgError s => print ("Slave " ^ site
596 ^ " returned error: " ^
597 s ^ "\n")
598 | _ => print ("Slave " ^ site
599 ^ " returned unexpected command\n");
600 OpenSSL.close bio
601 end
602 end
603
e0b0abd2
AC		 604val () = Env.registerPost (fn () =>
605 let
606 val diffs = findAllDiffs ()
6ae327f8 607
e0b0abd2
AC		 608 val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
609 (Slave.shellF ([Config.cp, " ", src, " ", dst],
610 fn cl => "Copy failed: " ^ cl);
611 (site,
6ae327f8
AC		 612 {action = Slave.Add,
613 domain = dom,
614 dir = dir,
e0b0abd2
AC		 615 file = dst}))
616 | (site, dom, dir, Delete' dst) =>
617 (OS.FileSys.remove dst
618 handle OS.SysErr _ =>
619 ErrorMsg.error NONE ("Delete failed for " ^ dst);
620 (site,
6ae327f8
AC		 621 {action = Slave.Delete,
622 domain = dom,
623 dir = dir,
e0b0abd2
AC		 624 file = dst}))
625 | (site, dom, dir, Modify' {src, dst}) =>
626 (Slave.shellF ([Config.cp, " ", src, " ", dst],
627 fn cl => "Copy failed: " ^ cl);
628 (site,
6ae327f8
AC		 629 {action = Slave.Modify,
630 domain = dom,
631 dir = dir,
e0b0abd2
AC		 632 file = dst}))) diffs
633 in
634 if !ErrorMsg.anyErrors then
635 ()
36e42cb8
AC		 636 else let
637 val changed = foldl (fn ((site, file), changed) =>
638 let
639 val ls = case SM.find (changed, site) of
640 NONE => []
641 | SOME ls => ls
642 in
643 SM.insert (changed, site, file :: ls)
644 end) SM.empty diffs
36e42cb8
AC		 645 in
646 SM.appi handleSite changed
647 end;
e0b0abd2 648 ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
559e89e9 649 fn cl => "Temp file cleanup failed: " ^ cl))
e0b0abd2 650 end)
6ae327f8 651
be1bea4c
AC		 652fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
653 orelse Acl.query {user = getUser (), class = "priv", value = priv}
654
655val _ = Env.type_one "dns_node"
656 Env.string
657 (fn node =>
658 List.exists (fn x => x = node) Config.dnsNodes_all
659 orelse (hasPriv "dns"
660 andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
60695e99 661
bbdf617f
AC		 662val _ = Env.type_one "mail_node"
663 Env.string
664 (fn node =>
665 List.exists (fn x => x = node) Config.mailNodes_all
666 orelse (hasPriv "mail"
667 andalso List.exists (fn x => x = node) Config.mailNodes_admin))
668
e69e60cc 669fun rmdom doms =
c189cbe9 670 let
c189cbe9
AC		 671 fun doNode (node, _) =
672 let
673 val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
674 file = node}
c189cbe9 675
e69e60cc 676 fun doDom (dom, actions) =
93c2f623 677 let
e69e60cc
AC		 678 val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
679 val dname = OS.Path.concat (dname, domPath)
680
681 fun visitDom (dom, dname, actions) =
682 let
683 val dir = Posix.FileSys.opendir dname
684
685 fun loop actions =
686 case Posix.FileSys.readdir dir of
687 NONE => actions
688 | SOME fname =>
689 let
690 val fnameFull = OS.Path.joinDirFile {dir = dname,
691 file = fname}
692 in
693 if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
694 loop (visitDom (fname ^ "." ^ dom,
695 fnameFull,
696 actions))
697 else
698 loop ({action = Slave.Delete,
699 domain = dom,
700 dir = dname,
701 file = fnameFull} :: actions)
702 end
703 in
704 loop actions
705 before Posix.FileSys.closedir dir
706 end
707 handle OS.SysErr _ =>
f208fe7e 708 (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ".\n");
e69e60cc 709 actions)
93c2f623 710 in
e69e60cc 711 visitDom (dom, dname, actions)
93c2f623
AC		 712 end
713
e69e60cc 714 val actions = foldl doDom [] doms
c189cbe9 715 in
c189cbe9
AC		 716 handleSite (node, actions)
717 end
e69e60cc 718 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
c189cbe9
AC		 719
720 fun cleanupNode (node, _) =
721 let
e69e60cc
AC		 722 fun doDom dom =
723 let
724 val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
725 val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
726 file = node}
727 val dname = OS.Path.concat (dname, domPath)
728 in
729 ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
730 end
c189cbe9 731 in
e69e60cc 732 app doDom doms
c189cbe9
AC		 733 end
734 in
735 app doNode Config.nodeIps;
736 app cleanupNode Config.nodeIps
737 end
738
a3698041 739end
Unnamed repository; edit this file to name it for gitweb.