X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/201b83c73c5a4e09dcf4c3f2f9b94ded360c78c6..0e0442b0650ceb74175905578054db8877b1bbbd:/src/mail/vmail.sml diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml index 48d2287..0594fb1 100644 --- a/src/mail/vmail.sml +++ b/src/mail/vmail.sml @@ -1,5 +1,6 @@ (* HCoop Domtool (http://hcoop.sourceforge.net/) * Copyright (c) 2006-2009, Adam Chlipala + * Copyright (c) 2014 Clinton Ebadi * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License @@ -26,39 +27,50 @@ fun rebuild () = let fun doNode (site, ok) = (print ("New vmail data for node " ^ site ^ "\n"); - if site = Config.dispatcherName 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) + Connect.commandWorker (Domain.get_context (), site, MsgVmailChanged)) in - Slave.shell [Config.Courier.pushUserdb] - andalso foldl doNode true Config.mailNodes_all + foldl doNode true Config.mailNodes_all end fun doChanged () = - Slave.shell [Config.Courier.pullUserdb] - andalso Slave.shell [Config.Courier.postReload] + Slave.shell [Config.Courier.postReload] + + +structure SM = DataStructures.StringMap + +exception Userdb of string + +fun readUserdb domain = + let + val file = OS.Path.joinDirFile {dir = Config.Vmail.userDatabase, + file = domain} + in + if Posix.FileSys.access (file, []) then + let + val inf = TextIO.openIn file + + fun parseField (field, fields) = + case String.fields (fn ch => ch = #"=") field of + [key, value] => SM.insert (fields, key, value) + | _ => raise Userdb ("Malformed fields in vmail userdb for domain " ^ domain) + + fun loop users = + case TextIO.inputLine inf of + NONE => users + | SOME line => + case String.tokens Char.isSpace line of + [addr, fields] => (case String.fields (fn ch => ch = #"@") addr of + [user, _] => + loop (SM.insert (users, user, foldl parseField SM.empty (String.fields (fn ch => ch = #"|") fields))) + | _ => raise Userdb ("Malformed address in vmail userdb for " ^ domain ^ ": " ^ addr)) + | _ => raise Userdb ("Malformed record in vmail userdb for domain " ^ domain) + in + loop SM.empty + before TextIO.closeIn inf + end + else + SM.empty + end datatype listing = Error of string @@ -66,7 +78,7 @@ datatype listing = fun list domain = let - val file = OS.Path.joinDirFile {dir = Config.Courier.userdbDir, + val file = OS.Path.joinDirFile {dir = Config.Vmail.userDatabase, file = domain} in if Posix.FileSys.access (file, []) then @@ -104,7 +116,7 @@ fun list domain = fun mailboxExists {domain, user} = let - val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Courier.userdbDir, + val inf = TextIO.openIn (OS.Path.joinDirFile {dir = Config.Vmail.userDatabase, file = domain}) fun loop () = @@ -124,6 +136,42 @@ fun mailboxExists {domain, user} = end handle IO.Io _ => false +fun setpassword {domain, user, passwd} = + let + val proc = Unix.execute ("/bin/sh", ["-c", + String.concat [Config.Vmail.userdbpw, " | ", Config.Vmail.userdb, + " -f ", Config.Vmail.userDatabase, "/", domain, + " \"", user, "@", domain, "\" set systempw"]]) + val outf = Unix.textOutstreamOf proc + in + TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]); + TextIO.closeOut outf; + OS.Process.isSuccess (Unix.reap proc) + end + + +fun checkpassword {domain, user, passwd} = + let + val proc = Unix.execute (Config.installPrefix ^ "/sbin/domtool-vmailpasswd", []) + val outf = Unix.textOutstreamOf proc + val db = readUserdb domain + in + case SM.find (db, user) of + SOME fields => + (case SM.find (fields, "systempw") of + SOME systempw => + (TextIO.output (outf, systempw ^ "\n"); + TextIO.output (outf, passwd ^ "\n"); + TextIO.closeOut outf; + OS.Process.isSuccess (Unix.reap proc)) + | NONE => raise Userdb ("systempw not found for user " ^ user ^ "@" ^ domain)) + | NONE => raise Userdb ("User " ^ user ^ " not found in vmail userdb for domain " ^ domain) + end + +fun deluser {domain, user} = + Slave.run (Config.Vmail.userdb, ["-f", Config.Vmail.userDatabase ^ "/" ^ domain, + user ^ "@" ^ domain, "del"]) + fun add {domain, requester, user, passwd, mailbox} = let val udb = Posix.SysDB.getpwnam requester @@ -133,53 +181,47 @@ fun add {domain, requester, user, passwd, mailbox} = in 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 + else if not (Slave.run (Config.Vmail.userdb, ["-f", Config.Vmail.userDatabase ^ "/" ^ domain, + user ^ "@" ^ domain, + "set", "home=" ^ home, "mail=" ^ mailbox, "uid=" ^ Int.toString uid, "gid=" ^ Int.toString gid])) then SOME "Error running userdb" + else if not (setpassword {domain = domain, user = user, passwd = passwd}) then + (ignore (deluser {domain = domain, user = user}); + SOME "Error setting password") + else if not (rebuild ()) then + (ignore (deluser {domain = domain, user = user}); + SOME "Error reloading userdb") 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 - (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]); - SOME "Error setting password") - else if not (rebuild ()) then - (ignore (Slave.shell [Config.Courier.userdb, " \"", domain, "/", user, "@", domain, "\" del"]); - SOME "Error reloading userdb") - else - NONE - end + NONE end fun passwd {domain, user, passwd} = 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 + else if not (setpassword {domain = domain, user = user, passwd = passwd}) then + SOME "Error setting password" + else if not (rebuild ()) then + SOME "Error reloading userdb" + else + NONE + +fun portalpasswd {domain, user, oldpasswd, newpasswd} = + (if not (mailboxExists {domain = domain, user = user}) then + SOME "Mailbox doesn't exist" + else if not (checkpassword {domain = domain, user = user, passwd = oldpasswd}) then + SOME "Old password incorrect" + else if not (setpassword {domain = domain, user = user, passwd = newpasswd}) then + SOME "Error setting password" + else if not (rebuild ()) then + SOME "Error reloading userdb" + else + NONE) + handle Userdb errmsg => SOME ("userdb error: " ^ errmsg) fun rm {domain, user} = 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 + else if not (deluser {domain = domain, user = user}) then SOME "Error deleting password entry" else if not (rebuild ()) then SOME "Error reloading userdb"