Listing vmail mailboxes

diff --git a/configDefault/courier.cfg b/configDefault/courier.cfg
index 025ee60..09b6607 100644 (file)
--- 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 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"
 (* 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 (file)
--- a/src/mail/vmail.sig
+++ b/src/mail/vmail.sig
@@ -22,6 +22,12 @@ signature VMAIL = sig
 
     val rebuild : unit -> bool
 
 
     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 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
 
 
     val rm : {domain : string, user : string} -> string option
 

+
+

 end
 end

diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
index a1f8648..f5010eb 100644 (file)
--- 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]
 
 
 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
 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 (file)
--- 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
        [] => 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,
            (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 (file)
--- 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 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}
     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 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -416,6 +416,22 @@ fun requestDbTable p =
        OpenSSL.close bio
     end
 
        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 () => ())
 fun requestNewMailbox p =
     let
        val (_, bio) = requestBio (fn () => ())


@@ -738,6 +754,20 @@ fun service () =
                                              SOME ("Invalid database name " ^ dbname)))
                                     (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
                              | 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 (file)
--- 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))
        (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
 
 fun checkIt v =
     case v of


@@ -208,6 +214,8 @@ fun recv bio =
                                (SOME domain, SOME user) =>
                                SOME (MsgRmMailbox {domain = domain, user = user})
                              | _ => NONE)
                                (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
                   | _ => NONE)
         
 end

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index c970491..cc792ff 100644 (file)
--- 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 *)
        (* 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
 
 end