datatype listing =
Error of string
- | Listing of string list
+ | Listing of {user : string, mailbox : string} list
val list : string -> listing
datatype listing =
Error of string
- | Listing of string list
+ | Listing of {user : string, mailbox : string} list
fun list domain =
let
NONE => Listing (rev users)
| SOME line =>
case String.tokens Char.isSpace line of
- [addr, _] =>
+ [addr, fields] =>
(case String.fields (fn ch => ch = #"@") addr of
- [user, _] => loop (user :: users)
+ [user, _] =>
+ let
+ fun parseFields fields =
+ case fields of
+ "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users)
+ | _ :: _ :: rest => parseFields rest
+ | _ => Error "Invalid fields in database"
+ in
+ parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields)
+ end
| _ => Error "Invalid e-mail address format in database")
| _ => Error "Invalid entry in database"
in
(case Main.requestListMailboxes domain of
Vmail.Error msg => (print msg;
print "\n")
- | Vmail.Listing users => app (fn user => (print user;
- print "\n")) users)
+ | Vmail.Listing users => app (fn {user, mailbox} => (print user;
+ print "\t";
+ print mailbox;
+ print "\n")) users)
| ["add", user, mailbox] =>
(case Client.getpass () of
OpenSSL.writeString (bio, domain))
| MsgMailboxes users =>
(OpenSSL.writeInt (bio, 22);
- sendList OpenSSL.writeString (bio, users))
+ sendList (fn (bio, {user, mailbox}) =>
+ (OpenSSL.writeString (bio, user);
+ OpenSSL.writeString (bio, mailbox)))
+ (bio, users))
fun checkIt v =
case v of
SOME (MsgRmMailbox {domain = domain, user = user})
| _ => NONE)
| 21 => Option.map MsgListMailboxes (OpenSSL.readString bio)
- | 22 => Option.map MsgMailboxes (recvList OpenSSL.readString bio)
+ | 22 => Option.map MsgMailboxes (recvList
+ (fn bio =>
+ case (OpenSSL.readString bio,
+ OpenSSL.readString bio) of
+ (SOME user, SOME mailbox) =>
+ SOME {user = user, mailbox = mailbox}
+ | _ => NONE)
+ bio)
| _ => NONE)
end
(* Remove a vmail mapping *)
| MsgListMailboxes of string
(* List all mailboxes for a domain *)
- | MsgMailboxes of string list
+ | MsgMailboxes of {user : string, mailbox : string} list
(* Reply to MsgListMailboxes *)
end