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

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

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