--- nfo/perl/scripts/dispatchmail/bin/dispatchmail	2003/01/22 05:07:56	1.1
+++ nfo/perl/scripts/dispatchmail/bin/dispatchmail	2003/01/22 07:16:51	1.3
@@ -1,59 +1,24 @@
 #!/usr/bin/perl
 
-# ==========================================================================
+# ============================================================
 #
-# recieveMail v0.04
-#   a simple mail filter done in perl with CPAN-module "Mail::Audit"
+#  dispatchmail v0.05
+#    A simple mail filter done in perl 
+#    with the Perl-module "Mail::Audit" 
+#    available from CPAN.
 #
+#  $Id: dispatchmail,v 1.3 2003/01/22 07:16:51 root Exp $
 #
-# 2002-11-09, joko@netfrag.org
-#   + recieveMail now can run globally (/etc/mail/smrsh!)
-#     + $HOME is taken from $ENV{HOME} or $ENV{PWD}
-#     + rules are taken from $HOME/Mail/.rules.pm
-#     + fallback mechanism(s)
-#   + bugfixes
-#
-# 2002-10-14, joko@netfrag.org
-#   + $LOGFILE is used now (recievemail.log)
-#   + tracing (uses $LOGFILE)
-#   + checks delivery path for existance,
-#     changes $LOGFILE if needed
-#   
-# 2002-07-17, joko@netfrag.org
-#   + added filtering by target (destination-routing)
-#     (looks in "to", "cc" and "bcc")
-#   
-# 2001-12-05, joko@netfrag.org
-#   + initial internal release
-#
-#
-# TODO:
-#   - more sophisticated filtering
-#   - configuration-comfort (use perl-arrays and -hashes for rule-declaration)
-#   - Html-Gui to add/edit/remove rules
-#   - rule base located in LDAP (local delivery routing)
-#   - completely hide away regex-stuff and provide simpler wildcarding
-#     - hide needed quoting of dots (.) and ats (@) in addresses
-#     - provide: beginsWith(string), endsWith(string), beginsAt(string, pos|regex)
-#       - this could become a CPAN-module sometimes (?):
-#       - "String"-Object to be inherited from gives these methods to you
-#       - examples:
-#         - routeTo("mbox:/path/to/mbox") if $to->beginsWith("hello");
-#         - routeTo("fax:+4930123456")    if $subject->contains("gatefax");
-#   - metadata:
-#     - add some info about the context we are running in:
-#       - console
-#       - sendmail/normal
-#       - sendmail/smrsh
-#     - add some info about the user we are doing this for:
-#       - username
-#       - home-directory
-#
-# WISHLIST:
-#   - format basic log-output similar to procmail.log
-#   - introduce some "extended logging" including the chosen routing path
+# ============================================================
+#  $Log: dispatchmail,v $
+#  Revision 1.3  2003/01/22 07:16:51  root
+#  + sub traceEntry
+#  + further refactorings
 #
-# ==========================================================================
+#  Revision 1.2  2003/01/22 05:38:44  collector
+#  + prepared refactoring to 'dispatchmail'
+#
+# ============================================================
 
 use strict;
 # don't use warnings;
@@ -63,6 +28,11 @@
 use Getopt::Long;
 
 
+use lib qw( /data/libs/nfo/perl/libs );
+use org::netfrag::shortcuts qw( now );
+
+
+
 # - - - - - - - - - - - - - - - - - - - -
 #               options
 # - - - - - - - - - - - - - - - - - - - -
@@ -75,6 +45,9 @@
 $opt_base ||= $ENV{HOME};
 $opt_base ||= $ENV{PWD};
 
+my $LOG     = 1;	# writes reports to logfile
+my $VERBOSE = 1;	# writes reports to STDOUT
+my $TRACE   = 1;	# writes contents of messages to logfile
 
 # - - - - - - - - - - - - - - - - - - - -
 #
@@ -85,17 +58,14 @@
 #      mail should be delivered to
 #
 # - - - - - - - - - - - - - - - - - - - -
-#my $HOME = "/home/joko/virtual/joko_mail";
 my $USER      = $ENV{USER};
 my $HOME      = $opt_base;
 my $MAILDIR   = "$HOME/Mail";
-my $LOGFILE   = "$MAILDIR/recievemail.log";
-my $RULESFILE = "$MAILDIR/.rules.pm";
-my $LOCKFILE  = "$HOME/.procmail.lockfile";
+my $RULESFILE = "$HOME/.dispatchmailrc.pm";
+#my $LOCKFILE  = "$HOME/.procmail.lockfile";
+my $LOCKFILE  = "$HOME/.dispatchmail.lockfile";
+my $LOGFILE   = "$MAILDIR/.dispatchmail.log";
 my $DEFAULT   = "$MAILDIR/Inbox";
-my $DEBUG   = 0;
-my $TRACE   = 1;
-my $VERBOSE = 1;
 
 # override settings
   # override $RULESFILE if given as option on the command line
@@ -103,6 +73,9 @@
   # change logfile
   $LOGFILE = "recievemail-emerg.log" if (! -e $MAILDIR);
 
+  $USER ||= '';
+
+
 
 # - - - - - - - - - - - - - - - - - - - -
 #                 main
@@ -111,11 +84,19 @@
   # "jump" into processing of new incoming mail and get a "handler" to this mail
   my $incoming = Mail::Audit->new;
 
+  sub traceEntry {
+    s2f('-' x 40 . '  TRACE  ' . '-' x 10);
+    s2f("From:    " . gchomp($incoming->from));
+    s2f("To:      " . gchomp($incoming->to));
+    s2f("Subject: " . gchomp($incoming->subject));
+    s2f('-' x 40 . '  TRACE  ' . '-' x 10);
+  }
+
+
   # 0.a. pre flight tracing
-    if ($TRACE) {
-      s2f("Mail from " . gchomp($incoming->from) . " to " . gchomp($incoming->to));
-      s2f("Subject: " . gchomp($incoming->subject));
-    }
+    my $now = now();
+    report("$0 running at $now for user '$USER'.");
+    traceEntry() if $TRACE;
 
   # 0.b. pre flight checks
 
@@ -125,25 +106,25 @@
      if (! -e $MAILDIR) {
        my $msg = "delivery failed, base directory $MAILDIR does not exist";
        report($msg);
-       accept_spool();
+       forward_delivery();
      }
 
   # 1. include rules or fallback
     # check if $RULESFILE exists
     if (-f $RULESFILE) {
-      report("loading rules from \"$RULESFILE\"");
+      report("Loading rules from \"$RULESFILE\".");
       require $RULESFILE;
     } else {
       #die("$RULESFILE doesn't exist");
-      report("configured rulesfile \"$RULESFILE\" doesn't exist");
-      accept_spool();
+      report("Configured rulesfile \"$RULESFILE\" doesn't exist.");
+      forward_delivery();
     }
 
   # 2. export required stuff to rules namespace
     export_symbols();
 
   # 3. run dispatcher
-    report("running \"rules::dispatch\"");
+    report("Running \"rules::dispatch\".");
     rules::dispatch();
 
   # 4. dispatcher didn't do anything
@@ -177,7 +158,7 @@
     # TODO: tracing, debugging
 
     print $msg, "\n" if $VERBOSE;
-    if ($TRACE) {
+    if ($LOG) {
       s2f($msg);
     }
 
@@ -199,12 +180,12 @@
   sub jaccept {
     my $deliver_to = shift;
     
-    report("delivering to: $deliver_to");
+    report("ACCEPT: $deliver_to");
 
     # check deliver_to path
     if (! -e $deliver_to) {
       report("deliver_to path \"$deliver_to\" doesn't exist");
-      accept_spool();
+      forward_delivery();
       return;
     }
 
@@ -217,6 +198,11 @@
     $incoming->accept($path);
   }
 
+  sub forward_delivery {
+    report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
+    $incoming->accept;
+  }
+
 
 # - - - - - - - - - - - - - - - - - - - -
 #             helper functions