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