Check mailbox existence for various vmail commands

diff --git a/Makefile b/Makefile
index 17f3c0d..42d1ccd 100644 (file)
--- 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/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
 
 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 (file)
--- a/src/mail/vmail.sig
+++ b/src/mail/vmail.sig
@@ -28,6 +28,8 @@ signature VMAIL = sig
 
     val list : string -> listing
 
 
     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
 
     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 (file)
--- a/src/mail/vmail.sml
+++ b/src/mail/vmail.sml
@@ -47,6 +47,28 @@ fun list domain =
     end
        handle IO.Io _ => Listing []
 
     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
 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
        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"
                             "\" 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} =
     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} =
 
 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"
        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 (file)
--- 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)
                                                             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 () => ())
                                
                                                              SOME msg))
                                     (fn () => ())
                                


@@ -808,7 +808,7 @@ fun service () =
                                                                passwd = passwd} of
                                                 NONE => ("Changed password of mailbox " ^ emailUser ^ "@" ^ domain,
                                                          NONE)
                                                                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 () => ())
 
                                                              SOME msg))
                                     (fn () => ())
 


@@ -824,7 +824,7 @@ fun service () =
                                             case Vmail.rm {domain = domain, user = emailUser} of
                                                 NONE => ("Deleted mailbox " ^ emailUser ^ "@" ^ domain,
                                                          NONE)
                                             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 () => ())
 
                                                              SOME msg))
                                     (fn () => ())