[hcoop/domtool2.git] / src / domain.sml

(* HCoop Domtool (http://hcoop.sourceforge.net/)
 * Copyright (c) 2006, Adam Chlipala
 *
 * This program is free software; you can redistribute it and/or
 * modify it under the terms of the GNU General Public License
 * as published by the Free Software Foundation; either version 2
 * of the License, or (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *)

(* Domain-related primitive actions *)

structure Domain :> DOMAIN = struct

structure SM = DataStructures.StringMap

val nodes = map #2 Config.nodeIps
val nodeMap = foldl (fn ((node, ip), mp) => SM.insert (mp, node, ip))
		    SM.empty Config.nodeIps

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 isIdent ch = Char.isLower ch orelse Char.isDigit ch

fun validHost s =
    size s > 0 andalso size s < 20
    andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s

fun validDomain s =
    size s > 0 andalso size s < 100
    andalso List.all validHost (String.fields (fn ch => ch = #".") s)

fun validNode s = List.exists (fn s' => s = s') nodes

val _ = Env.type_one "ip"
	Env.string
	validIp

val _ = Env.type_one "host"
	Env.string
	validHost

val _ = Env.type_one "domain"
	Env.string
	validDomain

val _ = Env.type_one "node"
	Env.string
	validNode

open Ast

val dl = ErrorMsg.dummyLoc

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.defaultNode, dl)),
	       dl)

val _ = Main.registerDefault ("DNS",
			      (TBase "dnsKind", dl),
			      (multiApp ((EVar "useDns", dl),
					 dl,
					 [soaD, masterD, (EList [], dl)])))

val _ = Main.registerDefault ("TTL",
			      (TBase "int", dl),
			      (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 master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (Env.string 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)
	       | _ => NONE

val befores = ref (fn (_ : string) => ())
val afters = ref (fn (_ : string) => ())

fun registerBefore f =
    let
	val old = !befores
    in
	befores := (fn x => (old x; f x))
    end

fun registerAfter f =
    let
	val old = !afters
    in
	afters := (fn x => (old x; f x))
    end

val current = ref ""
val currentPath = ref (fn (_ : string) => "")

val scratch = ref ""

fun currentDomain () = !current

fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
			       TextIO.openOut (!currentPath node ^ name))

fun getPath domain =
    let
	val toks = String.fields (fn ch => ch = #".") domain

	val elems = foldr (fn (piece, elems) =>
			      let
				  val elems = piece :: elems

				  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, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
    end

datatype file_action' =
	 Add' of {src : string, dst : string}
       | Delete' of string
       | Modify' of {src : string, dst : string}

fun findDiffs (site, dom, acts) =
    let
	val gp = getPath dom
	val realPath = gp (Config.resultRoot, site)
	val tmpPath = gp (Config.tmpDir, site)

	(*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)

	val dir = Posix.FileSys.opendir realPath

	fun loopReal acts =
	    case Posix.FileSys.readdir dir of
		NONE => (Posix.FileSys.closedir dir;
			 acts)
	      | SOME fname =>
		let
		    val real = OS.Path.joinDirFile {dir = realPath,
						    file = fname}
		    val tmp = OS.Path.joinDirFile {dir = tmpPath,
						   file = fname}
		in
		    if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
			loopReal acts
		    else if Posix.FileSys.access (tmp, []) then
			if Slave.shell [Config.diff, " ", real, " ",  tmp] then
			    loopReal acts
			else
			    loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
		    else
			loopReal ((site, dom, realPath, Delete' real) :: acts)
		end

	val acts = loopReal acts

	val dir = Posix.FileSys.opendir tmpPath

	fun loopTmp acts =
	    case Posix.FileSys.readdir dir of
		NONE => (Posix.FileSys.closedir dir;
			 acts)
	      | SOME fname =>
		let
		    val real = OS.Path.joinDirFile {dir = realPath,
						    file = fname}
		    val tmp = OS.Path.joinDirFile {dir = tmpPath,
						   file = fname}
		in
		    if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
			loopTmp acts
		    else if Posix.FileSys.access (real, []) then
			loopTmp acts
		    else
			loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
		end

	val acts = loopTmp acts
    in
	acts
    end

fun findAllDiffs () =
    let
	val dir = Posix.FileSys.opendir Config.tmpDir
	val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1

	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 (site, dom, diffs))
						  end
					      else
						  diffs)
				    end
			in
			    loop diffs
			    before Posix.FileSys.closedir dir
			end
		in
		    explore (OS.Path.joinDirFile {dir = Config.tmpDir,
						  file = site}, diffs)
		end
    in
	exploreSites []
	before Posix.FileSys.closedir dir
    end

val masterNode : string option ref = ref NONE
fun dnsMaster () = !masterNode

val _ = Env.containerV_one "domain"
			   ("domain", Env.string)
			   (fn (evs, dom) =>
			       let
				   val kind = Env.env dnsKind (evs, "DNS")
				   val ttl = Env.env Env.int (evs, "TTL")

				   val path = getPath dom

				   val () = (current := dom;
					     currentPath := (fn site => path (Config.tmpDir, site)))

				   fun saveSoa (kind, soa : soa) node =
				       let
					   val outf = domainFile {node = node, name = "soa"}
				       in
					   TextIO.output (outf, kind);
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString ttl);
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, #ns soa);
					   TextIO.output (outf, "\n");
					   case #serial soa of
					       NONE => ()
					     | SOME n => TextIO.output (outf, Int.toString n);
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString (#ref soa));
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString (#ret soa));
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString (#exp soa));
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString (#min soa));
					   TextIO.output (outf, "\n");
					   TextIO.closeOut outf
				       end

				   fun saveNamed (kind, soa : soa, masterIp) node =
				       let
					   val outf = domainFile {node = node, name = "named.conf"}
				       in
					   TextIO.output (outf, "\nzone \"");
					   TextIO.output (outf, dom);
					   TextIO.output (outf, "\" IN {\n\ttype ");
					   TextIO.output (outf, kind);
					   TextIO.output (outf, ";\n\tfile \"");
					   TextIO.output (outf, Config.Bind.zonePath);
					   TextIO.output (outf, "/");
					   TextIO.output (outf, dom);
					   TextIO.output (outf, ".zone\";\n");
					   case kind of
					       "master" => TextIO.output (outf, "\tallow-update { none; };\n")
					     | _ => (TextIO.output (outf, "\tmasters { ");
						     TextIO.output (outf, masterIp);
						     TextIO.output (outf, " };\n"));
					   TextIO.output (outf, "};\n");
					   TextIO.closeOut outf
				       end
			       in
				   case kind of
				       NoDns => masterNode := NONE
				     | UseDns dns =>
				       let
					   val masterIp =
					       case #master dns of
						   InternalMaster node => valOf (SM.find (nodeMap, node))
						 | ExternalMaster ip => ip
				       in
					   app (saveSoa ("slave", #soa dns)) (#slaves dns);
					   app (saveNamed ("slave", #soa dns, masterIp)) (#slaves dns);
					   case #master dns of
					       InternalMaster node =>
					       (masterNode := SOME node;
						saveSoa ("master", #soa dns) node;
						saveNamed ("master", #soa dns, masterIp) node)
					     | _ => masterNode := NONE;
					   !befores dom
				       end
			       end,
			    fn () => !afters (!current))

val () = Env.registerPre (fn () => (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))

val () = Env.registerPost (fn () =>
			      let
				  val diffs = findAllDiffs ()

				  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);
						       (site,
							{action = Slave.Delete,
							 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 (map #2 diffs);
				  ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
						     fn cl => "Temp file cleanup failed: " ^ cl))
			      end)


end
Commit	Line	Data
a3698041 AC	1	(* HCoop Domtool (http://hcoop.sourceforge.net/)
	2	* Copyright (c) 2006, Adam Chlipala
	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
	21	structure Domain :> DOMAIN = struct
	22
2ed6d0e5 AC	23	structure SM = DataStructures.StringMap
	24
	25	val nodes = map #2 Config.nodeIps
	26	val nodeMap = foldl (fn ((node, ip), mp) => SM.insert (mp, node, ip))
	27	SM.empty Config.nodeIps
	28
6ae327f8 AC	29	fun validIp s =
	30	case map Int.fromString (String.fields (fn ch => ch = #".") s) of
	31	[SOME n1, SOME n2, SOME n3, SOME n4] =>
	32	n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
	33	\| _ => false
	34
629a34f6 AC	35	fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
	36
	37	fun validHost s =
	38	size s > 0 andalso size s < 20
	39	andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
	40
	41	fun validDomain s =
	42	size s > 0 andalso size s < 100
	43	andalso List.all validHost (String.fields (fn ch => ch = #".") s)
	44
2ed6d0e5	45	fun validNode s = List.exists (fn s' => s = s') nodes
e0b0abd2	46
6ae327f8 AC	47	val _ = Env.type_one "ip"
	48	Env.string
	49	validIp
	50
629a34f6 AC	51	val _ = Env.type_one "host"
	52	Env.string
	53	validHost
	54
	55	val _ = Env.type_one "domain"
	56	Env.string
	57	validDomain
	58
e0b0abd2 AC	59	val _ = Env.type_one "node"
	60	Env.string
	61	validNode
	62
a3698041 AC	63	open Ast
a3698041 AC	64
6ae327f8 AC	65	val dl = ErrorMsg.dummyLoc
	66
	67	val nsD = (EString Config.defaultNs, dl)
	68	val serialD = (EVar "serialAuto", dl)
	69	val refD = (EInt Config.defaultRefresh, dl)
	70	val retD = (EInt Config.defaultRetry, dl)
	71	val expD = (EInt Config.defaultExpiry, dl)
	72	val minD = (EInt Config.defaultMinimum, dl)
	73
	74	val soaD = multiApp ((EVar "soa", dl),
	75	dl,
	76	[nsD, serialD, refD, retD, expD, minD])
	77
e0b0abd2 AC	78	val masterD = (EApp ((EVar "internalMaster", dl),
	79	(EString Config.defaultNode, dl)),
	80	dl)
	81
6ae327f8 AC	82	val _ = Main.registerDefault ("DNS",
6ae327f8 AC	83	(TBase "dnsKind", dl),
e0b0abd2 AC	84	(multiApp ((EVar "useDns", dl),
	85	dl,
	86	[soaD, masterD, (EList [], dl)])))
6ae327f8 AC	87
	88	val _ = Main.registerDefault ("TTL",
	89	(TBase "int", dl),
	90	(EInt Config.Bind.defaultTTL, dl))
	91
	92	type soa = {ns : string,
	93	serial : int option,
	94	ref : int,
	95	ret : int,
	96	exp : int,
	97	min : int}
	98
	99	val serial = fn (EVar "serialAuto", _) => SOME NONE
	100	\| (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
	101	\| _ => NONE
	102
	103	val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp
	104	((EVar "soa", _), ns), _),
	105	sl), _),
	106	rf), _),
	107	ret), _),
	108	exp), _),
	109	min), _) =>
	110	(case (Env.string ns, serial sl, Env.int rf,
	111	Env.int ret, Env.int exp, Env.int min) of
	112	(SOME ns, SOME sl, SOME rf,
	113	SOME ret, SOME exp, SOME min) =>
	114	SOME {ns = ns,
	115	serial = sl,
	116	ref = rf,
	117	ret = ret,
	118	exp = exp,
	119	min = min}
	120	\| _ => NONE)
	121	\| _ => NONE
	122
e0b0abd2 AC	123	datatype master =
	124	ExternalMaster of string
	125	\| InternalMaster of string
	126
	127	val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (Env.string e)
	128	\| (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
	129	\| _ => NONE
	130
6ae327f8	131	datatype dnsKind =
e0b0abd2 AC	132	UseDns of {soa : soa,
	133	master : master,
	134	slaves : string list}
6ae327f8 AC	135	\| NoDns
6ae327f8 AC	136
e0b0abd2 AC	137	val dnsKind = fn (EApp ((EApp ((EApp
	138	((EVar "useDns", _), sa), _),
	139	mstr), _),
	140	slaves), _) =>
	141	(case (soa sa, master mstr, Env.list Env.string slaves) of
	142	(SOME sa, SOME mstr, SOME slaves) =>
	143	SOME (UseDns {soa = sa,
	144	master = mstr,
	145	slaves = slaves})
	146	\| _ => NONE)
6ae327f8 AC	147	\| _ => NONE
6ae327f8 AC	148
a3698041 AC	149	val befores = ref (fn (_ : string) => ())
	150	val afters = ref (fn (_ : string) => ())
	151
	152	fun registerBefore f =
	153	let
	154	val old = !befores
	155	in
	156	befores := (fn x => (old x; f x))
	157	end
	158
	159	fun registerAfter f =
	160	let
	161	val old = !afters
	162	in
	163	afters := (fn x => (old x; f x))
	164	end
	165
	166	val current = ref ""
e0b0abd2	167	val currentPath = ref (fn (_ : string) => "")
dac62e84	168
d612d62c AC	169	val scratch = ref ""
d612d62c AC	170
dac62e84 AC	171	fun currentDomain () = !current
dac62e84 AC	172
e0b0abd2 AC	173	fun domainFile {node, name} = ((print ("Opening " ^ !currentPath node ^ name ^ "\n");)
e0b0abd2 AC	174	TextIO.openOut (!currentPath node ^ name))
dac62e84 AC	175
	176	fun getPath domain =
	177	let
	178	val toks = String.fields (fn ch => ch = #".") domain
	179
	180	val elems = foldr (fn (piece, elems) =>
	181	let
	182	val elems = piece :: elems
d612d62c	183
e0b0abd2 AC	184	fun doNode node =
	185	let
	186	val path = String.concatWith "/"
	187	(Config.resultRoot :: node :: rev elems)
	188	val tmpPath = String.concatWith "/"
	189	(Config.tmpDir :: node :: rev elems)
	190	in
	191	(if Posix.FileSys.ST.isDir
	192	(Posix.FileSys.stat path) then
	193	()
	194	else
	195	(OS.FileSys.remove path;
	196	OS.FileSys.mkDir path))
	197	handle OS.SysErr _ => OS.FileSys.mkDir path;
	198
	199	(if Posix.FileSys.ST.isDir
	200	(Posix.FileSys.stat tmpPath) then
	201	()
	202	else
	203	(OS.FileSys.remove tmpPath;
	204	OS.FileSys.mkDir tmpPath))
	205	handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
	206	end
	207	in
2ed6d0e5	208	app doNode nodes;
dac62e84 AC	209	elems
	210	end) [] toks
	211	in
e0b0abd2	212	fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
d612d62c AC	213	end
	214
	215	datatype file_action' =
	216	Add' of {src : string, dst : string}
	217	\| Delete' of string
	218	\| Modify' of {src : string, dst : string}
	219
e0b0abd2	220	fun findDiffs (site, dom, acts) =
d612d62c	221	let
e0b0abd2 AC	222	val gp = getPath dom
	223	val realPath = gp (Config.resultRoot, site)
	224	val tmpPath = gp (Config.tmpDir, site)
	225
	226	(val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n"))
d612d62c AC	227
	228	val dir = Posix.FileSys.opendir realPath
	229
	230	fun loopReal acts =
	231	case Posix.FileSys.readdir dir of
	232	NONE => (Posix.FileSys.closedir dir;
	233	acts)
	234	\| SOME fname =>
	235	let
	236	val real = OS.Path.joinDirFile {dir = realPath,
	237	file = fname}
	238	val tmp = OS.Path.joinDirFile {dir = tmpPath,
	239	file = fname}
	240	in
	241	if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
	242	loopReal acts
	243	else if Posix.FileSys.access (tmp, []) then
8df2e702	244	if Slave.shell [Config.diff, " ", real, " ", tmp] then
d612d62c AC	245	loopReal acts
d612d62c AC	246	else
e0b0abd2	247	loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
d612d62c	248	else
e0b0abd2	249	loopReal ((site, dom, realPath, Delete' real) :: acts)
d612d62c AC	250	end
d612d62c AC	251
e0b0abd2	252	val acts = loopReal acts
d612d62c	253
8df2e702	254	val dir = Posix.FileSys.opendir tmpPath
d612d62c AC	255
	256	fun loopTmp acts =
	257	case Posix.FileSys.readdir dir of
	258	NONE => (Posix.FileSys.closedir dir;
	259	acts)
	260	\| SOME fname =>
	261	let
	262	val real = OS.Path.joinDirFile {dir = realPath,
	263	file = fname}
	264	val tmp = OS.Path.joinDirFile {dir = tmpPath,
	265	file = fname}
	266	in
	267	if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
	268	loopTmp acts
	269	else if Posix.FileSys.access (real, []) then
	270	loopTmp acts
	271	else
e0b0abd2	272	loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
d612d62c AC	273	end
	274
	275	val acts = loopTmp acts
	276	in
	277	acts
dac62e84	278	end
a3698041	279
e0b0abd2 AC	280	fun findAllDiffs () =
	281	let
	282	val dir = Posix.FileSys.opendir Config.tmpDir
	283	val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
	284
	285	fun exploreSites diffs =
	286	case Posix.FileSys.readdir dir of
	287	NONE => diffs
	288	\| SOME site =>
	289	let
	290	fun explore (dname, diffs) =
	291	let
	292	val dir = Posix.FileSys.opendir dname
	293
	294	fun loop diffs =
	295	case Posix.FileSys.readdir dir of
	296	NONE => diffs
	297	\| SOME name =>
	298	let
	299	val fname = OS.Path.joinDirFile {dir = dname,
	300	file = name}
	301	in
	302	loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
	303	let
	304	val dom = String.fields (fn ch => ch = #"/") fname
	305	val dom = List.drop (dom, len)
	306	val dom = String.concatWith "." (rev dom)
	307
	308	val dname' = OS.Path.joinDirFile {dir = dname,
	309	file = name}
	310	in
	311	explore (dname',
	312	findDiffs (site, dom, diffs))
	313	end
	314	else
	315	diffs)
	316	end
	317	in
	318	loop diffs
	319	before Posix.FileSys.closedir dir
	320	end
	321	in
	322	explore (OS.Path.joinDirFile {dir = Config.tmpDir,
	323	file = site}, diffs)
	324	end
	325	in
	326	exploreSites []
	327	before Posix.FileSys.closedir dir
	328	end
	329
	330	val masterNode : string option ref = ref NONE
	331	fun dnsMaster () = !masterNode
	332
6ae327f8 AC	333	val _ = Env.containerV_one "domain"
	334	("domain", Env.string)
	335	(fn (evs, dom) =>
	336	let
	337	val kind = Env.env dnsKind (evs, "DNS")
	338	val ttl = Env.env Env.int (evs, "TTL")
	339
e0b0abd2	340	val path = getPath dom
6ae327f8 AC	341
6ae327f8 AC	342	val () = (current := dom;
e0b0abd2	343	currentPath := (fn site => path (Config.tmpDir, site)))
6ae327f8	344
e0b0abd2	345	fun saveSoa (kind, soa : soa) node =
6ae327f8	346	let
e0b0abd2	347	val outf = domainFile {node = node, name = "soa"}
6ae327f8 AC	348	in
	349	TextIO.output (outf, kind);
	350	TextIO.output (outf, "\n");
	351	TextIO.output (outf, Int.toString ttl);
	352	TextIO.output (outf, "\n");
	353	TextIO.output (outf, #ns soa);
	354	TextIO.output (outf, "\n");
	355	case #serial soa of
	356	NONE => ()
	357	\| SOME n => TextIO.output (outf, Int.toString n);
	358	TextIO.output (outf, "\n");
	359	TextIO.output (outf, Int.toString (#ref soa));
	360	TextIO.output (outf, "\n");
	361	TextIO.output (outf, Int.toString (#ret soa));
	362	TextIO.output (outf, "\n");
	363	TextIO.output (outf, Int.toString (#exp soa));
	364	TextIO.output (outf, "\n");
	365	TextIO.output (outf, Int.toString (#min soa));
	366	TextIO.output (outf, "\n");
	367	TextIO.closeOut outf
	368	end
	369
2ed6d0e5	370	fun saveNamed (kind, soa : soa, masterIp) node =
6ae327f8	371	let
e0b0abd2	372	val outf = domainFile {node = node, name = "named.conf"}
6ae327f8 AC	373	in
	374	TextIO.output (outf, "\nzone \"");
	375	TextIO.output (outf, dom);
	376	TextIO.output (outf, "\" IN {\n\ttype ");
	377	TextIO.output (outf, kind);
	378	TextIO.output (outf, ";\n\tfile \"");
	379	TextIO.output (outf, Config.Bind.zonePath);
	380	TextIO.output (outf, "/");
	381	TextIO.output (outf, dom);
	382	TextIO.output (outf, ".zone\";\n");
	383	case kind of
	384	"master" => TextIO.output (outf, "\tallow-update { none; };\n")
2ed6d0e5 AC	385	\| _ => (TextIO.output (outf, "\tmasters { ");
	386	TextIO.output (outf, masterIp);
	387	TextIO.output (outf, " };\n"));
	388	TextIO.output (outf, "};\n");
6ae327f8 AC	389	TextIO.closeOut outf
6ae327f8 AC	390	end
6ae327f8 AC	391	in
6ae327f8 AC	392	case kind of
e0b0abd2 AC	393	NoDns => masterNode := NONE
e0b0abd2 AC	394	\| UseDns dns =>
2ed6d0e5 AC	395	let
	396	val masterIp =
	397	case #master dns of
	398	InternalMaster node => valOf (SM.find (nodeMap, node))
	399	\| ExternalMaster ip => ip
	400	in
	401	app (saveSoa ("slave", #soa dns)) (#slaves dns);
	402	app (saveNamed ("slave", #soa dns, masterIp)) (#slaves dns);
	403	case #master dns of
	404	InternalMaster node =>
	405	(masterNode := SOME node;
	406	saveSoa ("master", #soa dns) node;
	407	saveNamed ("master", #soa dns, masterIp) node)
	408	\| _ => masterNode := NONE;
	409	!befores dom
	410	end
6ae327f8	411	end,
e0b0abd2 AC	412	fn () => !afters (!current))
	413
	414	val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
	415	fn cl => "Temp file cleanup failed: " ^ cl));
	416	OS.FileSys.mkDir Config.tmpDir;
	417	app (fn node => OS.FileSys.mkDir
	418	(OS.Path.joinDirFile {dir = Config.tmpDir,
	419	file = node}))
2ed6d0e5	420	nodes;
e0b0abd2 AC	421	app (fn node => OS.FileSys.mkDir
	422	(OS.Path.joinDirFile {dir = Config.resultRoot,
	423	file = node})
	424	handle OS.SysErr _ => ())
2ed6d0e5	425	nodes))
e0b0abd2 AC	426
	427	val () = Env.registerPost (fn () =>
	428	let
	429	val diffs = findAllDiffs ()
6ae327f8	430
e0b0abd2 AC	431	val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
	432	(Slave.shellF ([Config.cp, " ", src, " ", dst],
	433	fn cl => "Copy failed: " ^ cl);
	434	(site,
6ae327f8 AC	435	{action = Slave.Add,
	436	domain = dom,
	437	dir = dir,
e0b0abd2 AC	438	file = dst}))
	439	\| (site, dom, dir, Delete' dst) =>
	440	(OS.FileSys.remove dst
	441	handle OS.SysErr _ =>
	442	ErrorMsg.error NONE ("Delete failed for " ^ dst);
	443	(site,
6ae327f8 AC	444	{action = Slave.Delete,
	445	domain = dom,
	446	dir = dir,
e0b0abd2 AC	447	file = dst}))
	448	\| (site, dom, dir, Modify' {src, dst}) =>
	449	(Slave.shellF ([Config.cp, " ", src, " ", dst],
	450	fn cl => "Copy failed: " ^ cl);
	451	(site,
6ae327f8 AC	452	{action = Slave.Modify,
	453	domain = dom,
	454	dir = dir,
e0b0abd2 AC	455	file = dst}))) diffs
	456	in
	457	if !ErrorMsg.anyErrors then
	458	()
	459	else
	460	Slave.handleChanges (map #2 diffs);
	461	ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
	462	fn cl => "Temp file cleanup failed: " ^ cl))
	463	end)
6ae327f8 AC	464
6ae327f8 AC	465
a3698041 AC	466
a3698041 AC	467	end