First vmail support

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

diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
new file mode 100644 (file)
index 0000000..a1f8648
--- /dev/null
+++ b/src/mail/vmail.sml
@@ -0,0 +1,81 @@
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
+ *)
+
+(* Administration of Courier IMAP virtual mailboxes *)
+
+structure Vmail :> VMAIL = struct
+
+fun rebuild () = Slave.shell [Config.Courier.postReload]
+
+fun add {domain, requester, user, passwd, mailbox} =
+    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
+    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"
+       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
+    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
+
+fun rm {domain, user} =
+    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"
+    else
+       NONE
+
+end