X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/0868840155aca9662f97318b114a07ae4c8319d6..9ffe2f0fea48f1e2fa6a30b6a79b975b4a6f7671:/src/main.sml?ds=sidebyside

diff --git a/src/main.sml b/src/main.sml
index 5025cb2..4fe8124 100644
--- 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
@@ -758,7 +788,7 @@ fun service () =
 							     passwd = passwd, mailbox = mailbox} of
 						 NONE => ("Added mailbox " ^ emailUser ^ "@" ^ domain ^ " at " ^ mailbox,
 							  NONE)
-					       | SOME msg => ("Error adding mailbox: " ^ msg,
+					       | SOME msg => ("Error adding mailbox " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
 							      SOME msg))
 				     (fn () => ())
 				
@@ -778,7 +808,7 @@ fun service () =
 								passwd = passwd} of
 						 NONE => ("Changed password of mailbox " ^ emailUser ^ "@" ^ domain,
 							  NONE)
-					       | SOME msg => ("Error changing mailbox password: " ^ msg,
+					       | SOME msg => ("Error changing mailbox password for " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
 							      SOME msg))
 				     (fn () => ())
 
@@ -794,7 +824,7 @@ fun service () =
 					     case Vmail.rm {domain = domain, user = emailUser} of
 						 NONE => ("Deleted mailbox " ^ emailUser ^ "@" ^ domain,
 							  NONE)
-					       | SOME msg => ("Error deleting mailbox: " ^ msg,
+					       | SOME msg => ("Error deleting mailbox " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
 							      SOME msg))
 				     (fn () => ())