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

- * Copyright (c) 2006, Adam Chlipala
+ * 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


@@ -20,58 +21,207 @@
 
 structure Vmail :> VMAIL = struct
 
 
 structure Vmail :> VMAIL = struct
 

-fun rebuild () = Slave.shell [Config.Courier.postReload]
+open MsgTypes

 
 

-fun add {domain, requester, user, passwd, mailbox} =
+fun rebuild () =

     let
     let

-       val udb = Posix.SysDB.getpwnam requester
-       val uid = Word.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
-       val gid = Word.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
-       val home = Posix.SysDB.Passwd.home udb
+       fun doNode (site, ok) =
+           (print ("New vmail data for node " ^ site ^ "\n");
+            Connect.commandWorker (Domain.get_context (), site, MsgVmailChanged))

     in
     in

-       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"
+       foldl doNode true Config.mailNodes_all
+    end
+
+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
        else

+           SM.empty
+    end
+
+datatype listing =
+        Error of string
+       | Listing of {user : string, mailbox : string} list
+
+fun list domain =
+    let
+       val file = OS.Path.joinDirFile {dir = Config.Vmail.userDatabase,
+                                       file = domain}
+    in
+       if Posix.FileSys.access (file, []) then

            let
            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
+               val inf = TextIO.openIn file
+
+               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
            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
+               loop []
+               before TextIO.closeIn inf

            end
            end

+       else
+           Listing []

     end
     end

+    handle IO.Io {name, function, ...} =>
+          Error ("IO failure: " ^ name ^ ": " ^ function)

 
 

-fun passwd {domain, user, passwd} =
+fun mailboxExists {domain, user} =
+    let
+       val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Vmail.userDatabase,
+                                                     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 setpassword {domain, user, passwd} =

     let
        val proc = Unix.execute ("/bin/sh", ["-c",
     let
        val proc = Unix.execute ("/bin/sh", ["-c",

-                                            String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
-                                                           " \"", domain, "/", user, "@", domain, "\" set systempw"]])
+                                            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;
        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"
+       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
+       val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
+       val gid = SysWord.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
+       val home = Posix.SysDB.Passwd.home udb
+    in
+       if mailboxExists {domain = domain, user = user} then
+           SOME "Mailbox mapping already exists"
+       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"
+       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
        else if not (rebuild ()) then

-           SOME "Error reloading userdb"
+           (ignore (deluser {domain = domain, user = user});
+            SOME "Error reloading userdb")

        else
            NONE
     end
 
        else
            NONE
     end
 

+fun passwd {domain, user, passwd} =
+    if not (mailboxExists {domain = domain, user = user}) then
+       SOME "Mailbox doesn't exist"
+    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} =
 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 (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"