Listing vmail mailboxes

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

diff --git a/src/main.sml b/src/main.sml
index 5025cb2..23cedce 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -416,6 +416,22 @@ fun requestDbTable p =
        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.\n"
+          | 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.\n")
+       before OpenSSL.close bio
+    end
+
 fun requestNewMailbox p =
     let
        val (_, bio) = requestBio (fn () => ())
@@ -738,6 +754,20 @@ fun service () =
                                              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