1 (* HCoop
Domtool (http
://hcoop
.sourceforge
.net
/)
2 * Copyright (c
) 2006, 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
23 fun rebuild () = Slave
.shell
[Config
.Courier
.postReload
]
27 | Listing
of {user
: string, mailbox
: string} list
31 val file
= OS
.Path
.joinDirFile
{dir
= Config
.Courier
.userdbDir
,
34 if Posix
.FileSys
.access (file
, []) then
36 val inf
= TextIO.openIn file
39 case TextIO.inputLine inf
of
40 NONE
=> Listing (rev users
)
42 case String.tokens
Char.isSpace line
of
44 (case String.fields (fn ch
=> ch
= #
"@") addr
of
47 fun parseFields fields
=
49 "mail" :: mailbox
:: _
=> loop ({user
= user
, mailbox
= mailbox
} :: users
)
50 | _
:: _
:: rest
=> parseFields rest
51 | _
=> Error
"Invalid fields in database"
53 parseFields (String.fields (fn ch
=> ch
= #
"|" orelse ch
= #
"=") fields
)
55 | _
=> Error
"Invalid e-mail address format in database")
56 | _
=> Error
"Invalid entry in database"
59 before TextIO.closeIn inf
64 handle IO
.Io
{name
, function
, ...} =>
65 Error ("IO failure: " ^ name ^
": " ^ function
)
67 fun mailboxExists
{domain
, user
} =
69 val inf
= TextIO.openIn (OS
.Path
.joinDirFile
{dir
= Config
.Courier
.userdbDir
,
73 case TextIO.inputLine inf
of
76 case String.tokens
Char.isSpace line
of
78 (case String.fields (fn ch
=> ch
= #
"@") addr
of
80 user
' = user
orelse loop ()
85 before TextIO.closeIn inf
87 handle IO
.Io _
=> false
89 fun add
{domain
, requester
, user
, passwd
, mailbox
} =
91 val udb
= Posix
.SysDB
.getpwnam requester
92 val uid
= SysWord
.toInt (Posix
.ProcEnv
.uidToWord (Posix
.SysDB
.Passwd
.uid udb
))
93 val gid
= SysWord
.toInt (Posix
.ProcEnv
.gidToWord (Posix
.SysDB
.Passwd
.gid udb
))
94 val home
= Posix
.SysDB
.Passwd
.home udb
96 if mailboxExists
{domain
= domain
, user
= user
} then
97 SOME
"Mailbox mapping already exists"
98 else if not (Slave
.shell
[Config
.Courier
.userdb
, " \"", domain
, "/", user
, "@", domain
,
99 "\" set home=", home
, " mail=", mailbox
,
100 " uid=", Int.toString uid
, " gid=" ^
Int.toString gid
]) then
101 SOME
"Error running userdb"
104 val proc
= Unix
.execute ("/bin/sh", ["-c",
105 String.concat
[Config
.Courier
.userdbpw
, " | ", Config
.Courier
.userdb
,
106 " \"", domain
, "/", user
, "@", domain
, "\" set systempw"]])
107 val outf
= Unix
.textOutstreamOf proc
109 TextIO.output (outf
, String.concat
[passwd
, "\n", passwd
, "\n"]);
110 TextIO.closeOut outf
;
111 if not (OS
.Process
.isSuccess (Unix
.reap proc
)) then
112 (ignore (Slave
.shell
[Config
.Courier
.userdb
, " \"", domain
, "/", user
, "@", domain
, "\" del"]);
113 SOME
"Error setting password")
114 else if not (rebuild ()) then
115 (ignore (Slave
.shell
[Config
.Courier
.userdb
, " \"", domain
, "/", user
, "@", domain
, "\" del"]);
116 SOME
"Error reloading userdb")
122 fun passwd
{domain
, user
, passwd
} =
123 if not (mailboxExists
{domain
= domain
, user
= user
}) then
124 SOME
"Mailbox doesn't exist"
126 val proc
= Unix
.execute ("/bin/sh", ["-c",
127 String.concat
[Config
.Courier
.userdbpw
, " | ", Config
.Courier
.userdb
,
128 " \"", domain
, "/", user
, "@", domain
, "\" set systempw"]])
129 val outf
= Unix
.textOutstreamOf proc
131 TextIO.output (outf
, String.concat
[passwd
, "\n", passwd
, "\n"]);
132 TextIO.closeOut outf
;
133 if not (OS
.Process
.isSuccess (Unix
.reap proc
)) then
134 SOME
"Error setting password"
135 else if not (rebuild ()) then
136 SOME
"Error reloading userdb"
141 fun rm
{domain
, user
} =
142 if not (mailboxExists
{domain
= domain
, user
= user
}) then
143 SOME
"Mailbox doesn't exist"
144 else if not (Slave
.shell
[Config
.Courier
.userdb
, " \"", domain
, "/", user
, "@", domain
, "\" del"]) then
145 SOME
"Error deleting password entry"
146 else if not (rebuild ()) then
147 SOME
"Error reloading userdb"