vmail interprets relative paths relatively to caller's home directory
[hcoop/domtool2.git] / src / domain.sml
CommitLineData
a3698041 1(* HCoop Domtool (http://hcoop.sourceforge.net/)
3bf720f7 2 * Copyright (c) 2006-2007, Adam Chlipala
a3698041
AC
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
ca6ffb3f
AC
117 (CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
118 andalso ch <> #"\"" andalso ch <> #"'"))
d5754b53
AC
119val _ = Env.type_one "no_newlines"
120 Env.string
ca6ffb3f
AC
121 (CharVector.all (fn ch => Char.isPrint ch andalso ch <> #"\n" andalso ch <> #"\r"
122 andalso ch <> #"\"" andalso ch <> #"'"))
f8dfbbcc 123
6ae327f8
AC
124val _ = Env.type_one "ip"
125 Env.string
126 validIp
127
629a34f6
AC
128val _ = Env.type_one "host"
129 Env.string
130 validHost
131
132val _ = Env.type_one "domain"
133 Env.string
134 validDomain
135
12adf55a
AC
136val _ = Env.type_one "your_domain"
137 Env.string
138 yourDomain
139
edd38024
AC
140val _ = Env.type_one "your_domain_host"
141 Env.string
142 yourDomainHost
143
2aeb9eec
AC
144val _ = Env.type_one "user"
145 Env.string
146 validUser
147
148val _ = Env.type_one "group"
149 Env.string
150 validGroup
151
8a7c40fa
AC
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
e0b0abd2
AC
164val _ = Env.type_one "node"
165 Env.string
166 validNode
167
bbdf617f
AC
168val _ = Env.registerFunction ("dns_node_to_node",
169 fn [e] => SOME e
170 | _ => NONE)
171
172val _ = Env.registerFunction ("mail_node_to_node",
be1bea4c
AC
173 fn [e] => SOME e
174 | _ => NONE)
a3698041
AC
175open Ast
176
6ae327f8
AC
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
e0b0abd2 190val masterD = (EApp ((EVar "internalMaster", dl),
8b84db5b 191 (EString Config.masterNode, dl)),
e0b0abd2
AC
192 dl)
193
8b84db5b
AC
194val slavesD = (EList (map (fn s => (EString s, dl)) Config.slaveNodes), dl)
195
e0b80e65
AC
196val _ = Defaults.registerDefault ("Aliases",
197 (TList (TBase "your_domain", dl), dl),
198 (fn () => (EList [], dl)))
199
6bb366c5
AC
200val _ = Defaults.registerDefault ("Mailbox",
201 (TBase "email", dl),
202 (fn () => (EString (getUser ()), dl)))
203
aa56e112
AC
204val _ = Defaults.registerDefault ("DNS",
205 (TBase "dnsKind", dl),
206 (fn () => multiApp ((EVar "useDns", dl),
207 dl,
8b84db5b 208 [soaD, masterD, slavesD])))
6ae327f8 209
aa56e112
AC
210val _ = Defaults.registerDefault ("TTL",
211 (TBase "int", dl),
212 (fn () => (EInt Config.Bind.defaultTTL, dl)))
6ae327f8
AC
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
e0b0abd2
AC
245datatype master =
246 ExternalMaster of string
247 | InternalMaster of string
248
cf879b4f
AC
249val ip = Env.string
250
251val _ = Env.registerFunction ("ip_of_node",
252 fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
253 | _ => NONE)
97665758
AC
254
255val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
8b84db5b 256 | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
e0b0abd2
AC
257 | _ => NONE
258
6ae327f8 259datatype dnsKind =
e0b0abd2
AC
260 UseDns of {soa : soa,
261 master : master,
262 slaves : string list}
6ae327f8
AC
263 | NoDns
264
e0b0abd2
AC
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)
325285ab 275 | (EVar "noDns", _) => SOME NoDns
6ae327f8
AC
276 | _ => NONE
277
a3698041
AC
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
71420f8b
AC
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
a3698041 316val current = ref ""
e0b0abd2 317val currentPath = ref (fn (_ : string) => "")
e0b80e65 318val currentPathAli = ref (fn (_ : string, _ : string) => "")
dac62e84 319
d612d62c
AC
320val scratch = ref ""
321
dac62e84
AC
322fun currentDomain () = !current
323
e0b80e65
AC
324val currentsAli = ref ([] : string list)
325
326fun currentAliasDomains () = !currentsAli
327fun currentDomains () = currentDomain () :: currentAliasDomains ()
328
e0b0abd2
AC
329fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
330 TextIO.openOut (!currentPath node ^ name))
dac62e84 331
e0b80e65
AC
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
dac62e84
AC
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
d612d62c 353
e0b0abd2
AC
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
2ed6d0e5 378 app doNode nodes;
dac62e84
AC
379 elems
380 end) [] toks
381 in
e0b0abd2 382 fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
d612d62c
AC
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
e0b0abd2 390fun findDiffs (site, dom, acts) =
d612d62c 391 let
e0b0abd2
AC
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")*)
d612d62c
AC
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
8df2e702 414 if Slave.shell [Config.diff, " ", real, " ", tmp] then
d612d62c
AC
415 loopReal acts
416 else
e0b0abd2 417 loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
d612d62c 418 else
e0b0abd2 419 loopReal ((site, dom, realPath, Delete' real) :: acts)
d612d62c
AC
420 end
421
e0b0abd2 422 val acts = loopReal acts
d612d62c 423
8df2e702 424 val dir = Posix.FileSys.opendir tmpPath
d612d62c
AC
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
e0b0abd2 442 loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
d612d62c
AC
443 end
444
445 val acts = loopTmp acts
446 in
447 acts
dac62e84 448 end
a3698041 449
e0b0abd2
AC
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
36e42cb8
AC
492 exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
493 file = site}, diffs))
e0b0abd2
AC
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
6ae327f8
AC
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")
e0b80e65 509 val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
6ae327f8 510
e0b0abd2 511 val path = getPath dom
6ae327f8
AC
512
513 val () = (current := dom;
e0b80e65
AC
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)))
6ae327f8 517
e0b0abd2 518 fun saveSoa (kind, soa : soa) node =
e2359100 519 let
e0b80e65 520 val {write, writeDom, close} = domainsFile {node = node, name = "soa"}
e2359100 521 in
e0b80e65
AC
522 write kind;
523 write "\n";
524 write (Int.toString ttl);
525 write "\n";
526 write (#ns soa);
527 write "\n";
e2359100
AC
528 case #serial soa of
529 NONE => ()
e0b80e65
AC
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 ()
e2359100 541 end
6ae327f8 542
a431ca34 543 fun saveNamed (kind, soa : soa, masterIp, slaveIps) node =
b341fd6d
AC
544 if dom = "localhost" then
545 ()
546 else let
e0b80e65 547 val {write, writeDom, close} = domainsFile {node = node, name = "named.conf"}
b341fd6d 548 in
e0b80e65
AC
549 write "\nzone \"";
550 writeDom ();
a431ca34 551 write "\" {\n\ttype ";
e0b80e65
AC
552 write kind;
553 write ";\n\tfile \"";
554 write Config.Bind.zonePath_real;
555 write "/";
556 writeDom ();
557 write ".zone\";\n";
b341fd6d 558 case kind of
a431ca34
AC
559 "master" => (write "\tallow-transfer {\n";
560 app (fn ip => (write "\t\t";
561 write ip;
562 write ";\n")) slaveIps;
563 write "\t};\n")
e0b80e65
AC
564 | _ => (write "\tmasters { ";
565 write masterIp;
566 write "; };\n");
567 write "};\n";
568 close ()
b341fd6d 569 end
6ae327f8
AC
570 in
571 case kind of
e0b0abd2
AC
572 NoDns => masterNode := NONE
573 | UseDns dns =>
2ed6d0e5
AC
574 let
575 val masterIp =
576 case #master dns of
a431ca34 577 InternalMaster node => nodeIp node
2ed6d0e5 578 | ExternalMaster ip => ip
a431ca34
AC
579
580 val slaveIps = map nodeIp (#slaves dns)
2ed6d0e5
AC
581 in
582 app (saveSoa ("slave", #soa dns)) (#slaves dns);
a431ca34 583 app (saveNamed ("slave", #soa dns, masterIp, slaveIps)) (#slaves dns);
2ed6d0e5
AC
584 case #master dns of
585 InternalMaster node =>
586 (masterNode := SOME node;
587 saveSoa ("master", #soa dns) node;
a431ca34 588 saveNamed ("master", #soa dns, masterIp, slaveIps) node)
b25161c7
AC
589 | _ => masterNode := NONE
590 end;
591 !befores dom
6ae327f8 592 end,
e0b0abd2
AC
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}))
2ed6d0e5 601 nodes;
e0b0abd2
AC
602 app (fn node => OS.FileSys.mkDir
603 (OS.Path.joinDirFile {dir = Config.resultRoot,
604 file = node})
605 handle OS.SysErr _ => ())
2ed6d0e5 606 nodes))
e0b0abd2 607
c189cbe9
AC
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
e0b0abd2
AC
637val () = Env.registerPost (fn () =>
638 let
639 val diffs = findAllDiffs ()
6ae327f8 640
e0b0abd2
AC
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,
6ae327f8
AC
645 {action = Slave.Add,
646 domain = dom,
647 dir = dir,
e0b0abd2
AC
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,
6ae327f8
AC
654 {action = Slave.Delete,
655 domain = dom,
656 dir = dir,
e0b0abd2
AC
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,
6ae327f8
AC
662 {action = Slave.Modify,
663 domain = dom,
664 dir = dir,
e0b0abd2
AC
665 file = dst}))) diffs
666 in
667 if !ErrorMsg.anyErrors then
668 ()
36e42cb8
AC
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
36e42cb8
AC
678 in
679 SM.appi handleSite changed
680 end;
e0b0abd2 681 ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
559e89e9 682 fn cl => "Temp file cleanup failed: " ^ cl))
e0b0abd2 683 end)
6ae327f8 684
be1bea4c
AC
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))
60695e99 694
bbdf617f
AC
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
e69e60cc 702fun rmdom doms =
c189cbe9 703 let
c189cbe9
AC
704 fun doNode (node, _) =
705 let
706 val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
707 file = node}
c189cbe9 708
e69e60cc 709 fun doDom (dom, actions) =
93c2f623 710 let
e69e60cc
AC
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 _ =>
f208fe7e 741 (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ".\n");
e69e60cc 742 actions)
93c2f623 743 in
e69e60cc 744 visitDom (dom, dname, actions)
93c2f623
AC
745 end
746
e69e60cc 747 val actions = foldl doDom [] doms
c189cbe9 748 in
c189cbe9
AC
749 handleSite (node, actions)
750 end
e69e60cc 751 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
c189cbe9
AC
752
753 fun cleanupNode (node, _) =
754 let
e69e60cc
AC
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
c189cbe9 764 in
e69e60cc 765 app doDom doms
c189cbe9
AC
766 end
767 in
768 app doNode Config.nodeIps;
769 app cleanupNode Config.nodeIps
770 end
771
0da1c677
AC
772fun homedirOf uname =
773 Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
774
775fun homedir () = homedirOf (getUser ())
776
a3698041 777end