HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
merge toplevel-dynamic-environment
[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
6ae327f8
AC		 282
283type soa = {ns : string,
284 serial : int option,
285 ref : int,
286 ret : int,
287 exp : int,
288 min : int}
289
290val serial = fn (EVar "serialAuto", _) => SOME NONE
291 | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
292 | _ => NONE
293
294val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp
295 ((EVar "soa", _), ns), _),
296 sl), _),
297 rf), _),
298 ret), _),
299 exp), _),
300 min), _) =>
301 (case (Env.string ns, serial sl, Env.int rf,
302 Env.int ret, Env.int exp, Env.int min) of
303 (SOME ns, SOME sl, SOME rf,
304 SOME ret, SOME exp, SOME min) =>
305 SOME {ns = ns,
306 serial = sl,
307 ref = rf,
308 ret = ret,
309 exp = exp,
310 min = min}
311 | _ => NONE)
312 | _ => NONE
313
e0b0abd2
AC		 314datatype master =
315 ExternalMaster of string
316 | InternalMaster of string
317
cf879b4f
AC		 318val ip = Env.string
319
320val _ = Env.registerFunction ("ip_of_node",
321 fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
322 | _ => NONE)
97665758
AC		 323
324val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
8b84db5b 325 | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
e0b0abd2
AC		 326 | _ => NONE
327
6ae327f8 328datatype dnsKind =
e0b0abd2
AC		 329 UseDns of {soa : soa,
330 master : master,
331 slaves : string list}
6ae327f8
AC		 332 | NoDns
333
e0b0abd2
AC		 334val dnsKind = fn (EApp ((EApp ((EApp
335 ((EVar "useDns", _), sa), _),
336 mstr), _),
337 slaves), _) =>
338 (case (soa sa, master mstr, Env.list Env.string slaves) of
339 (SOME sa, SOME mstr, SOME slaves) =>
340 SOME (UseDns {soa = sa,
341 master = mstr,
342 slaves = slaves})
343 | _ => NONE)
325285ab 344 | (EVar "noDns", _) => SOME NoDns
6ae327f8
AC		 345 | _ => NONE
346
a3698041
AC		 347val befores = ref (fn (_ : string) => ())
348val afters = ref (fn (_ : string) => ())
349
350fun registerBefore f =
351 let
352 val old = !befores
353 in
354 befores := (fn x => (old x; f x))
355 end
356
357fun registerAfter f =
358 let
359 val old = !afters
360 in
361 afters := (fn x => (old x; f x))
362 end
363
71420f8b
AC		 364val globals = ref (fn () => ())
365val locals = ref (fn () => ())
366
367fun registerResetGlobal f =
368 let
369 val old = !globals
370 in
371 globals := (fn x => (old x; f x))
372 end
373
374fun registerResetLocal f =
375 let
376 val old = !locals
377 in
378 locals := (fn x => (old x; f x))
379 end
380
381fun resetGlobal () = (!globals ();
382 ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
383fun resetLocal () = !locals ()
384
a3698041 385val current = ref ""
e0b0abd2 386val currentPath = ref (fn (_ : string) => "")
e0b80e65 387val currentPathAli = ref (fn (_ : string, _ : string) => "")
dac62e84 388
d612d62c
AC		 389val scratch = ref ""
390
dac62e84
AC		 391fun currentDomain () = !current
392
e0b80e65
AC		 393val currentsAli = ref ([] : string list)
394
395fun currentAliasDomains () = !currentsAli
396fun currentDomains () = currentDomain () :: currentAliasDomains ()
397
e0b0abd2
AC		 398fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
399 TextIO.openOut (!currentPath node ^ name))
dac62e84 400
e0b80e65
AC		 401type files = {write : string -> unit,
402 writeDom : unit -> unit,
403 close : unit -> unit}
404
405fun domainsFile {node, name} =
406 let
407 val doms = currentDomains ()
408 val files = map (fn dom => (dom, TextIO.openOut (!currentPathAli (dom, node) ^ name))) doms
409 in
410 {write = fn s => app (fn (_, outf) => TextIO.output (outf, s)) files,
411 writeDom = fn () => app (fn (dom, outf) => TextIO.output (outf, dom)) files,
412 close = fn () => app (fn (_, outf) => TextIO.closeOut outf) files}
413 end
414
dac62e84
AC		 415fun getPath domain =
416 let
417 val toks = String.fields (fn ch => ch = #".") domain
418
419 val elems = foldr (fn (piece, elems) =>
420 let
421 val elems = piece :: elems
d612d62c 422
e0b0abd2
AC		 423 fun doNode node =
424 let
425 val path = String.concatWith "/"
426 (Config.resultRoot :: node :: rev elems)
427 val tmpPath = String.concatWith "/"
428 (Config.tmpDir :: node :: rev elems)
429 in
430 (if Posix.FileSys.ST.isDir
431 (Posix.FileSys.stat path) then
432 ()
433 else
434 (OS.FileSys.remove path;
435 OS.FileSys.mkDir path))
436 handle OS.SysErr _ => OS.FileSys.mkDir path;
437
438 (if Posix.FileSys.ST.isDir
439 (Posix.FileSys.stat tmpPath) then
440 ()
441 else
442 (OS.FileSys.remove tmpPath;
443 OS.FileSys.mkDir tmpPath))
444 handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
445 end
446 in
2ed6d0e5 447 app doNode nodes;
dac62e84
AC		 448 elems
449 end) [] toks
450 in
e0b0abd2 451 fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
d612d62c
AC		 452 end
453
454datatype file_action' =
455 Add' of {src : string, dst : string}
456 | Delete' of string
457 | Modify' of {src : string, dst : string}
458
aaf70d45 459fun findDiffs (prefixes, site, dom, acts) =
d612d62c 460 let
e0b0abd2
AC		 461 val gp = getPath dom
462 val realPath = gp (Config.resultRoot, site)
463 val tmpPath = gp (Config.tmpDir, site)
464
465 (*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)
d612d62c
AC		 466
467 val dir = Posix.FileSys.opendir realPath
468
469 fun loopReal acts =
470 case Posix.FileSys.readdir dir of
471 NONE => (Posix.FileSys.closedir dir;
472 acts)
473 | SOME fname =>
474 let
475 val real = OS.Path.joinDirFile {dir = realPath,
476 file = fname}
477 val tmp = OS.Path.joinDirFile {dir = tmpPath,
478 file = fname}
479 in
480 if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
481 loopReal acts
482 else if Posix.FileSys.access (tmp, []) then
8df2e702 483 if Slave.shell [Config.diff, " ", real, " ", tmp] then
d612d62c
AC		 484 loopReal acts
485 else
e0b0abd2 486 loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
4f9c5b51 487 else if List.exists (fn prefix => String.isPrefix prefix real) prefixes then
e0b0abd2 488 loopReal ((site, dom, realPath, Delete' real) :: acts)
aaf70d45
AC		 489 else
490 loopReal acts
d612d62c
AC		 491 end
492
e0b0abd2 493 val acts = loopReal acts
d612d62c 494
8df2e702 495 val dir = Posix.FileSys.opendir tmpPath
d612d62c
AC		 496
497 fun loopTmp acts =
498 case Posix.FileSys.readdir dir of
499 NONE => (Posix.FileSys.closedir dir;
500 acts)
501 | SOME fname =>
502 let
503 val real = OS.Path.joinDirFile {dir = realPath,
504 file = fname}
505 val tmp = OS.Path.joinDirFile {dir = tmpPath,
506 file = fname}
507 in
508 if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
509 loopTmp acts
510 else if Posix.FileSys.access (real, []) then
511 loopTmp acts
512 else
e0b0abd2 513 loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
d612d62c
AC		 514 end
515
516 val acts = loopTmp acts
517 in
518 acts
dac62e84 519 end
a3698041 520
aaf70d45 521fun findAllDiffs prefixes =
e0b0abd2
AC		 522 let
523 val dir = Posix.FileSys.opendir Config.tmpDir
524 val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
525
526 fun exploreSites diffs =
527 case Posix.FileSys.readdir dir of
528 NONE => diffs
529 | SOME site =>
530 let
531 fun explore (dname, diffs) =
532 let
533 val dir = Posix.FileSys.opendir dname
534
535 fun loop diffs =
536 case Posix.FileSys.readdir dir of
537 NONE => diffs
538 | SOME name =>
539 let
540 val fname = OS.Path.joinDirFile {dir = dname,
541 file = name}
542 in
543 loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
544 let
545 val dom = String.fields (fn ch => ch = #"/") fname
546 val dom = List.drop (dom, len)
547 val dom = String.concatWith "." (rev dom)
548
549 val dname' = OS.Path.joinDirFile {dir = dname,
550 file = name}
551 in
552 explore (dname',
aaf70d45 553 findDiffs (prefixes, site, dom, diffs))
e0b0abd2
AC		 554 end
555 else
556 diffs)
557 end
558 in
559 loop diffs
560 before Posix.FileSys.closedir dir
561 end
562 in
36e42cb8
AC		 563 exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
564 file = site}, diffs))
e0b0abd2
AC		 565 end
566 in
567 exploreSites []
568 before Posix.FileSys.closedir dir
569 end
570
571val masterNode : string option ref = ref NONE
572fun dnsMaster () = !masterNode
573
aaf70d45
AC		 574val seenDomains : string list ref = ref []
575
6ae327f8
AC		 576val _ = Env.containerV_one "domain"
577 ("domain", Env.string)
578 (fn (evs, dom) =>
579 let
aaf70d45
AC		 580 val () = seenDomains := dom :: !seenDomains
581
6ae327f8
AC		 582 val kind = Env.env dnsKind (evs, "DNS")
583 val ttl = Env.env Env.int (evs, "TTL")
e0b80e65 584 val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
6ae327f8 585
e0b0abd2 586 val path = getPath dom
6ae327f8
AC		 587
588 val () = (current := dom;
e0b80e65
AC		 589 currentsAli := Slave.remove (Slave.removeDups aliases, dom);
590 currentPath := (fn site => path (Config.tmpDir, site));
591 currentPathAli := (fn (dom, site) => getPath dom (Config.tmpDir, site)))
6ae327f8 592
e0b0abd2 593 fun saveSoa (kind, soa : soa) node =
e2359100 594 let
3ae703b6 595 val {write, writeDom, close} = domainsFile {node = node, name = "soa.conf"}
e2359100 596 in
e0b80e65
AC		 597 write kind;
598 write "\n";
599 write (Int.toString ttl);
600 write "\n";
601 write (#ns soa);
602 write "\n";
e2359100
AC		 603 case #serial soa of
604 NONE => ()
e0b80e65
AC		 605 | SOME n => write (Int.toString n);
606 write "\n";
607 write (Int.toString (#ref soa));
608 write "\n";
609 write (Int.toString (#ret soa));
610 write "\n";
611 write (Int.toString (#exp soa));
612 write "\n";
613 write (Int.toString (#min soa));
614 write "\n";
615 close ()
e2359100 616 end
6ae327f8 617
a431ca34 618 fun saveNamed (kind, soa : soa, masterIp, slaveIps) node =
b341fd6d
AC		 619 if dom = "localhost" then
620 ()
621 else let
e0b80e65 622 val {write, writeDom, close} = domainsFile {node = node, name = "named.conf"}
b341fd6d 623 in
e0b80e65
AC		 624 write "\nzone \"";
625 writeDom ();
a431ca34 626 write "\" {\n\ttype ";
e0b80e65
AC		 627 write kind;
628 write ";\n\tfile \"";
629 write Config.Bind.zonePath_real;
630 write "/";
631 writeDom ();
632 write ".zone\";\n";
b341fd6d 633 case kind of
a431ca34
AC		 634 "master" => (write "\tallow-transfer {\n";
635 app (fn ip => (write "\t\t";
636 write ip;
637 write ";\n")) slaveIps;
638 write "\t};\n")
e0b80e65
AC		 639 | _ => (write "\tmasters { ";
640 write masterIp;
036cfc59
AC		 641 write "; };\n";
642 write "// Updated: ";
643 write (Time.toString (Time.now ()));
644 write "\n");
e0b80e65
AC		 645 write "};\n";
646 close ()
b341fd6d 647 end
6ae327f8
AC		 648 in
649 case kind of
e0b0abd2
AC		 650 NoDns => masterNode := NONE
651 | UseDns dns =>
2ed6d0e5
AC		 652 let
653 val masterIp =
654 case #master dns of
a431ca34 655 InternalMaster node => nodeIp node
2ed6d0e5 656 | ExternalMaster ip => ip
a431ca34
AC		 657
658 val slaveIps = map nodeIp (#slaves dns)
2ed6d0e5
AC		 659 in
660 app (saveSoa ("slave", #soa dns)) (#slaves dns);
a431ca34 661 app (saveNamed ("slave", #soa dns, masterIp, slaveIps)) (#slaves dns);
2ed6d0e5
AC		 662 case #master dns of
663 InternalMaster node =>
664 (masterNode := SOME node;
665 saveSoa ("master", #soa dns) node;
a431ca34 666 saveNamed ("master", #soa dns, masterIp, slaveIps) node)
b25161c7
AC		 667 | _ => masterNode := NONE
668 end;
669 !befores dom
6ae327f8 670 end,
e0b0abd2
AC		 671 fn () => !afters (!current))
672
aaf70d45
AC		 673val () = Env.registerPre (fn () => (seenDomains := [];
674 ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
e0b0abd2
AC		 675 fn cl => "Temp file cleanup failed: " ^ cl));
676 OS.FileSys.mkDir Config.tmpDir;
677 app (fn node => OS.FileSys.mkDir
678 (OS.Path.joinDirFile {dir = Config.tmpDir,
679 file = node}))
2ed6d0e5 680 nodes;
e0b0abd2
AC		 681 app (fn node => OS.FileSys.mkDir
682 (OS.Path.joinDirFile {dir = Config.resultRoot,
683 file = node})
684 handle OS.SysErr _ => ())
2ed6d0e5 685 nodes))
e0b0abd2 686
c189cbe9
AC		 687fun handleSite (site, files) =
688 let
689
690 in
691 print ("New configuration for node " ^ site ^ "\n");
201b83c7 692 if site = Config.dispatcherName then
c189cbe9
AC		 693 Slave.handleChanges files
694 else let
8be753d9
AC		 695 val bio = OpenSSL.connect true (valOf (!ssl_context),
696 nodeIp site
697 ^ ":"
698 ^ Int.toString Config.slavePort)
c189cbe9
AC		 699 in
700 app (fn file => Msg.send (bio, MsgFile file)) files;
701 Msg.send (bio, MsgDoFiles);
702 case Msg.recv bio of
703 NONE => print "Slave closed connection unexpectedly\n"
704 | SOME m =>
705 case m of
706 MsgOk => print ("Slave " ^ site ^ " finished\n")
707 | MsgError s => print ("Slave " ^ site
708 ^ " returned error: " ^
709 s ^ "\n")
710 | _ => print ("Slave " ^ site
711 ^ " returned unexpected command\n");
712 OpenSSL.close bio
713 end
714 end
715
e0b0abd2
AC		 716val () = Env.registerPost (fn () =>
717 let
4f9c5b51
AC		 718 val prefixes = List.concat
719 (List.map (fn dom =>
720 let
721 val pieces = String.tokens (fn ch => ch = #".") dom
722 val path = String.concatWith "/" (rev pieces)
723 in
724 List.map (fn node =>
725 Config.resultRoot ^ "/" ^ node ^ "/" ^ path ^ "/")
726 nodes
727 end) (!seenDomains))
aaf70d45
AC		 728
729 val diffs = findAllDiffs prefixes
6ae327f8 730
e0b0abd2
AC		 731 val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
732 (Slave.shellF ([Config.cp, " ", src, " ", dst],
733 fn cl => "Copy failed: " ^ cl);
734 (site,
6ae327f8
AC		 735 {action = Slave.Add,
736 domain = dom,
737 dir = dir,
e0b0abd2
AC		 738 file = dst}))
739 | (site, dom, dir, Delete' dst) =>
740 (OS.FileSys.remove dst
741 handle OS.SysErr _ =>
742 ErrorMsg.error NONE ("Delete failed for " ^ dst);
743 (site,
1638d5a2 744 {action = Slave.Delete true,
6ae327f8
AC		 745 domain = dom,
746 dir = dir,
e0b0abd2
AC		 747 file = dst}))
748 | (site, dom, dir, Modify' {src, dst}) =>
749 (Slave.shellF ([Config.cp, " ", src, " ", dst],
750 fn cl => "Copy failed: " ^ cl);
751 (site,
6ae327f8
AC		 752 {action = Slave.Modify,
753 domain = dom,
754 dir = dir,
e0b0abd2
AC		 755 file = dst}))) diffs
756 in
757 if !ErrorMsg.anyErrors then
758 ()
36e42cb8
AC		 759 else let
760 val changed = foldl (fn ((site, file), changed) =>
761 let
762 val ls = case SM.find (changed, site) of
763 NONE => []
764 | SOME ls => ls
765 in
766 SM.insert (changed, site, file :: ls)
767 end) SM.empty diffs
36e42cb8
AC		 768 in
769 SM.appi handleSite changed
770 end;
e0b0abd2 771 ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
559e89e9 772 fn cl => "Temp file cleanup failed: " ^ cl))
e0b0abd2 773 end)
6ae327f8 774
be1bea4c
AC		 775fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
776 orelse Acl.query {user = getUser (), class = "priv", value = priv}
777
778val _ = Env.type_one "dns_node"
779 Env.string
780 (fn node =>
781 List.exists (fn x => x = node) Config.dnsNodes_all
782 orelse (hasPriv "dns"
783 andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
60695e99 784
bbdf617f
AC		 785val _ = Env.type_one "mail_node"
786 Env.string
787 (fn node =>
788 List.exists (fn x => x = node) Config.mailNodes_all
789 orelse (hasPriv "mail"
790 andalso List.exists (fn x => x = node) Config.mailNodes_admin))
791
1638d5a2 792fun rmdom' delete resultRoot doms =
c189cbe9 793 let
c189cbe9
AC		 794 fun doNode (node, _) =
795 let
1638d5a2 796 val dname = OS.Path.joinDirFile {dir = resultRoot,
c189cbe9 797 file = node}
c189cbe9 798
e69e60cc 799 fun doDom (dom, actions) =
93c2f623 800 let
e69e60cc
AC		 801 val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
802 val dname = OS.Path.concat (dname, domPath)
803
804 fun visitDom (dom, dname, actions) =
805 let
806 val dir = Posix.FileSys.opendir dname
807
808 fun loop actions =
809 case Posix.FileSys.readdir dir of
810 NONE => actions
811 | SOME fname =>
812 let
813 val fnameFull = OS.Path.joinDirFile {dir = dname,
814 file = fname}
815 in
816 if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
817 loop (visitDom (fname ^ "." ^ dom,
818 fnameFull,
819 actions))
1638d5a2 820 else
1638d5a2
AC		 821 loop ({action = Slave.Delete delete,
822 domain = dom,
823 dir = dname,
b200e996 824 file = fnameFull} :: actions)
e69e60cc
AC		 825 end
826 in
827 loop actions
828 before Posix.FileSys.closedir dir
829 end
1638d5a2
AC		 830 handle OS.SysErr (s, _) =>
831 (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ": " ^ s ^ "\n");
e69e60cc 832 actions)
93c2f623 833 in
e69e60cc 834 visitDom (dom, dname, actions)
93c2f623
AC		 835 end
836
e69e60cc 837 val actions = foldl doDom [] doms
c189cbe9 838 in
c189cbe9
AC		 839 handleSite (node, actions)
840 end
e69e60cc 841 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
c189cbe9
AC		 842
843 fun cleanupNode (node, _) =
844 let
e69e60cc
AC		 845 fun doDom dom =
846 let
847 val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
1638d5a2 848 val dname = OS.Path.joinDirFile {dir = resultRoot,
e69e60cc
AC		 849 file = node}
850 val dname = OS.Path.concat (dname, domPath)
851 in
1638d5a2
AC		 852 if delete then
853 ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
854 else
855 ()
e69e60cc 856 end
c189cbe9 857 in
e69e60cc 858 app doDom doms
c189cbe9
AC		 859 end
860 in
861 app doNode Config.nodeIps;
862 app cleanupNode Config.nodeIps
863 end
864
1638d5a2
AC		 865val rmdom = rmdom' true Config.resultRoot
866val rmdom' = rmdom' false
867
0da1c677
AC		 868fun homedirOf uname =
869 Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
870
871fun homedir () = homedirOf (getUser ())
b89f3b68 872 handle e => if !fakePrivs then "/tmp" else raise e
0da1c677 873
314ce7bd
AC		 874type subject = {node : string, domain : string}
875
876val describers : (subject -> string) list ref = ref []
877
878fun registerDescriber f = describers := f :: !describers
879
41c58daf 880fun describeOne arg = String.concat (map (fn f => f arg) (rev (!describers)))
314ce7bd 881
d300166d
AC		 882val line = "--------------------------------------------------------------\n"
883val dline = "==============================================================\n"
314ce7bd
AC		 884
885fun describe dom =
886 String.concat (List.mapPartial
887 (fn node =>
888 case describeOne {node = node, domain = dom} of
889 "" => NONE
890 | s =>
891 SOME (String.concat [dline, "Node ", node, "\n", dline, "\n", s]))
892 nodes)
893
894datatype description =
41c58daf 895 Filename of { filename : string, heading : string, showEmpty : bool }
314ce7bd
AC		 896 | Extension of { extension : string, heading : string -> string }
897
898fun considerAll ds {node, domain} =
899 let
900 val ds = map (fn d => (d, ref [])) ds
901
902 val path = Config.resultRoot
903 val jdf = OS.Path.joinDirFile
904 val path = jdf {dir = path, file = node}
905 val path = foldr (fn (more, path) => jdf {dir = path, file = more})
906 path (String.tokens (fn ch => ch = #".") domain)
907 in
908 if Posix.FileSys.access (path, []) then
909 let
910 val dir = Posix.FileSys.opendir path
911
912 fun loop () =
913 case Posix.FileSys.readdir dir of
914 NONE => ()
915 | SOME fname =>
41c58daf
AC		 916 (app (fn (d, entries) =>
917 let
918 fun readFile showEmpty entries' =
919 let
920 val fname = OS.Path.joinDirFile {dir = path,
921 file = fname}
922
923 val inf = TextIO.openIn fname
924
925 fun loop (seenOne, entries') =
926 case TextIO.inputLine inf of
927 NONE => if seenOne orelse showEmpty then
928 "\n" :: entries'
929 else
930 !entries
931 | SOME line => loop (true, line :: entries')
932 in
933 loop (false, entries')
934 before TextIO.closeIn inf
935 end
936 in
937 case d of
938 Filename {filename, heading, showEmpty} =>
939 if fname = filename then
d936cf4d 940 entries := readFile showEmpty ("\n" :: line :: "\n" :: heading :: line :: !entries)
41c58daf
AC		 941 else
942 ()
943 | Extension {extension, heading} =>
944 let
945 val {base, ext} = OS.Path.splitBaseExt fname
946 in
947 case ext of
948 NONE => ()
949 | SOME extension' =>
950 if extension' = extension then
d936cf4d 951 entries := readFile true ("\n" :: line :: "\n" :: heading base :: line :: !entries)
41c58daf
AC		 952 else
953 ()
954 end
955 end) ds;
956 loop ())
314ce7bd
AC		 957 in
958 loop ();
959 Posix.FileSys.closedir dir;
960 String.concat (List.concat (map (fn (_, entries) => rev (!entries)) ds))
961 end
962 else
963 ""
964 end
965
3ae703b6 966val () = registerDescriber (considerAll [Filename {filename = "soa.conf",
d936cf4d 967 heading = "DNS SOA:",
41c58daf 968 showEmpty = false}])
314ce7bd 969
e9f528ab
AC		 970val () = Env.registerAction ("domainHost",
971 fn (env, [(EString host, _)]) =>
972 SM.insert (env, "Hostname",
973 (EString (host ^ "." ^ currentDomain ()), dl))
974 | (_, args) => Env.badArgs ("domainHost", args))
975
563e7792
AC		 976val ouc = ref (fn () => ())
977
978fun registerOnUsersChange f =
979 let
980 val f' = !ouc
981 in
982 ouc := (fn () => (f' (); f ()))
983 end
984
985fun onUsersChange () = !ouc ()
986
a3698041 987end
Unnamed repository; edit this file to name it for gitweb.