Disentangle vmail from the mail node, Prepare for dovecot support
[hcoop/domtool2.git] / src / mail / vmail.sml
CommitLineData
08688401 1(* HCoop Domtool (http://hcoop.sourceforge.net/)
9b8c6dc8 2 * Copyright (c) 2006-2009, Adam Chlipala
8ca17b9a 3 * Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>
08688401
AC
4 *
5 * This program is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU General Public License
7 * as published by the Free Software Foundation; either version 2
8 * of the License, or (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18 *)
19
20(* Administration of Courier IMAP virtual mailboxes *)
21
22structure Vmail :> VMAIL = struct
23
9b8c6dc8
AC
24open MsgTypes
25
26fun rebuild () =
27 let
28 fun doNode (site, ok) =
29 (print ("New vmail data for node " ^ site ^ "\n");
8ca17b9a 30 Connect.commandWorker (Domain.get_context (), site, MsgVmailChanged))
9b8c6dc8 31 in
8ca17b9a 32 foldl doNode true Config.mailNodes_all
9b8c6dc8
AC
33 end
34
35fun doChanged () =
8ca17b9a 36 Slave.shell [Config.Courier.postReload]
08688401 37
1d3ef80e
AC
38datatype listing =
39 Error of string
2fc6b0dd 40 | Listing of {user : string, mailbox : string} list
1d3ef80e
AC
41
42fun list domain =
43 let
8ca17b9a 44 val file = OS.Path.joinDirFile {dir = Config.Vmail.userDatabase,
9b8c6dc8 45 file = domain}
1d3ef80e 46 in
dee1a22b
AC
47 if Posix.FileSys.access (file, []) then
48 let
49 val inf = TextIO.openIn file
50
51 fun loop users =
52 case TextIO.inputLine inf of
53 NONE => Listing (rev users)
54 | SOME line =>
55 case String.tokens Char.isSpace line of
56 [addr, fields] =>
57 (case String.fields (fn ch => ch = #"@") addr of
58 [user, _] =>
59 let
60 fun parseFields fields =
61 case fields of
62 "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users)
63 | _ :: _ :: rest => parseFields rest
64 | _ => Error "Invalid fields in database"
65 in
66 parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields)
67 end
68 | _ => Error "Invalid e-mail address format in database")
69 | _ => Error "Invalid entry in database"
70 in
71 loop []
72 before TextIO.closeIn inf
73 end
74 else
75 Listing []
1d3ef80e 76 end
dee1a22b
AC
77 handle IO.Io {name, function, ...} =>
78 Error ("IO failure: " ^ name ^ ": " ^ function)
1d3ef80e 79
9ffe2f0f
AC
80fun mailboxExists {domain, user} =
81 let
8ca17b9a 82 val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Vmail.userDatabase,
9ffe2f0f
AC
83 file = domain})
84
85 fun loop () =
86 case TextIO.inputLine inf of
87 NONE => false
88 | SOME line =>
89 case String.tokens Char.isSpace line of
90 [addr, _] =>
91 (case String.fields (fn ch => ch = #"@") addr of
92 [user', _] =>
93 user' = user orelse loop ()
94 | _ => false)
95 | _ => false
96 in
97 loop ()
98 before TextIO.closeIn inf
99 end
100 handle IO.Io _ => false
101
8ca17b9a
CE
102fun setpassword {domain, user, passwd} =
103 let
104 val proc = Unix.execute ("/bin/sh", ["-c",
105 String.concat [Config.Vmail.userdbpw, " | ", Config.Vmail.userdb,
106 " -f ", Config.Vmail.userDatabase, "/", domain,
107 " \"", user, "@", domain, "\" set systempw"]])
108 val outf = Unix.textOutstreamOf proc
109 in
110 TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
111 TextIO.closeOut outf;
112 OS.Process.isSuccess (Unix.reap proc)
113 end
114
115fun deluser {domain, user} =
116 Slave.run (Config.Vmail.userdb, ["-f", Config.Vmail.userDatabase ^ "/" ^ domain,
117 user ^ "@" ^ domain, "del"])
118
08688401
AC
119fun add {domain, requester, user, passwd, mailbox} =
120 let
121 val udb = Posix.SysDB.getpwnam requester
7a961682
AC
122 val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
123 val gid = SysWord.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
08688401
AC
124 val home = Posix.SysDB.Passwd.home udb
125 in
9ffe2f0f
AC
126 if mailboxExists {domain = domain, user = user} then
127 SOME "Mailbox mapping already exists"
8ca17b9a
CE
128 else if not (Slave.run (Config.Vmail.userdb, ["-f", Config.Vmail.userDatabase ^ "/" ^ domain,
129 user ^ "@" ^ domain,
130 "set", "home=" ^ home, "mail=" ^ mailbox, "uid=" ^ Int.toString uid, "gid=" ^ Int.toString gid])) then
08688401 131 SOME "Error running userdb"
8ca17b9a
CE
132 else if not (setpassword {domain = domain, user = user, passwd = passwd}) then
133 (ignore (deluser {domain = domain, user = user});
134 SOME "Error setting password")
135 else if not (rebuild ()) then
136 (ignore (deluser {domain = domain, user = user});
137 SOME "Error reloading userdb")
08688401 138 else
8ca17b9a 139 NONE
08688401
AC
140 end
141
142fun passwd {domain, user, passwd} =
9ffe2f0f
AC
143 if not (mailboxExists {domain = domain, user = user}) then
144 SOME "Mailbox doesn't exist"
8ca17b9a
CE
145 else if not (setpassword {domain = domain, user = user, passwd = passwd}) then
146 SOME "Error setting password"
147 else if not (rebuild ()) then
148 SOME "Error reloading userdb"
149 else
150 NONE
08688401
AC
151
152fun rm {domain, user} =
9ffe2f0f
AC
153 if not (mailboxExists {domain = domain, user = user}) then
154 SOME "Mailbox doesn't exist"
8ca17b9a 155 else if not (deluser {domain = domain, user = user}) then
08688401
AC
156 SOME "Error deleting password entry"
157 else if not (rebuild ()) then
158 SOME "Error reloading userdb"
159 else
160 NONE
161
162end