val userdbpw = "/usr/sbin/userdbpw"
val makeuserdb = "/usr/sbin/makeuserdb"
-val userdbDir = "/etc/userdb"
+val userdbDir = "/etc/courier/userdb"
(* Directory for storing userdb info *)
val postReload = "/usr/bin/sudo /usr/local/sbin/domtool-publish courier"
val rebuild : unit -> bool
+ datatype listing =
+ Error of string
+ | Listing of string list
+
+ val list : string -> listing
+
val add : {domain : string, requester : string, user : string,
passwd : string, mailbox : string} -> string option
val rm : {domain : string, user : string} -> string option
+
+
end
fun rebuild () = Slave.shell [Config.Courier.postReload]
+datatype listing =
+ Error of string
+ | Listing of string list
+
+fun list domain =
+ let
+ val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
+ file = domain})
+
+ fun loop users =
+ case TextIO.inputLine inf of
+ NONE => Listing (rev users)
+ | SOME line =>
+ case String.tokens Char.isSpace line of
+ [addr, _] =>
+ (case String.fields (fn ch => ch = #"@") addr of
+ [user, _] => loop (user :: users)
+ | _ => Error "Invalid e-mail address format in database")
+ | _ => Error "Invalid entry in database"
+ in
+ loop []
+ before TextIO.closeIn inf
+ end
+ handle IO.Io _ => Listing []
+
fun add {domain, requester, user, passwd, mailbox} =
let
val udb = Posix.SysDB.getpwnam requester
[] => print "Invalid command-line arguments\n"
| domain :: rest =>
case rest of
- ["add", user, mailbox] =>
+ ["list"] =>
+ (case Main.requestListMailboxes domain of
+ Vmail.Error msg => (print msg;
+ print "\n")
+ | Vmail.Listing users => app (fn user => (print user;
+ print "\n")) users)
+
+ | ["add", user, mailbox] =>
(case Client.getpass () of
Client.Passwd passwd =>
Main.requestNewMailbox {domain = domain,
val requestDbUser : {dbtype : string, passwd : string option} -> unit
val requestDbTable : {dbtype : string, dbname : string} -> unit
+ val requestListMailboxes : string -> Vmail.listing
val requestNewMailbox : {domain : string, user : string,
passwd : string, mailbox : string} -> unit
val requestPasswdMailbox : {domain : string, user : string, passwd : string}
OpenSSL.close bio
end
+fun requestListMailboxes domain =
+ let
+ val (_, bio) = requestBio (fn () => ())
+ in
+ Msg.send (bio, MsgListMailboxes domain);
+ (case Msg.recv bio of
+ NONE => Vmail.Error "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgMailboxes users => (Msg.send (bio, MsgOk);
+ Vmail.Listing users)
+ | MsgError s => Vmail.Error ("Creation failed: " ^ s)
+ | _ => Vmail.Error "Unexpected server reply.\n")
+ before OpenSSL.close bio
+ end
+
fun requestNewMailbox p =
let
val (_, bio) = requestBio (fn () => ())
SOME ("Invalid database name " ^ dbname)))
(fn () => ())
+ | MsgListMailboxes domain =>
+ doIt (fn () =>
+ if not (Domain.yourDomain domain) then
+ ("User wasn't authorized to list mailboxes for " ^ domain,
+ SOME "You're not authorized to configure that domain.")
+ else
+ case Vmail.list domain of
+ Vmail.Listing users => (Msg.send (bio, MsgMailboxes users);
+ ("Sent mailbox list for " ^ domain,
+ NONE))
+ | Vmail.Error msg => ("Error listing mailboxes for " ^ domain ^ ": " ^ msg,
+ SOME msg))
+ (fn () => ())
+
| MsgNewMailbox {domain, user = emailUser, passwd, mailbox} =>
doIt (fn () =>
if not (Domain.yourDomain domain) then
(OpenSSL.writeInt (bio, 20);
OpenSSL.writeString (bio, domain);
OpenSSL.writeString (bio, user))
+ | MsgListMailboxes domain =>
+ (OpenSSL.writeInt (bio, 21);
+ OpenSSL.writeString (bio, domain))
+ | MsgMailboxes users =>
+ (OpenSSL.writeInt (bio, 22);
+ sendList OpenSSL.writeString (bio, users))
fun checkIt v =
case v of
(SOME domain, SOME user) =>
SOME (MsgRmMailbox {domain = domain, user = user})
| _ => NONE)
+ | 21 => Option.map MsgListMailboxes (OpenSSL.readString bio)
+ | 22 => Option.map MsgMailboxes (recvList OpenSSL.readString bio)
| _ => NONE)
end
(* Change a vmail account's password *)
| MsgRmMailbox of {domain : string, user : string}
(* Remove a vmail mapping *)
+ | MsgListMailboxes of string
+ (* List all mailboxes for a domain *)
+ | MsgMailboxes of string list
+ (* Reply to MsgListMailboxes *)
end