.PHONY: all mlton smlnj install
mlton: bin/domtool-server bin/domtool-client bin/domtool-slave \
- bin/domtool-admin bin/domtool-doc bin/dbtool bin/vmail
+ bin/domtool-admin bin/domtool-doc bin/dbtool bin/vmail \
+ bin/smtplog
smlnj: $(COMMON_DEPS) openssl/smlnj/FFI/libssl.h.cm src/domtool.cm
$(MAKE_MLB_BASE) >src/setsa.mlb
echo "main-setsa.sml" >>src/setsa.mlb
+src/smtplog.mlb: src/prefix.mlb src/sources src/suffix.mlb
+ $(MAKE_MLB_BASE) >src/smtplog.mlb
+ echo "main-smtplog.sml" >>src/smtplog.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/setsa: $(COMMON_MLTON_DEPS) src/setsa.mlb
mlton -output bin/setsa -link-opt -ldl src/setsa.mlb
+bin/smtplog: $(COMMON_MLTON_DEPS) src/smtplog.mlb
+ mlton -output bin/smtplog -link-opt -ldl src/smtplog.mlb
+
install:
cp scripts/domtool-publish /usr/local/sbin/
cp scripts/domtool-reset-global /usr/local/sbin/
-cp bin/dbtool /usr/local/bin/
-cp bin/vmail /usr/local/bin/
-cp bin/setsa /usr/local/bin/
+ -cp bin/smtplog /usr/local/bin/
cp src/plugins/domtool-postgres /usr/local/sbin/
cp src/plugins/domtool-mysql /usr/local/sbin/
domtool-doc
dbtool
vmail
-setsa
\ No newline at end of file
+setsa
+smtplog
val diff = "/usr/bin/diff"
val rm = "/bin/rm"
val echo = "/bin/echo"
+val grep = "/bin/grep"
+val sudo = "/usr/bin/sudo"
+val domtool_publish = "/usr/local/sbin/domtool-publish"
val defaultNs = "ns.hcoop.net"
val diff : string
val rm : string
val echo : string
+val grep : string
+val sudo : string
+val domtool_publish : string
(* DNS SOA parameter defaults *)
val defaultNs : string
val aliasTo = ["deleuze"]
+val mainLog = "/var/log/exim4/mainlog"
+
end
val aliasTo : string list
(* Default nodes to which alias directives are applied *)
+val mainLog : string
+(* Path to main log file *)
+
end
/etc/init.d/mailman reload
;;
courier)
- cat /etc/courier/userdb/* >/etc/courier/exim
- chmod o-r /etc/courier/exim
- exim_dbmbuild /etc/courier/exim /etc/courier/exim.dat
- chgrp mail /etc/courier/exim.dat
- chmod o-r /etc/courier/exim.dat
+ /bin/cat /etc/courier/userdb/* >/etc/courier/exim
+ /bin/chmod o-r /etc/courier/exim
+ /usr/sbin/exim_dbmbuild /etc/courier/exim /etc/courier/exim.dat
+ /bin/chgrp mail /etc/courier/exim.dat
+ /bin/chmod o-r /etc/courier/exim.dat
+ ;;
+ smtplog)
+ /bin/grep $2 /var/log/exim4/mainlog
;;
*)
echo "Usage: domtool-publish [apache|bind|exim|mailman]"
dbtool.mlb
vmail.mlb
setsa.mlb
+smtplog.mlb
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * 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.
+ *)
+
+(* Selective viewing of SMTP logs *)
+
+signature SMTP_LOG = sig
+
+ val search : (string -> unit) -> string -> unit
+ (* Given a callback for each line of log text, find all lines of the
+ * current mail log containing the specified domain name. *)
+
+end
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * 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.
+ *)
+
+(* Selective viewing of SMTP logs *)
+
+structure SmtpLog :> SMTP_LOG = struct
+
+fun search handler domain =
+ let
+ val proc = Unix.execute (Config.sudo,
+ [Config.domtool_publish,
+ "smtplog",
+ String.translate (fn #"." => "\\."
+ | ch => str ch) domain])
+
+ val inf = Unix.textInstreamOf proc
+
+ fun loop () =
+ case TextIO.inputLine inf of
+ NONE => ()
+ | SOME line => (handler line;
+ loop ())
+ in
+ loop ()
+ before (TextIO.closeIn inf;
+ ignore (Unix.reap proc))
+end
+
+end
--- /dev/null
+(* HCoop Domtool (http://hcoop.sourceforge.net/)
+ * Copyright (c) 2006, Adam Chlipala
+ *
+ * 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.
+ *)
+
+(* Driver for SMTP log searching *)
+
+val _ =
+ case CommandLine.arguments () of
+ [domain] => Main.requestSmtpLog domain
+ | _ => print "Bad command-line arguments.\n"
val requestSaQuery : string -> unit
val requestSaSet : string * bool -> unit
+
+ val requestSmtpLog : string -> unit
end
OpenSSL.close bio
end
+fun requestSmtpLog domain =
+ let
+ val (_, bio) = requestBio (fn () => ())
+
+ val _ = Msg.send (bio, MsgSmtpLogReq domain)
+
+ fun loop () =
+ case Msg.recv bio of
+ NONE => print "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgOk => ()
+ | MsgSmtpLogRes line => (print line;
+ loop ())
+ | MsgError s => print ("Log search failed: " ^ s ^ "\n")
+ | _ => print "Unexpected server reply.\n"
+ in
+ loop ();
+ OpenSSL.close bio
+ end
+
fun regenerate context =
let
val b = basis ()
NONE)))
(fn () => ())
+ | MsgSmtpLogReq domain =>
+ doIt (fn () =>
+ if not (Domain.yourDomain domain) then
+ ("Unauthorized user tried to request SMTP logs for " ^ domain,
+ SOME "You aren't authorized to configure that domain.")
+ else
+ (SmtpLog.search (fn line => Msg.send (bio, MsgSmtpLogRes line))
+ domain;
+ ("Requested SMTP logs for " ^ domain,
+ NONE)))
+ (fn () => ())
+
| _ =>
doIt (fn () => ("Unexpected command",
SOME "Unexpected command"))
| MsgSaSet (addr, b) => (OpenSSL.writeInt (bio, 25);
OpenSSL.writeString (bio, addr);
sendBool (bio, b))
+ | MsgSmtpLogReq domain => (OpenSSL.writeInt (bio, 26);
+ OpenSSL.writeString (bio, domain))
+ | MsgSmtpLogRes domain => (OpenSSL.writeInt (bio, 27);
+ OpenSSL.writeString (bio, domain))
fun checkIt v =
case v of
| 25 => (case (OpenSSL.readString bio, recvBool bio) of
(SOME user, SOME b) => SOME (MsgSaSet (user, b))
| _ => NONE)
+ | 26 => Option.map MsgSmtpLogReq (OpenSSL.readString bio)
+ | 27 => Option.map MsgSmtpLogRes (OpenSSL.readString bio)
| _ => NONE)
end
(* Response to MsgSaQuery *)
| MsgSaSet of string * bool
(* Set the filtering status of a user or e-mail address *)
+ | MsgSmtpLogReq of string
+ (* Request all current SMTP log lines about a domain *)
+ | MsgSmtpLogRes of string
+ (* One line of a response to MsgSmtpLogReq *)
end
mail/setsa.sig
mail/setsa.sml
+mail/smtplog.sig
+mail/smtplog.sml
+
order.sig
order.sml