[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

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') Config.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 Config.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) 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 { 1.2.3.4; };\n");
					   TextIO.output (outf, "}\n");
					   TextIO.closeOut outf
				       end

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