X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/d612d62cd04b713bb1057fd2e666365704aaf3d6..9b8c6dc8df86d6ba1c7512cb12445912a9035a89:/src/domain.sml

diff --git a/src/domain.sml b/src/domain.sml
index 394bf80..cdc3580 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -1,5 +1,5 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2006-2007, Adam Chlipala
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -20,16 +20,174 @@
 
 structure Domain :> DOMAIN = struct
 
+open MsgTypes
+
+structure SM = DataStructures.StringMap
+structure SS = DataStructures.StringSet
+
+val ssl_context = ref (NONE : OpenSSL.context option)
+fun set_context ctx = ssl_context := SOME ctx
+fun get_context () = valOf (!ssl_context)
+
+val nodes = map #1 Config.nodeIps
+val nodeMap = foldl (fn ((node, ip), mp) => SM.insert (mp, node, ip))
+		    SM.empty Config.nodeIps
+fun nodeIp node = valOf (SM.find (nodeMap, node))
+
+val usr = ref ""
+fun getUser () = !usr
+val fakePrivs = ref false
+val isClient = ref false
+
+val your_doms = ref SS.empty
+fun your_domains () = !your_doms
+
+val your_usrs = ref SS.empty
+fun your_users () = !your_usrs
+
+val your_grps = ref SS.empty
+fun your_groups () = !your_grps
+
+val your_pths = ref SS.empty
+fun your_paths () = !your_pths
+
+val your_ipss = ref SS.empty
+fun your_ips () = !your_ipss
+
+val world_readable = SS.addList (SS.empty, Config.worldReadable)
+val readable_pths = ref world_readable
+fun readable_paths () = !readable_pths
+
+fun setUser user =
+    let
+	val () = usr := user
+
+	val your_paths = Acl.class {user = getUser (),
+				    class = "path"}
+    in
+	fakePrivs := false;
+	your_doms := Acl.class {user = getUser (),
+				class = "domain"};
+	your_usrs := Acl.class {user = getUser (),
+				class = "user"};
+	your_grps := Acl.class {user = getUser (),
+				class = "group"};
+	your_pths := your_paths;
+	readable_pths := SS.union (your_paths, world_readable);
+	your_ipss := Acl.class {user = getUser (),
+				class = "ip"}
+    end
+
+fun declareClient () = isClient := true
+fun fakePrivileges () = if !isClient then
+			    fakePrivs := true
+			else
+			    raise Fail "Tried to fake privileges as non-client"
+
+fun validIp s =
+    case map Int.fromString (String.fields (fn ch => ch = #".") s) of
+	[SOME n1, SOME n2, SOME n3, SOME n4] =>
+	n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
+      | _ => false
+
+fun isHexDigit ch = Char.isDigit ch orelse (ord ch >= ord #"a" andalso ord ch <= ord #"f")
+
+fun validIpv6 s =
+    let
+	val fields = String.fields (fn ch => ch = #":") s
+
+	val empties = foldl (fn ("", n) => n + 1
+			      | (_, n) => n) 0 fields
+
+	fun noIpv4 maxLen =
+	    length fields >= 2
+	    andalso length fields <= maxLen
+	    andalso empties <= 1
+	    andalso List.all (fn "" => true
+			       | s => size s <= 4
+				      andalso CharVector.all isHexDigit s) fields
+
+	fun hasIpv4 () =
+	    length fields > 0
+	    andalso
+	    let
+		val maybeIpv4 = List.last fields
+		val theRest = List.take (fields, length fields - 1)
+	    in
+		validIp maybeIpv4 andalso noIpv4 6
+	    end
+    in
+	noIpv4 8 orelse hasIpv4 ()
+    end
+
 fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
 
 fun validHost s =
-    size s > 0 andalso size s < 20
+    size s > 0 andalso size s < 50
     andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
 
 fun validDomain s =
-    size s > 0 andalso size s < 100
+    size s > 0 andalso size s < 200
     andalso List.all validHost (String.fields (fn ch => ch = #".") s)
 
+fun validNode s = List.exists (fn s' => s = s') nodes
+
+fun yourDomain s = !fakePrivs orelse SS.member (your_domains (), s)
+fun yourUser s = SS.member (your_users (), s)
+fun yourGroup s = SS.member (your_groups (), s)
+fun checkPath paths path =
+    (List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path)
+     andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"/"
+				      orelse ch = #"-" orelse ch = #"_") path
+     andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (paths ()))
+val yourPath = checkPath your_paths
+val readablePath = checkPath readable_paths
+fun yourIp s = !fakePrivs orelse SS.member (your_ips (), s)
+
+fun yourDomainHost s =
+    !fakePrivs
+    orelse yourDomain s
+    orelse let
+	val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
+    in
+	Substring.size suf > 0
+	andalso validHost (Substring.string pref)
+	andalso yourDomain (Substring.string
+				(Substring.slice (suf, 1, NONE)))
+    end
+
+val yourDomain = yourDomainHost
+
+fun validUser s = size s > 0 andalso size s < 20
+		  andalso CharVector.all Char.isAlphaNum s
+
+fun validEmailUser s =
+    size s > 0 andalso size s < 50
+    andalso CharVector.all (fn ch => Char.isAlphaNum ch
+				     orelse ch = #"."
+				     orelse ch = #"_"
+				     orelse ch = #"-"
+				     orelse ch = #"+") s
+
+val validGroup = validUser
+
+val _ = Env.type_one "no_spaces"
+		     Env.string
+		     (CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
+					       andalso ch <> #"\"" andalso ch <> #"'"))
+val _ = Env.type_one "no_newlines"
+		     Env.string
+		     (CharVector.all (fn ch => Char.isPrint ch andalso ch <> #"\n" andalso ch <> #"\r"
+					       andalso ch <> #"\""))
+
+val _ = Env.type_one "ip"
+	Env.string
+	validIp
+
+val _ = Env.type_one "ipv6"
+	Env.string
+	validIpv6
+
 val _ = Env.type_one "host"
 	Env.string
 	validHost
@@ -38,8 +196,176 @@ val _ = Env.type_one "domain"
 	Env.string
 	validDomain
 
+val _ = Env.type_one "your_domain"
+	Env.string
+	yourDomain
+
+val _ = Env.type_one "your_domain_host"
+	Env.string
+	yourDomainHost
+
+val _ = Env.type_one "user"
+	Env.string
+	validUser
+
+val _ = Env.type_one "group"
+	Env.string
+	validGroup
+
+val _ = Env.type_one "your_user"
+	Env.string
+	yourUser
+
+val _ = Env.type_one "your_group"
+	Env.string
+	yourGroup
+
+val _ = Env.type_one "your_path"
+	Env.string
+	yourPath
+
+val _ = Env.type_one "readable_path"
+	Env.string
+	readablePath
+
+val _ = Env.type_one "your_ip"
+	Env.string
+	yourIp
+
+val _ = Env.type_one "node"
+	Env.string
+	validNode
+
+val _ = Env.type_one "mime_type"
+	Env.string
+	(CharVector.exists (fn ch => ch = #"/"))
+
+val _ = Env.registerFunction ("your_ip_to_ip",
+			      fn [e] => SOME e
+			       | _ => NONE)
+
+val _ = Env.registerFunction ("dns_node_to_node",
+			      fn [e] => SOME e
+			       | _ => NONE)
+
+val _ = Env.registerFunction ("mail_node_to_node",
+			      fn [e] => SOME e
+			       | _ => NONE)
+
+
 open Ast
 
+val dl = ErrorMsg.dummyLoc
+
+val _ = Env.registerFunction ("end_in_slash",
+			      fn [(EString "", _)] => SOME (EString "/", dl)
+			       | [(EString s, _)] =>
+				 SOME (EString (if String.sub (s, size s - 1) = #"/" then
+						    s
+						else
+						    s ^ "/"), dl)
+			       | _ => NONE)
+
+
+val nsD = (EString Config.defaultNs, dl)
+val serialD = (EVar "serialAuto", dl)
+val refD = (EInt Config.defaultRefresh, dl)
+val retD = (EInt Config.defaultRetry, dl)
+val expD = (EInt Config.defaultExpiry, dl)
+val minD = (EInt Config.defaultMinimum, dl)
+
+val soaD = multiApp ((EVar "soa", dl),
+		     dl,
+		     [nsD, serialD, refD, retD, expD, minD])
+
+val masterD = (EApp ((EVar "internalMaster", dl),
+		     (EString Config.masterNode, dl)),
+	       dl)
+
+val slavesD = (EList (map (fn s => (EString s, dl)) Config.slaveNodes), dl)
+
+val _ = Defaults.registerDefault ("Aliases",
+				  (TList (TBase "your_domain", dl), dl),
+				  (fn () => (EList [], dl)))
+
+val _ = Defaults.registerDefault ("Mailbox",
+				  (TBase "email", dl),
+				  (fn () => (EString (getUser ()), dl)))
+
+val _ = Defaults.registerDefault ("DNS",
+				  (TBase "dnsKind", dl),
+				  (fn () => multiApp ((EVar "useDns", dl),
+						      dl,
+						      [soaD, masterD, slavesD])))
+
+val _ = Defaults.registerDefault ("TTL",
+				  (TBase "int", dl),
+				  (fn () => (EInt Config.Bind.defaultTTL, dl)))
+
+type soa = {ns : string,
+	    serial : int option,
+	    ref : int,
+	    ret : int,
+	    exp : int,
+	    min : int}
+
+val serial = fn (EVar "serialAuto", _) => SOME NONE
+	      | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
+	      | _ => NONE
+
+val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp 
+						     ((EVar "soa", _), ns), _),
+						sl), _),
+					 rf), _),
+				  ret), _),
+			   exp), _),
+		    min), _) =>
+	     (case (Env.string ns, serial sl, Env.int rf,
+		    Env.int ret, Env.int exp, Env.int min) of
+		  (SOME ns, SOME sl, SOME rf,
+		   SOME ret, SOME exp, SOME min) =>
+		  SOME {ns = ns,
+			serial = sl,
+			ref = rf,
+			ret = ret,
+			exp = exp,
+			min = min}
+		| _ => NONE)
+	   | _ => NONE
+
+datatype master =
+	 ExternalMaster of string
+       | InternalMaster of string
+
+val ip = Env.string
+
+val _ = Env.registerFunction ("ip_of_node",
+			      fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
+			       | _ => NONE)
+
+val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
+	      | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
+	      | _ => NONE
+
+datatype dnsKind =
+	 UseDns of {soa : soa,
+		    master : master,
+		    slaves : string list}
+       | NoDns
+
+val dnsKind = fn (EApp ((EApp ((EApp 
+				    ((EVar "useDns", _), sa), _),
+			       mstr), _),
+			slaves), _) =>
+		 (case (soa sa, master mstr, Env.list Env.string slaves) of
+		      (SOME sa, SOME mstr, SOME slaves) =>
+		      SOME (UseDns {soa = sa,
+				    master = mstr,
+				    slaves = slaves})
+		    | _ => NONE)
+	       | (EVar "noDns", _) => SOME NoDns
+	       | _ => NONE
+
 val befores = ref (fn (_ : string) => ())
 val afters = ref (fn (_ : string) => ())
 
@@ -57,14 +383,56 @@ fun registerAfter f =
 	afters := (fn x => (old x; f x))
     end
 
+val globals = ref (fn () => ())
+val locals = ref (fn () => ())
+
+fun registerResetGlobal f =
+    let
+	val old = !globals
+    in
+	globals := (fn x => (old x; f x))
+    end
+
+fun registerResetLocal f =
+    let
+	val old = !locals
+    in
+	locals := (fn x => (old x; f x))
+    end
+
+fun resetGlobal () = (!globals ();
+		      ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
+fun resetLocal () = !locals ()
+
 val current = ref ""
-val currentPath = ref ""
+val currentPath = ref (fn (_ : string) => "")
+val currentPathAli = ref (fn (_ : string, _ : string) => "")
 
 val scratch = ref ""
 
 fun currentDomain () = !current
 
-fun domainFile name = TextIO.openOut (!currentPath ^ name)
+val currentsAli = ref ([] : string list)
+
+fun currentAliasDomains () = !currentsAli
+fun currentDomains () = currentDomain () :: currentAliasDomains ()
+
+fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
+			       TextIO.openOut (!currentPath node ^ name))
+
+type files = {write : string -> unit,
+	      writeDom : unit -> unit,
+	      close : unit -> unit}
+
+fun domainsFile {node, name} =
+    let
+	val doms = currentDomains ()
+	val files = map (fn dom => (dom, TextIO.openOut (!currentPathAli (dom, node) ^ name))) doms
+    in
+	{write = fn s => app (fn (_, outf) => TextIO.output (outf, s)) files,
+	 writeDom = fn () => app (fn (dom, outf) => TextIO.output (outf, dom)) files,
+	 close = fn () => app (fn (_, outf) => TextIO.closeOut outf) files}
+    end
 
 fun getPath domain =
     let
@@ -73,29 +441,36 @@ fun getPath domain =
 	val elems = foldr (fn (piece, elems) =>
 			      let
 				  val elems = piece :: elems
-				  val path = String.concatWith "/" (Config.resultRoot :: rev elems)
-				  val tmpPath = String.concatWith "/" (Config.tmpDir :: rev elems)
-			      in
-				  (if Posix.FileSys.ST.isDir
-					  (Posix.FileSys.stat path) then
-				       ()
-				   else
-				       (OS.FileSys.remove path;
-					OS.FileSys.mkDir path))
-				  handle OS.SysErr _ => OS.FileSys.mkDir path;
-
-				  (if Posix.FileSys.ST.isDir
-					  (Posix.FileSys.stat tmpPath) then
-				       ()
-				   else
-				       (OS.FileSys.remove tmpPath;
-					OS.FileSys.mkDir tmpPath))
-				  handle OS.SysErr _ => OS.FileSys.mkDir tmpPath;
 
+				  fun doNode node =
+				      let
+					  val path = String.concatWith "/"
+								       (Config.resultRoot :: node :: rev elems)
+					  val tmpPath = String.concatWith "/"
+									  (Config.tmpDir :: node :: rev elems)
+				      in
+					  (if Posix.FileSys.ST.isDir
+						  (Posix.FileSys.stat path) then
+					       ()
+					   else
+					       (OS.FileSys.remove path;
+						OS.FileSys.mkDir path))
+					  handle OS.SysErr _ => OS.FileSys.mkDir path;
+
+					  (if Posix.FileSys.ST.isDir
+						  (Posix.FileSys.stat tmpPath) then
+					       ()
+					   else
+					       (OS.FileSys.remove tmpPath;
+						OS.FileSys.mkDir tmpPath))
+					  handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
+				      end
+			      in
+				  app doNode nodes;
 				  elems
 			      end) [] toks
     in
-	fn root => String.concatWith "/" (root :: rev ("" :: elems))
+	fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
     end
 
 datatype file_action' =
@@ -103,22 +478,13 @@ datatype file_action' =
        | Delete' of string
        | Modify' of {src : string, dst : string}
 
-fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))
-
-fun shellF (ss, msg) =
+fun findDiffs (prefixes, site, dom, acts) =
     let
-	val s = String.concat ss
-    in
-	if OS.Process.isSuccess (OS.Process.system s) then
-	    ()
-	else
-	    ErrorMsg.error NONE (msg s)
-    end
+	val gp = getPath dom
+	val realPath = gp (Config.resultRoot, site)
+	val tmpPath = gp (Config.tmpDir, site)
 
-fun findDiffs dom =
-    let
-	val realPath = getPath dom Config.resultRoot
-	val tmpPath = !currentPath
+	(*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)
 
 	val dir = Posix.FileSys.opendir realPath
 
@@ -136,17 +502,19 @@ fun findDiffs dom =
 		    if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
 			loopReal acts
 		    else if Posix.FileSys.access (tmp, []) then
-			if shell [Config.diff, " ", real, " ",  tmp] then
+			if Slave.shell [Config.diff, " ", real, " ",  tmp] then
 			    loopReal acts
 			else
-			    loopReal (Modify' {src = tmp, dst = real} :: acts)
+			    loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
+		    else if List.exists (fn prefix => String.isPrefix prefix real) prefixes then
+			loopReal ((site, dom, realPath, Delete' real) :: acts)
 		    else
-			loopReal (Delete' real :: acts)
+			loopReal acts
 		end
 
-	val acts = loopReal []
+	val acts = loopReal acts
 
-	val dir = Posix.FileSys.opendir realPath
+	val dir = Posix.FileSys.opendir tmpPath
 
 	fun loopTmp acts =
 	    case Posix.FileSys.readdir dir of
@@ -164,7 +532,7 @@ fun findDiffs dom =
 		    else if Posix.FileSys.access (real, []) then
 			loopTmp acts
 		    else
-			loopTmp (Add' {src = tmp, dst = real} :: acts)
+			loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
 		end
 
 	val acts = loopTmp acts
@@ -172,49 +540,469 @@ fun findDiffs dom =
 	acts
     end
 
-val _ = Env.container_one "domain"
-			  ("domain", Env.string)
-			  (fn dom =>
-			      let
-				  val path = getPath dom Config.tmpDir
-			      in
-				  current := dom;
-				  currentPath := path;
-				  !befores dom
-			      end,
-			   fn () =>
-			      let
-				  val dom = !current
-				  val () = !afters dom
+fun findAllDiffs prefixes =
+    let
+	val dir = Posix.FileSys.opendir Config.tmpDir
+	val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
 
-				  val diffs = findDiffs dom
+	fun exploreSites diffs =
+	    case Posix.FileSys.readdir dir of
+		NONE => diffs
+	      | SOME site =>
+		let
+		    fun explore (dname, diffs) =
+			let
+			    val dir = Posix.FileSys.opendir dname
+
+			    fun loop diffs =
+				case Posix.FileSys.readdir dir of
+				    NONE => diffs
+				  | SOME name =>
+				    let
+					val fname = OS.Path.joinDirFile {dir = dname,
+									 file = name}
+				    in
+					loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
+						  let
+						      val dom = String.fields (fn ch => ch = #"/") fname
+						      val dom = List.drop (dom, len)
+						      val dom = String.concatWith "." (rev dom)
+
+						      val dname' = OS.Path.joinDirFile {dir = dname,
+											file = name}
+						  in
+						      explore (dname',
+							       findDiffs (prefixes, site, dom, diffs))
+						  end
+					      else
+						  diffs)
+				    end
+			in
+			    loop diffs
+			    before Posix.FileSys.closedir dir
+			end
+		in
+		    exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
+								file = site}, diffs))
+		end
+    in
+	exploreSites []
+	before Posix.FileSys.closedir dir
+    end
 
-				  val diffs = map (fn Add' {src, dst} =>
-						      (shellF ([Config.cp, " ", src, " ", dst],
-							      fn cl => "Copy failed: " ^ cl);
-						       {action = Slave.Add,
-							domain = dom,
-							file = dst})
-						    | Delete' dst =>
+val masterNode : string option ref = ref NONE
+fun dnsMaster () = !masterNode
+
+val seenDomains : string list ref = ref []
+
+val _ = Env.containerV_one "domain"
+			   ("domain", Env.string)
+			   (fn (evs, dom) =>
+			       let
+				   val () = seenDomains := dom :: !seenDomains
+
+				   val kind = Env.env dnsKind (evs, "DNS")
+				   val ttl = Env.env Env.int (evs, "TTL")
+				   val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
+
+				   val path = getPath dom
+
+				   val () = (current := dom;
+					     currentsAli := Slave.remove (Slave.removeDups aliases, dom);
+					     currentPath := (fn site => path (Config.tmpDir, site));
+					     currentPathAli := (fn (dom, site) => getPath dom (Config.tmpDir, site)))
+
+				   fun saveSoa (kind, soa : soa) node =
+				       let
+					   val {write, writeDom, close} = domainsFile {node = node, name = "soa.conf"}
+				       in
+					   write kind;
+					   write "\n";
+					   write (Int.toString ttl);
+					   write "\n";
+					   write (#ns soa);
+					   write "\n";
+					   case #serial soa of
+					       NONE => ()
+					     | SOME n => write (Int.toString n);
+					   write "\n";
+					   write (Int.toString (#ref soa));
+					   write "\n";
+					   write (Int.toString (#ret soa));
+					   write "\n";
+					   write (Int.toString (#exp soa));
+					   write "\n";
+					   write (Int.toString (#min soa));
+					   write "\n";
+					   close ()
+				       end
+
+				   fun saveNamed (kind, soa : soa, masterIp, slaveIps) node =
+				       if dom = "localhost" then
+					   ()
+				       else let
+					       val {write, writeDom, close} = domainsFile {node = node, name = "named.conf"}
+					   in
+					       write "\nzone \"";
+					       writeDom ();
+					       write "\" {\n\ttype ";
+					       write kind;
+					       write ";\n\tfile \"";
+					       write Config.Bind.zonePath_real;
+					       write "/";
+					       writeDom ();
+					       write ".zone\";\n";
+					       case kind of
+						   "master" => (write "\tallow-transfer {\n";
+								app (fn ip => (write "\t\t";
+									       write ip;
+									       write ";\n")) slaveIps;
+								write "\t};\n")
+						 | _ => (write "\tmasters { ";
+							 write masterIp;
+							 write "; };\n";
+							 write "// Updated: ";
+							 write (Time.toString (Time.now ()));
+							 write "\n");
+					       write "};\n";
+					       close ()
+					   end
+			       in
+				   case kind of
+				       NoDns => masterNode := NONE
+				     | UseDns dns =>
+				       let
+					   val masterIp =
+					       case #master dns of
+						   InternalMaster node => nodeIp node
+						 | ExternalMaster ip => ip
+
+					   val slaveIps = map nodeIp (#slaves dns)
+				       in
+					   app (saveSoa ("slave", #soa dns)) (#slaves dns);
+					   app (saveNamed ("slave", #soa dns, masterIp, slaveIps)) (#slaves dns);
+					   case #master dns of
+					       InternalMaster node =>
+					       (masterNode := SOME node;
+						saveSoa ("master", #soa dns) node;
+						saveNamed ("master", #soa dns, masterIp, slaveIps) node)
+					     | _ => masterNode := NONE
+				       end;
+				   !befores dom
+			       end,
+			    fn () => !afters (!current))
+
+val () = Env.registerPre (fn () => (seenDomains := [];
+				    ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
+						       fn cl => "Temp file cleanup failed: " ^ cl));
+				    OS.FileSys.mkDir Config.tmpDir;
+				    app (fn node => OS.FileSys.mkDir
+							(OS.Path.joinDirFile {dir = Config.tmpDir,
+									      file = node}))
+					nodes;
+				    app (fn node => OS.FileSys.mkDir
+							(OS.Path.joinDirFile {dir = Config.resultRoot,
+									      file = node})
+					    handle OS.SysErr _ => ())
+					nodes))
+
+fun handleSite (site, files) =
+    let
+	
+    in
+	print ("New configuration for node " ^ site ^ "\n");
+	if site = Config.defaultNode then
+	    Slave.handleChanges files
+	else let
+		val bio = OpenSSL.connect true (valOf (!ssl_context),
+						nodeIp site
+						^ ":"
+						^ Int.toString Config.slavePort)
+	    in
+		app (fn file => Msg.send (bio, MsgFile file)) files;
+		Msg.send (bio, MsgDoFiles);
+		case Msg.recv bio of
+		    NONE => print "Slave closed connection unexpectedly\n"
+		  | SOME m =>
+		    case m of
+			MsgOk => print ("Slave " ^ site ^ " finished\n")
+		      | MsgError s => print ("Slave " ^ site
+					     ^ " returned error: " ^
+					     s ^ "\n")
+		      | _ => print ("Slave " ^ site
+				    ^ " returned unexpected command\n");
+		OpenSSL.close bio
+	    end
+    end
+
+val () = Env.registerPost (fn () =>
+			      let
+				  val prefixes = List.concat
+						     (List.map (fn dom =>
+								   let
+								       val pieces = String.tokens (fn ch => ch = #".") dom
+								       val path = String.concatWith "/" (rev pieces)
+								   in
+								       List.map (fn node =>
+										    Config.resultRoot ^ "/" ^ node ^ "/" ^ path ^ "/")
+										nodes
+								   end) (!seenDomains))
+								  
+				  val diffs = findAllDiffs prefixes
+
+				  val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
+						      (Slave.shellF ([Config.cp, " ", src, " ", dst],
+								  fn cl => "Copy failed: " ^ cl);
+						       (site,
+							{action = Slave.Add,
+							 domain = dom,
+							 dir = dir,
+							 file = dst}))
+						    | (site, dom, dir, Delete' dst) =>
 						      (OS.FileSys.remove dst
 						       handle OS.SysErr _ =>
 							      ErrorMsg.error NONE ("Delete failed for " ^ dst);
-						       {action = Slave.Delete,
-							domain = dom,
-							file = dst})
-						    | Modify' {src, dst} =>
-						      (shellF ([Config.cp, " ", src, " ", dst],
-							   fn cl => "Copy failed: " ^ cl);
-						       {action = Slave.Modify,
-							domain = dom,
-							file = dst})) diffs
+						       (site,
+							{action = Slave.Delete true,
+							 domain = dom,
+							 dir = dir,
+							 file = dst}))
+						    | (site, dom, dir, Modify' {src, dst}) =>
+						      (Slave.shellF ([Config.cp, " ", src, " ", dst],
+								  fn cl => "Copy failed: " ^ cl);
+						       (site,
+							{action = Slave.Modify,
+							 domain = dom,
+							 dir = dir,
+							 file = dst}))) diffs
 			      in
 				  if !ErrorMsg.anyErrors then
 				      ()
-				  else
-				      Slave.handleChanges diffs;
-				  ignore (shellF ([Config.rm, " -rf ", Config.tmpDir, "/*"],
-						  fn cl => "Temp file cleanup failed: " ^ cl))
+				  else let
+					  val changed = foldl (fn ((site, file), changed) =>
+								  let
+								      val ls = case SM.find (changed, site) of
+										   NONE => []
+										 | SOME ls => ls
+								  in
+								      SM.insert (changed, site, file :: ls)
+								  end) SM.empty diffs
+				      in
+					  SM.appi handleSite changed
+				      end;
+				  ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
+						     fn cl => "Temp file cleanup failed: " ^ cl))
 			      end)
 
+fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
+		   orelse Acl.query {user = getUser (), class = "priv", value = priv}
+
+val _ = Env.type_one "dns_node"
+	Env.string
+	(fn node =>
+	    List.exists (fn x => x = node) Config.dnsNodes_all
+	    orelse (hasPriv "dns"
+		    andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
+
+val _ = Env.type_one "mail_node"
+	Env.string
+	(fn node =>
+	    List.exists (fn x => x = node) Config.mailNodes_all
+	    orelse (hasPriv "mail"
+		    andalso List.exists (fn x => x = node) Config.mailNodes_admin))
+
+fun rmdom' delete resultRoot doms =
+    let
+	fun doNode (node, _) =
+	    let
+		val dname = OS.Path.joinDirFile {dir = resultRoot,
+						 file = node}
+
+		fun doDom (dom, actions) =
+		    let
+			val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+			val dname = OS.Path.concat (dname, domPath)
+
+			fun visitDom (dom, dname, actions) =
+			    let
+				val dir = Posix.FileSys.opendir dname
+
+				fun loop actions =
+				    case Posix.FileSys.readdir dir of
+					NONE => actions
+				      | SOME fname =>
+					let
+					    val fnameFull = OS.Path.joinDirFile {dir = dname,
+										 file = fname}
+					in
+					    if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
+						loop (visitDom (fname ^ "." ^ dom,
+								fnameFull,
+								actions))
+					    else			
+						 loop ({action = Slave.Delete delete,
+							domain = dom,
+							dir = dname,
+							file = fnameFull} :: actions)
+					end
+			    in
+				loop actions
+				before Posix.FileSys.closedir dir
+			    end
+				handle OS.SysErr (s, _) =>
+				       (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ": " ^ s ^ "\n");
+					actions)
+		    in
+			visitDom (dom, dname, actions)
+		    end
+
+		val actions = foldl doDom [] doms
+	    in
+		handleSite (node, actions)
+	    end
+		handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
+
+	fun cleanupNode (node, _) =
+	    let
+		fun doDom dom =
+		    let
+			val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+			val dname = OS.Path.joinDirFile {dir = resultRoot,
+							 file = node}
+			val dname = OS.Path.concat (dname, domPath)
+		    in
+			if delete then
+			    ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+			else
+			    ()
+		    end
+	    in
+		app doDom doms
+	    end
+    in
+	app doNode Config.nodeIps;
+	app cleanupNode Config.nodeIps
+    end
+
+val rmdom = rmdom' true Config.resultRoot
+val rmdom' = rmdom' false
+
+fun homedirOf uname =
+    Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
+
+fun homedir () = homedirOf (getUser ())
+
+type subject = {node : string, domain : string}
+
+val describers : (subject -> string) list ref = ref []
+
+fun registerDescriber f = describers := f :: !describers
+
+fun describeOne arg = String.concat (map (fn f => f arg) (rev (!describers)))
+
+val line = "--------------------------------------------------------------\n"
+val dline = "==============================================================\n"
+
+fun describe dom =
+    String.concat (List.mapPartial
+		       (fn node =>
+			   case describeOne {node = node, domain = dom} of
+			       "" => NONE
+			     | s =>
+			       SOME (String.concat [dline, "Node ", node, "\n", dline, "\n", s]))
+		       nodes)
+
+datatype description =
+	 Filename of { filename : string, heading : string, showEmpty : bool }
+       | Extension of { extension : string, heading : string -> string }
+			
+fun considerAll ds {node, domain} =
+    let
+	val ds = map (fn d => (d, ref [])) ds
+
+	val path = Config.resultRoot
+	val jdf = OS.Path.joinDirFile
+	val path = jdf {dir = path, file = node}
+	val path = foldr (fn (more, path) => jdf {dir = path, file = more})
+			 path (String.tokens (fn ch => ch = #".") domain)
+    in
+	if Posix.FileSys.access (path, []) then
+	    let
+		val dir = Posix.FileSys.opendir path
+
+		fun loop () =
+		    case Posix.FileSys.readdir dir of
+			NONE => ()
+		      | SOME fname =>
+			(app (fn (d, entries) =>
+				 let
+				     fun readFile showEmpty entries' =
+					 let
+					     val fname = OS.Path.joinDirFile {dir = path,
+									      file = fname}
+
+					     val inf = TextIO.openIn fname
+
+					     fun loop (seenOne, entries') =
+						 case TextIO.inputLine inf of
+						     NONE => if seenOne orelse showEmpty then
+								 "\n" :: entries'
+							     else
+								 !entries
+						   | SOME line => loop (true, line :: entries')
+					 in
+					     loop (false, entries')
+					     before TextIO.closeIn inf
+					 end
+				 in
+				     case d of
+					 Filename {filename, heading, showEmpty} =>
+					 if fname = filename then
+					     entries := readFile showEmpty ("\n" :: line :: "\n" :: heading :: line :: !entries)
+					 else
+					     ()
+				       | Extension {extension, heading} =>
+					 let
+					     val {base, ext} = OS.Path.splitBaseExt fname
+					 in
+					     case ext of
+						 NONE => ()
+					       | SOME extension' =>
+						 if extension' = extension then
+						     entries := readFile true ("\n" :: line :: "\n" :: heading base :: line :: !entries)
+						 else
+						     ()
+					 end
+				 end) ds;
+			 loop ())
+	    in
+		loop ();
+		Posix.FileSys.closedir dir;
+		String.concat (List.concat (map (fn (_, entries) => rev (!entries)) ds))
+	    end
+	else
+	    ""
+    end
+
+val () = registerDescriber (considerAll [Filename {filename = "soa.conf",
+						   heading = "DNS SOA:",
+						   showEmpty = false}])
+
+val () = Env.registerAction ("domainHost",
+			     fn (env, [(EString host, _)]) =>
+				SM.insert (env, "Hostname",
+					   (EString (host ^ "." ^ currentDomain ()), dl))
+			      | (_, args) => Env.badArgs ("domainHost", args))
+
+val ouc = ref (fn () => ())
+
+fun registerOnUsersChange f =
+    let
+	val f' = !ouc
+    in
+	ouc := (fn () => (f' (); f ()))
+    end
+
+fun onUsersChange () = !ouc ()
+
 end