smtplog

diff --git a/Makefile b/Makefile
index a89036b..8189d06 100644 (file)
--- 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 \
 .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
 
 
 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
 
        $(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*" \
 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/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/
 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/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/
 
        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 (file)
--- a/bin/.cvsignore
+++ b/bin/.cvsignore
@@ -5,4 +5,5 @@ domtool-admin
 domtool-doc
 dbtool
 vmail
 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 (file)
--- 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 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 defaultNs = "ns.hcoop.net"
 

diff --git a/configDefault/domtool.cfs b/configDefault/domtool.cfs
index 61375b1..ed66232 100644 (file)
--- 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 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
 
 (* DNS SOA parameter defaults *)
 val defaultNs : string

diff --git a/configDefault/exim.cfg b/configDefault/exim.cfg
index df73715..ac20501 100644 (file)
--- 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 aliasTo = ["deleuze"]
 

+val mainLog = "/var/log/exim4/mainlog"
+

 end
 end

diff --git a/configDefault/exim.csg b/configDefault/exim.csg
index e666016..b76e4c5 100644 (file)
--- 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 aliasTo : string list
 (* Default nodes to which alias directives are applied *)
 

+val mainLog : string
+(* Path to main log file *)
+

 end
 end

diff --git a/scripts/domtool-publish b/scripts/domtool-publish
index e208877..fdc9da8 100755 (executable)
--- a/scripts/domtool-publish
+++ b/scripts/domtool-publish
@@ -28,11 +28,14 @@ case $1 in
                /etc/init.d/mailman reload
        ;;
        courier)
                /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]"
        ;;
        *)
                echo "Usage: domtool-publish [apache|bind|exim|mailman]"

diff --git a/src/.cvsignore b/src/.cvsignore
index 09dde33..28d4055 100644 (file)
--- a/src/.cvsignore
+++ b/src/.cvsignore
@@ -10,3 +10,4 @@ domtool-doc.mlb
 dbtool.mlb
 vmail.mlb
 setsa.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 (file)
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 (file)
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 (file)
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 (file)
--- 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 requestSaQuery : string -> unit
     val requestSaSet : string * bool -> unit

+
+    val requestSmtpLog : string -> unit

 end
 end

diff --git a/src/main.sml b/src/main.sml
index ef6e563..f9b2c9f 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -510,6 +510,27 @@ fun requestSaSet p =
        OpenSSL.close bio
     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 ()
 fun regenerate context =
     let
        val b = basis ()


@@ -897,6 +918,18 @@ fun service () =
                                                             NONE)))
                                     (fn () => ())
 
                                                             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"))
                              | _ =>
                                doIt (fn () => ("Unexpected command",
                                                SOME "Unexpected command"))

diff --git a/src/msg.sml b/src/msg.sml
index 1d168af..cf7edbf 100644 (file)
--- 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))
       | 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
 
 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)
                   | 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
                   | _ => NONE)
         
 end

diff --git a/src/msgTypes.sml b/src/msgTypes.sml
index 7f328e3..efcbefa 100644 (file)
--- 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 *)
        (* 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
 
 end

diff --git a/src/sources b/src/sources
index 4eb2399..2aff199 100644 (file)
--- a/src/sources
+++ b/src/sources
@@ -92,6 +92,9 @@ mail/vmail.sml
 mail/setsa.sig
 mail/setsa.sml
 
 mail/setsa.sig
 mail/setsa.sml
 

+mail/smtplog.sig
+mail/smtplog.sml
+

 order.sig
 order.sml
 
 order.sig
 order.sml