src/mail/vmail.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006-2009, Adam Chlipala
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License
   6  * as published by the Free Software Foundation; either version 2
   7  * of the License, or (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  17  *)
  18
  19 (* Administration of Courier IMAP virtual mailboxes *)
  20
  21 structure Vmail :> VMAIL = struct
  22
  23 open MsgTypes
  24
  25 fun rebuild () =
  26     let
  27         fun doNode (site, ok) =
  28             (print ("New vmail data for node " ^ site ^ "\n");
  29              if site = Config.dispatcherName then
  30                  Slave.shell [Config.Courier.postReload] andalso ok
  31              else let
  32                      val bio = OpenSSL.connect true (Domain.get_context (),
  33                                                      Domain.nodeIp site
  34                                                      ^ ":"
  35                                                      ^ Int.toString Config.slavePort)
  36                  in
  37                      Msg.send (bio, MsgVmailChanged);
  38                      (case Msg.recv bio of
  39                           NONE => (print "Slave closed connection unexpectedly\n";
  40                                    false)
  41                         | SOME m =>
  42                           case m of
  43                               MsgOk => (print ("Slave " ^ site ^ " finished\n");
  44                                         ok)
  45                             | MsgError s => (print ("Slave " ^ site
  46                                                     ^ " returned error: " ^
  47                                                     s ^ "\n");
  48                                              false)
  49                             | _ => (print ("Slave " ^ site
  50                                            ^ " returned unexpected command\n");
  51                                     false))
  52                      before OpenSSL.close bio
  53                  end)
  54     in
  55         Slave.shell [Config.Courier.pushUserdb]
  56         andalso foldl doNode true Config.mailNodes_all
  57     end
  58
  59 fun doChanged () =
  60     Slave.shell [Config.Courier.pullUserdb]
  61     andalso Slave.shell [Config.Courier.postReload]
  62
  63 datatype listing =
  64          Error of string
  65        | Listing of {user : string, mailbox : string} list
  66
  67 fun list domain =
  68     let
  69         val file = OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
  70                                         file = domain}
  71     in
  72         if Posix.FileSys.access (file, []) then
  73             let
  74                 val inf = TextIO.openIn file
  75
  76                 fun loop users =
  77                     case TextIO.inputLine inf of
  78                         NONE => Listing (rev users)
  79                       | SOME line =>
  80                         case String.tokens Char.isSpace line of
  81                             [addr, fields] =>
  82                             (case String.fields (fn ch => ch = #"@") addr of
  83                                  [user, _] =>
  84                                  let
  85                                      fun parseFields fields =
  86                                          case fields of
  87                                              "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users)
  88                                            | _ :: _ :: rest => parseFields rest
  89                                            | _ => Error "Invalid fields in database"
  90                                  in
  91                                      parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields)
  92                                  end
  93                                | _ => Error "Invalid e-mail address format in database")
  94                           | _ => Error "Invalid entry in database"
  95             in
  96                 loop []
  97                 before TextIO.closeIn inf
  98             end
  99         else
 100             Listing []
 101     end
 102     handle IO.Io {name, function, ...} =>
 103            Error ("IO failure: " ^ name ^ ": " ^ function)
 104
 105 fun mailboxExists {domain, user} =
 106     let
 107         val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
 108                                                       file = domain})
 109
 110         fun loop () =
 111             case TextIO.inputLine inf of
 112                 NONE => false
 113               | SOME line =>
 114                 case String.tokens Char.isSpace line of
 115                     [addr, _] =>
 116                     (case String.fields (fn ch => ch = #"@") addr of
 117                          [user', _] =>
 118                          user' = user orelse loop ()
 119                        | _ => false)
 120                   | _ => false
 121     in
 122         loop ()
 123         before TextIO.closeIn inf
 124     end
 125         handle IO.Io _ => false
 126
 127 fun add {domain, requester, user, passwd, mailbox} =
 128     let
 129         val udb = Posix.SysDB.getpwnam requester
 130         val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
 131         val gid = SysWord.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
 132         val home = Posix.SysDB.Passwd.home udb
 133     in
 134         if mailboxExists {domain = domain, user = user} then
 135             SOME "Mailbox mapping already exists"
 136         else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain,
 137                              "\" set home=", home, " mail=", mailbox,
 138                              " uid=", Int.toString uid, " gid=" ^ Int.toString gid]) then
 139             SOME "Error running userdb"
 140         else
 141             let
 142                 val proc = Unix.execute ("/bin/sh", ["-c",
 143                                                      String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
 144                                                                     " \"", domain, "/", user, "@", domain, "\" set systempw"]])
 145                 val outf = Unix.textOutstreamOf proc
 146             in
 147                 TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
 148                 TextIO.closeOut outf;
 149                 if not (OS.Process.isSuccess (Unix.reap proc)) then
 150                     (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
 151                      SOME "Error setting password")
 152                 else if not (rebuild ()) then
 153                     (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
 154                      SOME "Error reloading userdb")
 155                 else
 156                     NONE
 157             end
 158     end
 159
 160 fun passwd {domain, user, passwd} =
 161     if not (mailboxExists {domain = domain, user = user}) then
 162         SOME "Mailbox doesn't exist"
 163     else let
 164             val proc = Unix.execute ("/bin/sh", ["-c",
 165                                                  String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
 166                                                                 " \"", domain, "/", user, "@", domain, "\" set systempw"]])
 167             val outf = Unix.textOutstreamOf proc
 168         in
 169             TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
 170             TextIO.closeOut outf;
 171             if not (OS.Process.isSuccess (Unix.reap proc)) then
 172                 SOME "Error setting password"
 173             else if not (rebuild ()) then
 174                 SOME "Error reloading userdb"
 175             else
 176                 NONE
 177         end
 178
 179 fun rm {domain, user} =
 180     if not (mailboxExists {domain = domain, user = user}) then
 181         SOME "Mailbox doesn't exist"
 182     else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]) then
 183         SOME "Error deleting password entry"
 184     else if not (rebuild ()) then
 185         SOME "Error reloading userdb"
 186     else
 187         NONE
 188
 189 end