setsa

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

diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
index a1f8648..39566dd 100644 (file)
--- a/src/mail/vmail.sml
+++ b/src/mail/vmail.sml
@@ -22,6 +22,62 @@ structure Vmail :> VMAIL = struct
 
 fun rebuild () = Slave.shell [Config.Courier.postReload]
 
 
 fun rebuild () = Slave.shell [Config.Courier.postReload]
 

+datatype listing =
+        Error of string
+       | Listing of {user : string, mailbox : string} list
+
+fun list domain =
+    let
+       val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
+                                                     file = domain})
+
+       fun loop users =
+           case TextIO.inputLine inf of
+               NONE => Listing (rev users)
+             | SOME line =>
+               case String.tokens Char.isSpace line of
+                   [addr, fields] =>
+                   (case String.fields (fn ch => ch = #"@") addr of
+                        [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
+       loop []
+       before TextIO.closeIn inf
+    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


@@ -29,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"


@@ -54,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"