Remove Config.{dispatcher,defaultNode}
[hcoop/domtool2.git] / src / main.sml
index f3bedc2..1552791 100644 (file)
@@ -1,5 +1,6 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006-2007, Adam Chlipala
+ * Copyright (c) 2006-2009, Adam Chlipala
+ * Copyright (c) 2012,2013,2014 Clinton Ebadi <clinton@unknownlamer.org>
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
@@ -25,15 +26,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 +81,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,17 +95,22 @@ 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
@@ -96,7 +119,24 @@ 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 ()
 
@@ -127,12 +167,16 @@ fun checkDir dname =
                 ())
     end
 
-fun reduce fname =
+fun checkDir dname =
+    (setupUser ();
+     checkDir' dname)
+
+fun reduce G fname =
     let
-       val (G, body) = check fname
+       val (G, body) = check fname
     in
        if !ErrorMsg.anyErrors then
-           NONE
+           (G, NONE)
        else
            case body of
                SOME body =>
@@ -143,31 +187,28 @@ 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') =>
-       if !ErrorMsg.anyErrors then
-           raise ErrorMsg.Error
-       else
-           Eval.exec (Defaults.eInit ()) body'
-      | NONE => raise ErrorMsg.Error
+(*(Defaults.eInit ())*)
 
-fun eval' fname =
-    case reduce fname of
-       (SOME body') =>
+fun eval G evs fname =
+    case reduce fname of
+       (G, SOME body') =>
        if !ErrorMsg.anyErrors then
            raise ErrorMsg.Error
        else
-           ignore (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
+    Domain.nodeIp Config.dispatcherName ^ ":" ^ Int.toString Config.dispatcherPort
 
 val self =
     "localhost:" ^ Int.toString Config.slavePort
@@ -176,26 +217,10 @@ 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 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 requestContext f =
     let
        val user = setupUser ()
@@ -209,35 +234,55 @@ fun requestContext f =
        (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 requestSlaveBio () =
+val requestBio = requestBio' true
+
+fun requestSlaveBio' printErr =
     let
        val (user, context) = requestContext (fn () => ())
     in
-       (user, OpenSSL.connect (context, self))
+       (user, OpenSSL.connect printErr (context, self))
     end
 
-fun request fname =
-    let
-       val (user, bio) = requestBio (fn () => ignore (check fname))
+fun requestSlaveBio () = requestSlaveBio' true
 
-       val inf = TextIO.openIn fname
+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
 
-       fun loop lines =
-           case TextIO.inputLine inf of
-               NONE => String.concat (List.rev lines)
-             | SOME line => loop (line :: lines)
+               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 = loop []
+       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 =>
@@ -256,12 +301,12 @@ fun requestDir dname =
                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";
+                    print "files in your ~/.domtool directory?\n";
                     OS.Process.exit OS.Process.failure)
 
        val _ = ErrorMsg.reset ()
 
-       val (user, bio) = requestBio (fn () => checkDir dname)
+       val (user, bio) = requestBio (fn () => checkDir' dname)
 
        val b = basis ()
 
@@ -317,7 +362,7 @@ fun requestDir dname =
 
 fun requestPing () =
     let
-       val (_, bio) = requestBio (fn () => ())
+       val (_, bio) = requestBio' false (fn () => ())
     in
        OpenSSL.close bio;
        OS.Process.success
@@ -330,7 +375,7 @@ fun requestShutdown () =
     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 "Shutdown begun.\n"
@@ -341,7 +386,7 @@ fun requestShutdown () =
 
 fun requestSlavePing () =
     let
-       val (_, bio) = requestSlaveBio ()
+       val (_, bio) = requestSlaveBio' false
     in
        OpenSSL.close bio;
        OS.Process.success
@@ -354,7 +399,7 @@ fun requestSlaveShutdown () =
     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 "Shutdown begun.\n"
@@ -491,7 +536,9 @@ fun requestRmuser user =
 
 fun requestDbUser dbtype =
     let
-       val (_, bio) = requestBio (fn () => ())
+       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
@@ -506,7 +553,9 @@ fun requestDbUser dbtype =
 
 fun requestDbPasswd rc =
     let
-       val (_, bio) = requestBio (fn () => ())
+       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
@@ -521,9 +570,11 @@ fun requestDbPasswd rc =
 
 fun requestDbTable p =
     let
-       val (user, bio) = requestBio (fn () => ())
+       val (user, context) = requestContext (fn () => ())
+       val bio = OpenSSL.connect true (context,
+                                       Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
     in
-       Msg.send (bio, MsgCreateDbTable p);
+       Msg.send (bio, MsgCreateDb p);
        case Msg.recv bio of
            NONE => print "Server closed connection unexpectedly.\n"
          | SOME m =>
@@ -534,6 +585,40 @@ fun requestDbTable p =
        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 () => ())
@@ -545,7 +630,7 @@ fun requestListMailboxes domain =
             case m of
                 MsgMailboxes users => (Msg.send (bio, MsgOk);
                                        Vmail.Listing users)
-              | MsgError s => Vmail.Error ("Creation failed: " ^ s)
+              | MsgError s => Vmail.Error ("Listing failed: " ^ s)
               | _ => Vmail.Error "Unexpected server reply.")
        before OpenSSL.close bio
     end
@@ -649,13 +734,30 @@ fun requestSmtpLog domain =
        OpenSSL.close bio
     end
 
+fun requestMysqlFixperms () =
+    let
+       val (_, context) = requestContext (fn () => ())
+       val bio = OpenSSL.connect true (context,
+                                       Config.Dbms.dbmsNode ^ ":" ^ Int.toString Config.slavePort)
+    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 (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QApt pkg))
 
@@ -678,13 +780,45 @@ fun requestApt {node, pkg} =
        before OpenSSL.close bio
     end
 
+fun requestAptExists {node, pkg} =
+    let
+       val (user, context) = requestContext (fn () => ())
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+
+       val _ = Msg.send (bio, MsgQuery (QAptExists pkg))
+
+       fun loop () =
+           case Msg.recv bio of
+               NONE => (print "Server closed connection unexpectedly.\n";
+                        OS.Process.failure)
+             | SOME m =>
+               case m of
+                   MsgAptQuery {section,description}  =>  (print "Package exists.\n";
+                                                           print ("Section: " ^ section ^ "\n");
+                                                           print ("Description: " ^ description ^ "\n");
+                                                           OS.Process.success)
+                 | MsgNo => (print "Package does not exist.\n";
+                             OS.Process.failure
+                            (* It might be the Wrong Thing (tm) to use MsgNo like this *))
+                 | MsgError s => (print ("APT existence 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 (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QCron uname))
 
@@ -710,10 +844,10 @@ fun requestCron {node, uname} =
 fun requestFtp {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QFtp uname))
 
@@ -739,10 +873,10 @@ fun requestFtp {node, uname} =
 fun requestTrustedPath {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QTrustedPath uname))
 
@@ -768,10 +902,10 @@ fun requestTrustedPath {node, uname} =
 fun requestSocketPerm {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
 
        val _ = Msg.send (bio, MsgQuery (QSocket uname))
 
@@ -799,12 +933,12 @@ fun requestSocketPerm {node, uname} =
 fun requestFirewall {node, uname} =
     let
        val (user, context) = requestContext (fn () => ())
-       val bio = OpenSSL.connect (context, if node = Config.masterNode then
-                                               dispatcher
-                                           else
-                                               Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
-
-       val _ = Msg.send (bio, MsgQuery (QFirewall uname))
+       val bio = OpenSSL.connect true (context, if node = Config.dispatcherName then
+                                                    dispatcher
+                                                else
+                                                    Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+                 
+       val _ = Msg.send (bio, MsgQuery (QFirewall {node = node, user = uname}))
 
        fun loop () =
            case Msg.recv bio of
@@ -823,25 +957,147 @@ fun requestFirewall {node, uname} =
        before OpenSSL.close bio
     end
 
-fun regenerate context =
+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
+
+fun requestFirewallRegen node = 
+    let
+       val (user, context) = requestContext (fn () => ())
+       val bio = OpenSSL.connect true (context, Domain.nodeIp node ^ ":" ^ Int.toString Config.slavePort)
+       (* Only supporting on slave nodes *)
+                 
+       val _ = Msg.send (bio, MsgFirewallRegen)
+
+       fun handleResult () =
+           case Msg.recv bio of
+               NONE => (print "Server closed connection unexpectedly.\n";
+                        OS.Process.failure)
+             | SOME m =>
+               case m of
+                   MsgOk => (print "Firewall regenerated.\n";
+                             OS.Process.success)
+                 | MsgError s => (print ("Firewall regeneration failed: " ^ s ^ "\n");
+                                  OS.Process.failure)
+                 | _ => (print "Unexpected server reply.\n";
+                         OS.Process.failure)
+    in
+       handleResult()
+       before 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 path = OS.Path.joinDirFile {dir = dname,
+                                                   file = node}
+
+                   fun visitDomains (path, bfor, dset) =
+                       let
+                           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
+                           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 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 () = Domain.resetGlobal ()
+       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
+           if node = Config.dispatcherName then
                Domain.resetLocal ()
            else let
-                   val bio = OpenSSL.connect (context,
-                                              ip
-                                              ^ ":"
-                                              ^ Int.toString Config.slavePort)
+                   val bio = OpenSSL.connect true (context,
+                                                   ip
+                                                   ^ ":"
+                                                   ^ Int.toString Config.slavePort)
                in
                    Msg.send (bio, MsgRegenerate);
                    case Msg.recv bio of
@@ -883,88 +1139,65 @@ fun regenerate context =
 
                        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"))
+                            print ("User " ^ user ^ "'s configuration has errors!\n");
+                            ok := false)
                        else
-                           app eval' files
+                           ();
+                       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 _ => ()
-                | OS.SysErr (s, _) => (print ("System error processing user " ^ user ^ ": " ^ s ^ "\n");
-                                       ok := false)
+           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
-       app contactNode Config.nodeIps;
-       Env.pre ();
+       ifReal (fn () => (app contactNode Config.nodeIps;
+                         Env.pre ()));
        app doUser (Acl.users ());
-       Env.post ();
+       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
 
-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 regenerate = regenerateEither false eval
+val regenerateTc = regenerateEither true
+                                   (fn G => fn evs => fn file =>
+                                                         (#1 (check G file), evs))
 
-                       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
+fun usersChanged () =
+    (Domain.onUsersChange ();
+     ignore (OS.Process.system Config.publish_reusers))
 
 fun rmuser user =
     let
@@ -975,7 +1208,8 @@ fun rmuser user =
                                     | _ => false) (StringSet.listItems doms)
     in
        Acl.rmuser user;
-       Domain.rmdom doms
+       Domain.rmdom doms;
+       usersChanged ()
     end
 
 fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
@@ -983,421 +1217,432 @@ fun now () = Date.toString (Date.fromTimeUniv (Time.now ()))
 fun answerQuery q =
     case q of
        QApt pkg => if Apt.installed pkg then MsgYes else MsgNo
+      | QAptExists pkg => (case Apt.info pkg of
+                             SOME {section, description} => MsgAptQuery {section = section, description = description}
+                           | NONE => 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)
+      | QFirewall {node, user} => MsgFirewall (Firewall.query (node, user))
 
 fun describeQuery q =
     case q of
        QApt pkg => "Requested installation status of package " ^ pkg
+      | QAptExists pkg => "Requested if package " ^ pkg ^ " exists"
       | 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
+      | QFirewall {node, user} => "Asked about firewall rules on " ^ node ^ " 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.serverCert,
-                              Config.serverKey,
+
+       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
-
-                   fun doIt 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)
+           (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 () => ())
+                              | 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 ())
-
-                   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 =
-                               let
-                                   val outf = TextIO.openOut outname
-                               in
-                                   TextIO.output (outf, code);
-                                   TextIO.closeOut outf;
-                                   eval' outname
-                               end
-                       in
-                           doIt (fn () => (Env.pre ();
-                                           app doOne 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;
-                                             ("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 => Acl.query {user = user, class = "domain", value = 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 () => ())
-
-                             | 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 () => ())
-
-                             | MsgCreateDbTable {dbtype, dbname} =>
-                               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 =>
-                                                case #createdb handler {user = user, dbname = dbname} 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 () => ())
-
-                             | 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.")
-                                        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 () => ())
-
-                             | _ =>
-                               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 ())
-                        | e =>
-                          (print "Unknown exception in main loop!\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";
@@ -1418,58 +1663,196 @@ fun slave () =
        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 ^ " 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))
-                                     | _ => (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
-                       case Msg.recv bio of
-                           SOME (MsgQuery q) => (print (describeQuery q ^ "\n");
-                                                 Msg.send (bio, answerQuery q);
-                                                 ignore (OpenSSL.readChar bio);
-                                                 OpenSSL.close bio;
-                                                 loop ())
-                         | _ => (OpenSSL.close bio;
-                                 loop ())
-               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 ())
-                        | 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 ())
+                                         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 () => ())
+                                  | 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 () => ()))
+                                  | MsgFirewallRegen =>
+                                    doIt (fn () => (Acl.read Config.aclFile;
+                                                    if Acl.query {user = user, class = "priv", value = "all"} then
+                                                        if List.exists (fn x => x = host) Config.Firewall.firewallNodes then
+                                                            if (Firewall.generateFirewallConfig (Firewall.parseRules ()) andalso Firewall.publishConfig ())
+                                                            then
+                                                                ("Firewall rules regenerated.", NONE)
+                                                            else
+                                                               ("Rules regeneration failed!", SOME "Script execution failed.")
+                                                       else ("Node not controlled by domtool firewall.", SOME (host))
+                                                    else
+                                                        ("Not authorized to regenerate firewall.", SOME ("Unauthorized user " ^ user ^ " attempted to regenerated firewall"))))
+                                         (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