X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/1d3ef80ec822ea0fa241eb5485549ca7417e787f..0e0442b0650ceb74175905578054db8877b1bbbd:/src/mail/vmail.sml?ds=inline

diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
index f5010eb..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, 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
@@ -20,83 +21,207 @@
 
 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"