Change DefaultAliasSource to $user@hcoop.net, add defaultMailUser extern
[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
9b8c6dc8 30fun get_context () = valOf (!ssl_context)
36e42cb8 31
12adf55a 32val nodes = map #1 Config.nodeIps
2ed6d0e5
AC
33val nodeMap = foldl (fn ((node, ip), mp) => SM.insert (mp, node, ip))
34 SM.empty Config.nodeIps
8a7c40fa 35fun nodeIp node = valOf (SM.find (nodeMap, node))
2ed6d0e5 36
12adf55a 37val usr = ref ""
12adf55a 38fun getUser () = !usr
04502362
AC
39val fakePrivs = ref false
40val isClient = ref false
12adf55a
AC
41
42val your_doms = ref SS.empty
43fun your_domains () = !your_doms
44
8a7c40fa
AC
45val your_usrs = ref SS.empty
46fun your_users () = !your_usrs
47
48val your_grps = ref SS.empty
49fun your_groups () = !your_grps
50
51val your_pths = ref SS.empty
52fun your_paths () = !your_pths
53
26c7d224
AC
54val your_ipss = ref SS.empty
55fun your_ips () = !your_ipss
56
998ed174 57val world_readable = SS.addList (SS.empty, Config.worldReadable)
70822196 58val readable_pths = ref world_readable
998ed174
AC
59fun readable_paths () = !readable_pths
60
aa56e112 61fun setUser user =
998ed174
AC
62 let
63 val () = usr := user
64
65 val your_paths = Acl.class {user = getUser (),
66 class = "path"}
67 in
04502362 68 fakePrivs := false;
998ed174
AC
69 your_doms := Acl.class {user = getUser (),
70 class = "domain"};
71 your_usrs := Acl.class {user = getUser (),
72 class = "user"};
8dccfcbc
CE
73 your_grps := SS.add (Acl.class {user = getUser (),
74 class = "group"},
75 "nogroup");
998ed174 76 your_pths := your_paths;
26c7d224
AC
77 readable_pths := SS.union (your_paths, world_readable);
78 your_ipss := Acl.class {user = getUser (),
79 class = "ip"}
998ed174 80 end
aa56e112 81
04502362
AC
82fun declareClient () = isClient := true
83fun fakePrivileges () = if !isClient then
84 fakePrivs := true
85 else
86 raise Fail "Tried to fake privileges as non-client"
87
6ae327f8
AC
88fun validIp s =
89 case map Int.fromString (String.fields (fn ch => ch = #".") s) of
90 [SOME n1, SOME n2, SOME n3, SOME n4] =>
91 n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
92 | _ => false
93
090692f7
AC
94fun isHexDigit ch = Char.isDigit ch orelse (ord ch >= ord #"a" andalso ord ch <= ord #"f")
95
96fun validIpv6 s =
97 let
98 val fields = String.fields (fn ch => ch = #":") s
99
100 val empties = foldl (fn ("", n) => n + 1
101 | (_, n) => n) 0 fields
102
103 fun noIpv4 maxLen =
104 length fields >= 2
105 andalso length fields <= maxLen
106 andalso empties <= 1
107 andalso List.all (fn "" => true
108 | s => size s <= 4
109 andalso CharVector.all isHexDigit s) fields
110
111 fun hasIpv4 () =
112 length fields > 0
113 andalso
114 let
115 val maybeIpv4 = List.last fields
116 val theRest = List.take (fields, length fields - 1)
117 in
118 validIp maybeIpv4 andalso noIpv4 6
119 end
120 in
121 noIpv4 8 orelse hasIpv4 ()
122 end
123
629a34f6
AC
124fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
125
126fun validHost s =
16c5174b 127 size s > 0 andalso size s < 50
629a34f6
AC
128 andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
129
130fun validDomain s =
16c5174b 131 size s > 0 andalso size s < 200
629a34f6
AC
132 andalso List.all validHost (String.fields (fn ch => ch = #".") s)
133
2ed6d0e5 134fun validNode s = List.exists (fn s' => s = s') nodes
e0b0abd2 135
04502362 136fun yourDomain s = !fakePrivs orelse SS.member (your_domains (), s)
b89f3b68
CE
137fun yourUser s = !fakePrivs orelse SS.member (your_users (), s)
138fun yourGroup s = !fakePrivs orelse SS.member (your_groups (), s)
139
998ed174 140fun checkPath paths path =
b89f3b68 141 !fakePrivs orelse
04502362
AC
142 (List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path)
143 andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"/"
144 orelse ch = #"-" orelse ch = #"_") path
145 andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (paths ()))
998ed174
AC
146val yourPath = checkPath your_paths
147val readablePath = checkPath readable_paths
b89f3b68 148
04502362 149fun yourIp s = !fakePrivs orelse SS.member (your_ips (), s)
12adf55a 150
edd38024 151fun yourDomainHost s =
04502362
AC
152 !fakePrivs
153 orelse yourDomain s
c98b57cf 154 orelse let
edd38024
AC
155 val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
156 in
edd38024
AC
157 Substring.size suf > 0
158 andalso validHost (Substring.string pref)
159 andalso yourDomain (Substring.string
c98b57cf 160 (Substring.slice (suf, 1, NONE)))
edd38024
AC
161 end
162
93c2f623
AC
163val yourDomain = yourDomainHost
164
2aeb9eec
AC
165fun validUser s = size s > 0 andalso size s < 20
166 andalso CharVector.all Char.isAlphaNum s
167
2e96b9d4
AC
168fun validEmailUser s =
169 size s > 0 andalso size s < 50
170 andalso CharVector.all (fn ch => Char.isAlphaNum ch
171 orelse ch = #"."
172 orelse ch = #"_"
173 orelse ch = #"-"
174 orelse ch = #"+") s
175
2aeb9eec
AC
176val validGroup = validUser
177
f8dfbbcc
AC
178val _ = Env.type_one "no_spaces"
179 Env.string
ca6ffb3f
AC
180 (CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
181 andalso ch <> #"\"" andalso ch <> #"'"))
d5754b53
AC
182val _ = Env.type_one "no_newlines"
183 Env.string
ca6ffb3f 184 (CharVector.all (fn ch => Char.isPrint ch andalso ch <> #"\n" andalso ch <> #"\r"
5e3ad5d2 185 andalso ch <> #"\""))
f8dfbbcc 186
6ae327f8
AC
187val _ = Env.type_one "ip"
188 Env.string
189 validIp
190
090692f7
AC
191val _ = Env.type_one "ipv6"
192 Env.string
193 validIpv6
194
629a34f6
AC
195val _ = Env.type_one "host"
196 Env.string
197 validHost
198
199val _ = Env.type_one "domain"
200 Env.string
201 validDomain
202
12adf55a
AC
203val _ = Env.type_one "your_domain"
204 Env.string
205 yourDomain
206
edd38024
AC
207val _ = Env.type_one "your_domain_host"
208 Env.string
209 yourDomainHost
210
2aeb9eec
AC
211val _ = Env.type_one "user"
212 Env.string
213 validUser
214
215val _ = Env.type_one "group"
216 Env.string
217 validGroup
218
8a7c40fa
AC
219val _ = Env.type_one "your_user"
220 Env.string
221 yourUser
222
223val _ = Env.type_one "your_group"
224 Env.string
225 yourGroup
226
227val _ = Env.type_one "your_path"
228 Env.string
229 yourPath
230
998ed174
AC
231val _ = Env.type_one "readable_path"
232 Env.string
233 readablePath
234
26c7d224
AC
235val _ = Env.type_one "your_ip"
236 Env.string
237 yourIp
238
e0b0abd2
AC
239val _ = Env.type_one "node"
240 Env.string
241 validNode
242
fb09779a
AC
243val _ = Env.type_one "mime_type"
244 Env.string
245 (CharVector.exists (fn ch => ch = #"/"))
246
2e87719c
AC
247val _ = Env.registerFunction ("your_ip_to_ip",
248 fn [e] => SOME e
249 | _ => NONE)
250
bbdf617f
AC
251val _ = Env.registerFunction ("dns_node_to_node",
252 fn [e] => SOME e
253 | _ => NONE)
254
255val _ = Env.registerFunction ("mail_node_to_node",
be1bea4c
AC
256 fn [e] => SOME e
257 | _ => NONE)
b0963032
AC
258
259
a3698041
AC
260open Ast
261
6ae327f8
AC
262val dl = ErrorMsg.dummyLoc
263
b0963032
AC
264val _ = Env.registerFunction ("end_in_slash",
265 fn [(EString "", _)] => SOME (EString "/", dl)
266 | [(EString s, _)] =>
267 SOME (EString (if String.sub (s, size s - 1) = #"/" then
268 s
269 else
270 s ^ "/"), dl)
271 | _ => NONE)
272
273
d08b9cf2
CE
274val _ = Env.registerFunction ("you",
275 fn [] => SOME (EString (getUser ()), dl)
276 | _ => NONE)
e0b0abd2 277
d08b9cf2
CE
278val _ = Env.registerFunction ("defaultMailbox",
279 fn [] => SOME (EString (getUser ()), dl)
280 | _ => NONE)
6ae327f8 281
2fc04473
CE
282val _ = Env.registerFunction ("defaultMailUser",
283 fn [] => SOME (EString (getUser ()), dl)
284 | _ => NONE)
285
6ae327f8
AC
286
287type soa = {ns : string,
288 serial : int option,
289 ref : int,
290 ret : int,
291 exp : int,
292 min : int}
293
294val serial = fn (EVar "serialAuto", _) => SOME NONE
295 | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
296 | _ => NONE
297
298val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp
299 ((EVar "soa", _), ns), _),
300 sl), _),
301 rf), _),
302 ret), _),
303 exp), _),
304 min), _) =>
305 (case (Env.string ns, serial sl, Env.int rf,
306 Env.int ret, Env.int exp, Env.int min) of
307 (SOME ns, SOME sl, SOME rf,
308 SOME ret, SOME exp, SOME min) =>
309 SOME {ns = ns,
310 serial = sl,
311 ref = rf,
312 ret = ret,
313 exp = exp,
314 min = min}
315 | _ => NONE)
316 | _ => NONE
317
e0b0abd2
AC
318datatype master =
319 ExternalMaster of string
320 | InternalMaster of string
321
cf879b4f
AC
322val ip = Env.string
323
324val _ = Env.registerFunction ("ip_of_node",
325 fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
326 | _ => NONE)
97665758
AC
327
328val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
8b84db5b 329 | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
e0b0abd2
AC
330 | _ => NONE
331
6ae327f8 332datatype dnsKind =
e0b0abd2
AC
333 UseDns of {soa : soa,
334 master : master,
335 slaves : string list}
6ae327f8
AC
336 | NoDns
337
e0b0abd2
AC
338val dnsKind = fn (EApp ((EApp ((EApp
339 ((EVar "useDns", _), sa), _),
340 mstr), _),
341 slaves), _) =>
342 (case (soa sa, master mstr, Env.list Env.string slaves) of
343 (SOME sa, SOME mstr, SOME slaves) =>
344 SOME (UseDns {soa = sa,
345 master = mstr,
346 slaves = slaves})
347 | _ => NONE)
325285ab 348 | (EVar "noDns", _) => SOME NoDns
6ae327f8
AC
349 | _ => NONE
350
a3698041
AC
351val befores = ref (fn (_ : string) => ())
352val afters = ref (fn (_ : string) => ())
353
354fun registerBefore f =
355 let
356 val old = !befores
357 in
358 befores := (fn x => (old x; f x))
359 end
360
361fun registerAfter f =
362 let
363 val old = !afters
364 in
365 afters := (fn x => (old x; f x))
366 end
367
71420f8b
AC
368val globals = ref (fn () => ())
369val locals = ref (fn () => ())
370
371fun registerResetGlobal f =
372 let
373 val old = !globals
374 in
375 globals := (fn x => (old x; f x))
376 end
377
378fun registerResetLocal f =
379 let
380 val old = !locals
381 in
382 locals := (fn x => (old x; f x))
383 end
384
385fun resetGlobal () = (!globals ();
386 ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
387fun resetLocal () = !locals ()
388
a3698041 389val current = ref ""
e0b0abd2 390val currentPath = ref (fn (_ : string) => "")
e0b80e65 391val currentPathAli = ref (fn (_ : string, _ : string) => "")
dac62e84 392
d612d62c
AC
393val scratch = ref ""
394
dac62e84
AC
395fun currentDomain () = !current
396
e0b80e65
AC
397val currentsAli = ref ([] : string list)
398
399fun currentAliasDomains () = !currentsAli
400fun currentDomains () = currentDomain () :: currentAliasDomains ()
401
e0b0abd2
AC
402fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
403 TextIO.openOut (!currentPath node ^ name))
dac62e84 404
e0b80e65
AC
405type files = {write : string -> unit,
406 writeDom : unit -> unit,
407 close : unit -> unit}
408
409fun domainsFile {node, name} =
410 let
411 val doms = currentDomains ()
412 val files = map (fn dom => (dom, TextIO.openOut (!currentPathAli (dom, node) ^ name))) doms
413 in
414 {write = fn s => app (fn (_, outf) => TextIO.output (outf, s)) files,
415 writeDom = fn () => app (fn (dom, outf) => TextIO.output (outf, dom)) files,
416 close = fn () => app (fn (_, outf) => TextIO.closeOut outf) files}
417 end
418
dac62e84
AC
419fun getPath domain =
420 let
421 val toks = String.fields (fn ch => ch = #".") domain
422
423 val elems = foldr (fn (piece, elems) =>
424 let
425 val elems = piece :: elems
d612d62c 426
e0b0abd2
AC
427 fun doNode node =
428 let
429 val path = String.concatWith "/"
430 (Config.resultRoot :: node :: rev elems)
431 val tmpPath = String.concatWith "/"
432 (Config.tmpDir :: node :: rev elems)
433 in
434 (if Posix.FileSys.ST.isDir
435 (Posix.FileSys.stat path) then
436 ()
437 else
438 (OS.FileSys.remove path;
439 OS.FileSys.mkDir path))
440 handle OS.SysErr _ => OS.FileSys.mkDir path;
441
442 (if Posix.FileSys.ST.isDir
443 (Posix.FileSys.stat tmpPath) then
444 ()
445 else
446 (OS.FileSys.remove tmpPath;
447 OS.FileSys.mkDir tmpPath))
448 handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
449 end
450 in
2ed6d0e5 451 app doNode nodes;
dac62e84
AC
452 elems
453 end) [] toks
454 in
e0b0abd2 455 fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
d612d62c
AC
456 end
457
458datatype file_action' =
459 Add' of {src : string, dst : string}
460 | Delete' of string
461 | Modify' of {src : string, dst : string}
462
aaf70d45 463fun findDiffs (prefixes, site, dom, acts) =
d612d62c 464 let
e0b0abd2
AC
465 val gp = getPath dom
466 val realPath = gp (Config.resultRoot, site)
467 val tmpPath = gp (Config.tmpDir, site)
468
469 (*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)
d612d62c
AC
470
471 val dir = Posix.FileSys.opendir realPath
472
473 fun loopReal acts =
474 case Posix.FileSys.readdir dir of
475 NONE => (Posix.FileSys.closedir dir;
476 acts)
477 | SOME fname =>
478 let
479 val real = OS.Path.joinDirFile {dir = realPath,
480 file = fname}
481 val tmp = OS.Path.joinDirFile {dir = tmpPath,
482 file = fname}
483 in
484 if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
485 loopReal acts
486 else if Posix.FileSys.access (tmp, []) then
8df2e702 487 if Slave.shell [Config.diff, " ", real, " ", tmp] then
d612d62c
AC
488 loopReal acts
489 else
e0b0abd2 490 loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
4f9c5b51 491 else if List.exists (fn prefix => String.isPrefix prefix real) prefixes then
e0b0abd2 492 loopReal ((site, dom, realPath, Delete' real) :: acts)
aaf70d45
AC
493 else
494 loopReal acts
d612d62c
AC
495 end
496
e0b0abd2 497 val acts = loopReal acts
d612d62c 498
8df2e702 499 val dir = Posix.FileSys.opendir tmpPath
d612d62c
AC
500
501 fun loopTmp acts =
502 case Posix.FileSys.readdir dir of
503 NONE => (Posix.FileSys.closedir dir;
504 acts)
505 | SOME fname =>
506 let
507 val real = OS.Path.joinDirFile {dir = realPath,
508 file = fname}
509 val tmp = OS.Path.joinDirFile {dir = tmpPath,
510 file = fname}
511 in
512 if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
513 loopTmp acts
514 else if Posix.FileSys.access (real, []) then
515 loopTmp acts
516 else
e0b0abd2 517 loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
d612d62c
AC
518 end
519
520 val acts = loopTmp acts
521 in
522 acts
dac62e84 523 end
a3698041 524
aaf70d45 525fun findAllDiffs prefixes =
e0b0abd2
AC
526 let
527 val dir = Posix.FileSys.opendir Config.tmpDir
528 val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
529
530 fun exploreSites diffs =
531 case Posix.FileSys.readdir dir of
532 NONE => diffs
533 | SOME site =>
534 let
535 fun explore (dname, diffs) =
536 let
537 val dir = Posix.FileSys.opendir dname
538
539 fun loop diffs =
540 case Posix.FileSys.readdir dir of
541 NONE => diffs
542 | SOME name =>
543 let
544 val fname = OS.Path.joinDirFile {dir = dname,
545 file = name}
546 in
547 loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
548 let
549 val dom = String.fields (fn ch => ch = #"/") fname
550 val dom = List.drop (dom, len)
551 val dom = String.concatWith "." (rev dom)
552
553 val dname' = OS.Path.joinDirFile {dir = dname,
554 file = name}
555 in
556 explore (dname',
aaf70d45 557 findDiffs (prefixes, site, dom, diffs))
e0b0abd2
AC
558 end
559 else
560 diffs)
561 end
562 in
563 loop diffs
564 before Posix.FileSys.closedir dir
565 end
566 in
36e42cb8
AC
567 exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
568 file = site}, diffs))
e0b0abd2
AC
569 end
570 in
571 exploreSites []
572 before Posix.FileSys.closedir dir
573 end
574
575val masterNode : string option ref = ref NONE
576fun dnsMaster () = !masterNode
577
aaf70d45
AC
578val seenDomains : string list ref = ref []
579
6ae327f8
AC
580val _ = Env.containerV_one "domain"
581 ("domain", Env.string)
582 (fn (evs, dom) =>
583 let
aaf70d45
AC
584 val () = seenDomains := dom :: !seenDomains
585
6ae327f8
AC
586 val kind = Env.env dnsKind (evs, "DNS")
587 val ttl = Env.env Env.int (evs, "TTL")
e0b80e65 588 val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
6ae327f8 589
e0b0abd2 590 val path = getPath dom
6ae327f8
AC
591
592 val () = (current := dom;
e0b80e65
AC
593 currentsAli := Slave.remove (Slave.removeDups aliases, dom);
594 currentPath := (fn site => path (Config.tmpDir, site));
595 currentPathAli := (fn (dom, site) => getPath dom (Config.tmpDir, site)))
6ae327f8 596
e0b0abd2 597 fun saveSoa (kind, soa : soa) node =
e2359100 598 let
3ae703b6 599 val {write, writeDom, close} = domainsFile {node = node, name = "soa.conf"}
e2359100 600 in
e0b80e65
AC
601 write kind;
602 write "\n";
603 write (Int.toString ttl);
604 write "\n";
605 write (#ns soa);
606 write "\n";
e2359100
AC
607 case #serial soa of
608 NONE => ()
e0b80e65
AC
609 | SOME n => write (Int.toString n);
610 write "\n";
611 write (Int.toString (#ref soa));
612 write "\n";
613 write (Int.toString (#ret soa));
614 write "\n";
615 write (Int.toString (#exp soa));
616 write "\n";
617 write (Int.toString (#min soa));
618 write "\n";
619 close ()
e2359100 620 end
6ae327f8 621
a431ca34 622 fun saveNamed (kind, soa : soa, masterIp, slaveIps) node =
b341fd6d
AC
623 if dom = "localhost" then
624 ()
625 else let
e0b80e65 626 val {write, writeDom, close} = domainsFile {node = node, name = "named.conf"}
b341fd6d 627 in
e0b80e65
AC
628 write "\nzone \"";
629 writeDom ();
a431ca34 630 write "\" {\n\ttype ";
e0b80e65
AC
631 write kind;
632 write ";\n\tfile \"";
633 write Config.Bind.zonePath_real;
634 write "/";
635 writeDom ();
636 write ".zone\";\n";
b341fd6d 637 case kind of
a431ca34
AC
638 "master" => (write "\tallow-transfer {\n";
639 app (fn ip => (write "\t\t";
640 write ip;
641 write ";\n")) slaveIps;
642 write "\t};\n")
e0b80e65
AC
643 | _ => (write "\tmasters { ";
644 write masterIp;
036cfc59
AC
645 write "; };\n";
646 write "// Updated: ";
647 write (Time.toString (Time.now ()));
648 write "\n");
e0b80e65
AC
649 write "};\n";
650 close ()
b341fd6d 651 end
6ae327f8
AC
652 in
653 case kind of
e0b0abd2
AC
654 NoDns => masterNode := NONE
655 | UseDns dns =>
2ed6d0e5
AC
656 let
657 val masterIp =
658 case #master dns of
a431ca34 659 InternalMaster node => nodeIp node
2ed6d0e5 660 | ExternalMaster ip => ip
a431ca34
AC
661
662 val slaveIps = map nodeIp (#slaves dns)
2ed6d0e5 663 in
a431ca34 664 app (saveNamed ("slave", #soa dns, masterIp, slaveIps)) (#slaves dns);
2ed6d0e5
AC
665 case #master dns of
666 InternalMaster node =>
667 (masterNode := SOME node;
668 saveSoa ("master", #soa dns) node;
a431ca34 669 saveNamed ("master", #soa dns, masterIp, slaveIps) node)
b25161c7
AC
670 | _ => masterNode := NONE
671 end;
672 !befores dom
6ae327f8 673 end,
e0b0abd2
AC
674 fn () => !afters (!current))
675
aaf70d45
AC
676val () = Env.registerPre (fn () => (seenDomains := [];
677 ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
e0b0abd2
AC
678 fn cl => "Temp file cleanup failed: " ^ cl));
679 OS.FileSys.mkDir Config.tmpDir;
680 app (fn node => OS.FileSys.mkDir
681 (OS.Path.joinDirFile {dir = Config.tmpDir,
682 file = node}))
2ed6d0e5 683 nodes;
e0b0abd2
AC
684 app (fn node => OS.FileSys.mkDir
685 (OS.Path.joinDirFile {dir = Config.resultRoot,
686 file = node})
687 handle OS.SysErr _ => ())
2ed6d0e5 688 nodes))
e0b0abd2 689
c189cbe9
AC
690fun handleSite (site, files) =
691 let
692
693 in
694 print ("New configuration for node " ^ site ^ "\n");
201b83c7 695 if site = Config.dispatcherName then
c189cbe9
AC
696 Slave.handleChanges files
697 else let
8be753d9
AC
698 val bio = OpenSSL.connect true (valOf (!ssl_context),
699 nodeIp site
700 ^ ":"
701 ^ Int.toString Config.slavePort)
c189cbe9
AC
702 in
703 app (fn file => Msg.send (bio, MsgFile file)) files;
704 Msg.send (bio, MsgDoFiles);
705 case Msg.recv bio of
706 NONE => print "Slave closed connection unexpectedly\n"
707 | SOME m =>
708 case m of
709 MsgOk => print ("Slave " ^ site ^ " finished\n")
710 | MsgError s => print ("Slave " ^ site
711 ^ " returned error: " ^
712 s ^ "\n")
713 | _ => print ("Slave " ^ site
714 ^ " returned unexpected command\n");
715 OpenSSL.close bio
716 end
717 end
718
e0b0abd2
AC
719val () = Env.registerPost (fn () =>
720 let
4f9c5b51
AC
721 val prefixes = List.concat
722 (List.map (fn dom =>
723 let
724 val pieces = String.tokens (fn ch => ch = #".") dom
725 val path = String.concatWith "/" (rev pieces)
726 in
727 List.map (fn node =>
728 Config.resultRoot ^ "/" ^ node ^ "/" ^ path ^ "/")
729 nodes
730 end) (!seenDomains))
aaf70d45
AC
731
732 val diffs = findAllDiffs prefixes
6ae327f8 733
e0b0abd2
AC
734 val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
735 (Slave.shellF ([Config.cp, " ", src, " ", dst],
736 fn cl => "Copy failed: " ^ cl);
737 (site,
6ae327f8
AC
738 {action = Slave.Add,
739 domain = dom,
740 dir = dir,
e0b0abd2
AC
741 file = dst}))
742 | (site, dom, dir, Delete' dst) =>
743 (OS.FileSys.remove dst
744 handle OS.SysErr _ =>
745 ErrorMsg.error NONE ("Delete failed for " ^ dst);
746 (site,
1638d5a2 747 {action = Slave.Delete true,
6ae327f8
AC
748 domain = dom,
749 dir = dir,
e0b0abd2
AC
750 file = dst}))
751 | (site, dom, dir, Modify' {src, dst}) =>
752 (Slave.shellF ([Config.cp, " ", src, " ", dst],
753 fn cl => "Copy failed: " ^ cl);
754 (site,
6ae327f8
AC
755 {action = Slave.Modify,
756 domain = dom,
757 dir = dir,
e0b0abd2
AC
758 file = dst}))) diffs
759 in
760 if !ErrorMsg.anyErrors then
761 ()
36e42cb8
AC
762 else let
763 val changed = foldl (fn ((site, file), changed) =>
764 let
765 val ls = case SM.find (changed, site) of
766 NONE => []
767 | SOME ls => ls
768 in
769 SM.insert (changed, site, file :: ls)
770 end) SM.empty diffs
36e42cb8
AC
771 in
772 SM.appi handleSite changed
773 end;
e0b0abd2 774 ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
559e89e9 775 fn cl => "Temp file cleanup failed: " ^ cl))
e0b0abd2 776 end)
6ae327f8 777
be1bea4c
AC
778fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
779 orelse Acl.query {user = getUser (), class = "priv", value = priv}
780
781val _ = Env.type_one "dns_node"
782 Env.string
783 (fn node =>
784 List.exists (fn x => x = node) Config.dnsNodes_all
785 orelse (hasPriv "dns"
786 andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
60695e99 787
bbdf617f
AC
788val _ = Env.type_one "mail_node"
789 Env.string
790 (fn node =>
791 List.exists (fn x => x = node) Config.mailNodes_all
792 orelse (hasPriv "mail"
793 andalso List.exists (fn x => x = node) Config.mailNodes_admin))
794
1638d5a2 795fun rmdom' delete resultRoot doms =
c189cbe9 796 let
c189cbe9
AC
797 fun doNode (node, _) =
798 let
1638d5a2 799 val dname = OS.Path.joinDirFile {dir = resultRoot,
c189cbe9 800 file = node}
c189cbe9 801
e69e60cc 802 fun doDom (dom, actions) =
93c2f623 803 let
e69e60cc
AC
804 val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
805 val dname = OS.Path.concat (dname, domPath)
806
807 fun visitDom (dom, dname, actions) =
808 let
809 val dir = Posix.FileSys.opendir dname
810
811 fun loop actions =
812 case Posix.FileSys.readdir dir of
813 NONE => actions
814 | SOME fname =>
815 let
816 val fnameFull = OS.Path.joinDirFile {dir = dname,
817 file = fname}
818 in
819 if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
820 loop (visitDom (fname ^ "." ^ dom,
821 fnameFull,
822 actions))
1638d5a2 823 else
1638d5a2
AC
824 loop ({action = Slave.Delete delete,
825 domain = dom,
826 dir = dname,
b200e996 827 file = fnameFull} :: actions)
e69e60cc
AC
828 end
829 in
830 loop actions
831 before Posix.FileSys.closedir dir
832 end
1638d5a2
AC
833 handle OS.SysErr (s, _) =>
834 (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ": " ^ s ^ "\n");
e69e60cc 835 actions)
93c2f623 836 in
e69e60cc 837 visitDom (dom, dname, actions)
93c2f623
AC
838 end
839
e69e60cc 840 val actions = foldl doDom [] doms
c189cbe9 841 in
c189cbe9
AC
842 handleSite (node, actions)
843 end
e69e60cc 844 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
c189cbe9
AC
845
846 fun cleanupNode (node, _) =
847 let
e69e60cc
AC
848 fun doDom dom =
849 let
850 val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
1638d5a2 851 val dname = OS.Path.joinDirFile {dir = resultRoot,
e69e60cc
AC
852 file = node}
853 val dname = OS.Path.concat (dname, domPath)
854 in
1638d5a2
AC
855 if delete then
856 ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
857 else
858 ()
e69e60cc 859 end
c189cbe9 860 in
e69e60cc 861 app doDom doms
c189cbe9
AC
862 end
863 in
864 app doNode Config.nodeIps;
865 app cleanupNode Config.nodeIps
866 end
867
1638d5a2
AC
868val rmdom = rmdom' true Config.resultRoot
869val rmdom' = rmdom' false
870
0da1c677
AC
871fun homedirOf uname =
872 Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
873
874fun homedir () = homedirOf (getUser ())
b89f3b68 875 handle e => if !fakePrivs then "/tmp" else raise e
0da1c677 876
314ce7bd
AC
877type subject = {node : string, domain : string}
878
879val describers : (subject -> string) list ref = ref []
880
881fun registerDescriber f = describers := f :: !describers
882
41c58daf 883fun describeOne arg = String.concat (map (fn f => f arg) (rev (!describers)))
314ce7bd 884
d300166d
AC
885val line = "--------------------------------------------------------------\n"
886val dline = "==============================================================\n"
314ce7bd
AC
887
888fun describe dom =
889 String.concat (List.mapPartial
890 (fn node =>
891 case describeOne {node = node, domain = dom} of
892 "" => NONE
893 | s =>
894 SOME (String.concat [dline, "Node ", node, "\n", dline, "\n", s]))
895 nodes)
896
897datatype description =
41c58daf 898 Filename of { filename : string, heading : string, showEmpty : bool }
314ce7bd
AC
899 | Extension of { extension : string, heading : string -> string }
900
901fun considerAll ds {node, domain} =
902 let
903 val ds = map (fn d => (d, ref [])) ds
904
905 val path = Config.resultRoot
906 val jdf = OS.Path.joinDirFile
907 val path = jdf {dir = path, file = node}
908 val path = foldr (fn (more, path) => jdf {dir = path, file = more})
909 path (String.tokens (fn ch => ch = #".") domain)
910 in
911 if Posix.FileSys.access (path, []) then
912 let
913 val dir = Posix.FileSys.opendir path
914
915 fun loop () =
916 case Posix.FileSys.readdir dir of
917 NONE => ()
918 | SOME fname =>
41c58daf
AC
919 (app (fn (d, entries) =>
920 let
921 fun readFile showEmpty entries' =
922 let
923 val fname = OS.Path.joinDirFile {dir = path,
924 file = fname}
925
926 val inf = TextIO.openIn fname
927
928 fun loop (seenOne, entries') =
929 case TextIO.inputLine inf of
930 NONE => if seenOne orelse showEmpty then
931 "\n" :: entries'
932 else
933 !entries
934 | SOME line => loop (true, line :: entries')
935 in
936 loop (false, entries')
937 before TextIO.closeIn inf
938 end
939 in
940 case d of
941 Filename {filename, heading, showEmpty} =>
942 if fname = filename then
d936cf4d 943 entries := readFile showEmpty ("\n" :: line :: "\n" :: heading :: line :: !entries)
41c58daf
AC
944 else
945 ()
946 | Extension {extension, heading} =>
947 let
948 val {base, ext} = OS.Path.splitBaseExt fname
949 in
950 case ext of
951 NONE => ()
952 | SOME extension' =>
953 if extension' = extension then
d936cf4d 954 entries := readFile true ("\n" :: line :: "\n" :: heading base :: line :: !entries)
41c58daf
AC
955 else
956 ()
957 end
958 end) ds;
959 loop ())
314ce7bd
AC
960 in
961 loop ();
962 Posix.FileSys.closedir dir;
963 String.concat (List.concat (map (fn (_, entries) => rev (!entries)) ds))
964 end
965 else
966 ""
967 end
968
3ae703b6 969val () = registerDescriber (considerAll [Filename {filename = "soa.conf",
d936cf4d 970 heading = "DNS SOA:",
41c58daf 971 showEmpty = false}])
314ce7bd 972
e9f528ab
AC
973val () = Env.registerAction ("domainHost",
974 fn (env, [(EString host, _)]) =>
975 SM.insert (env, "Hostname",
976 (EString (host ^ "." ^ currentDomain ()), dl))
977 | (_, args) => Env.badArgs ("domainHost", args))
978
563e7792
AC
979val ouc = ref (fn () => ())
980
981fun registerOnUsersChange f =
982 let
983 val f' = !ouc
984 in
985 ouc := (fn () => (f' (); f ()))
986 end
987
988fun onUsersChange () = !ouc ()
989
a3698041 990end