[hcoop/zz_old/domtool2-proto.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
a11c0ff3	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.
ae3a5b8c	17	*)
a11c0ff3	18
	19	(* Domain-related primitive actions *)
	20
	21	structure Domain :> DOMAIN = struct
	22
084d02b1	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
85af7d3e	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
2f68506c	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
084d02b1	45	fun validNode s = List.exists (fn s' => s = s') nodes
668e333e	46
85af7d3e	47	val _ = Env.type_one "ip"
	48	Env.string
	49	validIp
	50
2f68506c	51	val _ = Env.type_one "host"
	52	Env.string
	53	validHost
	54
	55	val _ = Env.type_one "domain"
	56	Env.string
	57	validDomain
	58
668e333e	59	val _ = Env.type_one "node"
	60	Env.string
	61	validNode
	62
a11c0ff3	63	open Ast
a11c0ff3	64
85af7d3e	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
668e333e	78	val masterD = (EApp ((EVar "internalMaster", dl),
	79	(EString Config.defaultNode, dl)),
	80	dl)
	81
85af7d3e	82	val _ = Main.registerDefault ("DNS",
85af7d3e	83	(TBase "dnsKind", dl),
668e333e	84	(multiApp ((EVar "useDns", dl),
	85	dl,
	86	[soaD, masterD, (EList [], dl)])))
85af7d3e	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
668e333e	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
85af7d3e	131	datatype dnsKind =
668e333e	132	UseDns of {soa : soa,
	133	master : master,
	134	slaves : string list}
85af7d3e	135	\| NoDns
85af7d3e	136
668e333e	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)
85af7d3e	147	\| _ => NONE
85af7d3e	148
a11c0ff3	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 ""
668e333e	167	val currentPath = ref (fn (_ : string) => "")
ae3a5b8c	168
c12828f2	169	val scratch = ref ""
c12828f2	170
ae3a5b8c	171	fun currentDomain () = !current
ae3a5b8c	172
668e333e	173	fun domainFile {node, name} = ((print ("Opening " ^ !currentPath node ^ name ^ "\n");)
668e333e	174	TextIO.openOut (!currentPath node ^ name))
ae3a5b8c	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
c12828f2	183
668e333e	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
084d02b1	208	app doNode nodes;
ae3a5b8c	209	elems
	210	end) [] toks
	211	in
668e333e	212	fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
c12828f2	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
668e333e	220	fun findDiffs (site, dom, acts) =
c12828f2	221	let
668e333e	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"))
c12828f2	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
1f53f82b	244	if Slave.shell [Config.diff, " ", real, " ", tmp] then
c12828f2	245	loopReal acts
c12828f2	246	else
668e333e	247	loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
c12828f2	248	else
668e333e	249	loopReal ((site, dom, realPath, Delete' real) :: acts)
c12828f2	250	end
c12828f2	251
668e333e	252	val acts = loopReal acts
c12828f2	253
1f53f82b	254	val dir = Posix.FileSys.opendir tmpPath
c12828f2	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
668e333e	272	loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
c12828f2	273	end
	274
	275	val acts = loopTmp acts
	276	in
	277	acts
ae3a5b8c	278	end
a11c0ff3	279
668e333e	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
85af7d3e	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
668e333e	340	val path = getPath dom
85af7d3e	341
85af7d3e	342	val () = (current := dom;
668e333e	343	currentPath := (fn site => path (Config.tmpDir, site)))
85af7d3e	344
668e333e	345	fun saveSoa (kind, soa : soa) node =
85af7d3e	346	let
668e333e	347	val outf = domainFile {node = node, name = "soa"}
85af7d3e	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
084d02b1	370	fun saveNamed (kind, soa : soa, masterIp) node =
85af7d3e	371	let
668e333e	372	val outf = domainFile {node = node, name = "named.conf"}
85af7d3e	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")
084d02b1	385	\| _ => (TextIO.output (outf, "\tmasters { ");
	386	TextIO.output (outf, masterIp);
	387	TextIO.output (outf, " };\n"));
	388	TextIO.output (outf, "};\n");
85af7d3e	389	TextIO.closeOut outf
85af7d3e	390	end
85af7d3e	391	in
85af7d3e	392	case kind of
668e333e	393	NoDns => masterNode := NONE
668e333e	394	\| UseDns dns =>
084d02b1	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
85af7d3e	411	end,
668e333e	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}))
084d02b1	420	nodes;
668e333e	421	app (fn node => OS.FileSys.mkDir
	422	(OS.Path.joinDirFile {dir = Config.resultRoot,
	423	file = node})
	424	handle OS.SysErr _ => ())
084d02b1	425	nodes))
668e333e	426
	427	val () = Env.registerPost (fn () =>
	428	let
	429	val diffs = findAllDiffs ()
85af7d3e	430
668e333e	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,
85af7d3e	435	{action = Slave.Add,
	436	domain = dom,
	437	dir = dir,
668e333e	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,
85af7d3e	444	{action = Slave.Delete,
	445	domain = dom,
	446	dir = dir,
668e333e	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,
85af7d3e	452	{action = Slave.Modify,
	453	domain = dom,
	454	dir = dir,
668e333e	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)
85af7d3e	464
85af7d3e	465
a11c0ff3	466
a11c0ff3	467	end