Expand valid proxyHosts

[hcoop/domtool2.git] / src / mail / vmail.sml

diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
index f5010eb..1d5262d 100644 (file)
--- a/src/mail/vmail.sml
+++ b/src/mail/vmail.sml
@@ -1,5 +1,5 @@
 (* HCoop Domtool (http://hcoop.sourceforge.net/)
 (* HCoop Domtool (http://hcoop.sourceforge.net/)

- * Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2006-2009, Adam Chlipala

  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License
  *
  * This program is free software; you can redistribute it and/or
  * modify it under the terms of the GNU General Public License


@@ -20,41 +20,120 @@
 
 structure Vmail :> VMAIL = struct
 
 
 structure Vmail :> VMAIL = struct
 

-fun rebuild () = Slave.shell [Config.Courier.postReload]
+open MsgTypes
+
+fun rebuild () =
+    let
+       fun doNode (site, ok) =
+           (print ("New vmail data for node " ^ site ^ "\n");
+            if site = Config.defaultNode then
+                Slave.shell [Config.Courier.postReload] andalso ok
+            else let
+                    val bio = OpenSSL.connect true (Domain.get_context (),
+                                                    Domain.nodeIp site
+                                                    ^ ":"
+                                                    ^ Int.toString Config.slavePort)
+                in
+                    Msg.send (bio, MsgVmailChanged);
+                    (case Msg.recv bio of
+                         NONE => (print "Slave closed connection unexpectedly\n";
+                                  false)
+                       | SOME m =>
+                         case m of
+                             MsgOk => (print ("Slave " ^ site ^ " finished\n");
+                                       ok)
+                           | MsgError s => (print ("Slave " ^ site
+                                                   ^ " returned error: " ^
+                                                   s ^ "\n");
+                                            false)
+                           | _ => (print ("Slave " ^ site
+                                          ^ " returned unexpected command\n");
+                                   false))
+                    before OpenSSL.close bio
+                end)
+    in
+       Slave.shell [Config.Courier.pushUserdb]
+       andalso foldl doNode true Config.mailNodes_all
+    end
+
+fun doChanged () =
+    Slave.shell [Config.Courier.pullUserdb]
+    andalso Slave.shell [Config.Courier.postReload]

 
 datatype listing =
         Error of string
 
 datatype listing =
         Error of string

-       | Listing of string list
+       | Listing of {user : string, mailbox : string} list

 
 fun list domain =
 
 fun list domain =

+    let
+       val file = OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
+                                       file = domain}
+    in
+       if Posix.FileSys.access (file, []) then
+           let
+               val inf = TextIO.openIn file
+
+               fun loop users =
+                   case TextIO.inputLine inf of
+                       NONE => Listing (rev users)
+                     | SOME line =>
+                       case String.tokens Char.isSpace line of
+                           [addr, fields] =>
+                           (case String.fields (fn ch => ch = #"@") addr of
+                                [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
+               loop []
+               before TextIO.closeIn inf
+           end
+       else
+           Listing []
+    end
+    handle IO.Io {name, function, ...} =>
+          Error ("IO failure: " ^ name ^ ": " ^ function)
+
+fun mailboxExists {domain, user} =

     let
        val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
                                                      file = domain})
 
     let
        val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
                                                      file = domain})
 

-       fun loop users =
+       fun loop () =

            case TextIO.inputLine inf of
            case TextIO.inputLine inf of

-               NONE => Listing (rev users)
+               NONE => false

              | SOME line =>
                case String.tokens Char.isSpace line of
                    [addr, _] =>
                    (case String.fields (fn ch => ch = #"@") addr of
              | 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"
+                        [user', _] =>
+                        user' = user orelse loop ()
+                      | _ => false)
+                 | _ => false

     in
     in

-       loop []
+       loop ()

        before TextIO.closeIn inf
     end
        before TextIO.closeIn inf
     end

-       handle IO.Io _ => Listing []
+       handle IO.Io _ => false

 
 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

-       val uid = Word.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
-       val gid = Word.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
+       val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
+       val gid = SysWord.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))

        val home = Posix.SysDB.Passwd.home udb
     in
        val home = Posix.SysDB.Passwd.home udb
     in

-       if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain,
+       if mailboxExists {domain = domain, user = user} then
+           SOME "Mailbox mapping already exists"
+       else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain,

                             "\" set home=", home, " mail=", mailbox,
                             " uid=", Int.toString uid, " gid=" ^ Int.toString gid]) then
            SOME "Error running userdb"
                             "\" set home=", home, " mail=", mailbox,
                             " uid=", Int.toString uid, " gid=" ^ Int.toString gid]) then
            SOME "Error running userdb"


@@ -79,24 +158,28 @@ fun add {domain, requester, user, passwd, mailbox} =
     end
 
 fun passwd {domain, user, passwd} =
     end
 
 fun passwd {domain, user, passwd} =

-    let
-       val proc = Unix.execute ("/bin/sh", ["-c",
-                                            String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
-                                                           " \"", domain, "/", user, "@", domain, "\" set systempw"]])
-       val outf = Unix.textOutstreamOf proc
-    in
-       TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
-       TextIO.closeOut outf;
-       if not (OS.Process.isSuccess (Unix.reap proc)) then
-           SOME "Error setting password"
-       else if not (rebuild ()) then
-           SOME "Error reloading userdb"
-       else
-           NONE
-    end
+    if not (mailboxExists {domain = domain, user = user}) then
+       SOME "Mailbox doesn't exist"
+    else let
+           val proc = Unix.execute ("/bin/sh", ["-c",
+                                                String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
+                                                               " \"", domain, "/", user, "@", domain, "\" set systempw"]])
+           val outf = Unix.textOutstreamOf proc
+       in
+           TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
+           TextIO.closeOut outf;
+           if not (OS.Process.isSuccess (Unix.reap proc)) then
+               SOME "Error setting password"
+           else if not (rebuild ()) then
+               SOME "Error reloading userdb"
+           else
+               NONE
+       end

 
 fun rm {domain, user} =
 
 fun rm {domain, user} =

-    if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]) then
+    if not (mailboxExists {domain = domain, user = user}) then
+       SOME "Mailbox doesn't exist"
+    else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]) then

        SOME "Error deleting password entry"
     else if not (rebuild ()) then
        SOME "Error reloading userdb"
        SOME "Error deleting password entry"
     else if not (rebuild ()) then
        SOME "Error reloading userdb"