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

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

(* Domain-related primitive actions *)

structure Domain :> DOMAIN = struct

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