From 71420f8bc34bbe2c76bd368613d4e024072e9817 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sat, 16 Dec 2006 00:29:12 +0000
Subject: [PATCH] Full regeneration

---
 src/domain.sig            |  9 +++++++++
 src/domain.sml            | 21 +++++++++++++++++++++
 src/main.sml              | 34 +++++++++++++++++++++++++++++++---
 src/plugins/apache.sml    |  3 +++
 src/plugins/bind.sml      |  4 ++++
 src/plugins/webalizer.sml |  6 ++++++
 6 files changed, 74 insertions(+), 3 deletions(-)

diff --git a/src/domain.sig b/src/domain.sig
index 1d708f5..a937624 100644
--- a/src/domain.sig
+++ b/src/domain.sig
@@ -27,6 +27,15 @@ signature DOMAIN = sig
 
     val ip : string Env.arg
 
+    val registerResetGlobal : (unit -> unit) -> unit
+    val registerResetLocal : (unit -> unit) -> unit
+    (* Register functions for clearing out all Domtool configuration at the global
+     * (AFS) and local levels, respectively. *)
+
+    val resetGlobal : unit -> unit
+    val resetLocal : unit -> unit
+    (* Call all registered functions *)
+
     val registerBefore : (string -> unit) -> unit
     val registerAfter : (string -> unit) -> unit
     (* Register handlers to run just before and after entering a domain
diff --git a/src/domain.sml b/src/domain.sml
index 0354944..9913dfc 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -276,6 +276,27 @@ fun registerAfter f =
 	afters := (fn x => (old x; f x))
     end
 
+val globals = ref (fn () => ())
+val locals = ref (fn () => ())
+
+fun registerResetGlobal f =
+    let
+	val old = !globals
+    in
+	globals := (fn x => (old x; f x))
+    end
+
+fun registerResetLocal f =
+    let
+	val old = !locals
+    in
+	locals := (fn x => (old x; f x))
+    end
+
+fun resetGlobal () = (!globals ();
+		      ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
+fun resetLocal () = !locals ()
+
 val current = ref ""
 val currentPath = ref (fn (_ : string) => "")
 
diff --git a/src/main.sml b/src/main.sml
index 715b486..f22c430 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -371,10 +371,35 @@ fun requestRmdom dom =
 	OpenSSL.close bio
     end
 
-fun regenerate () =
+fun regenerate context =
     let
 	val b = basis ()
-	val _ = Tycheck.disallowExterns ()
+	val () = Tycheck.disallowExterns ()
+
+	val () = Domain.resetGlobal ()
+
+	fun contactNode (node, ip) =
+	    if node = Config.defaultNode then
+		Domain.resetLocal ()
+	    else let
+		    val bio = OpenSSL.connect (context,
+					       ip
+					       ^ ":"
+					       ^ Int.toString Config.slavePort)
+		in
+		    Msg.send (bio, MsgRegenerate);
+		    case Msg.recv bio of
+			NONE => print "Slave closed connection unexpectedly\n"
+		      | SOME m =>
+			case m of
+			    MsgOk => print ("Slave " ^ node ^ " pre-regeneration finished\n")
+			  | MsgError s => print ("Slave " ^ node
+						 ^ " returned error: " ^
+						 s ^ "\n")
+			  | _ => print ("Slave " ^ node
+					^ " returned unexpected command\n");
+		    OpenSSL.close bio
+		end		
 
 	fun doUser user =
 	    let
@@ -408,6 +433,7 @@ fun regenerate () =
 		handle IO.Io _ => ()
 		     | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")
     in
+	app contactNode Config.nodeIps;
 	Env.pre ();
 	app doUser (Acl.users ());
 	Env.post ()
@@ -584,7 +610,7 @@ fun service () =
 			      | MsgRegenerate =>
 				if Acl.query {user = user, class = "priv", value = "regen"}
 				   orelse Acl.query {user = user, class = "priv", value = "all"} then
-				    ((regenerate ();
+				    ((regenerate context;
 				      Msg.send (bio, MsgOk);
 				      print "Regenerated all configuration.\n")
 				     handle OpenSSL.OpenSSL s =>
@@ -661,6 +687,8 @@ fun slave () =
 					MsgFile file => loop' (file :: files)
 				      | MsgDoFiles => (Slave.handleChanges files;
 						       Msg.send (bio, MsgOk))
+				      | MsgRegenerate => (Domain.resetLocal ();
+							  Msg.send (bio, MsgOk))
 				      | _ => (print "Dispatcher sent unexpected command\n";
 					      Msg.send (bio, MsgError "Unexpected command"))
 			in
diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 83a8ce8..65ba7fb 100644
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -739,4 +739,7 @@ val () = Env.action_one "readmeName"
 		      write name;
 		      write "\n"))
 
+val () = Domain.registerResetLocal (fn () =>
+				       ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
+
 end
diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml
index 217ef45..9c72152 100644
--- a/src/plugins/bind.sml
+++ b/src/plugins/bind.sml
@@ -266,4 +266,8 @@ val () = Slave.registerPostHandler
 				 fn cl => "Error reloading bind with " ^ cl)
 		  else
 		      ()))
+
+val () = Domain.registerResetLocal (fn () =>
+				       ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/zones/*")))
+
 end
diff --git a/src/plugins/webalizer.sml b/src/plugins/webalizer.sml
index c6043af..7ac523b 100644
--- a/src/plugins/webalizer.sml
+++ b/src/plugins/webalizer.sml
@@ -116,4 +116,10 @@ val () = Slave.registerFileHandler (fn fs =>
 					     | _ => ()
 				       end)
 
+val () = Domain.registerResetLocal (fn () =>
+				       app (fn (node, _) =>
+					       ignore (OS.Process.system (Config.rm ^ " -rf "
+									  ^ Config.Webalizer.configDir ^ "/"
+									  ^ node ^ "/*"))) Config.nodeIps)
+
 end
-- 
2.20.1