X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/d300166d083192ef3d4242013adcef345b0126f3..5e3ad5d2b6de3ed66e2f4ea4fa4a0de1b4881f1d:/src/domain.sml

diff --git a/src/domain.sml b/src/domain.sml
index 642f71c..94eb077 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -48,8 +48,11 @@ fun your_groups () = !your_grps
 val your_pths = ref SS.empty
 fun your_paths () = !your_pths
 
+val your_ipss = ref SS.empty
+fun your_ips () = !your_ipss
+
 val world_readable = SS.addList (SS.empty, Config.worldReadable)
-val readable_pths = ref SS.empty
+val readable_pths = ref world_readable
 fun readable_paths () = !readable_pths
 
 fun setUser user =
@@ -66,7 +69,9 @@ fun setUser user =
 	your_grps := Acl.class {user = getUser (),
 				class = "group"};
 	your_pths := your_paths;
-	readable_pths := SS.union (your_paths, world_readable)
+	readable_pths := SS.union (your_paths, world_readable);
+	your_ipss := Acl.class {user = getUser (),
+				class = "ip"}
     end
 
 fun validIp s =
@@ -97,6 +102,7 @@ fun checkPath paths path =
     andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (paths ())
 val yourPath = checkPath your_paths
 val readablePath = checkPath readable_paths
+fun yourIp s = SS.member (your_ips (), s)
 
 fun yourDomainHost s =
     yourDomain s
@@ -131,7 +137,7 @@ val _ = Env.type_one "no_spaces"
 val _ = Env.type_one "no_newlines"
 		     Env.string
 		     (CharVector.all (fn ch => Char.isPrint ch andalso ch <> #"\n" andalso ch <> #"\r"
-					       andalso ch <> #"\"" andalso ch <> #"'"))
+					       andalso ch <> #"\""))
 
 val _ = Env.type_one "ip"
 	Env.string
@@ -177,10 +183,18 @@ val _ = Env.type_one "readable_path"
 	Env.string
 	readablePath
 
+val _ = Env.type_one "your_ip"
+	Env.string
+	yourIp
+
 val _ = Env.type_one "node"
 	Env.string
 	validNode
 
+val _ = Env.registerFunction ("your_ip_to_ip",
+			      fn [e] => SOME e
+			       | _ => NONE)
+
 val _ = Env.registerFunction ("dns_node_to_node",
 			      fn [e] => SOME e
 			       | _ => NONE)
@@ -188,10 +202,22 @@ val _ = Env.registerFunction ("dns_node_to_node",
 val _ = Env.registerFunction ("mail_node_to_node",
 			      fn [e] => SOME e
 			       | _ => NONE)
+
+
 open Ast
 
 val dl = ErrorMsg.dummyLoc
 
+val _ = Env.registerFunction ("end_in_slash",
+			      fn [(EString "", _)] => SOME (EString "/", dl)
+			       | [(EString s, _)] =>
+				 SOME (EString (if String.sub (s, size s - 1) = #"/" then
+						    s
+						else
+						    s ^ "/"), dl)
+			       | _ => NONE)
+
+
 val nsD = (EString Config.defaultNs, dl)
 val serialD = (EVar "serialAuto", dl)
 val refD = (EInt Config.defaultRefresh, dl)
@@ -403,7 +429,7 @@ datatype file_action' =
        | Delete' of string
        | Modify' of {src : string, dst : string}
 
-fun findDiffs (site, dom, acts) =
+fun findDiffs (prefixes, site, dom, acts) =
     let
 	val gp = getPath dom
 	val realPath = gp (Config.resultRoot, site)
@@ -431,8 +457,10 @@ fun findDiffs (site, dom, acts) =
 			    loopReal acts
 			else
 			    loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
-		    else
+		    else if List.exists (fn prefix => String.isPrefix prefix real) prefixes then
 			loopReal ((site, dom, realPath, Delete' real) :: acts)
+		    else
+			loopReal acts
 		end
 
 	val acts = loopReal acts
@@ -463,7 +491,7 @@ fun findDiffs (site, dom, acts) =
 	acts
     end
 
-fun findAllDiffs () =
+fun findAllDiffs prefixes =
     let
 	val dir = Posix.FileSys.opendir Config.tmpDir
 	val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
@@ -495,7 +523,7 @@ fun findAllDiffs () =
 											file = name}
 						  in
 						      explore (dname',
-							       findDiffs (site, dom, diffs))
+							       findDiffs (prefixes, site, dom, diffs))
 						  end
 					      else
 						  diffs)
@@ -516,10 +544,14 @@ fun findAllDiffs () =
 val masterNode : string option ref = ref NONE
 fun dnsMaster () = !masterNode
 
+val seenDomains : string list ref = ref []
+
 val _ = Env.containerV_one "domain"
 			   ("domain", Env.string)
 			   (fn (evs, dom) =>
 			       let
+				   val () = seenDomains := dom :: !seenDomains
+
 				   val kind = Env.env dnsKind (evs, "DNS")
 				   val ttl = Env.env Env.int (evs, "TTL")
 				   val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
@@ -608,7 +640,8 @@ val _ = Env.containerV_one "domain"
 			       end,
 			    fn () => !afters (!current))
 
-val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
+val () = Env.registerPre (fn () => (seenDomains := [];
+				    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
@@ -652,7 +685,18 @@ fun handleSite (site, files) =
 
 val () = Env.registerPost (fn () =>
 			      let
-				  val diffs = findAllDiffs ()
+				  val prefixes = List.concat
+						     (List.map (fn dom =>
+								   let
+								       val pieces = String.tokens (fn ch => ch = #".") dom
+								       val path = String.concatWith "/" (rev pieces)
+								   in
+								       List.map (fn node =>
+										    Config.resultRoot ^ "/" ^ node ^ "/" ^ path ^ "/")
+										nodes
+								   end) (!seenDomains))
+								  
+				  val diffs = findAllDiffs prefixes
 
 				  val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
 						      (Slave.shellF ([Config.cp, " ", src, " ", dst],
@@ -667,7 +711,7 @@ val () = Env.registerPost (fn () =>
 						       handle OS.SysErr _ =>
 							      ErrorMsg.error NONE ("Delete failed for " ^ dst);
 						       (site,
-							{action = Slave.Delete,
+							{action = Slave.Delete true,
 							 domain = dom,
 							 dir = dir,
 							 file = dst}))
@@ -715,11 +759,11 @@ val _ = Env.type_one "mail_node"
 	    orelse (hasPriv "mail"
 		    andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 
-fun rmdom doms =
+fun rmdom' delete resultRoot doms =
     let
 	fun doNode (node, _) =
 	    let
-		val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+		val dname = OS.Path.joinDirFile {dir = resultRoot,
 						 file = node}
 
 		fun doDom (dom, actions) =
@@ -743,18 +787,18 @@ fun rmdom doms =
 						loop (visitDom (fname ^ "." ^ dom,
 								fnameFull,
 								actions))
-					    else							
-						loop ({action = Slave.Delete,
-						       domain = dom,
-						       dir = dname,
-						       file = fnameFull} :: actions)
+					    else			
+						 loop ({action = Slave.Delete delete,
+							domain = dom,
+							dir = dname,
+							file = fnameFull} :: actions)
 					end
 			    in
 				loop actions
 				before Posix.FileSys.closedir dir
 			    end
-				handle OS.SysErr _ =>
-				       (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ".\n");
+				handle OS.SysErr (s, _) =>
+				       (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ": " ^ s ^ "\n");
 					actions)
 		    in
 			visitDom (dom, dname, actions)
@@ -771,11 +815,14 @@ fun rmdom doms =
 		fun doDom dom =
 		    let
 			val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
-			val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+			val dname = OS.Path.joinDirFile {dir = resultRoot,
 							 file = node}
 			val dname = OS.Path.concat (dname, domPath)
 		    in
-			ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+			if delete then
+			    ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+			else
+			    ()
 		    end
 	    in
 		app doDom doms
@@ -785,6 +832,9 @@ fun rmdom doms =
 	app cleanupNode Config.nodeIps
     end
 
+val rmdom = rmdom' true Config.resultRoot
+val rmdom' = rmdom' false
+
 fun homedirOf uname =
     Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
 
@@ -856,7 +906,7 @@ fun considerAll ds {node, domain} =
 				     case d of
 					 Filename {filename, heading, showEmpty} =>
 					 if fname = filename then
-					     entries := readFile showEmpty ("\n" :: line :: ":\n" :: heading :: line :: !entries)
+					     entries := readFile showEmpty ("\n" :: line :: "\n" :: heading :: line :: !entries)
 					 else
 					     ()
 				       | Extension {extension, heading} =>
@@ -867,7 +917,7 @@ fun considerAll ds {node, domain} =
 						 NONE => ()
 					       | SOME extension' =>
 						 if extension' = extension then
-						     entries := readFile true ("\n" :: line :: ":\n" :: heading base :: line :: !entries)
+						     entries := readFile true ("\n" :: line :: "\n" :: heading base :: line :: !entries)
 						 else
 						     ()
 					 end
@@ -883,7 +933,13 @@ fun considerAll ds {node, domain} =
     end
 
 val () = registerDescriber (considerAll [Filename {filename = "soa",
-						   heading = "DNS SOA",
+						   heading = "DNS SOA:",
 						   showEmpty = false}])
 
+val () = Env.registerAction ("domainHost",
+			     fn (env, [(EString host, _)]) =>
+				SM.insert (env, "Hostname",
+					   (EString (host ^ "." ^ currentDomain ()), dl))
+			      | (_, args) => Env.badArgs ("domainHost", args))
+
 end