From 2bc5ed226e9a0cba24f9d689754e1d62bb883d86 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 24 Dec 2006 03:30:43 +0000 Subject: [PATCH] smtplog --- Makefile | 11 +++++++++- bin/.cvsignore | 3 ++- configDefault/domtool.cfg | 3 +++ configDefault/domtool.cfs | 3 +++ configDefault/exim.cfg | 2 ++ configDefault/exim.csg | 3 +++ scripts/domtool-publish | 13 +++++++----- src/.cvsignore | 1 + src/mail/smtplog.sig | 27 ++++++++++++++++++++++++ src/mail/smtplog.sml | 44 +++++++++++++++++++++++++++++++++++++++ src/main-smtplog.sml | 24 +++++++++++++++++++++ src/main.sig | 2 ++ src/main.sml | 33 +++++++++++++++++++++++++++++ src/msg.sml | 6 ++++++ src/msgTypes.sml | 4 ++++ src/sources | 3 +++ 16 files changed, 175 insertions(+), 7 deletions(-) create mode 100644 src/mail/smtplog.sig create mode 100644 src/mail/smtplog.sml create mode 100644 src/main-smtplog.sml diff --git a/Makefile b/Makefile index a89036b..8189d06 100644 --- a/Makefile +++ b/Makefile @@ -6,7 +6,8 @@ COMMON_DEPS := configDefault/config.sig configDefault/configDefault.sml \ .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 @@ -73,6 +74,10 @@ src/setsa.mlb: src/prefix.mlb src/sources src/suffix.mlb $(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*" \ @@ -120,6 +125,9 @@ bin/vmail: $(COMMON_MLTON_DEPS) src/vmail.mlb 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/ @@ -137,6 +145,7 @@ install: -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/ diff --git a/bin/.cvsignore b/bin/.cvsignore index 21f1267..fe46df0 100644 --- a/bin/.cvsignore +++ b/bin/.cvsignore @@ -5,4 +5,5 @@ domtool-admin domtool-doc dbtool vmail -setsa \ No newline at end of file +setsa +smtplog diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg index e1d427a..730414f 100644 --- a/configDefault/domtool.cfg +++ b/configDefault/domtool.cfg @@ -7,6 +7,9 @@ val cp = "/bin/cp" 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" diff --git a/configDefault/domtool.cfs b/configDefault/domtool.cfs index 61375b1..ed66232 100644 --- a/configDefault/domtool.cfs +++ b/configDefault/domtool.cfs @@ -14,6 +14,9 @@ val cp : string 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 diff --git a/configDefault/exim.cfg b/configDefault/exim.cfg index df73715..ac20501 100644 --- a/configDefault/exim.cfg +++ b/configDefault/exim.cfg @@ -8,4 +8,6 @@ val reload = "/usr/bin/sudo /usr/local/sbin/domtool-publish exim" val aliasTo = ["deleuze"] +val mainLog = "/var/log/exim4/mainlog" + end diff --git a/configDefault/exim.csg b/configDefault/exim.csg index e666016..b76e4c5 100644 --- a/configDefault/exim.csg +++ b/configDefault/exim.csg @@ -14,4 +14,7 @@ val handleDomains : string val aliasTo : string list (* Default nodes to which alias directives are applied *) +val mainLog : string +(* Path to main log file *) + end diff --git a/scripts/domtool-publish b/scripts/domtool-publish index e208877..fdc9da8 100755 --- a/scripts/domtool-publish +++ b/scripts/domtool-publish @@ -28,11 +28,14 @@ case $1 in /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]" diff --git a/src/.cvsignore b/src/.cvsignore index 09dde33..28d4055 100644 --- a/src/.cvsignore +++ b/src/.cvsignore @@ -10,3 +10,4 @@ domtool-doc.mlb dbtool.mlb vmail.mlb setsa.mlb +smtplog.mlb diff --git a/src/mail/smtplog.sig b/src/mail/smtplog.sig new file mode 100644 index 0000000..cd64a2f --- /dev/null +++ b/src/mail/smtplog.sig @@ -0,0 +1,27 @@ +(* 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 diff --git a/src/mail/smtplog.sml b/src/mail/smtplog.sml new file mode 100644 index 0000000..63f0fae --- /dev/null +++ b/src/mail/smtplog.sml @@ -0,0 +1,44 @@ +(* 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 diff --git a/src/main-smtplog.sml b/src/main-smtplog.sml new file mode 100644 index 0000000..60000c5 --- /dev/null +++ b/src/main-smtplog.sml @@ -0,0 +1,24 @@ +(* 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" diff --git a/src/main.sig b/src/main.sig index 621b455..c4f9b19 100644 --- a/src/main.sig +++ b/src/main.sig @@ -60,4 +60,6 @@ signature MAIN = sig val requestSaQuery : string -> unit val requestSaSet : string * bool -> unit + + val requestSmtpLog : string -> unit end diff --git a/src/main.sml b/src/main.sml index ef6e563..f9b2c9f 100644 --- a/src/main.sml +++ b/src/main.sml @@ -510,6 +510,27 @@ fun requestSaSet p = 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 () @@ -897,6 +918,18 @@ fun service () = 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")) diff --git a/src/msg.sml b/src/msg.sml index 1d168af..cf7edbf 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -162,6 +162,10 @@ fun send (bio, m) = | 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 @@ -250,6 +254,8 @@ fun recv bio = | 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 diff --git a/src/msgTypes.sml b/src/msgTypes.sml index 7f328e3..efcbefa 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -75,5 +75,9 @@ datatype msg = (* 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 diff --git a/src/sources b/src/sources index 4eb2399..2aff199 100644 --- a/src/sources +++ b/src/sources @@ -92,6 +92,9 @@ mail/vmail.sml mail/setsa.sig mail/setsa.sml +mail/smtplog.sig +mail/smtplog.sml + order.sig order.sml -- 2.20.1