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 ())

fun yourDomainHost s =
    yourDomain s
    orelse let
	val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
    in
	Substring.size suf > 0
	andalso validHost (Substring.string pref)
	andalso yourDomain (Substring.string
				(Substring.slice (suf, 1, NONE)))
    end

fun validUser s = size s > 0 andalso size s < 20
		  andalso CharVector.all Char.isAlphaNum s

val validGroup = validUser

val _ = Env.type_one "no_spaces"
		     Env.string
		     (CharVector.all (fn ch => not (Char.isSpace ch)))
val _ = Env.type_one "no_newlines"
		     Env.string
		     (CharVector.all (fn ch => ch <> #"\n" andalso ch <> #"\r"))

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_domain_host"
	Env.string
	yourDomainHost

val _ = Env.type_one "user"
	Env.string
	validUser

val _ = Env.type_one "group"
	Env.string
	validGroup

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