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 {user : string, mailbox : string} list
  28
  29 fun list domain =
  30     let
  31         val file = OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
  32                                                       file = domain}
  33     in
  34         if Posix.FileSys.access (file, []) then
  35             let
  36                 val inf = TextIO.openIn file
  37
  38                 fun loop users =
  39                     case TextIO.inputLine inf of
  40                         NONE => Listing (rev users)
  41                       | SOME line =>
  42                         case String.tokens Char.isSpace line of
  43                             [addr, fields] =>
  44                             (case String.fields (fn ch => ch = #"@") addr of
  45                                  [user, _] =>
  46                                  let
  47                                      fun parseFields fields =
  48                                          case fields of
  49                                              "mail" :: mailbox :: _ => loop ({user = user, mailbox = mailbox} :: users)
  50                                            | _ :: _ :: rest => parseFields rest
  51                                            | _ => Error "Invalid fields in database"
  52                                  in
  53                                      parseFields (String.fields (fn ch => ch = #"|" orelse ch = #"=") fields)
  54                                  end
  55                                | _ => Error "Invalid e-mail address format in database")
  56                           | _ => Error "Invalid entry in database"
  57             in
  58                 loop []
  59                 before TextIO.closeIn inf
  60             end
  61         else
  62             Listing []
  63     end
  64     handle IO.Io {name, function, ...} =>
  65            Error ("IO failure: " ^ name ^ ": " ^ function)
  66
  67 fun mailboxExists {domain, user} =
  68     let
  69         val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir,
  70                                                       file = domain})
  71
  72         fun loop () =
  73             case TextIO.inputLine inf of
  74                 NONE => false
  75               | SOME line =>
  76                 case String.tokens Char.isSpace line of
  77                     [addr, _] =>
  78                     (case String.fields (fn ch => ch = #"@") addr of
  79                          [user', _] =>
  80                          user' = user orelse loop ()
  81                        | _ => false)
  82                   | _ => false
  83     in
  84         loop ()
  85         before TextIO.closeIn inf
  86     end
  87         handle IO.Io _ => false
  88
  89 fun add {domain, requester, user, passwd, mailbox} =
  90     let
  91         val udb = Posix.SysDB.getpwnam requester
  92         val uid = SysWord.toInt (Posix.ProcEnv.uidToWord (Posix.SysDB.Passwd.uid udb))
  93         val gid = SysWord.toInt (Posix.ProcEnv.gidToWord (Posix.SysDB.Passwd.gid udb))
  94         val home = Posix.SysDB.Passwd.home udb
  95     in
  96         if mailboxExists {domain = domain, user = user} then
  97             SOME "Mailbox mapping already exists"
  98         else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain,
  99                              "\" set home=", home, " mail=", mailbox,
 100                              " uid=", Int.toString uid, " gid=" ^ Int.toString gid]) then
 101             SOME "Error running userdb"
 102         else
 103             let
 104                 val proc = Unix.execute ("/bin/sh", ["-c",
 105                                                      String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
 106                                                                     " \"", domain, "/", user, "@", domain, "\" set systempw"]])
 107                 val outf = Unix.textOutstreamOf proc
 108             in
 109                 TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
 110                 TextIO.closeOut outf;
 111                 if not (OS.Process.isSuccess (Unix.reap proc)) then
 112                     (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
 113                      SOME "Error setting password")
 114                 else if not (rebuild ()) then
 115                     (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]);
 116                      SOME "Error reloading userdb")
 117                 else
 118                     NONE
 119             end
 120     end
 121
 122 fun passwd {domain, user, passwd} =
 123     if not (mailboxExists {domain = domain, user = user}) then
 124         SOME "Mailbox doesn't exist"
 125     else let
 126             val proc = Unix.execute ("/bin/sh", ["-c",
 127                                                  String.concat [Config.Courier.userdbpw, " | ", Config.Courier.userdb,
 128                                                                 " \"", domain, "/", user, "@", domain, "\" set systempw"]])
 129             val outf = Unix.textOutstreamOf proc
 130         in
 131             TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
 132             TextIO.closeOut outf;
 133             if not (OS.Process.isSuccess (Unix.reap proc)) then
 134                 SOME "Error setting password"
 135             else if not (rebuild ()) then
 136                 SOME "Error reloading userdb"
 137             else
 138                 NONE
 139         end
 140
 141 fun rm {domain, user} =
 142     if not (mailboxExists {domain = domain, user = user}) then
 143         SOME "Mailbox doesn't exist"
 144     else if not (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]) then
 145         SOME "Error deleting password entry"
 146     else if not (rebuild ()) then
 147         SOME "Error reloading userdb"
 148     else
 149         NONE
 150
 151 end