X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/8e965b2da49aab1faef95b25471513498ceca895..1824f573f7f8720514af1dc94d7cfb1de5b15fef:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index 0f65362..715b486 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -116,10 +116,13 @@ fun checkDir dname =
 	val (_, files) = Order.order (SOME b) files
     in
 	if !ErrorMsg.anyErrors then
-	    false
+	    raise ErrorMsg.Error
 	else
 	    (foldl (fn (fname, G) => check' G fname) b files;
-	     !ErrorMsg.anyErrors)
+	     if !ErrorMsg.anyErrors then
+		 raise ErrorMsg.Error
+	     else
+		 ())
     end
 
 fun reduce fname =
@@ -152,6 +155,15 @@ fun eval fname =
 	    Eval.exec (Defaults.eInit ()) body'
       | NONE => raise ErrorMsg.Error
 
+fun eval' fname =
+    case reduce fname of
+	(SOME body') =>
+	if !ErrorMsg.anyErrors then
+	    raise ErrorMsg.Error
+	else
+	    ignore (Eval.exec' (Defaults.eInit ()) body')
+      | NONE => raise ErrorMsg.Error
+
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
 
@@ -207,7 +219,9 @@ fun request fname =
 
 fun requestDir dname =
     let
-	val (user, bio) = requestBio (fn () => ignore (checkDir dname))
+	val _ = ErrorMsg.reset ()
+
+	val (user, bio) = requestBio (fn () => checkDir dname)
 
 	val b = basis ()
 
@@ -246,15 +260,18 @@ fun requestDir dname =
 				before TextIO.closeIn inf
 			    end) files
     in
-	Msg.send (bio, MsgMultiConfig codes);
-	case Msg.recv bio of
-	    NONE => print "Server closed connection unexpectedly.\n"
-	  | SOME m =>
-	    case m of
-		MsgOk => print "Configuration succeeded.\n"
-	      | MsgError s => print ("Configuration failed: " ^ s ^ "\n")
-	      | _ => print "Unexpected server reply.\n";
-	OpenSSL.close bio
+	if !ErrorMsg.anyErrors then
+	    ()
+	else
+	    (Msg.send (bio, MsgMultiConfig codes);
+	     case Msg.recv bio of
+		 NONE => print "Server closed connection unexpectedly.\n"
+	       | SOME m =>
+		 case m of
+		     MsgOk => print "Configuration succeeded.\n"
+		   | MsgError s => print ("Configuration failed: " ^ s ^ "\n")
+		   | _ => print "Unexpected server reply.\n";
+	     OpenSSL.close bio)
     end
     handle ErrorMsg.Error => ()
 
@@ -324,6 +341,21 @@ fun requestWhoHas perm =
 	before OpenSSL.close bio
     end
 
+fun requestRegen () =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgRegenerate);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print "Regeneration succeeded.\n"
+	      | MsgError s => print ("Regeneration failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
 fun requestRmdom dom =
     let
 	val (_, bio) = requestBio (fn () => ())
@@ -339,6 +371,48 @@ fun requestRmdom dom =
 	OpenSSL.close bio
     end
 
+fun regenerate () =
+    let
+	val b = basis ()
+	val _ = Tycheck.disallowExterns ()
+
+	fun doUser user =
+	    let
+		val _ = Domain.setUser user
+		val _ = ErrorMsg.reset ()
+
+		val dname = Config.domtoolDir user
+
+		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
+		    print ("User " ^ user ^ "'s configuration has errors!\n")
+		else
+		    app eval' files
+	    end
+		handle IO.Io _ => ()
+		     | OS.SysErr (s, _) => print ("System error processing user " ^ user ^ ": " ^ s ^ "\n")
+    in
+	Env.pre ();
+	app doUser (Acl.users ());
+	Env.post ()
+    end
+
 fun service () =
     let
 	val () = Acl.read Config.aclFile
@@ -373,10 +447,12 @@ fun service () =
 				in
 				    TextIO.output (outf, code);
 				    TextIO.closeOut outf;
-				    eval outname
+				    eval' outname
 				end
 			in
-			    (app doOne codes;
+			    (Env.pre ();
+			     app doOne codes;
+			     Env.post ();
 			     Msg.send (bio, MsgOk))
 			    handle ErrorMsg.Error =>
 				   (print "Compilation error\n";
@@ -503,6 +579,30 @@ fun service () =
 				      ignore (OpenSSL.readChar bio);
 				      OpenSSL.close bio)
 				     handle OpenSSL.OpenSSL _ => ();
+				     loop ())
+
+			      | MsgRegenerate =>
+				if Acl.query {user = user, class = "priv", value = "regen"}
+				   orelse Acl.query {user = user, class = "priv", value = "all"} then
+				    ((regenerate ();
+				      Msg.send (bio, MsgOk);
+				      print "Regenerated all configuration.\n")
+				     handle OpenSSL.OpenSSL s =>
+					    (print "OpenSSL error\n";
+					     Msg.send (bio,
+						       MsgError
+							   ("Error during regeneration: "
+							    ^ s)));
+				    (ignore (OpenSSL.readChar bio);
+				     OpenSSL.close bio)
+				    handle OpenSSL.OpenSSL _ => ();
+				    loop ())
+				else
+				    ((Msg.send (bio, MsgError "Not authorized to regeneration");
+				      print "Unauthorized user asked to regenerate!\n";
+				      ignore (OpenSSL.readChar bio);
+				      OpenSSL.close bio)
+				     handle OpenSSL.OpenSSL _ => ();
 				     loop ())				
 
 			      | _ =>