X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/7d04245261160cf03725cae8557c5e546b832ded..c189cbe97d554b26ec6b203b4ce9f697947ecc38:/src/domain.sml

diff --git a/src/domain.sml b/src/domain.sml
index 85dcd67..0354944 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -153,6 +153,13 @@ val _ = Env.type_one "node"
 	Env.string
 	validNode
 
+val _ = Env.registerFunction ("dns_node_to_node",
+			      fn [e] => SOME e
+			       | _ => NONE)
+
+val _ = Env.registerFunction ("mail_node_to_node",
+			      fn [e] => SOME e
+			       | _ => NONE)
 open Ast
 
 val dl = ErrorMsg.dummyLoc
@@ -223,8 +230,11 @@ datatype master =
 	 ExternalMaster of string
        | InternalMaster of string
 
-val ip = fn (EApp ((EVar "ip_of_node", _), e), _) => Option.map nodeIp (Env.string e)
-	  | e => Env.string e
+val ip = Env.string
+
+val _ = Env.registerFunction ("ip_of_node",
+			      fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
+			       | _ => NONE)
 
 val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
 	      | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
@@ -527,6 +537,35 @@ val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", C
 					    handle OS.SysErr _ => ())
 					nodes))
 
+fun handleSite (site, files) =
+    let
+	
+    in
+	print ("New configuration for node " ^ site ^ "\n");
+	if site = Config.defaultNode then
+	    Slave.handleChanges files
+	else let
+		val bio = OpenSSL.connect (valOf (!ssl_context),
+					   nodeIp site
+					   ^ ":"
+					   ^ Int.toString Config.slavePort)
+	    in
+		app (fn file => Msg.send (bio, MsgFile file)) files;
+		Msg.send (bio, MsgDoFiles);
+		case Msg.recv bio of
+		    NONE => print "Slave closed connection unexpectedly\n"
+		  | SOME m =>
+		    case m of
+			MsgOk => print ("Slave " ^ site ^ " finished\n")
+		      | MsgError s => print ("Slave " ^ site
+					     ^ " returned error: " ^
+					     s ^ "\n")
+		      | _ => print ("Slave " ^ site
+				    ^ " returned unexpected command\n");
+		OpenSSL.close bio
+	    end
+    end
+
 val () = Env.registerPost (fn () =>
 			      let
 				  val diffs = findAllDiffs ()
@@ -568,35 +607,6 @@ val () = Env.registerPost (fn () =>
 								  in
 								      SM.insert (changed, site, file :: ls)
 								  end) SM.empty diffs
-
-					  fun handleSite (site, files) =
-					      let
-						  
-					      in
-						  print ("New configuration for node " ^ site ^ "\n");
-						  if site = Config.defaultNode then
-						      Slave.handleChanges files
-						  else let
-							  val bio = OpenSSL.connect (valOf (!ssl_context),
-										     nodeIp site
-										     ^ ":"
-										     ^ Int.toString Config.slavePort)
-						      in
-							  app (fn file => Msg.send (bio, MsgFile file)) files;
-							  Msg.send (bio, MsgDoFiles);
-							  case Msg.recv bio of
-							      NONE => print "Slave closed connection unexpectedly\n"
-							    | SOME m =>
-							      case m of
-								  MsgOk => print ("Slave " ^ site ^ " finished\n")
-								| MsgError s => print ("Slave " ^ site
-										       ^ " returned error: " ^
-										       s ^ "\n")
-								| _ => print ("Slave " ^ site
-									      ^ " returned unexpected command\n");
-							  OpenSSL.close bio
-						      end
-					      end
 				      in
 					  SM.appi handleSite changed
 				      end;
@@ -604,4 +614,62 @@ val () = Env.registerPost (fn () =>
 						     fn cl => "Temp file cleanup failed: " ^ cl))
 			      end)
 
+fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
+		   orelse Acl.query {user = getUser (), class = "priv", value = priv}
+
+val _ = Env.type_one "dns_node"
+	Env.string
+	(fn node =>
+	    List.exists (fn x => x = node) Config.dnsNodes_all
+	    orelse (hasPriv "dns"
+		    andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
+
+val _ = Env.type_one "mail_node"
+	Env.string
+	(fn node =>
+	    List.exists (fn x => x = node) Config.mailNodes_all
+	    orelse (hasPriv "mail"
+		    andalso List.exists (fn x => x = node) Config.mailNodes_admin))
+
+fun rmdom dom =
+    let
+	val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+
+	fun doNode (node, _) =
+	    let
+		val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+						 file = node}
+		val dname = OS.Path.concat (dname, domPath)
+
+		val dir = Posix.FileSys.opendir dname
+
+		fun loop actions =
+		    case Posix.FileSys.readdir dir of
+			NONE => actions
+		      | SOME fname => loop ({action = Slave.Delete,
+					     domain = dom,
+					     dir = dname,
+					     file = OS.Path.joinDirFile {dir = dname,
+									 file = fname}} :: actions)
+
+		val actions = loop []
+	    in
+		Posix.FileSys.closedir dir;
+		handleSite (node, actions)
+	    end
+		handle IO.Io _ => print ("Warning: IO error deleting domain " ^ dom ^ " on " ^ node ^ ".\n")
+
+	fun cleanupNode (node, _) =
+	    let
+		val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+						 file = node}
+		val dname = OS.Path.concat (dname, domPath)
+	    in
+		ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+	    end
+    in
+	app doNode Config.nodeIps;
+	app cleanupNode Config.nodeIps
+    end
+
 end