smtplog

[hcoop/domtool2.git] / src / main.sml

diff --git a/src/main.sml b/src/main.sml
index 91ae29e..f9b2c9f 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -386,6 +386,151 @@ fun requestRmuser user =
        OpenSSL.close bio
     end
 
        OpenSSL.close bio
     end
 

+fun requestDbUser dbtype =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgCreateDbUser dbtype);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print "Your user has been created.\n"
+             | MsgError s => print ("Creation failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
+fun requestDbTable p =
+    let
+       val (user, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgCreateDbTable p);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print ("Your database " ^ user ^ "_" ^ #dbname p ^ " has been created.\n")
+             | MsgError s => print ("Creation failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
+fun requestListMailboxes domain =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgListMailboxes domain);
+       (case Msg.recv bio of
+            NONE => Vmail.Error "Server closed connection unexpectedly."
+          | SOME m =>
+            case m of
+                MsgMailboxes users => (Msg.send (bio, MsgOk);
+                                       Vmail.Listing users)
+              | MsgError s => Vmail.Error ("Creation failed: " ^ s)
+              | _ => Vmail.Error "Unexpected server reply.")
+       before OpenSSL.close bio
+    end
+
+fun requestNewMailbox p =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgNewMailbox p);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print ("A mapping for " ^ #user p ^ "@" ^ #domain p ^ " has been created.\n")
+             | MsgError s => print ("Creation failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
+fun requestPasswdMailbox p =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgPasswdMailbox p);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print ("The password for " ^ #user p ^ "@" ^ #domain p ^ " has been changed.\n")
+             | MsgError s => print ("Set failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
+fun requestRmMailbox p =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgRmMailbox p);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print ("The mapping for mailbox " ^ #user p ^ "@" ^ #domain p ^ " has been deleted.\n")
+             | MsgError s => print ("Remove failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
+fun requestSaQuery addr =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgSaQuery addr);
+       (case Msg.recv bio of
+            NONE => print "Server closed connection unexpectedly.\n"
+          | SOME m =>
+            case m of
+                MsgSaStatus b => (print ("SpamAssassin filtering for " ^ addr ^ " is "
+                                         ^ (if b then "ON" else "OFF") ^ ".\n");
+                                  Msg.send (bio, MsgOk))
+              | MsgError s => print ("Query failed: " ^ s ^ "\n")
+              | _ => print "Unexpected server reply.\n")
+       before OpenSSL.close bio
+    end
+
+fun requestSaSet p =
+    let
+       val (_, bio) = requestBio (fn () => ())
+    in
+       Msg.send (bio, MsgSaSet p);
+       case Msg.recv bio of
+           NONE => print "Server closed connection unexpectedly.\n"
+         | SOME m =>
+           case m of
+               MsgOk => print ("SpamAssassin filtering for " ^ #1 p ^ " is now "
+                               ^ (if #2 p then "ON" else "OFF") ^ ".\n")
+             | MsgError s => print ("Set failed: " ^ s ^ "\n")
+             | _ => print "Unexpected server reply.\n";
+       OpenSSL.close bio
+    end
+
+fun requestSmtpLog domain =
+    let
+       val (_, bio) = requestBio (fn () => ())
+
+       val _ = Msg.send (bio, MsgSmtpLogReq domain)
+
+       fun loop () =
+           case Msg.recv bio of
+               NONE => print "Server closed connection unexpectedly.\n"
+             | SOME m =>
+               case m of
+                   MsgOk => ()
+                 | MsgSmtpLogRes line => (print line;
+                                          loop ())
+                 | MsgError s => print ("Log search failed: " ^ s ^ "\n")
+                 | _ => print "Unexpected server reply.\n"
+    in
+       loop ();
+       OpenSSL.close bio
+    end
+

 fun regenerate context =
     let
        val b = basis ()
 fun regenerate context =
     let
        val b = basis ()


@@ -486,6 +631,40 @@ fun service () =
                    val () = print ("\nConnection from " ^ user ^ "\n")
                    val () = Domain.setUser user
 
                    val () = print ("\nConnection from " ^ user ^ "\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 OpenSSL.OpenSSL _ =>
+                               print "OpenSSL error\n"
+                             | 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"
                    fun doConfig codes =
                        let
                            val _ = print "Configuration:\n"


@@ -503,27 +682,28 @@ fun service () =
                                    eval' outname
                                end
                        in
                                    eval' outname
                                end
                        in

-                           (Env.pre ();
-                            app doOne codes;
-                            Env.post ();
-                            Msg.send (bio, MsgOk))
-                           handle ErrorMsg.Error =>
-                                  (print "Compilation error\n";
-                                   Msg.send (bio,
-                                             MsgError "Error during configuration evaluation"))
-                                | OpenSSL.OpenSSL s =>
-                                  (print "OpenSSL error\n";
-                                   Msg.send (bio,
-                                             MsgError
-                                                 ("Error during configuration evaluation: "
-                                                  ^ s)));
-                          OS.FileSys.remove outname;
-                          (ignore (OpenSSL.readChar bio);
-                           OpenSSL.close bio)
-                          handle OpenSSL.OpenSSL _ => ();
-                          loop ()
+                           doIt (fn () => (Env.pre ();
+                                           app doOne codes;
+                                           Env.post ();
+                                           Msg.send (bio, MsgOk);
+                                           ("Configuration complete.", NONE)))
+                                (fn () => OS.FileSys.remove outname)

                        end
 
                        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
                    fun cmdLoop () =
                        case Msg.recv bio of
                            NONE => (OpenSSL.close bio


@@ -535,162 +715,225 @@ fun service () =
                              | MsgMultiConfig codes => doConfig codes
 
                              | MsgGrant acl =>
                              | MsgMultiConfig codes => doConfig codes
 
                              | MsgGrant acl =>

-                               if Acl.query {user = user, class = "priv", value = "all"} then
-                                   ((Acl.grant acl;
-                                     Acl.write Config.aclFile;
-                                     Msg.send (bio, MsgOk);
-                                     print ("Granted permission " ^ #value acl ^ " to " ^ #user acl ^ " in " ^ #class acl ^ ".\n"))
-                                    handle OpenSSL.OpenSSL s =>
-                                           (print "OpenSSL error\n";
-                                            Msg.send (bio,
-                                                      MsgError
-                                                          ("Error during granting: "
-                                                           ^ s)));
-                                   (ignore (OpenSSL.readChar bio);
-                                    OpenSSL.close bio)
-                                   handle OpenSSL.OpenSSL _ => ();
-                                   loop ())
-                               else
-                                   ((Msg.send (bio, MsgError "Not authorized to grant privileges");
-                                     print "Unauthorized user asked to grant a permission!\n";
-                                     ignore (OpenSSL.readChar bio);
-                                     OpenSSL.close bio)
-                                    handle OpenSSL.OpenSSL _ => ();
-                                    loop ())
-
+                               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 =>
                              | MsgRevoke acl =>

-                               if Acl.query {user = user, class = "priv", value = "all"} then
-                                   ((Acl.revoke acl;
-                                     Acl.write Config.aclFile;
-                                     Msg.send (bio, MsgOk);
-                                     print ("Revoked permission " ^ #value acl ^ " from " ^ #user acl ^ " in " ^ #class acl ^ ".\n"))
-                                    handle OpenSSL.OpenSSL s =>
-                                           (print "OpenSSL error\n";
-                                            Msg.send (bio,
-                                                      MsgError
-                                                          ("Error during revocation: "
-                                                           ^ s)));
-                                   (ignore (OpenSSL.readChar bio);
-                                    OpenSSL.close bio)
-                                   handle OpenSSL.OpenSSL _ => ();
-                                   loop ())
-                               else
-                                   ((Msg.send (bio, MsgError "Not authorized to revoke privileges");
-                                     print "Unauthorized user asked to revoke a permission!\n";
-                                     ignore (OpenSSL.readChar bio);
-                                     OpenSSL.close bio)
-                                    handle OpenSSL.OpenSSL _ => ();
-                                    loop ())
+                               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 =>
 
                              | MsgListPerms user =>

-                               ((Msg.send (bio, MsgPerms (Acl.queryAll user));
-                                 print ("Sent permission list for user " ^ user ^ ".\n"))
-                                handle OpenSSL.OpenSSL s =>
-                                       (print "OpenSSL error\n";
-                                        Msg.send (bio,
-                                                  MsgError
-                                                      ("Error during permission listing: "
-                                                       ^ s)));
-                               (ignore (OpenSSL.readChar bio);
-                                OpenSSL.close bio)
-                               handle OpenSSL.OpenSSL _ => ();
-                               loop ())
+                               doIt (fn () =>
+                                        (Msg.send (bio, MsgPerms (Acl.queryAll user));
+                                         ("Sent permission list for user " ^ user ^ ".",
+                                          NONE)))
+                                    (fn () => ())

 
                              | MsgWhoHas perm =>
 
                              | MsgWhoHas perm =>

-                               ((Msg.send (bio, MsgWhoHasResponse (Acl.whoHas perm));
-                                 print ("Sent whohas response for " ^ #class perm ^ " / " ^ #value perm ^ ".\n"))
-                                handle OpenSSL.OpenSSL s =>
-                                       (print "OpenSSL error\n";
-                                        Msg.send (bio,
-                                                  MsgError
-                                                      ("Error during whohas: "
-                                                       ^ s)));
-                               (ignore (OpenSSL.readChar bio);
-                                OpenSSL.close bio)
-                               handle OpenSSL.OpenSSL _ => ();
-                               loop ())
+                               doIt (fn () =>
+                                        (Msg.send (bio, MsgWhoHasResponse (Acl.whoHas perm));
+                                         ("Sent whohas response for " ^ #class perm ^ " / " ^ #value perm ^ ".",
+                                          NONE)))
+                                    (fn () => ())

 
                              | MsgRmdom doms =>
 
                              | MsgRmdom doms =>

-                               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;
-                                     Msg.send (bio, MsgOk);
-                                     print ("Removed domains" ^ foldl (fn (d, s) => s ^ " " ^ d) "" doms ^ ".\n"))
-                                    handle OpenSSL.OpenSSL s =>
-                                           (print "OpenSSL error\n";
-                                            Msg.send (bio,
-                                                      MsgError
-                                                          ("Error during revocation: "
-                                                           ^ s)));
-                                   (ignore (OpenSSL.readChar bio);
-                                    OpenSSL.close bio)
-                                   handle OpenSSL.OpenSSL _ => ();
-                                   loop ())
-                               else
-                                   ((Msg.send (bio, MsgError "Not authorized to remove that domain");
-                                     print "Unauthorized user asked to remove a domain!\n";
-                                     ignore (OpenSSL.readChar bio);
-                                     OpenSSL.close bio)
-                                    handle OpenSSL.OpenSSL _ => ();
-                                    loop ())
+                               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 =>
 
                              | MsgRegenerate =>

-                               if Acl.query {user = user, class = "priv", value = "regen"}
-                                  orelse Acl.query {user = user, class = "priv", value = "all"} then
-                                   ((regenerate context;
-                                     Msg.send (bio, MsgOk);
-                                     print "Regenerated all configuration.\n")
-                                    handle OpenSSL.OpenSSL s =>
-                                           (print "OpenSSL error\n";
-                                            Msg.send (bio,
-                                                      MsgError
-                                                          ("Error during regeneration: "
-                                                           ^ s)));
-                                   (ignore (OpenSSL.readChar bio);
-                                    OpenSSL.close bio)
-                                   handle OpenSSL.OpenSSL _ => ();
-                                   loop ())
-                               else
-                                   ((Msg.send (bio, MsgError "Not authorized to regeneration");
-                                     print "Unauthorized user asked to regenerate!\n";
-                                     ignore (OpenSSL.readChar bio);
-                                     OpenSSL.close bio)
-                                    handle OpenSSL.OpenSSL _ => ();
-                                    loop ())
+                               doIt (fn () =>
+                                        if Acl.query {user = user, class = "priv", value = "regen"}
+                                           orelse Acl.query {user = user, class = "priv", value = "all"} then
+                                            (regenerate context;
+                                             ("Regenerated all configuration.",
+                                              NONE))
+                                        else
+                                            ("Unauthorized user asked to regenerate!",
+                                             SOME "Not authorized to regenerate"))
+                                    (fn () => ())

 
                              | MsgRmuser user' =>
 
                              | MsgRmuser user' =>

-                               if Acl.query {user = user, class = "priv", value = "all"} then
-                                   ((rmuser user';
-                                     Acl.write Config.aclFile;
-                                     Msg.send (bio, MsgOk);
-                                     print ("Removed user " ^ user' ^ ".\n"))
-                                    handle OpenSSL.OpenSSL s =>
-                                           (print "OpenSSL error\n";
-                                            Msg.send (bio,
-                                                      MsgError
-                                                          ("Error during revocation: "
-                                                           ^ s)));
-                                   (ignore (OpenSSL.readChar bio);
-                                    OpenSSL.close bio)
-                                   handle OpenSSL.OpenSSL _ => ();
-                                   loop ())
-                               else
-                                   ((Msg.send (bio, MsgError "Not authorized to remove users");
-                                     print "Unauthorized user asked to remove a user!\n";
-                                     ignore (OpenSSL.readChar bio);
-                                     OpenSSL.close bio)
-                                    handle OpenSSL.OpenSSL _ => ();
-                                    loop ())                           
+                               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 () => ())
+
+                             | 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 () => ())

 
                              | _ =>
 
                              | _ =>

-                               (Msg.send (bio, MsgError "Unexpected command")
-                                handle OpenSSL.OpenSSL _ => ();
-                                OpenSSL.close bio
-                                handle OpenSSL.OpenSSL _ => ();
-                                loop ())
+                               doIt (fn () => ("Unexpected command",
+                                               SOME "Unexpected command"))
+                                    (fn () => ())

                in
                    cmdLoop ()
                end
                in
                    cmdLoop ()
                end


@@ -766,7 +1009,7 @@ fun slave () =
        OpenSSL.shutdown sock
     end
 
        OpenSSL.shutdown sock
     end
 

-fun autodocBasis outdir =
+fun listBasis () =

     let
        val dir = Posix.FileSys.opendir Config.libRoot
 
     let
        val dir = Posix.FileSys.opendir Config.libRoot
 


@@ -781,10 +1024,11 @@ fun autodocBasis outdir =
                          :: files)
                else
                    loop files
                          :: files)
                else
                    loop files

-
-       val files = loop []

     in
     in

-       Autodoc.autodoc {outdir = outdir, infiles = files}
+       loop []

     end
 
     end
 

+fun autodocBasis outdir =
+    Autodoc.autodoc {outdir = outdir, infiles = listBasis ()}
+

 end
 end