From 1d3ef80ec822ea0fa241eb5485549ca7417e787f Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 23 Dec 2006 21:18:31 +0000 Subject: [PATCH] Listing vmail mailboxes --- configDefault/courier.cfg | 2 +- src/mail/vmail.sig | 8 ++++++++ src/mail/vmail.sml | 25 +++++++++++++++++++++++++ src/main-vmail.sml | 9 ++++++++- src/main.sig | 1 + src/main.sml | 30 ++++++++++++++++++++++++++++++ src/msg.sml | 8 ++++++++ src/msgTypes.sml | 4 ++++ 8 files changed, 85 insertions(+), 2 deletions(-) diff --git a/configDefault/courier.cfg b/configDefault/courier.cfg index 025ee60..09b6607 100644 --- a/configDefault/courier.cfg +++ b/configDefault/courier.cfg @@ -6,7 +6,7 @@ val maildirmake = "/usr/bin/maildirmake.courier" 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" diff --git a/src/mail/vmail.sig b/src/mail/vmail.sig index 37e4ee0..de3e44b 100644 --- a/src/mail/vmail.sig +++ b/src/mail/vmail.sig @@ -22,6 +22,12 @@ signature VMAIL = sig 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 @@ -30,4 +36,6 @@ signature VMAIL = sig val rm : {domain : string, user : string} -> string option + + end diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml index a1f8648..f5010eb 100644 --- a/src/mail/vmail.sml +++ b/src/mail/vmail.sml @@ -22,6 +22,31 @@ structure Vmail :> VMAIL = struct 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 diff --git a/src/main-vmail.sml b/src/main-vmail.sml index 63ea19d..05cb86f 100644 --- a/src/main-vmail.sml +++ b/src/main-vmail.sml @@ -23,7 +23,14 @@ val _ = [] => 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, diff --git a/src/main.sig b/src/main.sig index e9a8d2d..1449967 100644 --- a/src/main.sig +++ b/src/main.sig @@ -51,6 +51,7 @@ signature MAIN = sig 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} diff --git a/src/main.sml b/src/main.sml index 5025cb2..23cedce 100644 --- a/src/main.sml +++ b/src/main.sml @@ -416,6 +416,22 @@ fun requestDbTable p = 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 () => ()) @@ -738,6 +754,20 @@ fun service () = 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 diff --git a/src/msg.sml b/src/msg.sml index d0d917c..6fdda0a 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -134,6 +134,12 @@ fun send (bio, m) = (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 @@ -208,6 +214,8 @@ fun recv bio = (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 diff --git a/src/msgTypes.sml b/src/msgTypes.sml index c970491..cc792ff 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -65,5 +65,9 @@ datatype msg = (* 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 -- 2.20.1