(* HCoop Domtool (http://hcoop.sourceforge.net/)
- * Copyright (c) 2006, Adam Chlipala
+ * Copyright (c) 2006-2009, Adam Chlipala
+ * Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>
*
* This program is free software; you can redistribute it and/or
* modify it under the terms of the GNU General Public License
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");
+ Connect.commandWorker (Domain.get_context (), site, MsgVmailChanged))
+ in
+ foldl doNode true Config.mailNodes_all
+ end
+
+fun doChanged () =
+ 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
- | Listing of string list
+ | Listing of {user : string, mailbox : string} list
fun list domain =
let
- val inf = TextIO.openIn (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
+ 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.Vmail.userDatabase,
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} =
+fun setpassword {domain, user, passwd} =
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 home = Posix.SysDB.Passwd.home udb
+ 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
- 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"
- 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
+ TextIO.output (outf, String.concat [passwd, "\n", passwd, "\n"]);
+ TextIO.closeOut outf;
+ OS.Process.isSuccess (Unix.reap proc)
end
-fun passwd {domain, user, passwd} =
+
+fun checkpassword {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 proc = Unix.execute (Config.installPrefix ^ "/sbin/domtool-vmailpasswd", [])
val outf = Unix.textOutstreamOf proc
+ val db = readUserdb domain
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"
+ 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
+ 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 mailboxExists {domain = domain, user = user} then
+ SOME "Mailbox mapping already exists"
+ 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
- SOME "Error reloading userdb"
+ (ignore (deluser {domain = domain, user = user});
+ SOME "Error reloading userdb")
else
NONE
end
+fun passwd {domain, user, passwd} =
+ if not (mailboxExists {domain = domain, user = user}) then
+ SOME "Mailbox doesn't exist"
+ 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 (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 (deluser {domain = domain, user = user}) then
SOME "Error deleting password entry"
else if not (rebuild ()) then
SOME "Error reloading userdb"
HCoop / hcoop / domtool2.git / blobdiff