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

diff --git a/src/domain.sml b/src/domain.sml
index d7603b2..0354944 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -537,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 ()
@@ -578,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;
@@ -631,4 +631,45 @@ val _ = Env.type_one "mail_node"
 	    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