[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
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
fun nodeIp node = valOf (SM.find (nodeMap, node))

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

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

val your_usrs = ref SS.empty
fun your_users () = !your_usrs

val your_grps = ref SS.empty
fun your_groups () = !your_grps

val your_pths = ref SS.empty
fun your_paths () = !your_pths

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)
fun yourUser s = SS.member (your_users (), s)
fun yourGroup s = SS.member (your_groups (), s)
fun yourPath path =
    List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path)
    andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"/"
				     orelse ch = #"-" orelse ch = #"_") path
    andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (your_paths ())

val _ = Env.type_one "no_spaces"
		     Env.string
		     (CharVector.all (fn ch => not (Char.isSpace ch)))

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 "your_user"
	Env.string
	yourUser

val _ = Env.type_one "your_group"
	Env.string
	yourGroup

val _ = Env.type_one "your_path"
	Env.string
	yourPath

val _ = Env.type_one "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),
			      (fn () => multiApp ((EVar "useDns", dl),
					 dl,
					 [soaD, masterD, (EList [], dl)])))

val _ = Main.registerDefault ("TTL",
			      (TBase "int", dl),
			      (fn () => (EInt Config.Bind.defaultTTL, dl)))

type soa = {ns : string,
	    serial : int option,
	    ref : int,
	    ret : int,
	    exp : int,
	    min : int}

val serial = fn (EVar "serialAuto", _) => SOME NONE
	      | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
	      | _ => NONE

val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp 
						     ((EVar "soa", _), ns), _),
						sl), _),
					 rf), _),
				  ret), _),
			   exp), _),
		    min), _) =>
	     (case (Env.string ns, serial sl, Env.int rf,
		    Env.int ret, Env.int exp, Env.int min) of
		  (SOME ns, SOME sl, SOME rf,
		   SOME ret, SOME exp, SOME min) =>
		  SOME {ns = ns,
			serial = sl,
			ref = rf,
			ret = ret,
			exp = exp,
			min = min}
		| _ => NONE)
	   | _ => NONE

datatype master =
	 ExternalMaster of string
       | InternalMaster of string

val 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"};
					   your_usrs := Acl.class {user = getUser (),
								   class = "user"};
					   your_grps := Acl.class {user = getUser (),
								   class = "group"};
					   your_pths := Acl.class {user = getUser (),
								   class = "path"}))

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