X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/095de39e1be653dcb6438d19c719bd7797e0772a..d612d62cd04b713bb1057fd2e666365704aaf3d6:/src/domain.sml

diff --git a/src/domain.sml b/src/domain.sml
index 4ec6f55..394bf80 100644
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -60,6 +60,8 @@ fun registerAfter f =
 val current = ref ""
 val currentPath = ref ""
 
+val scratch = ref ""
+
 fun currentDomain () = !current
 
 fun domainFile name = TextIO.openOut (!currentPath ^ name)
@@ -72,6 +74,7 @@ fun getPath domain =
 			      let
 				  val elems = piece :: elems
 				  val path = String.concatWith "/" (Config.resultRoot :: rev elems)
+				  val tmpPath = String.concatWith "/" (Config.tmpDir :: rev elems)
 			      in
 				  (if Posix.FileSys.ST.isDir
 					  (Posix.FileSys.stat path) then
@@ -80,17 +83,138 @@ fun getPath domain =
 				       (OS.FileSys.remove path;
 					OS.FileSys.mkDir path))
 				  handle OS.SysErr _ => OS.FileSys.mkDir path;
+
+				  (if Posix.FileSys.ST.isDir
+					  (Posix.FileSys.stat tmpPath) then
+				       ()
+				   else
+				       (OS.FileSys.remove tmpPath;
+					OS.FileSys.mkDir tmpPath))
+				  handle OS.SysErr _ => OS.FileSys.mkDir tmpPath;
+
 				  elems
 			      end) [] toks
     in
-	String.concatWith "/" (Config.resultRoot :: rev ("" :: elems))
+	fn root => String.concatWith "/" (root :: rev ("" :: elems))
+    end
+
+datatype file_action' =
+	 Add' of {src : string, dst : string}
+       | Delete' of string
+       | Modify' of {src : string, dst : string}
+
+fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))
+
+fun shellF (ss, msg) =
+    let
+	val s = String.concat ss
+    in
+	if OS.Process.isSuccess (OS.Process.system s) then
+	    ()
+	else
+	    ErrorMsg.error NONE (msg s)
+    end
+
+fun findDiffs dom =
+    let
+	val realPath = getPath dom Config.resultRoot
+	val tmpPath = !currentPath
+
+	val dir = Posix.FileSys.opendir realPath
+
+	fun loopReal acts =
+	    case Posix.FileSys.readdir dir of
+		NONE => (Posix.FileSys.closedir dir;
+			 acts)
+	      | SOME fname =>
+		let
+		    val real = OS.Path.joinDirFile {dir = realPath,
+						    file = fname}
+		    val tmp = OS.Path.joinDirFile {dir = tmpPath,
+						   file = fname}
+		in
+		    if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
+			loopReal acts
+		    else if Posix.FileSys.access (tmp, []) then
+			if shell [Config.diff, " ", real, " ",  tmp] then
+			    loopReal acts
+			else
+			    loopReal (Modify' {src = tmp, dst = real} :: acts)
+		    else
+			loopReal (Delete' real :: acts)
+		end
+
+	val acts = loopReal []
+
+	val dir = Posix.FileSys.opendir realPath
+
+	fun loopTmp acts =
+	    case Posix.FileSys.readdir dir of
+		NONE => (Posix.FileSys.closedir dir;
+			 acts)
+	      | SOME fname =>
+		let
+		    val real = OS.Path.joinDirFile {dir = realPath,
+						    file = fname}
+		    val tmp = OS.Path.joinDirFile {dir = tmpPath,
+						   file = fname}
+		in
+		    if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
+			loopTmp acts
+		    else if Posix.FileSys.access (real, []) then
+			loopTmp acts
+		    else
+			loopTmp (Add' {src = tmp, dst = real} :: acts)
+		end
+
+	val acts = loopTmp acts
+    in
+	acts
     end
 
 val _ = Env.container_one "domain"
 			  ("domain", Env.string)
-			  (fn dom => (current := dom;
-				      currentPath := getPath dom;
-				      !befores dom),
-			   fn () => !afters (!current))
+			  (fn dom =>
+			      let
+				  val path = getPath dom Config.tmpDir
+			      in
+				  current := dom;
+				  currentPath := path;
+				  !befores dom
+			      end,
+			   fn () =>
+			      let
+				  val dom = !current
+				  val () = !afters dom
+
+				  val diffs = findDiffs dom
+
+				  val diffs = map (fn Add' {src, dst} =>
+						      (shellF ([Config.cp, " ", src, " ", dst],
+							      fn cl => "Copy failed: " ^ cl);
+						       {action = Slave.Add,
+							domain = dom,
+							file = dst})
+						    | Delete' dst =>
+						      (OS.FileSys.remove dst
+						       handle OS.SysErr _ =>
+							      ErrorMsg.error NONE ("Delete failed for " ^ dst);
+						       {action = Slave.Delete,
+							domain = dom,
+							file = dst})
+						    | Modify' {src, dst} =>
+						      (shellF ([Config.cp, " ", src, " ", dst],
+							   fn cl => "Copy failed: " ^ cl);
+						       {action = Slave.Modify,
+							domain = dom,
+							file = dst})) diffs
+			      in
+				  if !ErrorMsg.anyErrors then
+				      ()
+				  else
+				      Slave.handleChanges diffs;
+				  ignore (shellF ([Config.rm, " -rf ", Config.tmpDir, "/*"],
+						  fn cl => "Temp file cleanup failed: " ^ cl))
+			      end)
 
 end