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

diff --git a/src/domain.sml b/src/domain.sml
index 0354944..3d8290b 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -97,6 +97,8 @@ fun yourDomainHost s =
 				(Substring.slice (suf, 1, NONE)))
     end
 
+val yourDomain = yourDomainHost
+
 fun validUser s = size s > 0 andalso size s < 20
 		  andalso CharVector.all Char.isAlphaNum s
 
@@ -276,6 +278,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) => "")
 
@@ -631,41 +654,70 @@ val _ = Env.type_one "mail_node"
 	    orelse (hasPriv "mail"
 		    andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 
-fun rmdom dom =
+fun rmdom doms =
     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 []
+		fun doDom (dom, actions) =
+		    let
+			val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+			val dname = OS.Path.concat (dname, domPath)
+
+			fun visitDom (dom, dname, actions) =
+			    let
+				val dir = Posix.FileSys.opendir dname
+
+				fun loop actions =
+				    case Posix.FileSys.readdir dir of
+					NONE => actions
+				      | SOME fname =>
+					let
+					    val fnameFull = OS.Path.joinDirFile {dir = dname,
+										 file = fname}
+					in
+					    if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
+						loop (visitDom (fname ^ "." ^ dom,
+								fnameFull,
+								actions))
+					    else							
+						loop ({action = Slave.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");
+					actions)
+		    in
+			visitDom (dom, dname, actions)
+		    end
+
+		val actions = foldl doDom [] doms
 	    in
-		Posix.FileSys.closedir dir;
 		handleSite (node, actions)
 	    end
-		handle IO.Io _ => print ("Warning: IO error deleting domain " ^ dom ^ " on " ^ node ^ ".\n")
+		handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
 
 	fun cleanupNode (node, _) =
 	    let
-		val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
-						 file = node}
-		val dname = OS.Path.concat (dname, domPath)
+		fun doDom dom =
+		    let
+			val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+			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
-		ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+		app doDom doms
 	    end
     in
 	app doNode Config.nodeIps;