X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/d612d62cd04b713bb1057fd2e666365704aaf3d6..6ae327f88a6be8efd02cfe4b713444f9f3ac2672:/src/domain.sml?ds=sidebyside

diff --git a/src/domain.sml b/src/domain.sml
index 394bf80..6b645cb 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -20,6 +20,12 @@
 
 structure Domain :> DOMAIN = struct
 
+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 =
@@ -30,6 +36,10 @@ fun validDomain s =
     size s > 0 andalso size s < 100
     andalso List.all validHost (String.fields (fn ch => ch = #".") s)
 
+val _ = Env.type_one "ip"
+	Env.string
+	validIp
+
 val _ = Env.type_one "host"
 	Env.string
 	validHost
@@ -40,6 +50,69 @@ val _ = Env.type_one "domain"
 
 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 _ = Main.registerDefault ("DNS",
+			      (TBase "dnsKind", dl),
+			      (EApp ((EVar "master", dl),
+				     soaD), dl))
+
+val _ = Main.registerDefault ("TTL",
+			      (TBase "int", dl),
+			      (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 dnsKind =
+	 Master of soa
+       | Slave of soa
+       | NoDns
+
+val dnsKind = fn (EApp ((EVar "master", _), e), _) => Option.map Master (soa e)
+	       | (EApp ((EVar "slave", _), e), _) => Option.map Slave (soa e)
+	       | (EVar "noDns", _) => SOME NoDns
+	       | _ => NONE
+
 val befores = ref (fn (_ : string) => ())
 val afters = ref (fn (_ : string) => ())
 
@@ -103,18 +176,6 @@ datatype file_action' =
        | Delete' of string
        | Modify' of {src : string, dst : string}
 
-fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))
-
-fun shellF (ss, msg) =
-    let
-	val s = String.concat ss
-    in
-	if OS.Process.isSuccess (OS.Process.system s) then
-	    ()
-	else
-	    ErrorMsg.error NONE (msg s)
-    end
-
 fun findDiffs dom =
     let
 	val realPath = getPath dom Config.resultRoot
@@ -136,7 +197,7 @@ fun findDiffs dom =
 		    if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
 			loopReal acts
 		    else if Posix.FileSys.access (tmp, []) then
-			if shell [Config.diff, " ", real, " ",  tmp] then
+			if Slave.shell [Config.diff, " ", real, " ",  tmp] then
 			    loopReal acts
 			else
 			    loopReal (Modify' {src = tmp, dst = real} :: acts)
@@ -146,7 +207,7 @@ fun findDiffs dom =
 
 	val acts = loopReal []
 
-	val dir = Posix.FileSys.opendir realPath
+	val dir = Posix.FileSys.opendir tmpPath
 
 	fun loopTmp acts =
 	    case Posix.FileSys.readdir dir of
@@ -172,49 +233,111 @@ fun findDiffs dom =
 	acts
     end
 
-val _ = Env.container_one "domain"
-			  ("domain", Env.string)
-			  (fn dom =>
-			      let
-				  val path = getPath dom Config.tmpDir
-			      in
-				  current := dom;
-				  currentPath := path;
-				  !befores dom
-			      end,
-			   fn () =>
-			      let
-				  val dom = !current
-				  val () = !afters dom
-
-				  val diffs = findDiffs dom
-
-				  val diffs = map (fn Add' {src, dst} =>
-						      (shellF ([Config.cp, " ", src, " ", dst],
-							      fn cl => "Copy failed: " ^ cl);
-						       {action = Slave.Add,
-							domain = dom,
-							file = dst})
-						    | Delete' dst =>
-						      (OS.FileSys.remove dst
-						       handle OS.SysErr _ =>
-							      ErrorMsg.error NONE ("Delete failed for " ^ dst);
-						       {action = Slave.Delete,
-							domain = dom,
-							file = dst})
-						    | Modify' {src, dst} =>
-						      (shellF ([Config.cp, " ", src, " ", dst],
-							   fn cl => "Copy failed: " ^ cl);
-						       {action = Slave.Modify,
-							domain = dom,
-							file = dst})) diffs
-			      in
-				  if !ErrorMsg.anyErrors then
-				      ()
-				  else
-				      Slave.handleChanges diffs;
-				  ignore (shellF ([Config.rm, " -rf ", Config.tmpDir, "/*"],
-						  fn cl => "Temp file cleanup failed: " ^ cl))
-			      end)
+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 Config.tmpDir
+
+				   val () = (current := dom;
+					     currentPath := path;
+					     !befores dom)
+
+				   fun saveSoa (kind, soa : soa) =
+				       let
+					   val outf = domainFile "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) =
+				       let
+					   val outf = domainFile "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 { 1.2.3.4; };\n");
+					   TextIO.output (outf, "}\n");
+					   TextIO.closeOut outf
+				       end
+
+				   fun saveBoth ks = (saveSoa ks; saveNamed ks)
+			       in
+				   case kind of
+				       NoDns => ()
+				     | Master soa => saveBoth ("master", soa)
+				     | Slave soa => saveBoth ("slave", soa)
+			       end,
+			    fn () =>
+			       let
+				   val dom = !current
+				   val () = !afters dom
+
+				   val diffs = findDiffs dom
+
+				   val dir = getPath dom Config.resultRoot
+
+				   val diffs = map (fn Add' {src, dst} =>
+						       (Slave.shellF ([Config.cp, " ", src, " ", dst],
+								   fn cl => "Copy failed: " ^ cl);
+							{action = Slave.Add,
+							 domain = dom,
+							 dir = dir,
+							 file = dst})
+						     | Delete' dst =>
+						       (OS.FileSys.remove dst
+							handle OS.SysErr _ =>
+							       ErrorMsg.error NONE ("Delete failed for " ^ dst);
+							{action = Slave.Delete,
+							 domain = dom,
+							 dir = dir,
+							 file = dst})
+						     | Modify' {src, dst} =>
+						       (Slave.shellF ([Config.cp, " ", src, " ", dst],
+								   fn cl => "Copy failed: " ^ cl);
+							{action = Slave.Modify,
+							 domain = dom,
+							 dir = dir,
+							 file = dst})) diffs
+			       in
+				   if !ErrorMsg.anyErrors then
+				       ()
+				   else
+				       Slave.handleChanges diffs;
+				   ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, "/*"],
+						      fn cl => "Temp file cleanup failed: " ^ cl))
+			       end)
+
+
 
 end