Check mailbox existence for various vmail commands
[hcoop/domtool2.git] / src / mail / vmail.sml
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
21 structure Vmail :> VMAIL = struct
22
23 fun rebuild () = Slave.shell [Config.Courier.postReload]
24
25 datatype listing =
26 Error of string
27 | Listing of string list
28
29 fun list domain =
30 let
31 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
32 file = domain})
33
34 fun loop users =
35 case TextIO.inputLine inf of
36 NONE => Listing (rev users)
37 | SOME line =>
38 case String.tokens Char.isSpace line of
39 [addr, _] =>
40 (case String.fields (fn ch => ch = #"@") addr of
41 [user, _] => loop (user :: users)
42 | _ => Error "Invalid e-mail address format in database")
43 | _ => Error "Invalid entry in database"
44 in
45 loop []
46 before TextIO.closeIn inf
47 end
48 handle IO.Io _ => Listing []
49
50 fun mailboxExists {domain, user} =
51 let
52 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
53 file = domain})
54
55 fun loop () =
56 case TextIO.inputLine inf of
57 NONE => false
58 | SOME line =>
59 case String.tokens Char.isSpace line of
60 [addr, _] =>
61 (case String.fields (fn ch => ch = #"@") addr of
62 [user', _] =>
63 user' = user orelse loop ()
64 | _ => false)
65 | _ => false
66 in
67 loop ()
68 before TextIO.closeIn inf
69 end
70 handle IO.Io _ => false
71
72 fun add {domain, requester, user, passwd, mailbox} =
73 let
74 val udb = Posix.SysDB.getpwnam requester
75 val uid = Word.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
76 val gid = Word.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
77 val home = Posix.SysDB.Passwd.home udb
78 in
79 if mailboxExists {domain = domain, user = user} then
80 SOME "Mailbox mapping already exists"
81 else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain,
82 "\" set home=", home, " mail=", mailbox,
83 " uid=", Int.toString uid, " gid=" ^ Int.toString gid]) then
84 SOME "Error running userdb"
85 else
86 let
87 val proc = Unix.execute ("/bin/sh", ["-c",
88 String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
89 " \"", domain, "/", user, "@", domain, "\" set systempw"]])
90 val outf = Unix.textOutstreamOf proc
91 in
92 TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
93 TextIO.closeOut outf;
94 if not (OS.Process.isSuccess (Unix.reap proc)) then
95 (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
96 SOME "Error setting password")
97 else if not (rebuild ()) then
98 (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
99 SOME "Error reloading userdb")
100 else
101 NONE
102 end
103 end
104
105 fun passwd {domain, user, passwd} =
106 if not (mailboxExists {domain = domain, user = user}) then
107 SOME "Mailbox doesn't exist"
108 else let
109 val proc = Unix.execute ("/bin/sh", ["-c",
110 String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
111 " \"", domain, "/", user, "@", domain, "\" set systempw"]])
112 val outf = Unix.textOutstreamOf proc
113 in
114 TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
115 TextIO.closeOut outf;
116 if not (OS.Process.isSuccess (Unix.reap proc)) then
117 SOME "Error setting password"
118 else if not (rebuild ()) then
119 SOME "Error reloading userdb"
120 else
121 NONE
122 end
123
124 fun rm {domain, user} =
125 if not (mailboxExists {domain = domain, user = user}) then
126 SOME "Mailbox doesn't exist"
127 else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]) then
128 SOME "Error deleting password entry"
129 else if not (rebuild ()) then
130 SOME "Error reloading userdb"
131 else
132 NONE
133
134 end