Printing mailbox locations for vmail list

[hcoop/domtool2.git] / src / mail / vmail.sml

diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
index f5010eb..39566dd 100644 (file)
--- a/src/mail/vmail.sml
+++ b/src/mail/vmail.sml
@@ -24,7 +24,7 @@ fun rebuild () = Slave.shell [Config.Courier.postReload]
 
 datatype listing =
         Error of string
 
 datatype listing =
         Error of string

-       | Listing of string list
+       | Listing of {user : string, mailbox : string} list

 
 fun list domain =
     let
 
 fun list domain =
     let


@@ -36,9 +36,18 @@ fun list domain =
                NONE => Listing (rev users)
              | SOME line =>
                case String.tokens Char.isSpace line of
                NONE => Listing (rev users)
              | SOME line =>
                case String.tokens Char.isSpace line of

-                   [addr, _] =>
+                   [addr, fields] =>

                    (case String.fields (fn ch => ch = #"@") addr of
                    (case String.fields (fn ch => ch = #"@") addr of

-                        [user, _] => loop (user :: users)
+                        [user, _] =>
+                        let
+                            fun parseFields fields =
+                                case fields of
+                                    "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users)
+                                  | _ :: _ :: rest => parseFields rest
+                                  | _ => Error "Invalid fields in database"
+                        in
+                            parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields)
+                        end

                       | _ => Error "Invalid e-mail address format in database")
                  | _ => Error "Invalid entry in database"
     in
                       | _ => Error "Invalid e-mail address format in database")
                  | _ => Error "Invalid entry in database"
     in


@@ -47,6 +56,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 +85,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 +112,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"