X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/1d3ef80ec822ea0fa241eb5485549ca7417e787f..291eacbf162d2823f4667cbb3f9330528c4acf99:/src/mail/vmail.sml?ds=sidebyside diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml index f5010eb..1d5262d 100644 --- a/src/mail/vmail.sml +++ b/src/mail/vmail.sml @@ -1,5 +1,5 @@ (* 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 @@ -20,41 +20,120 @@ 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 - | Listing of string list + | Listing of {user : string, mailbox : string} list 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}) - fun loop users = + fun loop () = 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 - [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 - loop [] + loop () 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 - 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 - 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" @@ -79,24 +158,28 @@ fun add {domain, requester, user, passwd, mailbox} = 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} = - 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"