[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 "no_spaces"
		     Env.string
		     (CharVector.all (fn ch => not (Char.isSpace ch)))

val _ = Env.type_one "ip"
	Env.string
	validIp

val _ = Env.type_one "host"
	Env.string
	validHost

val _ = Env.type_one "domain"
	Env.string
	validDomain

val _ = Env.type_one "your_domain"
	Env.string
	yourDomain

val _ = Env.type_one "your_user"
	Env.string
	yourUser

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

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

val _ = Env.type_one "node"
	Env.string
	validNode

open Ast

val dl = ErrorMsg.dummyLoc

val nsD = (EString Config.defaultNs, dl)
val serialD = (EVar "serialAuto", dl)
val refD = (EInt Config.defaultRefresh, dl)
val retD = (EInt Config.defaultRetry, dl)
val expD = (EInt Config.defaultExpiry, dl)
val minD = (EInt Config.defaultMinimum, dl)

val soaD = multiApp ((EVar "soa", dl),
		     dl,
		     [nsD, serialD, refD, retD, expD, minD])

val masterD = (EApp ((EVar "internalMaster", dl),
		     (EString Config.defaultNode, dl)),
	       dl)

val _ = Main.registerDefault ("DNS",
			      (TBase "dnsKind", dl),
			      (fn () => multiApp ((EVar "useDns", dl),
					 dl,
					 [soaD, masterD, (EList [], dl)])))

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

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

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

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

datatype master =
	 ExternalMaster of string
       | InternalMaster of string

val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (Env.string e)
	      | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
	      | _ => NONE

datatype dnsKind =
	 UseDns of {soa : soa,
		    master : master,
		    slaves : string list}
       | NoDns

val dnsKind = fn (EApp ((EApp ((EApp 
				    ((EVar "useDns", _), sa), _),
			       mstr), _),
			slaves), _) =>
		 (case (soa sa, master mstr, Env.list Env.string slaves) of
		      (SOME sa, SOME mstr, SOME slaves) =>
		      SOME (UseDns {soa = sa,
				    master = mstr,
				    slaves = slaves})
		    | _ => NONE)
	       | _ => NONE

val befores = ref (fn (_ : string) => ())
val afters = ref (fn (_ : string) => ())

fun registerBefore f =
    let
	val old = !befores
    in
	befores := (fn x => (old x; f x))
    end

fun registerAfter f =
    let
	val old = !afters
    in
	afters := (fn x => (old x; f x))
    end

val current = ref ""
val currentPath = ref (fn (_ : string) => "")

val scratch = ref ""

fun currentDomain () = !current

fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
			       TextIO.openOut (!currentPath node ^ name))

fun getPath domain =
    let
	val toks = String.fields (fn ch => ch = #".") domain

	val elems = foldr (fn (piece, elems) =>
			      let
				  val elems = piece :: elems

				  fun doNode node =
				      let
					  val path = String.concatWith "/"
								       (Config.resultRoot :: node :: rev elems)
					  val tmpPath = String.concatWith "/"
									  (Config.tmpDir :: node :: rev elems)
				      in
					  (if Posix.FileSys.ST.isDir
						  (Posix.FileSys.stat path) then
					       ()
					   else
					       (OS.FileSys.remove path;
						OS.FileSys.mkDir path))
					  handle OS.SysErr _ => OS.FileSys.mkDir path;

					  (if Posix.FileSys.ST.isDir
						  (Posix.FileSys.stat tmpPath) then
					       ()
					   else
					       (OS.FileSys.remove tmpPath;
						OS.FileSys.mkDir tmpPath))
					  handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
				      end
			      in
				  app doNode nodes;
				  elems
			      end) [] toks
    in
	fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
    end

datatype file_action' =
	 Add' of {src : string, dst : string}
       | Delete' of string
       | Modify' of {src : string, dst : string}

fun findDiffs (site, dom, acts) =
    let
	val gp = getPath dom
	val realPath = gp (Config.resultRoot, site)
	val tmpPath = gp (Config.tmpDir, site)

	(*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)

	val dir = Posix.FileSys.opendir realPath

	fun loopReal acts =
	    case Posix.FileSys.readdir dir of
		NONE => (Posix.FileSys.closedir dir;
			 acts)
	      | SOME fname =>
		let
		    val real = OS.Path.joinDirFile {dir = realPath,
						    file = fname}
		    val tmp = OS.Path.joinDirFile {dir = tmpPath,
						   file = fname}
		in
		    if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
			loopReal acts
		    else if Posix.FileSys.access (tmp, []) then
			if Slave.shell [Config.diff, " ", real, " ",  tmp] then
			    loopReal acts
			else
			    loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
		    else
			loopReal ((site, dom, realPath, Delete' real) :: acts)
		end

	val acts = loopReal acts

	val dir = Posix.FileSys.opendir tmpPath

	fun loopTmp acts =
	    case Posix.FileSys.readdir dir of
		NONE => (Posix.FileSys.closedir dir;
			 acts)
	      | SOME fname =>
		let
		    val real = OS.Path.joinDirFile {dir = realPath,
						    file = fname}
		    val tmp = OS.Path.joinDirFile {dir = tmpPath,
						   file = fname}
		in
		    if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
			loopTmp acts
		    else if Posix.FileSys.access (real, []) then
			loopTmp acts
		    else
			loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
		end

	val acts = loopTmp acts
    in
	acts
    end

fun findAllDiffs () =
    let
	val dir = Posix.FileSys.opendir Config.tmpDir
	val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1

	fun exploreSites diffs =
	    case Posix.FileSys.readdir dir of
		NONE => diffs
	      | SOME site =>
		let
		    fun explore (dname, diffs) =
			let
			    val dir = Posix.FileSys.opendir dname

			    fun loop diffs =
				case Posix.FileSys.readdir dir of
				    NONE => diffs
				  | SOME name =>
				    let
					val fname = OS.Path.joinDirFile {dir = dname,
									 file = name}
				    in
					loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
						  let
						      val dom = String.fields (fn ch => ch = #"/") fname
						      val dom = List.drop (dom, len)
						      val dom = String.concatWith "." (rev dom)

						      val dname' = OS.Path.joinDirFile {dir = dname,
											file = name}
						  in
						      explore (dname',
							       findDiffs (site, dom, diffs))
						  end
					      else
						  diffs)
				    end
			in
			    loop diffs
			    before Posix.FileSys.closedir dir
			end
		in
		    explore (OS.Path.joinDirFile {dir = Config.tmpDir,
						  file = site}, diffs)
		end
    in
	exploreSites []
	before Posix.FileSys.closedir dir
    end

val masterNode : string option ref = ref NONE
fun dnsMaster () = !masterNode

val _ = Env.containerV_one "domain"
			   ("domain", Env.string)
			   (fn (evs, dom) =>
			       let
				   val kind = Env.env dnsKind (evs, "DNS")
				   val ttl = Env.env Env.int (evs, "TTL")

				   val path = getPath dom

				   val () = (current := dom;
					     currentPath := (fn site => path (Config.tmpDir, site)))

				   fun saveSoa (kind, soa : soa) node =
				       let
					   val outf = domainFile {node = node, name = "soa"}
				       in
					   TextIO.output (outf, kind);
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString ttl);
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, #ns soa);
					   TextIO.output (outf, "\n");
					   case #serial soa of
					       NONE => ()
					     | SOME n => TextIO.output (outf, Int.toString n);
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString (#ref soa));
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString (#ret soa));
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString (#exp soa));
					   TextIO.output (outf, "\n");
					   TextIO.output (outf, Int.toString (#min soa));
					   TextIO.output (outf, "\n");
					   TextIO.closeOut outf
				       end

				   fun saveNamed (kind, soa : soa, masterIp) node =
				       let
					   val outf = domainFile {node = node, name = "named.conf"}
				       in
					   TextIO.output (outf, "\nzone \"");
					   TextIO.output (outf, dom);
					   TextIO.output (outf, "\" IN {\n\ttype ");
					   TextIO.output (outf, kind);
					   TextIO.output (outf, ";\n\tfile \"");
					   TextIO.output (outf, Config.Bind.zonePath);
					   TextIO.output (outf, "/");
					   TextIO.output (outf, dom);
					   TextIO.output (outf, ".zone\";\n");
					   case kind of
					       "master" => TextIO.output (outf, "\tallow-update { none; };\n")
					     | _ => (TextIO.output (outf, "\tmasters { ");
						     TextIO.output (outf, masterIp);
						     TextIO.output (outf, " };\n"));
					   TextIO.output (outf, "};\n");
					   TextIO.closeOut outf
				       end
			       in
				   case kind of
				       NoDns => masterNode := NONE
				     | UseDns dns =>
				       let
					   val masterIp =
					       case #master dns of
						   InternalMaster node => valOf (SM.find (nodeMap, node))
						 | ExternalMaster ip => ip
				       in
					   app (saveSoa ("slave", #soa dns)) (#slaves dns);
					   app (saveNamed ("slave", #soa dns, masterIp)) (#slaves dns);
					   case #master dns of
					       InternalMaster node =>
					       (masterNode := SOME node;
						saveSoa ("master", #soa dns) node;
						saveNamed ("master", #soa dns, masterIp) node)
					     | _ => masterNode := NONE;
					   !befores dom
				       end
			       end,
			    fn () => !afters (!current))

val () = Env.registerPreTycheck (fn () => (setUser Config.testUser;
					   Acl.read Config.aclFile;
					   your_doms := Acl.class {user = getUser (),
								   class = "domain"};
					   your_usrs := Acl.class {user = getUser (),
								   class = "user"};
					   your_grps := Acl.class {user = getUser (),
								   class = "group"};
					   your_pths := Acl.class {user = getUser (),
								   class = "path"}))

val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
						       fn cl => "Temp file cleanup failed: " ^ cl));
				    OS.FileSys.mkDir Config.tmpDir;
				    app (fn node => OS.FileSys.mkDir
							(OS.Path.joinDirFile {dir = Config.tmpDir,
									      file = node}))
					nodes;
				    app (fn node => OS.FileSys.mkDir
							(OS.Path.joinDirFile {dir = Config.resultRoot,
									      file = node})
					    handle OS.SysErr _ => ())
					nodes))

val () = Env.registerPost (fn () =>
			      let
				  val diffs = findAllDiffs ()

				  val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
						      (Slave.shellF ([Config.cp, " ", src, " ", dst],
								  fn cl => "Copy failed: " ^ cl);
						       (site,
							{action = Slave.Add,
							 domain = dom,
							 dir = dir,
							 file = dst}))
						    | (site, dom, dir, Delete' dst) =>
						      (OS.FileSys.remove dst
						       handle OS.SysErr _ =>
							      ErrorMsg.error NONE ("Delete failed for " ^ dst);
						       (site,
							{action = Slave.Delete,
							 domain = dom,
							 dir = dir,
							 file = dst}))
						    | (site, dom, dir, Modify' {src, dst}) =>
						      (Slave.shellF ([Config.cp, " ", src, " ", dst],
								  fn cl => "Copy failed: " ^ cl);
						       (site,
							{action = Slave.Modify,
							 domain = dom,
							 dir = dir,
							 file = dst}))) diffs
			      in
				  if !ErrorMsg.anyErrors then
				      ()
				  else
				      Slave.handleChanges (map #2 diffs)(*;
				  ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
						     fn cl => "Temp file cleanup failed: " ^ cl))*)
			      end)


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