[clinton/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
structure SS = DataStructures.StringSet

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

val usr = ref ""
fun setUser ur = usr := ur
fun getUser () = !usr

val your_doms = ref SS.empty
fun your_domains () = !your_doms

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

fun yourDomain s = SS.member (your_domains (), s)

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 "your_domain"
	Env.string
	yourDomain

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.registerPreTycheck (fn () => (setUser Config.testUser;
					   Acl.read Config.aclFile;
					   your_doms := Acl.class {user = getUser (),
								   class = "domain"}))

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