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 | |
1d3ef80e AC |
38 | datatype listing = |
39 | Error of string | |
2fc6b0dd | 40 | | Listing of {user : string, mailbox : string} list |
1d3ef80e AC |
41 | |
42 | fun 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 |
80 | fun 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 |
102 | fun 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 | ||
115 | fun deluser {domain, user} = | |
116 | Slave.run (Config.Vmail.userdb, ["-f", Config.Vmail.userDatabase ^ "/" ^ domain, | |
117 | user ^ "@" ^ domain, "del"]) | |
118 | ||
08688401 AC |
119 | fun 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 | ||
142 | fun 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 | |
152 | fun 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 | ||
162 | end |