First vmail support
[hcoop/domtool2.git] / src / mail / vmail.sml
CommitLineData
08688401
AC
1(* HCoop Domtool (http://hcoop.sourceforge.net/)
2 * Copyright (c) 2006, Adam Chlipala
3 *
4 * This program is free software; you can redistribute it and/or
5 * modify it under the terms of the GNU General Public License
6 * as published by the Free Software Foundation; either version 2
7 * of the License, or (at your option) any later version.
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
17 *)
18
19(* Administration of Courier IMAP virtual mailboxes *)
20
21structure Vmail :> VMAIL = struct
22
23fun rebuild () = Slave.shell [Config.Courier.postReload]
24
25fun add {domain, requester, user, passwd, mailbox} =
26 let
27 val udb = Posix.SysDB.getpwnam requester
28 val uid = Word.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
29 val gid = Word.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
30 val home = Posix.SysDB.Passwd.home udb
31 in
32 if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain,
33 "\" set home=", home, " mail=", mailbox,
34 " uid=", Int.toString uid, " gid=" ^ Int.toString gid]) then
35 SOME "Error running userdb"
36 else
37 let
38 val proc = Unix.execute ("/bin/sh", ["-c",
39 String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
40 " \"", domain, "/", user, "@", domain, "\" set systempw"]])
41 val outf = Unix.textOutstreamOf proc
42 in
43 TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
44 TextIO.closeOut outf;
45 if not (OS.Process.isSuccess (Unix.reap proc)) then
46 (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
47 SOME "Error setting password")
48 else if not (rebuild ()) then
49 (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
50 SOME "Error reloading userdb")
51 else
52 NONE
53 end
54 end
55
56fun passwd {domain, user, passwd} =
57 let
58 val proc = Unix.execute ("/bin/sh", ["-c",
59 String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
60 " \"", domain, "/", user, "@", domain, "\" set systempw"]])
61 val outf = Unix.textOutstreamOf proc
62 in
63 TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
64 TextIO.closeOut outf;
65 if not (OS.Process.isSuccess (Unix.reap proc)) then
66 SOME "Error setting password"
67 else if not (rebuild ()) then
68 SOME "Error reloading userdb"
69 else
70 NONE
71 end
72
73fun rm {domain, user} =
74 if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]) then
75 SOME "Error deleting password entry"
76 else if not (rebuild ()) then
77 SOME "Error reloading userdb"
78 else
79 NONE
80
81end