X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/c53e82e40cef407de986aa329d31457915ad0dbe..c362e4cc29d981936644c90c71e9d2127b5ea6d3:/src/main.sml

diff --git a/src/main.sml b/src/main.sml
index 3c0b728..cf53af0 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -1,5 +1,5 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2006-2009, Adam Chlipala
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -25,15 +25,32 @@ open Ast MsgTypes Print
 structure SM = StringMap
 
 fun init () = Acl.read Config.aclFile
-	    
+
+fun isLib fname = OS.Path.file fname = "lib.dtl"
+
+fun wrapFile (fname, file) =
+    case (isLib fname, file) of
+	(true, (comment, ds, SOME e)) =>
+	let
+	    val (_, loc) = e
+	in
+	    (comment, ds, SOME (ELocal (e, (ESkip, loc)), loc))
+	end
+      | _ => file
+
 fun check' G fname =
     let
 	val prog = Parse.parse fname
+	val prog = wrapFile (fname, prog)
     in
 	if !ErrorMsg.anyErrors then
 	    G
 	else
-	    Tycheck.checkFile G (Defaults.tInit ()) prog
+	    (if isLib fname then
+		 ()
+	     else
+		 Option.app (Unused.check G) (#3 prog);
+	     Tycheck.checkFile G (Defaults.tInit prog) prog)
     end
 
 fun basis () =
@@ -63,12 +80,12 @@ fun basis () =
 	     before Tycheck.disallowExterns ())
     end
 
-fun check fname =
+(* val b = basis () *)
+
+fun check G fname =
     let
 	val _ = ErrorMsg.reset ()
 	val _ = Env.preTycheck ()
-
-	val b = basis ()
     in
 	if !ErrorMsg.anyErrors then
 	    raise ErrorMsg.Error
@@ -77,24 +94,48 @@ fun check fname =
 		val _ = Tycheck.disallowExterns ()
 		val _ = ErrorMsg.reset ()
 		val prog = Parse.parse fname
+		val prog = wrapFile (fname, prog)
 	    in
 		if !ErrorMsg.anyErrors then
 		    raise ErrorMsg.Error
 		else
 		    let
-			val G' = Tycheck.checkFile b (Defaults.tInit ()) prog
+			val G' = Tycheck.checkFile G (Defaults.tInit prog) prog
 		    in
 			if !ErrorMsg.anyErrors then
 			    raise ErrorMsg.Error
 			else
-			    (G', #3 prog)
+			    (if isLib fname then
+				 ()
+			     else
+				 Option.app (Unused.check G) (#3 prog);
+			     (G', #3 prog))
 		    end
 	    end
     end
 
-val notTmp = CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-")
+fun notTmp s =
+    String.sub (s, 0) <> #"."
+    andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-") s
 
-fun checkDir dname =
+fun setupUser () =
+    let
+	val user =
+	    case Posix.ProcEnv.getenv "DOMTOOL_USER" of
+		NONE =>
+		let
+		    val uid = Posix.ProcEnv.getuid ()
+		in
+		    Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
+		end
+	      | SOME user => user
+    in
+	Acl.read Config.aclFile;
+	Domain.setUser user;
+	user
+    end
+
+fun checkDir' dname =
     let
 	val b = basis ()
 
@@ -116,18 +157,25 @@ 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 =
+fun checkDir dname =
+    (setupUser ();
+     checkDir' dname)
+
+fun reduce G fname =
     let
-	val (G, body) = check fname
+	val (G, body) = check G fname
     in
 	if !ErrorMsg.anyErrors then
-	    NONE
+	    (G, NONE)
 	else
 	    case body of
 		SOME body =>
@@ -138,62 +186,102 @@ fun reduce fname =
 					 [PD.string "Result:",
 					  PD.space 1,
 					  p_exp body']))*)
-		    SOME body'
+		    (G, SOME body')
 		end
-	      | _ => NONE
+	      | _ => (G, NONE)
     end
 
-fun eval fname =
-    case reduce fname of
-	(SOME body') =>
+(*(Defaults.eInit ())*)
+
+fun eval G evs fname =
+    case reduce G fname of
+	(G, SOME body') =>
 	if !ErrorMsg.anyErrors then
 	    raise ErrorMsg.Error
 	else
-	    Eval.exec (Defaults.eInit ()) body'
-      | NONE => raise ErrorMsg.Error
+	    let
+		val evs' = Eval.exec' evs body'
+	    in
+		(G, evs')
+	    end
+      | (G, NONE) => (G, evs)
 
 val dispatcher =
     Config.dispatcher ^ ":" ^ Int.toString Config.dispatcherPort
 
+val self =
+    "localhost:" ^ Int.toString Config.slavePort
+
+fun context x =
+    (OpenSSL.context false x)
+    handle e as OpenSSL.OpenSSL s =>
+	   (print "Couldn't find your certificate.\nYou probably haven't been given any Domtool privileges.\n";
+	    print ("I looked in: " ^ #1 x ^ "\n");
+	    print ("Additional information: " ^ s ^ "\n");
+	    raise e)
+
 fun requestContext f =
     let
-	val uid = Posix.ProcEnv.getuid ()
-	val user = Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
-		   
-	val () = Acl.read Config.aclFile
-	val () = Domain.setUser user
+	val user = setupUser ()
 		 
 	val () = f ()
 
-	val context = OpenSSL.context (Config.certDir ^ "/" ^ user ^ ".pem",
-				       Config.keyDir ^ "/" ^ user ^ "/key.pem",
-				       Config.trustStore)
+	val context = context (Config.certDir ^ "/" ^ user ^ ".pem",
+			       Config.keyDir ^ "/" ^ user ^ "/key.pem",
+			       Config.trustStore)
     in
 	(user, context)
     end
 
-fun requestBio f =
+fun requestBio' printErr f =
     let
 	val (user, context) = requestContext f
     in
-	(user, OpenSSL.connect (context, dispatcher))
+	(user, OpenSSL.connect printErr (context, dispatcher))
     end
 
-fun request fname =
+val requestBio = requestBio' true
+
+fun requestSlaveBio' printErr =
     let
-	val (user, bio) = requestBio (fn () => ignore (check fname))
+	val (user, context) = requestContext (fn () => ())
+    in
+	(user, OpenSSL.connect printErr (context, self))
+    end
 
-	val inf = TextIO.openIn fname
+fun requestSlaveBio () = requestSlaveBio' true
 
-	fun loop lines =
-	    case TextIO.inputLine inf of
-		NONE => String.concat (List.rev lines)
-	      | SOME line => loop (line :: lines)
+fun request (fname, libOpt) =
+    let
+	val (user, bio) = requestBio (fn () =>
+					 let
+					     val env = basis ()
+					     val env = case libOpt of
+							   NONE => env
+							 | SOME lib => #1 (check env lib)
+					 in
+					     ignore (check env fname)
+					 end)
+
+	fun readFile fname =
+	    let
+		val inf = TextIO.openIn fname
 
-	val code = loop []
+		fun loop lines =
+		    case TextIO.inputLine inf of
+			NONE => String.concat (rev lines)
+		      | SOME line => loop (line :: lines)
+	    in
+		loop []
+		before TextIO.closeIn inf
+	    end
+
+	val code = readFile fname
+	val msg = case libOpt of
+		      NONE => MsgConfig code
+		    | SOME fname' => MsgMultiConfig [readFile fname', code]
     in
-	TextIO.closeIn inf;
-	Msg.send (bio, MsgConfig code);
+	Msg.send (bio, msg);
 	case Msg.recv bio of
 	    NONE => print "Server closed connection unexpectedly.\n"
 	  | SOME m =>
@@ -207,7 +295,17 @@ fun request fname =
 
 fun requestDir dname =
     let
-	val (user, bio) = requestBio (fn () => ignore (checkDir dname))
+	val _ = if Posix.FileSys.access (dname, []) then
+		    ()
+		else
+		    (print ("Can't access " ^ dname ^ ".\n");
+		     print "Did you mean to run domtool on a specific file, instead of asking for all\n";
+		     print "files in your ~/.domtool directory?\n";
+		     OS.Process.exit OS.Process.failure)
+
+	val _ = ErrorMsg.reset ()
+
+	val (user, bio) = requestBio (fn () => checkDir' dname)
 
 	val b = basis ()
 
@@ -246,17 +344,68 @@ fun requestDir dname =
 				before TextIO.closeIn inf
 			    end) files
     in
-	Msg.send (bio, MsgMultiConfig codes);
+	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 => ()
+
+fun requestPing () =
+    let
+	val (_, bio) = requestBio' false (fn () => ())
+    in
+	OpenSSL.close bio;
+	OS.Process.success
+    end
+    handle _ => OS.Process.failure
+
+fun requestShutdown () =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgShutdown);
 	case Msg.recv bio of
-	    NONE => print "Server closed connection unexpectedly.\n"
+	    NONE => ()
 	  | SOME m =>
 	    case m of
-		MsgOk => print "Configuration succeeded.\n"
-	      | MsgError s => print ("Configuration failed: " ^ s ^ "\n")
+		MsgOk => print "Shutdown begun.\n"
+	      | MsgError s => print ("Shutdown failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestSlavePing () =
+    let
+	val (_, bio) = requestSlaveBio' false
+    in
+	OpenSSL.close bio;
+	OS.Process.success
+    end
+    handle _ => OS.Process.failure
+
+fun requestSlaveShutdown () =
+    let
+	val (_, bio) = requestSlaveBio ()
+    in
+	Msg.send (bio, MsgShutdown);
+	case Msg.recv bio of
+	    NONE => ()
+	  | SOME m =>
+	    case m of
+		MsgOk => print "Shutdown begun.\n"
+	      | MsgError s => print ("Shutdown failed: " ^ s ^ "\n")
 	      | _ => print "Unexpected server reply.\n";
 	OpenSSL.close bio
     end
-    handle ErrorMsg.Error => ()
 
 fun requestGrant acl =
     let
@@ -324,168 +473,1126 @@ fun requestWhoHas perm =
 	before OpenSSL.close bio
     end
 
-fun service () =
+fun requestRegen () =
     let
-	val () = Acl.read Config.aclFile
-	
-	val context = OpenSSL.context (Config.serverCert,
-				       Config.serverKey,
-				       Config.trustStore)
-	val _ = Domain.set_context context
+	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
 
-	val sock = OpenSSL.listen (context, Config.dispatcherPort)
+fun requestRegenTc () =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgRegenerateTc);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print "All configuration validated.\n"
+	      | MsgError s => print ("Configuration validation failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestRmdom dom =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgRmdom dom);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print "Removal succeeded.\n"
+	      | MsgError s => print ("Removal failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestRmuser user =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgRmuser user);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print "Removal succeeded.\n"
+	      | MsgError s => print ("Removal failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestDbUser dbtype =
+    let
+	val (_, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context,
+					Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
+    in
+	Msg.send (bio, MsgCreateDbUser dbtype);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print "Your user has been created.\n"
+	      | MsgError s => print ("Creation failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestDbPasswd rc =
+    let
+	val (_, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context,
+					Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
+    in
+	Msg.send (bio, MsgDbPasswd rc);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print "Your password has been changed.\n"
+	      | MsgError s => print ("Password set failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestDbTable p =
+    let
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context,
+					Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
+    in
+	Msg.send (bio, MsgCreateDb p);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print ("Your database " ^ user ^ "_" ^ #dbname p ^ " has been created.\n")
+	      | MsgError s => print ("Creation failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestDbDrop p =
+    let
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context,
+					Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
+    in
+	Msg.send (bio, MsgDropDb p);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print ("Your database " ^ user ^ "_" ^ #dbname p ^ " has been dropped.\n")
+	      | MsgError s => print ("Drop failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestDbGrant p =
+    let
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context,
+					Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
+    in
+	Msg.send (bio, MsgGrantDb p);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print ("You've been granted all allowed privileges to database " ^ user ^ "_" ^ #dbname p ^ ".\n")
+	      | MsgError s => print ("Grant failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestListMailboxes domain =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgListMailboxes domain);
+	(case Msg.recv bio of
+	     NONE => Vmail.Error "Server closed connection unexpectedly."
+	   | SOME m =>
+	     case m of
+		 MsgMailboxes users => (Msg.send (bio, MsgOk);
+					Vmail.Listing users)
+	       | MsgError s => Vmail.Error ("Listing failed: " ^ s)
+	       | _ => Vmail.Error "Unexpected server reply.")
+	before OpenSSL.close bio
+    end
+
+fun requestNewMailbox p =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgNewMailbox p);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print ("A mapping for " ^ #user p ^ "@" ^ #domain p ^ " has been created.\n")
+	      | MsgError s => print ("Creation failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestPasswdMailbox p =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgPasswdMailbox p);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print ("The password for " ^ #user p ^ "@" ^ #domain p ^ " has been changed.\n")
+	      | MsgError s => print ("Set failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestRmMailbox p =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgRmMailbox p);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print ("The mapping for mailbox " ^ #user p ^ "@" ^ #domain p ^ " has been deleted.\n")
+	      | MsgError s => print ("Remove failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestSaQuery addr =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgSaQuery addr);
+	(case Msg.recv bio of
+	     NONE => print "Server closed connection unexpectedly.\n"
+	   | SOME m =>
+	     case m of
+		 MsgSaStatus b => (print ("SpamAssassin filtering for " ^ addr ^ " is "
+					  ^ (if b then "ON" else "OFF") ^ ".\n");
+				   Msg.send (bio, MsgOk))
+	       | MsgError s => print ("Query failed: " ^ s ^ "\n")
+	       | _ => print "Unexpected server reply.\n")
+	before OpenSSL.close bio
+    end
+
+fun requestSaSet p =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgSaSet p);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print ("SpamAssassin filtering for " ^ #1 p ^ " is now "
+				^ (if #2 p then "ON" else "OFF") ^ ".\n")
+	      | MsgError s => print ("Set failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestSmtpLog domain =
+    let
+	val (_, bio) = requestBio (fn () => ())
+
+	val _ = Msg.send (bio, MsgSmtpLogReq domain)
 
 	fun loop () =
-	    case OpenSSL.accept sock of
-		NONE => ()
-	      | SOME bio =>
+	    case Msg.recv bio of
+		NONE => print "Server closed connection unexpectedly.\n"
+	      | SOME m =>
+		case m of
+		    MsgOk => ()
+		  | MsgSmtpLogRes line => (print line;
+					   loop ())
+		  | MsgError s => print ("Log search failed: " ^ s ^ "\n")
+		  | _ => print "Unexpected server reply.\n"
+    in
+	loop ();
+	OpenSSL.close bio
+    end
+
+fun requestMysqlFixperms () =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgMysqlFixperms);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print "Permissions granted.\n"
+	      | MsgError s => print ("Failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestApt {node, pkg} =
+    let
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+						     dispatcher
+						 else
+						     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+	val _ = Msg.send (bio, MsgQuery (QApt pkg))
+
+	fun loop () =
+	    case Msg.recv bio of
+		NONE => (print "Server closed connection unexpectedly.\n";
+			 OS.Process.failure)
+	      | SOME m =>
+		case m of
+		    MsgYes => (print "Package is installed.\n";
+			       OS.Process.success)
+		  | MsgNo => (print "Package is not installed.\n";
+			      OS.Process.failure)
+		  | MsgError s => (print ("APT query failed: " ^ s ^ "\n");
+				   OS.Process.failure)
+		  | _ => (print "Unexpected server reply.\n";
+			  OS.Process.failure)
+    in
+	loop ()
+	before OpenSSL.close bio
+    end
+
+fun requestCron {node, uname} =
+    let
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+						     dispatcher
+						 else
+						     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+	val _ = Msg.send (bio, MsgQuery (QCron uname))
+
+	fun loop () =
+	    case Msg.recv bio of
+		NONE => (print "Server closed connection unexpectedly.\n";
+			 OS.Process.failure)
+	      | SOME m =>
+		case m of
+		    MsgYes => (print "User has cron permissions.\n";
+			       OS.Process.success)
+		  | MsgNo => (print "User does not have cron permissions.\n";
+			      OS.Process.failure)
+		  | MsgError s => (print ("Cron query failed: " ^ s ^ "\n");
+				   OS.Process.failure)
+		  | _ => (print "Unexpected server reply.\n";
+			  OS.Process.failure)
+    in
+	loop ()
+	before OpenSSL.close bio
+    end
+
+fun requestFtp {node, uname} =
+    let
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+						     dispatcher
+						 else
+						     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+	val _ = Msg.send (bio, MsgQuery (QFtp uname))
+
+	fun loop () =
+	    case Msg.recv bio of
+		NONE => (print "Server closed connection unexpectedly.\n";
+			 OS.Process.failure)
+	      | SOME m =>
+		case m of
+		    MsgYes => (print "User has FTP permissions.\n";
+			       OS.Process.success)
+		  | MsgNo => (print "User does not have FTP permissions.\n";
+			      OS.Process.failure)
+		  | MsgError s => (print ("FTP query failed: " ^ s ^ "\n");
+				   OS.Process.failure)
+		  | _ => (print "Unexpected server reply.\n";
+			  OS.Process.failure)
+    in
+	loop ()
+	before OpenSSL.close bio
+    end
+
+fun requestTrustedPath {node, uname} =
+    let
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+						     dispatcher
+						 else
+						     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+	val _ = Msg.send (bio, MsgQuery (QTrustedPath uname))
+
+	fun loop () =
+	    case Msg.recv bio of
+		NONE => (print "Server closed connection unexpectedly.\n";
+			 OS.Process.failure)
+	      | SOME m =>
+		case m of
+		    MsgYes => (print "User has trusted path restriction.\n";
+			       OS.Process.success)
+		  | MsgNo => (print "User does not have trusted path restriction.\n";
+			      OS.Process.failure)
+		  | MsgError s => (print ("Trusted path query failed: " ^ s ^ "\n");
+				   OS.Process.failure)
+		  | _ => (print "Unexpected server reply.\n";
+			  OS.Process.failure)
+    in
+	loop ()
+	before OpenSSL.close bio
+    end
+
+fun requestSocketPerm {node, uname} =
+    let
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+						     dispatcher
+						 else
+						     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+	val _ = Msg.send (bio, MsgQuery (QSocket uname))
+
+	fun loop () =
+	    case Msg.recv bio of
+		NONE => (print "Server closed connection unexpectedly.\n";
+			 OS.Process.failure)
+	      | SOME m =>
+		case m of
+		    MsgSocket p => (case p of
+					Any => print "Any\n"
+				      | Client => print "Client\n"
+				      | Server => print "Server\n"
+				      | Nada => print "Nada\n";
+				    OS.Process.success)
+		  | MsgError s => (print ("Socket permission query failed: " ^ s ^ "\n");
+				   OS.Process.failure)
+		  | _ => (print "Unexpected server reply.\n";
+			  OS.Process.failure)
+    in
+	loop ()
+	before OpenSSL.close bio
+    end
+
+fun requestFirewall {node, uname} =
+    let
+	val (user, context) = requestContext (fn () => ())
+	val bio = OpenSSL.connect true (context, if node = Config.masterNode then
+						     dispatcher
+						 else
+						     Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+		  
+	val _ = Msg.send (bio, MsgQuery (QFirewall uname))
+
+	fun loop () =
+	    case Msg.recv bio of
+		NONE => (print "Server closed connection unexpectedly.\n";
+			 OS.Process.failure)
+	      | SOME m =>
+		case m of
+		    MsgFirewall ls => (app (fn s => (print s; print "\n")) ls;
+				       OS.Process.success)
+		  | MsgError s => (print ("Firewall query failed: " ^ s ^ "\n");
+				   OS.Process.failure)
+		  | _ => (print "Unexpected server reply.\n";
+			  OS.Process.failure)
+    in
+	loop ()
+	before OpenSSL.close bio
+    end
+
+fun requestDescribe dom =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgDescribe dom);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgDescription s => print s
+	      | MsgError s => print ("Description failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+fun requestReUsers () =
+    let
+	val (_, bio) = requestBio (fn () => ())
+    in
+	Msg.send (bio, MsgReUsers);
+	case Msg.recv bio of
+	    NONE => print "Server closed connection unexpectedly.\n"
+	  | SOME m =>
+	    case m of
+		MsgOk => print "Callbacks run.\n"
+	      | MsgError s => print ("Failed: " ^ s ^ "\n")
+	      | _ => print "Unexpected server reply.\n";
+	OpenSSL.close bio
+    end
+
+structure SS = StringSet
+
+fun domainList dname =
+    let
+	val dir = Posix.FileSys.opendir dname
+
+	fun visitNode dset =
+	    case Posix.FileSys.readdir dir of
+		NONE => dset
+	      | SOME node =>
 		let
-		    val user = OpenSSL.peerCN bio
-		    val () = print ("\nConnection from " ^ user ^ "\n")
-		    val () = Domain.setUser user
+		    val path = OS.Path.joinDirFile {dir = dname,
+						    file = node}
 
-		    fun doConfig codes =
+		    fun visitDomains (path, bfor, dset) =
 			let
-			    val _ = print "Configuration:\n"
-			    val _ = app (fn s => (print s; print "\n")) codes
-			    val _ = print "\n"
-
-			    val outname = OS.FileSys.tmpName ()
-
-			    fun doOne code =
-				let
-				    val outf = TextIO.openOut outname
-				in
-				    TextIO.output (outf, code);
-				    TextIO.closeOut outf;
-				    eval outname
-				end
+			    val dir = Posix.FileSys.opendir path
+
+			    fun loop dset =
+				case Posix.FileSys.readdir dir of
+				    NONE => dset
+				  | SOME dname =>
+				    let
+					val path = OS.Path.joinDirFile {dir = path,
+									file = dname}
+				    in
+					if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
+					    let
+						val bfor = dname :: bfor
+					    in
+						loop (visitDomains (path, bfor,
+								    SS.add (dset,
+									    String.concatWith "." bfor)))
+					    end
+					else
+					    loop dset
+				    end
 			in
-			    (app doOne codes;
-			     Msg.send (bio, MsgOk))
-			    handle ErrorMsg.Error =>
-				   (print "Compilation error\n";
-				    Msg.send (bio,
-					      MsgError "Error during configuration evaluation"))
-				 | OpenSSL.OpenSSL s =>
-				   (print "OpenSSL error\n";
-				    Msg.send (bio,
-					      MsgError
-						  ("Error during configuration evaluation: "
-						   ^ s)));
-			   OS.FileSys.remove outname;
-			   (ignore (OpenSSL.readChar bio);
-			    OpenSSL.close bio)
-			   handle OpenSSL.OpenSSL _ => ();
-			   loop ()
+			    loop dset
+			    before Posix.FileSys.closedir dir
 			end
+		in
+		    visitNode (visitDomains (path, [], dset))
+		end
+    in
+	visitNode SS.empty
+	before Posix.FileSys.closedir dir
+    end
 
-		    fun cmdLoop () =
-			case Msg.recv bio of
-			    NONE => (OpenSSL.close bio
-				     handle OpenSSL.OpenSSL _ => ();
-				     loop ())
-			  | SOME m =>
-			    case m of
-				MsgConfig code => doConfig [code]
-			      | MsgMultiConfig codes => doConfig codes
-
-			      | MsgGrant acl =>
-				if Acl.query {user = user, class = "priv", value = "all"} then
-				    ((Acl.grant acl;
-				      Acl.write Config.aclFile;
-				      Msg.send (bio, MsgOk);
-				      print ("Granted permission " ^ #value acl ^ " to " ^ #user acl ^ " in " ^ #class acl ^ ".\n"))
-				     handle OpenSSL.OpenSSL s =>
-					    (print "OpenSSL error\n";
-					     Msg.send (bio,
-						       MsgError
-							   ("Error during granting: "
-							    ^ s)));
-				    (ignore (OpenSSL.readChar bio);
-				     OpenSSL.close bio)
-				    handle OpenSSL.OpenSSL _ => ();
-				    loop ())
-				else
-				    ((Msg.send (bio, MsgError "Not authorized to grant privileges");
-				      print "Unauthorized user asked to grant a permission!\n";
-				      ignore (OpenSSL.readChar bio);
-				      OpenSSL.close bio)
-				     handle OpenSSL.OpenSSL _ => ();
-				     loop ())
-
-			      | MsgRevoke acl =>
-				if Acl.query {user = user, class = "priv", value = "all"} then
-				    ((Acl.revoke acl;
-				      Acl.write Config.aclFile;
-				      Msg.send (bio, MsgOk);
-				      print ("Revoked permission " ^ #value acl ^ " from " ^ #user acl ^ " in " ^ #class acl ^ ".\n"))
-				     handle OpenSSL.OpenSSL s =>
-					    (print "OpenSSL error\n";
-					     Msg.send (bio,
-						       MsgError
-							   ("Error during revocation: "
-							    ^ s)));
-				    (ignore (OpenSSL.readChar bio);
-				     OpenSSL.close bio)
-				    handle OpenSSL.OpenSSL _ => ();
-				    loop ())
-				else
-				    ((Msg.send (bio, MsgError "Not authorized to revoke privileges");
-				      print "Unauthorized user asked to revoke a permission!\n";
-				      ignore (OpenSSL.readChar bio);
-				      OpenSSL.close bio)
-				     handle OpenSSL.OpenSSL _ => ();
-				     loop ())
-
-			      | MsgListPerms user =>
-				((Msg.send (bio, MsgPerms (Acl.queryAll user));
-				  print ("Sent permission list for user " ^ user ^ ".\n"))
-				 handle OpenSSL.OpenSSL s =>
-					(print "OpenSSL error\n";
-					 Msg.send (bio,
-						   MsgError
-						       ("Error during permission listing: "
-							^ s)));
-				(ignore (OpenSSL.readChar bio);
-				 OpenSSL.close bio)
-				handle OpenSSL.OpenSSL _ => ();
-				loop ())
-
-			      | MsgWhoHas perm =>
-				((Msg.send (bio, MsgWhoHasResponse (Acl.whoHas perm));
-				  print ("Sent whohas response for " ^ #class perm ^ " / " ^ #value perm ^ ".\n"))
-				 handle OpenSSL.OpenSSL s =>
-					(print "OpenSSL error\n";
-					 Msg.send (bio,
-						   MsgError
-						       ("Error during whohas: "
-							^ s)));
-				(ignore (OpenSSL.readChar bio);
-				 OpenSSL.close bio)
-				handle OpenSSL.OpenSSL _ => ();
-				loop ())
-
-			      | _ =>
-				(Msg.send (bio, MsgError "Unexpected command")
-				 handle OpenSSL.OpenSSL _ => ();
-				 OpenSSL.close bio
-				 handle OpenSSL.OpenSSL _ => ();
-				 loop ())
+fun regenerateEither tc checker context =
+    let
+	val () = print "Starting regeneration....\n"
+
+	val domainsBefore =
+	    if tc then
+		SS.empty
+	    else
+		domainList Config.resultRoot
+
+	fun ifReal f =
+	    if tc then
+		()
+	    else
+		f ()
+
+	val _ = ErrorMsg.reset ()
+
+	val b = basis ()
+	val () = Tycheck.disallowExterns ()
+
+	val () = ifReal (fn () =>
+			    (ignore (OS.Process.system ("rm -rf " ^ Config.oldResultRoot ^ "/*"));
+			     ignore (OS.Process.system ("cp -r " ^ Config.resultRoot
+							^ "/* " ^ Config.oldResultRoot ^ "/"));
+			     Domain.resetGlobal ()))
+
+	val ok = ref true
+ 
+	fun contactNode (node, ip) =
+	    if node = Config.defaultNode then
+		Domain.resetLocal ()
+	    else let
+		    val bio = OpenSSL.connect true (context,
+						    ip
+						    ^ ":"
+						    ^ Int.toString Config.slavePort)
 		in
-		    cmdLoop ()
+		    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
-		    handle OpenSSL.OpenSSL s =>
-			   (print ("OpenSSL error: " ^ s ^ "\n");
-			    OpenSSL.close bio
-			    handle OpenSSL.OpenSSL _ => ();
-			    loop ())
-			 | OS.SysErr (s, _) =>
-			   (print ("System error: " ^ s ^ "\n");
-			    OpenSSL.close bio
-			    handle OpenSSL.OpenSSL _ => ();
-			    loop ())
+		 handle OpenSSL.OpenSSL s => print ("OpenSSL error: " ^ s ^ "\n")
+
+	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
+
+			fun checker' (file, (G, evs)) =
+			    checker G evs file
+		    in
+			if !ErrorMsg.anyErrors then
+			    (ErrorMsg.reset ();
+			     print ("User " ^ user ^ "'s configuration has errors!\n");
+			     ok := false)
+			else
+			    ();
+			ignore (foldl checker' (basis (), Defaults.eInit ()) files)
+		    end
+		else if String.isSuffix "_admin" user then
+		    ()    
+		else
+		    (print ("Couldn't access " ^ user ^ "'s ~/.domtool directory.\n");
+		     ok := false)
+	    end
+	    handle IO.Io {name, function, ...} =>
+		   (print ("IO error processing user " ^ user ^ ": " ^ function ^ ": " ^ name ^ "\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
+	ifReal (fn () => (app contactNode Config.nodeIps;
+			  Env.pre ()));
+	app doUser (Acl.users ());
+	ifReal (fn () =>
+		   let
+		       val domainsAfter = domainList Config.resultRoot
+		       val domainsGone = SS.difference (domainsBefore, domainsAfter)
+		   in
+		       if SS.isEmpty domainsGone then
+			   ()
+		       else
+			   (print "Domains to kill:";
+			    SS.app (fn s => (print " "; print s)) domainsGone;
+			    print "\n";
+
+			    Domain.rmdom' Config.oldResultRoot (SS.listItems domainsGone));
+		       
+		       Env.post ()
+		   end);
+	!ok
+    end
+
+val regenerate = regenerateEither false eval
+val regenerateTc = regenerateEither true
+				    (fn G => fn evs => fn file =>
+							  (#1 (check G file), evs))
+
+fun usersChanged () =
+    (Domain.onUsersChange ();
+     ignore (OS.Process.system Config.publish_reusers))
+
+fun rmuser user =
+    let
+	val doms = Acl.class {user = user, class = "domain"}
+	val doms = List.filter (fn dom =>
+				   case Acl.whoHas {class = "domain", value = dom} of
+				       [_] => true
+				     | _ => false) (StringSet.listItems doms)
+    in
+	Acl.rmuser user;
+	Domain.rmdom doms;
+	usersChanged ()
+    end
+
+fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
+
+fun answerQuery q =
+    case q of
+	QApt pkg => if Apt.installed pkg then MsgYes else MsgNo
+      | QCron user => if Cron.allowed user then MsgYes else MsgNo
+      | QFtp user => if Ftp.allowed user then MsgYes else MsgNo
+      | QTrustedPath user => if TrustedPath.query user then MsgYes else MsgNo
+      | QSocket user => MsgSocket (SocketPerm.query user)
+      | QFirewall user => MsgFirewall (Firewall.query user)
+
+fun describeQuery q =
+    case q of
+	QApt pkg => "Requested installation status of package " ^ pkg
+      | QCron user => "Asked about cron permissions for user " ^ user
+      | QFtp user => "Asked about FTP permissions for user " ^ user
+      | QTrustedPath user => "Asked about trusted path settings for user " ^ user
+      | QSocket user => "Asked about socket permissions for user " ^ user
+      | QFirewall user => "Asked about firewall rules for user " ^ user
+
+fun doIt' loop bio f cleanup =
+	       ((case f () of
+		     (msgLocal, SOME msgRemote) => 
+		     (print msgLocal;
+		      print "\n";
+		      Msg.send (bio, MsgError msgRemote))
+		   | (msgLocal, NONE) =>
+		     (print msgLocal;
+		      print "\n";
+		      Msg.send (bio, MsgOk)))
+		handle e as (OpenSSL.OpenSSL s) =>
+		       (print ("OpenSSL error: " ^ s ^ "\n");
+			app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
+			Msg.send (bio, MsgError ("OpenSSL error: " ^ s))
+			handle OpenSSL.OpenSSL _ => ())
+		     | OS.SysErr (s, _) =>
+		       (print "System error: ";
+			print s;
+			print "\n";
+			Msg.send (bio, MsgError ("System error: " ^ s))
+			handle OpenSSL.OpenSSL _ => ())
+		     | Fail s =>
+		       (print "Failure: ";
+			print s;
+			print "\n";
+			Msg.send (bio, MsgError ("Failure: " ^ s))
+			handle OpenSSL.OpenSSL _ => ())
+		     | ErrorMsg.Error =>
+		       (print "Compilation error\n";
+			Msg.send (bio, MsgError "Error during configuration evaluation")
+			handle OpenSSL.OpenSSL _ => ());
+		(cleanup ();
+		 ignore (OpenSSL.readChar bio);
+		 OpenSSL.close bio)
+		handle OpenSSL.OpenSSL _ => ();
+		loop ())
+
+fun service () =
+    let
+	val host = Slave.hostname ()
+
+	val () = Acl.read Config.aclFile
+
+	val context = context (Config.certDir ^ "/" ^ host ^ ".pem",
+			       Config.keyDir ^ "/" ^ host ^ "/key.pem",
+			       Config.trustStore)
+	val _ = Domain.set_context context
+
+	val sock = OpenSSL.listen (context, Config.dispatcherPort)
+
+	fun loop () =
+	    (case OpenSSL.accept sock of
+		 NONE => ()
+	       | SOME bio =>
+		 let
+		     val user = OpenSSL.peerCN bio
+		     val () = print ("\nConnection from " ^ user ^ " at " ^ now () ^ "\n")
+		     val () = Domain.setUser user
+		     val doIt = doIt' loop bio
+
+		     fun doConfig codes =
+			 let
+			     val _ = print "Configuration:\n"
+			     val _ = app (fn s => (print s; print "\n")) codes
+			     val _ = print "\n"
+
+			     val outname = OS.FileSys.tmpName ()
+
+			     fun doOne (code, (G, evs)) =
+				 let
+				     val outf = TextIO.openOut outname
+				 in
+				     TextIO.output (outf, code);
+				     TextIO.closeOut outf;
+				     eval G evs outname
+				 end
+			 in
+			     doIt (fn () => (Env.pre ();
+					     ignore (foldl doOne (basis (), Defaults.eInit ()) codes);
+					     Env.post ();
+					     Msg.send (bio, MsgOk);
+					     ("Configuration complete.", NONE)))
+				  (fn () => OS.FileSys.remove outname)
+			 end
+
+		     fun checkAddr s =
+			 case String.fields (fn ch => ch = #"@") s of
+			     [user'] =>
+			     if user = user' then
+				 SOME (SetSA.User s)
+			     else
+				 NONE
+			   | [user', domain] =>
+			     if Domain.validEmailUser user' andalso Domain.yourDomain domain then
+				 SOME (SetSA.Email s)
+			     else
+				 NONE
+			   | _ => NONE
+
+		     fun cmdLoop () =
+			 case Msg.recv bio of
+			     NONE => (OpenSSL.close bio
+				      handle OpenSSL.OpenSSL _ => ();
+				      loop ())
+			   | SOME m =>
+			     case m of
+				 MsgConfig code => doConfig [code]
+			       | MsgMultiConfig codes => doConfig codes
+
+			       | MsgShutdown =>
+				 if Acl.query {user = user, class = "priv", value = "all"}
+				    orelse Acl.query {user = user, class = "priv", value = "shutdown"} then
+				     print ("Domtool dispatcher shutting down at " ^ now () ^ "\n\n")
+				 else
+				     (print "Unauthorized shutdown command!\n";
+				      OpenSSL.close bio
+				      handle OpenSSL.OpenSSL _ => ();
+				      loop ())
+
+			       | MsgGrant acl =>
+				 doIt (fn () =>
+					  if Acl.query {user = user, class = "priv", value = "all"} then
+					      (Acl.grant acl;
+					       Acl.write Config.aclFile;
+					       if #class acl = "user" then
+						   usersChanged ()
+					       else
+						   ();
+					       ("Granted permission " ^ #value acl ^ " to " ^ #user acl ^ " in " ^ #class acl ^ ".",
+						NONE))
+					  else
+					      ("Unauthorized user asked to grant a permission!",
+					       SOME "Not authorized to grant privileges"))
+				      (fn () => ())
+				 
+			       | MsgRevoke acl =>
+				 doIt (fn () =>
+					  if Acl.query {user = user, class = "priv", value = "all"} then
+					      (Acl.revoke acl;
+					       Acl.write Config.aclFile;
+					       ("Revoked permission " ^ #value acl ^ " from " ^ #user acl ^ " in " ^ #class acl ^ ".",
+						NONE))
+					  else
+					      ("Unauthorized user asked to revoke a permission!",
+					       SOME "Not authorized to revoke privileges"))
+				      (fn () => ())
+
+			       | MsgListPerms user =>
+				 doIt (fn () =>
+					  (Msg.send (bio, MsgPerms (Acl.queryAll user));
+					   ("Sent permission list for user " ^ user ^ ".",
+					    NONE)))
+				      (fn () => ())
+
+			       | MsgWhoHas perm =>
+				 doIt (fn () =>
+					  (Msg.send (bio, MsgWhoHasResponse (Acl.whoHas perm));
+					   ("Sent whohas response for " ^ #class perm ^ " / " ^ #value perm ^ ".",
+					    NONE)))
+				      (fn () => ())
+
+			       | MsgRmdom doms =>
+				 doIt (fn () =>
+					  if Acl.query {user = user, class = "priv", value = "all"}
+					     orelse List.all (fn dom => Domain.validDomain dom
+									andalso Acl.queryDomain {user = user, domain = dom}) doms then
+					      (Domain.rmdom doms;
+					       (*app (fn dom =>
+						       Acl.revokeFromAll {class = "domain", value = dom}) doms;
+					       Acl.write Config.aclFile;*)
+					       ("Removed domains" ^ foldl (fn (d, s) => s ^ " " ^ d) "" doms ^ ".",
+						NONE))
+					  else
+					      ("Unauthorized user asked to remove a domain!",
+					       SOME "Not authorized to remove that domain"))
+				      (fn () => ())
+
+			       | MsgRegenerate =>
+				 doIt (fn () =>
+					  if Acl.query {user = user, class = "priv", value = "regen"}
+					     orelse Acl.query {user = user, class = "priv", value = "all"} then
+					      (if regenerate context then
+						   ("Regenerated all configuration.",
+						    NONE)
+					       else
+						   ("Error regenerating configuration!",
+						    SOME "Error regenerating configuration!  Consult /var/log/domtool.log."))
+					  else
+					      ("Unauthorized user asked to regenerate!",
+					       SOME "Not authorized to regenerate"))
+				      (fn () => ())
+
+			       | MsgRegenerateTc =>
+				 doIt (fn () =>
+					  if Acl.query {user = user, class = "priv", value = "regen"}
+					     orelse Acl.query {user = user, class = "priv", value = "all"} then
+					      (if regenerateTc context then
+						   ("Checked all configuration.",
+						    NONE)
+					       else
+						   ("Found a compilation error!",
+						    SOME "Found a compilation error!  Consult /var/log/domtool.log."))
+					  else
+					      ("Unauthorized user asked to regenerate -tc!",
+					       SOME "Not authorized to regenerate -tc"))
+				      (fn () => ())
+
+			       | MsgRmuser user' =>
+				 doIt (fn () =>
+					  if Acl.query {user = user, class = "priv", value = "all"} then
+					      (rmuser user';
+					       Acl.write Config.aclFile;
+					       ("Removed user " ^ user' ^ ".",
+						NONE))
+					  else
+					      ("Unauthorized user asked to remove a user!",
+					       SOME "Not authorized to remove users"))
+				      (fn () => ())
+
+			       | MsgListMailboxes domain =>
+				 doIt (fn () =>
+					  if not (Domain.yourDomain domain) then
+					      ("User wasn't authorized to list mailboxes for " ^ domain,
+					       SOME "You're not authorized to configure that domain.")
+					  else
+					      case Vmail.list domain of
+						  Vmail.Listing users => (Msg.send (bio, MsgMailboxes users);
+									  ("Sent mailbox list for " ^ domain,
+									   NONE))
+						| Vmail.Error msg => ("Error listing mailboxes for " ^ domain ^ ": " ^ msg,
+								      SOME msg))
+				      (fn () => ())
+
+			       | MsgNewMailbox {domain, user = emailUser, passwd, mailbox} =>
+				 doIt (fn () =>
+					  if not (Domain.yourDomain domain) then
+					      ("User wasn't authorized to add a mailbox to " ^ domain,
+					       SOME "You're not authorized to configure that domain.")
+					  else if not (Domain.validEmailUser emailUser) then
+					      ("Invalid e-mail username " ^ emailUser,
+					       SOME "Invalid e-mail username")
+					  else if not (CharVector.all Char.isGraph passwd) then
+					      ("Invalid password",
+					       SOME "Invalid password; may only contain printable, non-space characters")
+					  else if not (Domain.yourPath mailbox) then
+					      ("User wasn't authorized to add a mailbox at " ^ mailbox,
+					       SOME ("You're not authorized to use that mailbox location. ("
+						     ^ mailbox ^ ")"))
+					  else
+					      case Vmail.add {requester = user,
+							      domain = domain, user = emailUser,
+							      passwd = passwd, mailbox = mailbox} of
+						  NONE => ("Added mailbox " ^ emailUser ^ "@" ^ domain ^ " at " ^ mailbox,
+							   NONE)
+						| SOME msg => ("Error adding mailbox " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
+							       SOME msg))
+				      (fn () => ())
+				 
+			       | MsgPasswdMailbox {domain, user = emailUser, passwd} =>
+				 doIt (fn () =>
+					  if not (Domain.yourDomain domain) then
+					      ("User wasn't authorized to change password of a mailbox for " ^ domain,
+					       SOME "You're not authorized to configure that domain.")
+					  else if not (Domain.validEmailUser emailUser) then
+					      ("Invalid e-mail username " ^ emailUser,
+					       SOME "Invalid e-mail username")
+					  else if not (CharVector.all Char.isGraph passwd) then
+					      ("Invalid password",
+					       SOME "Invalid password; may only contain printable, non-space characters")
+					  else
+					      case Vmail.passwd {domain = domain, user = emailUser,
+								 passwd = passwd} of
+						  NONE => ("Changed password of mailbox " ^ emailUser ^ "@" ^ domain,
+							   NONE)
+						| SOME msg => ("Error changing mailbox password for " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
+							       SOME msg))
+				      (fn () => ())
+
+			       | MsgRmMailbox {domain, user = emailUser} =>
+				 doIt (fn () =>
+					  if not (Domain.yourDomain domain) then
+					      ("User wasn't authorized to change password of a mailbox for " ^ domain,
+					       SOME "You're not authorized to configure that domain.")
+					  else if not (Domain.validEmailUser emailUser) then
+					      ("Invalid e-mail username " ^ emailUser,
+					       SOME "Invalid e-mail username")
+					  else
+					      case Vmail.rm {domain = domain, user = emailUser} of
+						  NONE => ("Deleted mailbox " ^ emailUser ^ "@" ^ domain,
+							   NONE)
+						| SOME msg => ("Error deleting mailbox " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
+							       SOME msg))
+				      (fn () => ())
+
+			       | MsgSaQuery addr =>
+				 doIt (fn () =>
+					  case checkAddr addr of
+					      NONE => ("User tried to query SA filtering for " ^ addr,
+						       SOME "You aren't allowed to configure SA filtering for that recipient.")
+					    | SOME addr' => (Msg.send (bio, MsgSaStatus (SetSA.query addr'));
+							     ("Queried SA filtering status for " ^ addr,
+							      NONE)))
+				      (fn () => ())
+
+			       | MsgSaSet (addr, b) =>
+				 doIt (fn () =>
+					  case checkAddr addr of
+					      NONE => ("User tried to set SA filtering for " ^ addr,
+						       SOME "You aren't allowed to configure SA filtering for that recipient.")
+					    | SOME addr' => (SetSA.set (addr', b);
+							     Msg.send (bio, MsgOk);
+							     ("Set SA filtering status for " ^ addr ^ " to "
+							      ^ (if b then "ON" else "OFF"),
+							      NONE)))
+				      (fn () => ())
+
+			       | MsgSmtpLogReq domain =>
+				 doIt (fn () =>
+					  if not (Domain.yourDomain domain) then
+					      ("Unauthorized user tried to request SMTP logs for " ^ domain,
+					       SOME "You aren't authorized to configure that domain.")
+					  else
+					      (SmtpLog.search (fn line => Msg.send (bio, MsgSmtpLogRes line))
+							      domain;
+					       ("Requested SMTP logs for " ^ domain,
+						NONE)))
+				      (fn () => ())
+
+			       | MsgQuery q =>
+				 doIt (fn () => (Msg.send (bio, answerQuery q);
+						 (describeQuery q,
+						  NONE)))
+				      (fn () => ())
+
+			       | MsgMysqlFixperms =>
+				 (print "Starting mysql-fixperms\n";
+				  doIt (fn () => if OS.Process.isSuccess
+							(OS.Process.system "/usr/bin/sudo -H /afs/hcoop.net/common/etc/scripts/mysql-grant-table-drop") then
+						     ("Requested mysql-fixperms",
+						      NONE)
+						 else
+						     ("Requested mysql-fixperms, but execution failed!",
+						      SOME "Script execution failed."))
+				       (fn () => ()))
+
+			       | MsgDescribe dom =>
+				 doIt (fn () => if not (Domain.validDomain dom) then
+						    ("Requested description of invalid domain " ^ dom,
+						     SOME "Invalid domain name")
+						else if not (Domain.yourDomain dom
+							     orelse Acl.query {user = user, class = "priv", value = "all"}) then
+						    ("Requested description of " ^ dom ^ ", but not allowed access",
+						     SOME "Access denied")
+						else
+						    (Msg.send (bio, MsgDescription (Domain.describe dom));
+						     ("Sent description of domain " ^ dom,
+						      NONE)))
+				      (fn () => ())
+
+			       | MsgReUsers =>
+				 doIt (fn () => if Acl.query {user = user, class = "priv", value = "regen"}
+						   orelse Acl.query {user = user, class = "priv", value = "all"} then
+						    (usersChanged ();
+						     ("Users change callbacks run", NONE))
+						else
+						    ("Unauthorized user asked to reusers!",
+						     SOME "You aren't authorized to regenerate files."))
+				      (fn () => ())
+
+			       | _ =>
+				 doIt (fn () => ("Unexpected command",
+						 SOME "Unexpected command"))
+				      (fn () => ())
+		 in
+		     cmdLoop ()
+		 end
+		 handle e as (OpenSSL.OpenSSL s) =>
+			(print ("OpenSSL error: " ^ s ^ "\n");
+			 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
+			 OpenSSL.close bio
+			 handle OpenSSL.OpenSSL _ => ();
+			 loop ())
+		      | OS.SysErr (s, _) =>
+			(print ("System error: " ^ s ^ "\n");
+			 OpenSSL.close bio
+			 handle OpenSSL.OpenSSL _ => ();
+			 loop ())
+		      | IO.Io {name, function, cause} =>
+			(print ("IO error: " ^ function ^ " for " ^ name ^ "\n");
+			 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory cause);
+			 OpenSSL.close bio
+			 handle OpenSSL.OpenSSL _ => ();
+			 loop ())
+		      | OS.Path.InvalidArc =>
+			(print "Invalid arc\n";
+			 OpenSSL.close bio
+			 handle OpenSSL.OpenSSL _ => ();
+			 loop ())
+		      | e =>
+			(print "Unknown exception in main loop!\n";
+			 app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
+			 OpenSSL.close bio
+			 handle OpenSSL.OpenSSL _ => ();
+			 loop ()))
+	    handle e as (OpenSSL.OpenSSL s) =>
+		   (print ("OpenSSL error: " ^ s ^ "\n");
+		    app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
+		    loop ())
+		 | OS.SysErr (s, _) =>
+		   (print ("System error: " ^ s ^ "\n");
+		    loop ())
+		 | IO.Io {name, function, cause} =>
+		   (print ("IO error: " ^ function ^ " for " ^ name ^ "\n");
+		    app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory cause);
+		    loop ())
+		 | e =>
+		   (print "Unknown exception in main loop!\n";
+		    app (fn x => print (x ^ "\n")) (SMLofNJ.exnHistory e);
+		    loop ())
     in
+	print ("Domtool dispatcher starting up at " ^ now () ^ "\n");
 	print "Listening for connections....\n";
 	loop ();
 	OpenSSL.shutdown sock
@@ -495,57 +1602,187 @@ fun slave () =
     let
 	val host = Slave.hostname ()
 
-	val context = OpenSSL.context (Config.certDir ^ "/" ^ host ^ ".pem",
-				       Config.keyDir ^ "/" ^ host ^ "/key.pem",
-				       Config.trustStore)
+	val context = context (Config.certDir ^ "/" ^ host ^ ".pem",
+			       Config.keyDir ^ "/" ^ host ^ "/key.pem",
+			       Config.trustStore)
 
 	val sock = OpenSSL.listen (context, Config.slavePort)
 
+	val _ = print ("Slave server starting at " ^ now () ^ "\n")
+
 	fun loop () =
-	    case OpenSSL.accept sock of
-		NONE => ()
-	      | SOME bio =>
-		let
-		    val peer = OpenSSL.peerCN bio
-		    val () = print ("\nConnection from " ^ peer ^ "\n")
-		in
-		    if peer <> Config.dispatcherName then
-			(print "Not authorized!\n";
-			 OpenSSL.close bio;
-			 loop ())
-		    else let
-			    fun loop' files =
-				case Msg.recv bio of
-				    NONE => print "Dispatcher closed connection unexpectedly\n"
-				  | SOME m =>
-				    case m of
-					MsgFile file => loop' (file :: files)
-				      | MsgDoFiles => (Slave.handleChanges files;
-						       Msg.send (bio, MsgOk))
-				      | _ => (print "Dispatcher sent unexpected command\n";
-					      Msg.send (bio, MsgError "Unexpected command"))
-			in
-			    loop' [];
-			    ignore (OpenSSL.readChar bio);
-			    OpenSSL.close bio;
-			    loop ()
-			end
-		end handle OpenSSL.OpenSSL s =>
-			   (print ("OpenSSL error: "^ s ^ "\n");
-			    OpenSSL.close bio
+	    (case OpenSSL.accept sock of
+		 NONE => ()
+	       | SOME bio =>
+		 let
+		     val peer = OpenSSL.peerCN bio
+		     val () = print ("\nConnection from " ^ peer ^ " at " ^ now () ^ "\n")
+		 in
+		     if peer = Config.dispatcherName then let
+			     fun loop' files =
+				 case Msg.recv bio of
+				     NONE => print "Dispatcher closed connection unexpectedly\n"
+				   | SOME m =>
+				     case m of
+					 MsgFile file => loop' (file :: files)
+				       | MsgDoFiles => (Slave.handleChanges files;
+							Msg.send (bio, MsgOk))
+				       | MsgRegenerate => (Domain.resetLocal ();
+							   Msg.send (bio, MsgOk))
+				       | MsgVmailChanged => (if Vmail.doChanged () then
+								 Msg.send (bio, MsgOk)
+							     else
+								 Msg.send (bio, MsgError "userdb update failed"))
+				       | _ => (print "Dispatcher sent unexpected command\n";
+					       Msg.send (bio, MsgError "Unexpected command"))
+			 in
+			     loop' [];
+			     ignore (OpenSSL.readChar bio);
+			     OpenSSL.close bio;
+			     loop ()
+			 end
+		     else if peer = "domtool" then
+			 case Msg.recv bio of
+			     SOME MsgShutdown => (OpenSSL.close bio;
+						  print ("Shutting down at " ^ now () ^ "\n\n"))
+			   | _ => (OpenSSL.close bio;
+				   loop ())
+		     else
+			 let
+			     val doIt = doIt' loop bio
+			     val user = peer
+			 in
+			     case Msg.recv bio of
+				 NONE => (OpenSSL.close bio
 					  handle OpenSSL.OpenSSL _ => ();
-			    loop ())
-			 | OS.SysErr (s, _) =>
-			   (print ("System error: "^ s ^ "\n");
-			    OpenSSL.close bio
-			    handle OpenSSL.OpenSSL _ => ();
-			    loop ())
+					  loop ())
+			       | SOME m =>
+				 case m of 
+				     (MsgQuery q) => (print (describeQuery q ^ "\n");
+						      Msg.send (bio, answerQuery q);
+						      ignore (OpenSSL.readChar bio);
+						      OpenSSL.close bio;
+						      loop ())
+				   | MsgCreateDbUser {dbtype, passwd} =>
+				     doIt (fn () =>
+					      case Dbms.lookup dbtype of
+						  NONE => ("Database user creation request with unknown datatype type " ^ dbtype,
+							   SOME ("Unknown database type " ^ dbtype))
+						| SOME handler =>
+						  case #adduser handler {user = user, passwd = passwd} of
+						      NONE => ("Added " ^ dbtype ^ " user " ^ user ^ ".",
+							       NONE)
+						    | SOME msg =>
+						      ("Error adding a " ^ dbtype ^ " user " ^ user ^ ": " ^ msg,
+						       SOME ("Error adding user: " ^ msg)))
+					  (fn () => ())
+
+				   | MsgDbPasswd {dbtype, passwd} =>
+				     doIt (fn () =>
+					      case Dbms.lookup dbtype of
+						  NONE => ("Database passwd request with unknown datatype type " ^ dbtype,
+							   SOME ("Unknown database type " ^ dbtype))
+						| SOME handler =>
+						  case #passwd handler {user = user, passwd = passwd} of
+						      NONE => ("Changed " ^ dbtype ^ " password of user " ^ user ^ ".",
+							       NONE)
+						    | SOME msg =>
+						      ("Error setting " ^ dbtype ^ " password of user " ^ user ^ ": " ^ msg,
+						       SOME ("Error adding user: " ^ msg)))
+					  (fn () => ())
+
+				   | MsgCreateDb {dbtype, dbname, encoding} =>
+				     doIt (fn () =>
+					      if Dbms.validDbname dbname then
+						  case Dbms.lookup dbtype of
+						      NONE => ("Database creation request with unknown datatype type " ^ dbtype,
+							       SOME ("Unknown database type " ^ dbtype))
+						    | SOME handler =>
+						      if not (Dbms.validEncoding encoding) then
+							  ("Invalid encoding " ^ valOf encoding ^ " requested for database creation.",
+							   SOME "Invalid encoding")
+						      else
+							  case #createdb handler {user = user, dbname = dbname, encoding = encoding} of
+							      NONE => ("Created database " ^ user ^ "_" ^ dbname ^ ".",
+								       NONE)
+							    | SOME msg => ("Error creating database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
+									   SOME ("Error creating database: " ^ msg))
+					      else
+						  ("Invalid database name " ^ user ^ "_" ^ dbname,
+						   SOME ("Invalid database name " ^ dbname)))
+					  (fn () => ())
+
+				   | MsgDropDb {dbtype, dbname} =>
+				     doIt (fn () =>
+					      if Dbms.validDbname dbname then
+						  case Dbms.lookup dbtype of
+						      NONE => ("Database drop request with unknown datatype type " ^ dbtype,
+							       SOME ("Unknown database type " ^ dbtype))
+						    | SOME handler =>
+						      case #dropdb handler {user = user, dbname = dbname} of
+							  NONE => ("Drop database " ^ user ^ "_" ^ dbname ^ ".",
+								   NONE)
+							| SOME msg => ("Error dropping database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
+								       SOME ("Error dropping database: " ^ msg))
+					      else
+						  ("Invalid database name " ^ user ^ "_" ^ dbname,
+						   SOME ("Invalid database name " ^ dbname)))
+					  (fn () => ())
+
+				   | MsgGrantDb {dbtype, dbname} =>
+				     doIt (fn () =>
+					      if Dbms.validDbname dbname then
+						  case Dbms.lookup dbtype of
+						      NONE => ("Database drop request with unknown datatype type " ^ dbtype,
+							       SOME ("Unknown database type " ^ dbtype))
+						    | SOME handler =>
+						      case #grant handler {user = user, dbname = dbname} of
+							  NONE => ("Grant permissions to database " ^ user ^ "_" ^ dbname ^ ".",
+								   NONE)
+							| SOME msg => ("Error granting permissions to database " ^ user ^ "_" ^ dbname ^ ": " ^ msg,
+								       SOME ("Error granting permissions to database: " ^ msg))
+					      else
+						  ("Invalid database name " ^ user ^ "_" ^ dbname,
+						   SOME ("Invalid database name " ^ dbname)))
+					  (fn () => ())
+				   | _ => (OpenSSL.close bio;
+					   loop ())
+			 end
+		 end handle OpenSSL.OpenSSL s =>
+			    (print ("OpenSSL error: " ^ s ^ "\n");
+			     OpenSSL.close bio
+			     handle OpenSSL.OpenSSL _ => ();
+			     loop ())
+			  | e as OS.SysErr (s, _) =>
+			    (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+			     print ("System error: "^ s ^ "\n");
+			     OpenSSL.close bio
+			     handle OpenSSL.OpenSSL _ => ();
+			     loop ())
+			  | IO.Io {function, name, ...} =>
+			    (print ("IO error: " ^ function ^ ": " ^ name ^ "\n");
+			     OpenSSL.close bio
+			     handle OpenSSL.OpenSSL _ => ();
+			     loop ())
+			  | e =>
+			    (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+			     print "Uncaught exception!\n";
+			     OpenSSL.close bio
+			     handle OpenSSL.OpenSSL _ => ();
+			     loop ()))
+	    handle OpenSSL.OpenSSL s =>
+		   (print ("OpenSSL error: " ^ s ^ "\n");
+		    loop ())
+		 | e =>
+		   (app (fn s => print (s ^ "\n")) (SMLofNJ.exnHistory e);
+		    print "Uncaught exception!\n";
+		    loop ())
     in
 	loop ();
 	OpenSSL.shutdown sock
     end
 
-fun autodocBasis outdir =
+fun listBasis () =
     let
 	val dir = Posix.FileSys.opendir Config.libRoot
 
@@ -560,10 +1797,11 @@ fun autodocBasis outdir =
 			  :: files)
 		else
 		    loop files
-
-	val files = loop []
     in
-	Autodoc.autodoc {outdir = outdir, infiles = files}
+	loop []
     end
 
+fun autodocBasis outdir =
+    Autodoc.autodoc {outdir = outdir, infiles = listBasis ()}
+
 end