From: Adam Chlipala <adamc@hcoop.net>
Date: Sat, 23 Dec 2006 21:37:17 +0000 (+0000)
Subject: Check mailbox existence for various vmail commands
X-Git-Tag: release_2010-11-19~277
X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/9ffe2f0fea48f1e2fa6a30b6a79b975b4a6f7671

Check mailbox existence for various vmail commands
---

diff --git a/Makefile b/Makefile
index 17f3c0d..42d1ccd 100644
--- a/Makefile
+++ b/Makefile
@@ -89,7 +89,8 @@ COMMON_MLTON_DEPS := openssl/mlton/FFI/libssl.h.mlb \
 	src/domtool.lex.sml \
 	src/domtool.grm.sig src/domtool.grm.sml \
 	$(COMMON_DEPS) src/*.sig src/*.sml \
-	src/plugins/*.sig src/plugins/*.sml
+	src/plugins/*.sig src/plugins/*.sml \
+	src/mail/*.sig src/mail/*.sml
 
 bin/domtool-server: $(COMMON_MLTON_DEPS) src/domtool-server.mlb 
 	mlton -output bin/domtool-server -link-opt -ldl src/domtool-server.mlb
diff --git a/src/mail/vmail.sig b/src/mail/vmail.sig
index de3e44b..a70e525 100644
--- a/src/mail/vmail.sig
+++ b/src/mail/vmail.sig
@@ -28,6 +28,8 @@ signature VMAIL = sig
 
     val list : string -> listing
 
+    val mailboxExists : {domain : string, user : string} -> bool
+
     val add : {domain : string, requester : string, user : string,
 	       passwd : string, mailbox : string} -> string option
 
diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
index f5010eb..5801cb9 100644
--- a/src/mail/vmail.sml
+++ b/src/mail/vmail.sml
@@ -47,6 +47,28 @@ fun list domain =
     end
 	handle IO.Io _ => Listing []
 
+fun mailboxExists {domain, user} =
+    let
+	val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
+						      file = domain})
+
+	fun loop () =
+	    case TextIO.inputLine inf of
+		NONE => false
+	      | SOME line =>
+		case String.tokens Char.isSpace line of
+		    [addr, _] =>
+		    (case String.fields (fn ch => ch = #"@") addr of
+			 [user', _] =>
+			 user' = user orelse loop ()
+		       | _ => false)
+		  | _ => false
+    in
+	loop ()
+	before TextIO.closeIn inf
+    end
+	handle IO.Io _ => false
+
 fun add {domain, requester, user, passwd, mailbox} =
     let
 	val udb = Posix.SysDB.getpwnam requester
@@ -54,7 +76,9 @@ fun add {domain, requester, user, passwd, mailbox} =
 	val gid = Word.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
 	val home = Posix.SysDB.Passwd.home udb
     in
-	if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain,
+	if mailboxExists {domain = domain, user = user} then
+	    SOME "Mailbox mapping already exists"
+	else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain,
 			     "\" set home=", home, " mail=", mailbox,
 			     " uid=", Int.toString uid, " gid=" ^ Int.toString gid]) then
 	    SOME "Error running userdb"
@@ -79,24 +103,28 @@ fun add {domain, requester, user, passwd, mailbox} =
     end
 
 fun passwd {domain, user, passwd} =
-    let
-	val proc = Unix.execute ("/bin/sh", ["-c",
-					     String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
-							    " \"", domain, "/", user, "@", domain, "\" set systempw"]])
-	val outf = Unix.textOutstreamOf proc
-    in
-	TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
-	TextIO.closeOut outf;
-	if not (OS.Process.isSuccess (Unix.reap proc)) then
-	    SOME "Error setting password"
-	else if not (rebuild ()) then
-	    SOME "Error reloading userdb"
-	else
-	    NONE
-    end
+    if not (mailboxExists {domain = domain, user = user}) then
+	SOME "Mailbox doesn't exist"
+    else let
+	    val proc = Unix.execute ("/bin/sh", ["-c",
+						 String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
+								" \"", domain, "/", user, "@", domain, "\" set systempw"]])
+	    val outf = Unix.textOutstreamOf proc
+	in
+	    TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
+	    TextIO.closeOut outf;
+	    if not (OS.Process.isSuccess (Unix.reap proc)) then
+		SOME "Error setting password"
+	    else if not (rebuild ()) then
+		SOME "Error reloading userdb"
+	    else
+		NONE
+	end
 
 fun rm {domain, user} =
-    if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]) then
+    if not (mailboxExists {domain = domain, user = user}) then
+	SOME "Mailbox doesn't exist"
+    else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]) then
 	SOME "Error deleting password entry"
     else if not (rebuild ()) then
 	SOME "Error reloading userdb"
diff --git a/src/main.sml b/src/main.sml
index 23cedce..4fe8124 100644
--- a/src/main.sml
+++ b/src/main.sml
@@ -788,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 () => ())
 				
@@ -808,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 () => ())
 
@@ -824,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 () => ())