mlton: bin/domtool-server bin/domtool-client bin/domtool-slave \
bin/domtool-admin bin/domtool-doc bin/dbtool bin/vmail \
bin/smtplog bin/setsa bin/mysql-fixperms bin/webbw bin/domtool-tail \
- bin/fwtool bin/domtool-config
+ bin/fwtool bin/domtool-config bin/domtool-portal
smlnj: $(COMMON_DEPS) openssl/smlnj/FFI/libssl.h.cm pcre/smlnj/FFI/libpcre.h.cm \
src/domtool.cm
$(MAKE_MLB_BASE) >src/domtool-config.mlb
echo "main-config.sml" >>src/domtool-config.mlb
+src/domtool-portal.mlb: src/prefix.mlb src/sources src/suffix.mlb
+ $(MAKE_MLB_BASE) >src/domtool-portal.mlb
+ echo "main-portal.sml" >>src/domtool-portal.mlb
+
openssl/smlnj/FFI/libssl.h.cm: openssl/openssl_sml.h
cd openssl/smlnj ; ml-nlffigen -d FFI -lh LibsslH.libh -include ../libssl-h.sml \
-cm libssl.h.cm -D__builtin_va_list="void*" \
bin/domtool-config: $(COMMON_MLTON_DEPS) src/domtool-config.mlb src/main-config.sml
$(MLTON) -output bin/domtool-config src/domtool-config.mlb
+bin/domtool-portal: $(COMMON_MLTON_DEPS) src/domtool-portal.mlb src/main-portal.sml
+ $(MLTON) -output bin/domtool-portal src/domtool-portal.mlb
+
elisp/domtool-tables.el: lib/*.dtl bin/domtool-doc
bin/domtool-doc -basis -emacs >$@
cp scripts/domtool-publish /usr/local/sbin/
cp scripts/domtool-reset-global /usr/local/sbin/
cp scripts/domtool-reset-local /usr/local/sbin/
+ cp scripts/domtool-vmailpasswd /usr/local/sbin/
cp scripts/domtool-adduser /usr/local/bin/
cp scripts/domtool-addcert /usr/local/bin/
cp scripts/domtool-readdcerts /usr/local/bin/
-cp bin/domtool-tail /usr/local/bin/
-chmod +s /usr/local/bin/domtool-tail
cp bin/domtool-config /usr/local/bin/
+ cp bin/domtool-portal /usr/local/sbin/
cp src/plugins/domtool-postgres /usr/local/sbin/
cp src/plugins/domtool-mysql /usr/local/sbin/
-mkdir -p $(EMACS_DIR)
--- /dev/null
+#!/usr/bin/python2
+# -*- python -*-
+
+# Helper for domtool to check if a vmail password matches the stored
+# password, before allowing the portal to change the password. This
+# should never be run manually, since it does not suppress echoing of
+# anything entered.
+
+import crypt, getpass, sys
+
+def getpasswords ():
+ crypted = raw_input()
+ clear = raw_input()
+ return (crypted, clear)
+
+def checkpassword (crypted, clear):
+ return crypt.crypt (clear, crypted) == crypted
+
+def main ():
+ (crypted, clear) = getpasswords ()
+ if checkpassword (crypted, clear):
+ sys.exit ()
+ else:
+ sys.exit (1)
+
+if __name__ == "__main__":
+ main ()
val passwd : {domain : string, user : string, passwd : string}
-> string option
+ val portalpasswd : {domain : string, user : string, oldpasswd : string, newpasswd : string}
+ -> string option
+
val rm : {domain : string, user : string} -> string option
val doChanged : unit -> bool
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
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"])
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"
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * 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
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *)
+
+(* Portal helper utility. *)
+
+(* Duplicated from main-config.sml, should be put into a common module
+ and all domtool commands should return proper exit codes instead of
+ always succeeding *)
+
+fun println x = (print x; print "\n")
+fun printerr x = (TextIO.output (TextIO.stdErr, x); TextIO.flushOut TextIO.stdErr)
+fun die reason = (printerr reason; printerr "\n"; OS.Process.exit OS.Process.failure)
+
+val _ =
+ case CommandLine.arguments () of
+ ["vmailpasswd", domain, user] =>
+ (case Client.getpass () of
+ Client.Passwd oldpasswd =>
+ (case Client.getpass () of
+ Client.Passwd newpasswd =>
+ Main.requestPortalPasswdMailbox {domain = domain,
+ user = user,
+ oldpasswd = oldpasswd,
+ newpasswd = newpasswd}
+ | Client.Aborted => die "Aborted"
+ | Client.Error => die "New passwords did not match")
+ | _ => die "Error entering old password")
+ | _ => die "Invalid command-line arguments"
+
passwd : string, mailbox : string} -> unit
val requestPasswdMailbox : {domain : string, user : string, passwd : string}
-> unit
+ val requestPortalPasswdMailbox : {domain : string, user : string, oldpasswd : string, newpasswd : string}
+ -> unit
val requestRmMailbox : {domain : string, user : string} -> unit
val requestSaQuery : string -> unit
OpenSSL.close bio
end
+fun requestPortalPasswdMailbox p =
+ let
+ val (_, bio) = requestBio (fn () => ())
+ in
+ Msg.send (bio, MsgPortalPasswdMailbox p);
+ case Msg.recv bio of
+ NONE => print "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgOk => print ("The password for " ^ #user p ^ "@" ^ #domain p ^ " has been changed.\n")
+ | MsgError s => print ("Set failed: " ^ s ^ "\n")
+ | _ => print "Unexpected server reply.\n";
+ OpenSSL.close bio
+ end
+
fun requestRmMailbox p =
let
val (_, bio) = requestBio (fn () => ())
SOME msg))
(fn () => ())
+ | MsgPortalPasswdMailbox {domain, user = emailUser, oldpasswd, newpasswd} =>
+ doIt (fn () =>
+ if not (Acl.query {user = user, class = "priv", value = "vmail"}) then
+ ("User is not authorized to run portal vmail password",
+ SOME "You're not authorized to use the portal password command")
+ else if not (Domain.validEmailUser emailUser) then
+ ("Invalid e-mail username " ^ emailUser,
+ SOME "Invalid e-mail username")
+ else if not (CharVector.all Char.isGraph oldpasswd
+ andalso CharVector.all Char.isGraph newpasswd) then
+ ("Invalid password",
+ SOME "Invalid password; may only contain printable, non-space characters")
+ else
+ case Vmail.portalpasswd {domain = domain, user = emailUser,
+ oldpasswd = oldpasswd, newpasswd = newpasswd} of
+ NONE => ("Changed password of mailbox " ^ emailUser ^ "@" ^ domain,
+ NONE)
+ | SOME msg => ("Error changing mailbox password for " ^ emailUser ^ "@" ^ domain ^ ": " ^ msg,
+ SOME msg))
+ (fn () => ())
+
| MsgRmMailbox {domain, user = emailUser} =>
doIt (fn () =>
if not (Domain.yourDomain domain) then
OpenSSL.writeString (bio, section);
OpenSSL.writeString (bio, description))
| MsgSaChanged => OpenSSL.writeInt (bio, 45)
+ | MsgPortalPasswdMailbox {domain : string, user : string, oldpasswd : string, newpasswd : string} =>
+ (OpenSSL.writeInt (bio, 46);
+ OpenSSL.writeString (bio, domain);
+ OpenSSL.writeString (bio, user);
+ OpenSSL.writeString (bio, oldpasswd);
+ OpenSSL.writeString (bio, newpasswd))
fun checkIt v =
case v of
(SOME section, SOME description) => SOME (MsgAptQuery {section = section, description = description})
| _ => NONE)
| 45 => SOME MsgSaChanged
+ | 46 => (case (OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio, OpenSSL.readString bio) of
+ (SOME domain, SOME user, SOME oldpasswd, SOME newpasswd) =>
+ SOME (MsgPortalPasswdMailbox {domain = domain, user = user, oldpasswd = oldpasswd, newpasswd = newpasswd})
+ | _ => NONE)
| _ => NONE)
end
(* Request creation of a new vmail mapping *)
| MsgPasswdMailbox of {domain : string, user : string, passwd : string}
(* Change a vmail account's password *)
+ | MsgPortalPasswdMailbox of {domain : string, user : string, oldpasswd : string, newpasswd : string}
+ (* Change a vmail account's password if the old password matches *)
| MsgRmMailbox of {domain : string, user : string}
(* Remove a vmail mapping *)
| MsgListMailboxes of string