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
]
40 | Listing
of {user
: string, mailbox
: string} list
44 val file
= OS
.Path
.joinDirFile
{dir
= Config
.Vmail
.userDatabase
,
47 if Posix
.FileSys
.access (file
, []) then
49 val inf
= TextIO.openIn file
52 case TextIO.inputLine inf
of
53 NONE
=> Listing (rev users
)
55 case String.tokens
Char.isSpace line
of
57 (case String.fields (fn ch
=> ch
= #
"@") addr
of
60 fun parseFields fields
=
62 "mail" :: mailbox
:: _
=> loop ({user
= user
, mailbox
= mailbox
} :: users
)
63 | _
:: _
:: rest
=> parseFields rest
64 | _
=> Error
"Invalid fields in database"
66 parseFields (String.fields (fn ch
=> ch
= #
"|" orelse ch
= #
"=") fields
)
68 | _
=> Error
"Invalid e-mail address format in database")
69 | _
=> Error
"Invalid entry in database"
72 before TextIO.closeIn inf
77 handle IO
.Io
{name
, function
, ...} =>
78 Error ("IO failure: " ^ name ^
": " ^ function
)
80 fun mailboxExists
{domain
, user
} =
82 val inf
= TextIO.openIn (OS
.Path
.joinDirFile
{dir
= Config
.Vmail
.userDatabase
,
86 case TextIO.inputLine inf
of
89 case String.tokens
Char.isSpace line
of
91 (case String.fields (fn ch
=> ch
= #
"@") addr
of
93 user
' = user
orelse loop ()
98 before TextIO.closeIn inf
100 handle IO
.Io _
=> false
102 fun setpassword
{domain
, user
, passwd
} =
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
110 TextIO.output (outf
, String.concat
[passwd
, "\n", passwd
, "\n"]);
111 TextIO.closeOut outf
;
112 OS
.Process
.isSuccess (Unix
.reap proc
)
115 fun deluser
{domain
, user
} =
116 Slave
.run (Config
.Vmail
.userdb
, ["-f", Config
.Vmail
.userDatabase ^
"/" ^ domain
,
117 user ^
"@" ^ domain
, "del"])
119 fun add
{domain
, requester
, user
, passwd
, mailbox
} =
121 val udb
= Posix
.SysDB
.getpwnam requester
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
))
124 val home
= Posix
.SysDB
.Passwd
.home udb
126 if mailboxExists
{domain
= domain
, user
= user
} then
127 SOME
"Mailbox mapping already exists"
128 else if not (Slave
.run (Config
.Vmail
.userdb
, ["-f", Config
.Vmail
.userDatabase ^
"/" ^ domain
,
130 "set", "home=" ^ home
, "mail=" ^ mailbox
, "uid=" ^
Int.toString uid
, "gid=" ^
Int.toString gid
])) then
131 SOME
"Error running userdb"
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")
142 fun passwd
{domain
, user
, passwd
} =
143 if not (mailboxExists
{domain
= domain
, user
= user
}) then
144 SOME
"Mailbox doesn't exist"
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"
152 fun rm
{domain
, user
} =
153 if not (mailboxExists
{domain
= domain
, user
= user
}) then
154 SOME
"Mailbox doesn't exist"
155 else if not (deluser
{domain
= domain
, user
= user
}) then
156 SOME
"Error deleting password entry"
157 else if not (rebuild ()) then
158 SOME
"Error reloading userdb"