Commit | Line | Data |
---|---|---|
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 | ||
22 | structure Vmail :> VMAIL = struct | |
23 | ||
9b8c6dc8 AC |
24 | open MsgTypes |
25 | ||
26 | fun 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 | ||
35 | fun doChanged () = | |
8ca17b9a | 36 | Slave.shell [Config.Courier.postReload] |
08688401 | 37 | |
0e0442b0 CE |
38 | |
39 | structure SM = DataStructures.StringMap | |
40 | ||
41 | exception Userdb of string | |
42 | ||
43 | fun readUserdb domain = | |
44 | let | |
45 | val file = OS.Path.joinDirFile {dir = Config.Vmail.userDatabase, | |
46 | file = domain} | |
47 | in | |
48 | if Posix.FileSys.access (file, []) then | |
49 | let | |
50 | val inf = TextIO.openIn file | |
51 | ||
52 | fun parseField (field, fields) = | |
53 | case String.fields (fn ch => ch = #"=") field of | |
54 | [key, value] => SM.insert (fields, key, value) | |
55 | | _ => raise Userdb ("Malformed fields in vmail userdb for domain " ^ domain) | |
56 | ||
57 | fun loop users = | |
58 | case TextIO.inputLine inf of | |
59 | NONE => users | |
60 | | SOME line => | |
61 | case String.tokens Char.isSpace line of | |
62 | [addr, fields] => (case String.fields (fn ch => ch = #"@") addr of | |
63 | [user, _] => | |
64 | loop (SM.insert (users, user, foldl parseField SM.empty (String.fields (fn ch => ch = #"|") fields))) | |
65 | | _ => raise Userdb ("Malformed address in vmail userdb for " ^ domain ^ ": " ^ addr)) | |
66 | | _ => raise Userdb ("Malformed record in vmail userdb for domain " ^ domain) | |
67 | in | |
68 | loop SM.empty | |
69 | before TextIO.closeIn inf | |
70 | end | |
71 | else | |
72 | SM.empty | |
73 | end | |
74 | ||
1d3ef80e AC |
75 | datatype listing = |
76 | Error of string | |
2fc6b0dd | 77 | | Listing of {user : string, mailbox : string} list |
1d3ef80e AC |
78 | |
79 | fun list domain = | |
80 | let | |
8ca17b9a | 81 | val file = OS.Path.joinDirFile {dir = Config.Vmail.userDatabase, |
9b8c6dc8 | 82 | file = domain} |
1d3ef80e | 83 | in |
dee1a22b AC |
84 | if Posix.FileSys.access (file, []) then |
85 | let | |
86 | val inf = TextIO.openIn file | |
87 | ||
88 | fun loop users = | |
89 | case TextIO.inputLine inf of | |
90 | NONE => Listing (rev users) | |
91 | | SOME line => | |
92 | case String.tokens Char.isSpace line of | |
93 | [addr, fields] => | |
94 | (case String.fields (fn ch => ch = #"@") addr of | |
95 | [user, _] => | |
96 | let | |
97 | fun parseFields fields = | |
98 | case fields of | |
99 | "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users) | |
100 | | _ :: _ :: rest => parseFields rest | |
101 | | _ => Error "Invalid fields in database" | |
102 | in | |
103 | parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields) | |
104 | end | |
105 | | _ => Error "Invalid e-mail address format in database") | |
106 | | _ => Error "Invalid entry in database" | |
107 | in | |
108 | loop [] | |
109 | before TextIO.closeIn inf | |
110 | end | |
111 | else | |
112 | Listing [] | |
1d3ef80e | 113 | end |
dee1a22b AC |
114 | handle IO.Io {name, function, ...} => |
115 | Error ("IO failure: " ^ name ^ ": " ^ function) | |
1d3ef80e | 116 | |
9ffe2f0f AC |
117 | fun mailboxExists {domain, user} = |
118 | let | |
8ca17b9a | 119 | val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Vmail.userDatabase, |
9ffe2f0f AC |
120 | file = domain}) |
121 | ||
122 | fun loop () = | |
123 | case TextIO.inputLine inf of | |
124 | NONE => false | |
125 | | SOME line => | |
126 | case String.tokens Char.isSpace line of | |
127 | [addr, _] => | |
128 | (case String.fields (fn ch => ch = #"@") addr of | |
129 | [user', _] => | |
130 | user' = user orelse loop () | |
131 | | _ => false) | |
132 | | _ => false | |
133 | in | |
134 | loop () | |
135 | before TextIO.closeIn inf | |
136 | end | |
137 | handle IO.Io _ => false | |
138 | ||
8ca17b9a CE |
139 | fun setpassword {domain, user, passwd} = |
140 | let | |
141 | val proc = Unix.execute ("/bin/sh", ["-c", | |
142 | String.concat [Config.Vmail.userdbpw, " | ", Config.Vmail.userdb, | |
143 | " -f ", Config.Vmail.userDatabase, "/", domain, | |
144 | " \"", user, "@", domain, "\" set systempw"]]) | |
145 | val outf = Unix.textOutstreamOf proc | |
146 | in | |
147 | TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]); | |
148 | TextIO.closeOut outf; | |
149 | OS.Process.isSuccess (Unix.reap proc) | |
150 | end | |
151 | ||
0e0442b0 CE |
152 | |
153 | fun checkpassword {domain, user, passwd} = | |
154 | let | |
155 | val proc = Unix.execute (Config.installPrefix ^ "/sbin/domtool-vmailpasswd", []) | |
156 | val outf = Unix.textOutstreamOf proc | |
157 | val db = readUserdb domain | |
158 | in | |
159 | case SM.find (db, user) of | |
160 | SOME fields => | |
161 | (case SM.find (fields, "systempw") of | |
162 | SOME systempw => | |
163 | (TextIO.output (outf, systempw ^ "\n"); | |
164 | TextIO.output (outf, passwd ^ "\n"); | |
165 | TextIO.closeOut outf; | |
166 | OS.Process.isSuccess (Unix.reap proc)) | |
167 | | NONE => raise Userdb ("systempw not found for user " ^ user ^ "@" ^ domain)) | |
168 | | NONE => raise Userdb ("User " ^ user ^ " not found in vmail userdb for domain " ^ domain) | |
169 | end | |
170 | ||
8ca17b9a CE |
171 | fun deluser {domain, user} = |
172 | Slave.run (Config.Vmail.userdb, ["-f", Config.Vmail.userDatabase ^ "/" ^ domain, | |
173 | user ^ "@" ^ domain, "del"]) | |
174 | ||
08688401 AC |
175 | fun add {domain, requester, user, passwd, mailbox} = |
176 | let | |
177 | val udb = Posix.SysDB.getpwnam requester | |
7a961682 AC |
178 | val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb)) |
179 | val gid = SysWord.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb)) | |
08688401 AC |
180 | val home = Posix.SysDB.Passwd.home udb |
181 | in | |
9ffe2f0f AC |
182 | if mailboxExists {domain = domain, user = user} then |
183 | SOME "Mailbox mapping already exists" | |
8ca17b9a CE |
184 | else if not (Slave.run (Config.Vmail.userdb, ["-f", Config.Vmail.userDatabase ^ "/" ^ domain, |
185 | user ^ "@" ^ domain, | |
186 | "set", "home=" ^ home, "mail=" ^ mailbox, "uid=" ^ Int.toString uid, "gid=" ^ Int.toString gid])) then | |
08688401 | 187 | SOME "Error running userdb" |
8ca17b9a CE |
188 | else if not (setpassword {domain = domain, user = user, passwd = passwd}) then |
189 | (ignore (deluser {domain = domain, user = user}); | |
190 | SOME "Error setting password") | |
191 | else if not (rebuild ()) then | |
192 | (ignore (deluser {domain = domain, user = user}); | |
193 | SOME "Error reloading userdb") | |
08688401 | 194 | else |
8ca17b9a | 195 | NONE |
08688401 AC |
196 | end |
197 | ||
198 | fun passwd {domain, user, passwd} = | |
9ffe2f0f AC |
199 | if not (mailboxExists {domain = domain, user = user}) then |
200 | SOME "Mailbox doesn't exist" | |
8ca17b9a CE |
201 | else if not (setpassword {domain = domain, user = user, passwd = passwd}) then |
202 | SOME "Error setting password" | |
203 | else if not (rebuild ()) then | |
204 | SOME "Error reloading userdb" | |
205 | else | |
206 | NONE | |
08688401 | 207 | |
0e0442b0 CE |
208 | fun portalpasswd {domain, user, oldpasswd, newpasswd} = |
209 | (if not (mailboxExists {domain = domain, user = user}) then | |
210 | SOME "Mailbox doesn't exist" | |
211 | else if not (checkpassword {domain = domain, user = user, passwd = oldpasswd}) then | |
212 | SOME "Old password incorrect" | |
213 | else if not (setpassword {domain = domain, user = user, passwd = newpasswd}) then | |
214 | SOME "Error setting password" | |
215 | else if not (rebuild ()) then | |
216 | SOME "Error reloading userdb" | |
217 | else | |
218 | NONE) | |
219 | handle Userdb errmsg => SOME ("userdb error: " ^ errmsg) | |
220 | ||
08688401 | 221 | fun rm {domain, user} = |
9ffe2f0f AC |
222 | if not (mailboxExists {domain = domain, user = user}) then |
223 | SOME "Mailbox doesn't exist" | |
8ca17b9a | 224 | else if not (deluser {domain = domain, user = user}) then |
08688401 AC |
225 | SOME "Error deleting password entry" |
226 | else if not (rebuild ()) then | |
227 | SOME "Error reloading userdb" | |
228 | else | |
229 | NONE | |
230 | ||
231 | end |