src/mail/vmail.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006, 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 fun rebuild () = Slave.shell [Config.Courier.postReload]
  24
  25 datatype listing =
  26          Error of string
  27        | Listing of string list
  28
  29 fun list domain =
  30     let
  31         val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
  32                                                       file = domain})
  33
  34         fun loop users =
  35             case TextIO.inputLine inf of
  36                 NONE => Listing (rev users)
  37               | SOME line =>
  38                 case String.tokens Char.isSpace line of
  39                     [addr, _] =>
  40                     (case String.fields (fn ch => ch = #"@") addr of
  41                          [user, _] => loop (user :: users)
  42                        | _ => Error "Invalid e-mail address format in database")
  43                   | _ => Error "Invalid entry in database"
  44     in
  45         loop []
  46         before TextIO.closeIn inf
  47     end
  48         handle IO.Io _ => Listing []
  49
  50 fun add {domain, requester, user, passwd, mailbox} =
  51     let
  52         val udb = Posix.SysDB.getpwnam requester
  53         val uid = Word.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
  54         val gid = Word.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
  55         val home = Posix.SysDB.Passwd.home udb
  56     in
  57         if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain,
  58                              "\" set home=", home, " mail=", mailbox,
  59                              " uid=", Int.toString uid, " gid=" ^ Int.toString gid]) then
  60             SOME "Error running userdb"
  61         else
  62             let
  63                 val proc = Unix.execute ("/bin/sh", ["-c",
  64                                                      String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
  65                                                                     " \"", domain, "/", user, "@", domain, "\" set systempw"]])
  66                 val outf = Unix.textOutstreamOf proc
  67             in
  68                 TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
  69                 TextIO.closeOut outf;
  70                 if not (OS.Process.isSuccess (Unix.reap proc)) then
  71                     (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
  72                      SOME "Error setting password")
  73                 else if not (rebuild ()) then
  74                     (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
  75                      SOME "Error reloading userdb")
  76                 else
  77                     NONE
  78             end
  79     end
  80
  81 fun passwd {domain, user, passwd} =
  82     let
  83         val proc = Unix.execute ("/bin/sh", ["-c",
  84                                              String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
  85                                                             " \"", domain, "/", user, "@", domain, "\" set systempw"]])
  86         val outf = Unix.textOutstreamOf proc
  87     in
  88         TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
  89         TextIO.closeOut outf;
  90         if not (OS.Process.isSuccess (Unix.reap proc)) then
  91             SOME "Error setting password"
  92         else if not (rebuild ()) then
  93             SOME "Error reloading userdb"
  94         else
  95             NONE
  96     end
  97
  98 fun rm {domain, user} =
  99     if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]) then
 100         SOME "Error deleting password entry"
 101     else if not (rebuild ()) then
 102         SOME "Error reloading userdb"
 103     else
 104         NONE
 105
 106 end