X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/8ca17b9a328732cac9ccd9e1c96c8d35777afe88..0e0442b0650ceb74175905578054db8877b1bbbd:/src/mail/vmail.sml

diff --git a/src/mail/vmail.sml b/src/mail/vmail.sml
index 8e92f60..0594fb1 100644
--- a/src/mail/vmail.sml
+++ b/src/mail/vmail.sml
@@ -35,6 +35,43 @@ fun rebuild () =
 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 {user : string, mailbox : string} list
@@ -112,6 +149,25 @@ fun setpassword {domain, user, passwd} =
 	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"])
@@ -149,6 +205,19 @@ fun passwd {domain, user, passwd} =
     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"