1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006-2009, Adam Chlipala
3 * Copyright (c
) 2014 Clinton Ebadi
<clinton@unknownlamer
.org
>
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
.
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
.
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
.
20 (* Administration
of Courier IMAP virtual mailboxes
*)
22 structure Vmail
:> VMAIL
= struct
28 fun doNode (site
, ok
) =
29 (print ("New vmail data for node " ^ site ^
"\n");
30 Connect
.commandWorker (Domain
.get_context (), site
, MsgVmailChanged
))
32 foldl doNode
true Config
.mailNodes_all
36 Slave
.shell
[Config
.Courier
.postReload
]
39 structure SM
= DataStructures
.StringMap
41 exception Userdb
of string
43 fun readUserdb domain
=
45 val file
= OS
.Path
.joinDirFile
{dir
= Config
.Vmail
.userDatabase
,
48 if Posix
.FileSys
.access (file
, []) then
50 val inf
= TextIO.openIn file
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
)
58 case TextIO.inputLine inf
of
61 case String.tokens
Char.isSpace line
of
62 [addr
, fields
] => (case String.fields (fn ch
=> ch
= #
"@") addr
of
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
)
69 before TextIO.closeIn inf
77 | Listing
of {user
: string, mailbox
: string} list
81 val file
= OS
.Path
.joinDirFile
{dir
= Config
.Vmail
.userDatabase
,
84 if Posix
.FileSys
.access (file
, []) then
86 val inf
= TextIO.openIn file
89 case TextIO.inputLine inf
of
90 NONE
=> Listing (rev users
)
92 case String.tokens
Char.isSpace line
of
94 (case String.fields (fn ch
=> ch
= #
"@") addr
of
97 fun parseFields fields
=
99 "mail" :: mailbox
:: _
=> loop ({user
= user
, mailbox
= mailbox
} :: users
)
100 | _
:: _
:: rest
=> parseFields rest
101 | _
=> Error
"Invalid fields in database"
103 parseFields (String.fields (fn ch
=> ch
= #
"|" orelse ch
= #
"=") fields
)
105 | _
=> Error
"Invalid e-mail address format in database")
106 | _
=> Error
"Invalid entry in database"
109 before TextIO.closeIn inf
114 handle IO
.Io
{name
, function
, ...} =>
115 Error ("IO failure: " ^ name ^
": " ^ function
)
117 fun mailboxExists
{domain
, user
} =
119 val inf
= TextIO.openIn (OS
.Path
.joinDirFile
{dir
= Config
.Vmail
.userDatabase
,
123 case TextIO.inputLine inf
of
126 case String.tokens
Char.isSpace line
of
128 (case String.fields (fn ch
=> ch
= #
"@") addr
of
130 user
' = user
orelse loop ()
135 before TextIO.closeIn inf
137 handle IO
.Io _
=> false
139 fun setpassword
{domain
, user
, passwd
} =
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
147 TextIO.output (outf
, String.concat
[passwd
, "\n", passwd
, "\n"]);
148 TextIO.closeOut outf
;
149 OS
.Process
.isSuccess (Unix
.reap proc
)
153 fun checkpassword
{domain
, user
, passwd
} =
155 val proc
= Unix
.execute (Config
.installPrefix ^
"/sbin/domtool-vmailpasswd", [])
156 val outf
= Unix
.textOutstreamOf proc
157 val db
= readUserdb domain
159 case SM
.find (db
, user
) of
161 (case SM
.find (fields
, "systempw") of
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
)
171 fun deluser
{domain
, user
} =
172 Slave
.run (Config
.Vmail
.userdb
, ["-f", Config
.Vmail
.userDatabase ^
"/" ^ domain
,
173 user ^
"@" ^ domain
, "del"])
175 fun add
{domain
, requester
, user
, passwd
, mailbox
} =
177 val udb
= Posix
.SysDB
.getpwnam requester
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
))
180 val home
= Posix
.SysDB
.Passwd
.home udb
182 if mailboxExists
{domain
= domain
, user
= user
} then
183 SOME
"Mailbox mapping already exists"
184 else if not (Slave
.run (Config
.Vmail
.userdb
, ["-f", Config
.Vmail
.userDatabase ^
"/" ^ domain
,
186 "set", "home=" ^ home
, "mail=" ^ mailbox
, "uid=" ^
Int.toString uid
, "gid=" ^
Int.toString gid
])) then
187 SOME
"Error running userdb"
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")
198 fun passwd
{domain
, user
, passwd
} =
199 if not (mailboxExists
{domain
= domain
, user
= user
}) then
200 SOME
"Mailbox doesn't exist"
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"
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"
219 handle Userdb errmsg
=> SOME ("userdb error: " ^ errmsg
)
221 fun rm
{domain
, user
} =
222 if not (mailboxExists
{domain
= domain
, user
= user
}) then
223 SOME
"Mailbox doesn't exist"
224 else if not (deluser
{domain
= domain
, user
= user
}) then
225 SOME
"Error deleting password entry"
226 else if not (rebuild ()) then
227 SOME
"Error reloading userdb"