X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/a378e68834840e0a2f856837532ca23ba8dba07c..998ed17495b77c478978f547c154e28d96a03357:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index 660c892..4198901 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -869,14 +869,20 @@ fun requestFirewall {node, uname} =
 	before OpenSSL.close bio
     end
 
-fun regenerate context =
+fun regenerateEither tc checker context =
     let
+	fun ifReal f =
+	    if tc then
+		()
+	    else
+		f ()
+
 	val _ = ErrorMsg.reset ()
 
 	val b = basis ()
 	val () = Tycheck.disallowExterns ()
 
-	val () = Domain.resetGlobal ()
+	val () = ifReal Domain.resetGlobal
 
 	val ok = ref true
  
@@ -934,7 +940,7 @@ fun regenerate context =
 			    (ErrorMsg.reset ();
 			     print ("User " ^ user ^ "'s configuration has errors!\n"))
 			else
-			    app eval' files
+			    app checker files
 		    end
 		else
 		    ()
@@ -942,77 +948,23 @@ fun regenerate context =
 	    handle IO.Io {name, function, ...} =>
 		   (print ("IO error processing user " ^ user ^ ": " ^ function ^ ": " ^ name ^ "\n");
 		    ok := false)
-		 | OS.SysErr (s, _) => (print ("System error processing user " ^ user ^ ": " ^ s ^ "\n");
-					ok := false)
+		 | exn as OS.SysErr (s, _) => (print ("System error processing user " ^ user ^ ": " ^ s ^ "\n");
+					       ok := false)
 		 | ErrorMsg.Error => (ErrorMsg.reset ();
 				      print ("User " ^ user ^ " had a compilation error.\n");
 				      ok := false)
 		 | _ => (print "Unknown exception during regeneration!\n";
 			 ok := false)
     in
-	app contactNode Config.nodeIps;
-	Env.pre ();
+	ifReal (fn () => (app contactNode Config.nodeIps;
+			  Env.pre ()));
 	app doUser (Acl.users ());
-	Env.post ();
+	ifReal Env.post;
 	!ok
     end
 
-fun regenerateTc context =
-    let
-	val _ = ErrorMsg.reset ()
-
-	val b = basis ()
-	val () = Tycheck.disallowExterns ()
-
-	val () = Domain.resetGlobal ()
-
-	val ok = ref true
-
-	fun doUser user =
-	    let
-		val _ = Domain.setUser user
-		val _ = ErrorMsg.reset ()
-
-		val dname = Config.domtoolDir user
-	    in
-		if Posix.FileSys.access (dname, []) then
-		    let
-			val dir = Posix.FileSys.opendir dname
-
-			fun loop files =
-			    case Posix.FileSys.readdir dir of
-				NONE => (Posix.FileSys.closedir dir;
-					 files)
-			      | SOME fname =>
-				if notTmp fname then
-				    loop (OS.Path.joinDirFile {dir = dname,
-							       file = fname}
-					  :: files)
-				else
-				    loop files
-
-			val files = loop []
-			val (_, files) = Order.order (SOME b) files
-		    in
-			if !ErrorMsg.anyErrors then
-			    (ErrorMsg.reset ();
-			     print ("User " ^ user ^ "'s configuration has errors!\n");
-			     ok := false)
-			else
-			    app (ignore o check) files
-		    end
-		else
-		    ()
-	    end
-	    handle IO.Io _ => ()
-		 | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")
-		 | ErrorMsg.Error => (ErrorMsg.reset ();
-				      print ("User " ^ user ^ " had a compilation error.\n"))
-		 | _ => print "Unknown exception during -tc regeneration!\n"
-    in
-	app doUser (Acl.users ());
-	!ok
-    end
+val regenerate = regenerateEither false eval'
+val regenerateTc = regenerateEither true (ignore o check)
 
 fun rmuser user =
     let