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 48d2287..0594fb1 100644 (file)
--- a/src/mail/vmail.sml
+++ b/src/mail/vmail.sml
@@ -1,5 +1,6 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
  * Copyright (c) 2006-2009, Adam Chlipala
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
  * Copyright (c) 2006-2009, Adam Chlipala

+ * Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>

  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License


@@ -26,39 +27,50 @@ fun rebuild () =
     let
        fun doNode (site, ok) =
            (print ("New vmail data for node " ^ site ^ "\n");
     let
        fun doNode (site, ok) =
            (print ("New vmail data for node " ^ site ^ "\n");

-            if site = Config.dispatcherName then
-                Slave.shell [Config.Courier.postReload] andalso ok
-            else let
-                    val bio = OpenSSL.connect true (Domain.get_context (),
-                                                    Domain.nodeIp site
-                                                    ^ ":"
-                                                    ^ Int.toString Config.slavePort)
-                in
-                    Msg.send (bio, MsgVmailChanged);
-                    (case Msg.recv bio of
-                         NONE => (print "Slave closed connection unexpectedly\n";
-                                  false)
-                       | SOME m =>
-                         case m of
-                             MsgOk => (print ("Slave " ^ site ^ " finished\n");
-                                       ok)
-                           | MsgError s => (print ("Slave " ^ site
-                                                   ^ " returned error: " ^
-                                                   s ^ "\n");
-                                            false)
-                           | _ => (print ("Slave " ^ site
-                                          ^ " returned unexpected command\n");
-                                   false))
-                    before OpenSSL.close bio
-                end)
+            Connect.commandWorker (Domain.get_context (), site, MsgVmailChanged))

     in
     in

-       Slave.shell [Config.Courier.pushUserdb]
-       andalso foldl doNode true Config.mailNodes_all
+       foldl doNode true Config.mailNodes_all

     end
 
 fun doChanged () =
     end
 
 fun doChanged () =

-    Slave.shell [Config.Courier.pullUserdb]
-    andalso Slave.shell [Config.Courier.postReload]
+    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
 
 datatype listing =
         Error of string


@@ -66,7 +78,7 @@ datatype listing =
 
 fun list domain =
     let
 
 fun list domain =
     let

-       val file = OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
+       val file = OS.Path.joinDirFile {dir = Config.Vmail.userDatabase,

                                        file = domain}
     in
        if Posix.FileSys.access (file, []) then
                                        file = domain}
     in
        if Posix.FileSys.access (file, []) then


@@ -104,7 +116,7 @@ fun list domain =
 
 fun mailboxExists {domain, user} =
     let
 
 fun mailboxExists {domain, user} =
     let

-       val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
+       val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Vmail.userDatabase,

                                                      file = domain})
 
        fun loop () =
                                                      file = domain})
 
        fun loop () =


@@ -124,6 +136,42 @@ fun mailboxExists {domain, user} =
     end
        handle IO.Io _ => false
 
     end
        handle IO.Io _ => false
 

+fun setpassword {domain, user, passwd} =
+    let
+       val proc = Unix.execute ("/bin/sh", ["-c",
+                                            String.concat [Config.Vmail.userdbpw, " | ", Config.Vmail.userdb,
+                                                           " -f ", Config.Vmail.userDatabase, "/", domain,
+                                                           " \"", user, "@", domain, "\" set systempw"]])
+       val outf = Unix.textOutstreamOf proc
+    in
+       TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
+       TextIO.closeOut outf;
+       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"])
+

 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


@@ -133,53 +181,47 @@ fun add {domain, requester, user, passwd, mailbox} =
     in
        if mailboxExists {domain = domain, user = user} then
            SOME "Mailbox mapping already exists"
     in
        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
+       else if not (Slave.run (Config.Vmail.userdb, ["-f", Config.Vmail.userDatabase ^ "/" ^ domain,
+                                                     user ^ "@" ^ domain,
+                                                     "set", "home=" ^ home, "mail=" ^ mailbox, "uid=" ^ Int.toString uid, "gid=" ^ Int.toString gid])) then

            SOME "Error running userdb"
            SOME "Error running userdb"

+       else if not (setpassword {domain = domain, user = user, passwd = passwd}) then
+           (ignore (deluser {domain = domain, user = user});
+            SOME "Error setting password")
+       else if not (rebuild ()) then
+           (ignore (deluser {domain = domain, user = user});
+            SOME "Error reloading userdb")

        else
        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
-                   (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
-                    SOME "Error setting password")
-               else if not (rebuild ()) then
-                   (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
-                    SOME "Error reloading userdb")
-               else
-                   NONE
-           end
+           NONE

     end
 
 fun passwd {domain, user, passwd} =
     if not (mailboxExists {domain = domain, user = user}) then
        SOME "Mailbox doesn't exist"
     end
 
 fun passwd {domain, user, passwd} =
     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
+    else  if not (setpassword {domain = domain, user = user, passwd = passwd}) then
+       SOME "Error setting password"
+    else if not (rebuild ()) then
+       SOME "Error reloading userdb"
+    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"
 
 fun rm {domain, user} =
     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
+    else if not (deluser {domain = domain, user = user}) 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"