Add vmail command for changing password when you know the current password

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

diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
index 8e92f60..0594fb1 100644 (file)
--- a/src/mail/vmail.sml
+++ b/src/mail/vmail.sml
@@ -35,6 +35,43 @@ fun rebuild () =
 fun doChanged () =
     Slave.shell [Config.Courier.postReload]
 
+
+structure SM = DataStructures.StringMap
+
+exception Userdb of string
+
+fun readUserdb domain =
+    let
+       val file = OS.Path.joinDirFile {dir = Config.Vmail.userDatabase,
+                                       file = domain}
+    in
+       if Posix.FileSys.access (file, []) then
+           let
+               val inf = TextIO.openIn file
+
+               fun parseField (field, fields) =
+                   case String.fields (fn ch => ch = #"=") field of
+                       [key, value] => SM.insert (fields, key, value)
+                     | _ => raise Userdb ("Malformed fields in vmail userdb for domain " ^ domain)
+
+               fun loop users =
+                   case TextIO.inputLine inf of
+                       NONE => users
+                     | SOME line =>
+                       case String.tokens Char.isSpace line of
+                           [addr, fields] => (case String.fields (fn ch => ch = #"@") addr of
+                                                  [user, _] =>
+                                                  loop (SM.insert (users, user, foldl parseField SM.empty (String.fields (fn ch => ch = #"|") fields)))
+                                                | _ => raise Userdb ("Malformed address in vmail userdb for " ^ domain ^ ": " ^ addr))
+                         | _ => raise Userdb ("Malformed record in vmail userdb for domain " ^ domain)
+           in
+               loop SM.empty
+               before TextIO.closeIn inf
+           end
+       else
+           SM.empty
+    end
+
 datatype listing =
         Error of string
        | Listing of {user : string, mailbox : string} list
@@ -112,6 +149,25 @@ fun setpassword {domain, user, passwd} =
        OS.Process.isSuccess (Unix.reap proc)
     end
 
+
+fun checkpassword {domain, user, passwd} =
+    let
+       val proc = Unix.execute (Config.installPrefix ^ "/sbin/domtool-vmailpasswd", [])
+       val outf = Unix.textOutstreamOf proc
+       val db = readUserdb domain
+    in
+       case SM.find (db, user) of
+           SOME fields =>
+           (case SM.find (fields, "systempw") of
+                SOME systempw =>
+                (TextIO.output (outf, systempw ^ "\n");
+                 TextIO.output (outf, passwd ^ "\n");
+                 TextIO.closeOut outf;
+                 OS.Process.isSuccess (Unix.reap proc))
+              | NONE => raise Userdb ("systempw not found for user " ^ user ^ "@" ^ domain))
+           | NONE => raise Userdb ("User " ^ user ^ " not found in vmail userdb for domain " ^ domain)
+    end
+
 fun deluser {domain, user} =
     Slave.run (Config.Vmail.userdb, ["-f", Config.Vmail.userDatabase ^ "/" ^ domain,
                                     user ^ "@" ^ domain, "del"])
@@ -149,6 +205,19 @@ fun passwd {domain, user, passwd} =
     else
        NONE
 
+fun portalpasswd {domain, user, oldpasswd, newpasswd} =
+    (if not (mailboxExists {domain = domain, user = user}) then
+        SOME "Mailbox doesn't exist"
+     else if not (checkpassword {domain = domain, user = user, passwd = oldpasswd}) then
+        SOME "Old password incorrect"
+     else  if not (setpassword {domain = domain, user = user, passwd = newpasswd}) then
+        SOME "Error setting password"
+     else if not (rebuild ()) then
+        SOME "Error reloading userdb"
+     else
+        NONE)
+    handle Userdb errmsg => SOME ("userdb error: " ^ errmsg)
+
 fun rm {domain, user} =
     if not (mailboxExists {domain = domain, user = user}) then
        SOME "Mailbox doesn't exist"