1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006-2009, Adam Chlipala
4 * This program is free software
; you can redistribute it
and/or
5 * modify it under the terms
of the GNU General Public License
6 * as published by the Free Software Foundation
; either version
2
7 * of the License
, or (at your option
) any later version
.
9 * This program is distributed
in the hope that it will be useful
,
10 * but WITHOUT ANY WARRANTY
; without even the implied warranty
of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
. See the
12 * GNU General Public License for more details
.
14 * You should have received a copy
of the GNU General Public License
15 * along
with this program
; if not
, write to the Free Software
16 * Foundation
, Inc
., 51 Franklin Street
, Fifth Floor
, Boston
, MA
02110-1301, USA
.
19 (* Administration
of Courier IMAP virtual mailboxes
*)
21 structure Vmail
:> VMAIL
= struct
27 fun doNode (site
, ok
) =
28 (print ("New vmail data for node " ^ site ^
"\n");
29 if site
= Config
.defaultNode
then
30 Slave
.shell
[Config
.Courier
.postReload
] andalso ok
32 val bio
= OpenSSL
.connect
true (Domain
.get_context (),
35 ^
Int.toString Config
.slavePort
)
37 Msg
.send (bio
, MsgVmailChanged
);
39 NONE
=> (print
"Slave closed connection unexpectedly\n";
43 MsgOk
=> (print ("Slave " ^ site ^
" finished\n");
45 | MsgError s
=> (print ("Slave " ^ site
46 ^
" returned error: " ^
49 | _
=> (print ("Slave " ^ site
50 ^
" returned unexpected command\n");
52 before OpenSSL
.close bio
55 Slave
.shell
[Config
.Courier
.pushUserdb
]
56 andalso foldl doNode
true Config
.mailNodes_all
60 Slave
.shell
[Config
.Courier
.pullUserdb
]
61 andalso Slave
.shell
[Config
.Courier
.postReload
]
65 | Listing
of {user
: string, mailbox
: string} list
69 val file
= OS
.Path
.joinDirFile
{dir
= Config
.Courier
.userdbDir
,
72 if Posix
.FileSys
.access (file
, []) then
74 val inf
= TextIO.openIn file
77 case TextIO.inputLine inf
of
78 NONE
=> Listing (rev users
)
80 case String.tokens
Char.isSpace line
of
82 (case String.fields (fn ch
=> ch
= #
"@") addr
of
85 fun parseFields fields
=
87 "mail" :: mailbox
:: _
=> loop ({user
= user
, mailbox
= mailbox
} :: users
)
88 | _
:: _
:: rest
=> parseFields rest
89 | _
=> Error
"Invalid fields in database"
91 parseFields (String.fields (fn ch
=> ch
= #
"|" orelse ch
= #
"=") fields
)
93 | _
=> Error
"Invalid e-mail address format in database")
94 | _
=> Error
"Invalid entry in database"
97 before TextIO.closeIn inf
102 handle IO
.Io
{name
, function
, ...} =>
103 Error ("IO failure: " ^ name ^
": " ^ function
)
105 fun mailboxExists
{domain
, user
} =
107 val inf
= TextIO.openIn (OS
.Path
.joinDirFile
{dir
= Config
.Courier
.userdbDir
,
111 case TextIO.inputLine inf
of
114 case String.tokens
Char.isSpace line
of
116 (case String.fields (fn ch
=> ch
= #
"@") addr
of
118 user
' = user
orelse loop ()
123 before TextIO.closeIn inf
125 handle IO
.Io _
=> false
127 fun add
{domain
, requester
, user
, passwd
, mailbox
} =
129 val udb
= Posix
.SysDB
.getpwnam requester
130 val uid
= SysWord
.toInt (Posix
.ProcEnv
.uidToWord (Posix
.SysDB
.Passwd
.uid udb
))
131 val gid
= SysWord
.toInt (Posix
.ProcEnv
.gidToWord (Posix
.SysDB
.Passwd
.gid udb
))
132 val home
= Posix
.SysDB
.Passwd
.home udb
134 if mailboxExists
{domain
= domain
, user
= user
} then
135 SOME
"Mailbox mapping already exists"
136 else if not (Slave
.shell
[Config
.Courier
.userdb
, " \"", domain
, "/", user
, "@", domain
,
137 "\" set home=", home
, " mail=", mailbox
,
138 " uid=", Int.toString uid
, " gid=" ^
Int.toString gid
]) then
139 SOME
"Error running userdb"
142 val proc
= Unix
.execute ("/bin/sh", ["-c",
143 String.concat
[Config
.Courier
.userdbpw
, " | ", Config
.Courier
.userdb
,
144 " \"", domain
, "/", 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 if not (OS
.Process
.isSuccess (Unix
.reap proc
)) then
150 (ignore (Slave
.shell
[Config
.Courier
.userdb
, " \"", domain
, "/", user
, "@", domain
, "\" del"]);
151 SOME
"Error setting password")
152 else if not (rebuild ()) then
153 (ignore (Slave
.shell
[Config
.Courier
.userdb
, " \"", domain
, "/", user
, "@", domain
, "\" del"]);
154 SOME
"Error reloading userdb")
160 fun passwd
{domain
, user
, passwd
} =
161 if not (mailboxExists
{domain
= domain
, user
= user
}) then
162 SOME
"Mailbox doesn't exist"
164 val proc
= Unix
.execute ("/bin/sh", ["-c",
165 String.concat
[Config
.Courier
.userdbpw
, " | ", Config
.Courier
.userdb
,
166 " \"", domain
, "/", user
, "@", domain
, "\" set systempw"]])
167 val outf
= Unix
.textOutstreamOf proc
169 TextIO.output (outf
, String.concat
[passwd
, "\n", passwd
, "\n"]);
170 TextIO.closeOut outf
;
171 if not (OS
.Process
.isSuccess (Unix
.reap proc
)) then
172 SOME
"Error setting password"
173 else if not (rebuild ()) then
174 SOME
"Error reloading userdb"
179 fun rm
{domain
, user
} =
180 if not (mailboxExists
{domain
= domain
, user
= user
}) then
181 SOME
"Mailbox doesn't exist"
182 else if not (Slave
.shell
[Config
.Courier
.userdb
, " \"", domain
, "/", user
, "@", domain
, "\" del"]) then
183 SOME
"Error deleting password entry"
184 else if not (rebuild ()) then
185 SOME
"Error reloading userdb"