Better OpenSSL error reporting
[hcoop/domtool2.git] / src / main.sml
index db657da..6644d76 100644 (file)
@@ -1025,411 +1025,426 @@ fun service () =
        val sock = OpenSSL.listen (context, Config.dispatcherPort)
 
        fun loop () =
        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
+
+                    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)
+                         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 () => ())
+
+                              | 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 () => ())
+
+                              | 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 ())
                         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 () => ())
-
-                             | 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 () => ())
-
-                             | 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 ())
+                     | 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";
     in
        print ("Domtool dispatcher starting up at " ^ now () ^ "\n");
        print "Listening for connections....\n";