--- nfo/perl/scripts/dispatchmail/recieveMail	2002/10/21 12:22:55	1.3
+++ nfo/perl/scripts/dispatchmail/recieveMail	2002/11/10 02:44:36	1.4
@@ -2,10 +2,17 @@
 
 # ==========================================================================
 #
-# recieveMail v0.03
+# recieveMail v0.04
 #   a simple mail filter done in perl with CPAN-module "Mail::Audit"
 #
 #
+# 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)
@@ -18,57 +25,141 @@
 #   
 # 2001-12-05, joko@netfrag.org
 #   + initial internal release
-#   TODO:
+#
+#
+# TODO:
 #   - more sophisticated filtering
-#   - configuration-comfort (use arrays and hashes, no "matching-code-worm")
-#   - Html-Gui to define rules
+#   - 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
 #
 # ==========================================================================
 
 use strict;
 # don't use warnings;
 
-# ----------------------------------------------------------
-# declare and initialize some variables
-# these are mostly directories for routing our mail to
-my $HOME = "/home/joko/virtual/joko_mail";
-my $MAILDIR = "$HOME/Mail";
-my $LOGFILE = "$MAILDIR/recievemail.log";
-my $LOCKFILE = "$HOME/.procmail.lockfile";
-my $DEFAULT = "$MAILDIR/SORTED/misc/Inbox";
-my $DEBUG = 0;
-my $TRACE = 1;
-
-if (! -e $HOME) {
-  $LOGFILE = "log/recievemail-emerg.log";
-  my $msg = "delivery failed, base directory $HOME does not exist";
-  open(FH, '>>' . $LOGFILE);
-  print FH $msg, "\n";
-  close(FH);
-  die($msg);
-}
+use Mail::Audit;
+use Data::Dumper;
+use Getopt::Long;
+
+
+# - - - - - - - - - - - - - - - - - - - -
+#               options
+# - - - - - - - - - - - - - - - - - - - -
+my $opt_base      = '';
+my $opt_rulesfile = '';
+GetOptions(
+  'base=s'  => \$opt_base,
+  'rules=s' => \$opt_rulesfile,
+);
+$opt_base ||= $ENV{HOME};
+$opt_base ||= $ENV{PWD};
 
-# ----------------------------------------------------------
-#			main
-# ----------------------------------------------------------
 
-  # cry for our "Auditor"
-  use Mail::Audit;
+# - - - - - - - - - - - - - - - - - - - -
+#
+#                targets
+#
+#  declare and initialize some variables
+#      these are mostly base paths
+#      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 $DEFAULT   = "$MAILDIR/Inbox";
+my $DEBUG   = 0;
+my $TRACE   = 1;
+my $VERBOSE = 1;
+
+# override settings
+  # override $RULESFILE if given as option on the command line
+  $RULESFILE = $opt_rulesfile if ($opt_rulesfile);
+  # change logfile
+  $LOGFILE = "recievemail-emerg.log" if (! -e $MAILDIR);
+
+
+# - - - - - - - - - - - - - - - - - - - -
+#                 main
+# - - - - - - - - - - - - - - - - - - - -
 
   # "jump" into processing of new incoming mail and get a "handler" to this mail
   my $incoming = Mail::Audit->new;
 
-  my $from    = $incoming->from;
-  my $to      = $incoming->to;
-  my $subject = $incoming->subject;
-
-  chomp($from);
-  chomp($to);
-  chomp($subject);
+  # 0.a. pre flight tracing
+    if ($TRACE) {
+      s2f("Mail from " . gchomp($incoming->from) . " to " . gchomp($incoming->to));
+      s2f("Subject: " . gchomp($incoming->subject));
+    }
+
+  # 0.b. pre flight checks
+
+     # TODO: check if $HOME is empty
+
+     # check if $HOME exists
+     if (! -e $MAILDIR) {
+       my $msg = "delivery failed, base directory $MAILDIR does not exist";
+       report($msg);
+       accept_spool();
+     }
+
+  # 1. include rules or fallback
+    # check if $RULESFILE exists
+    if (-f $RULESFILE) {
+      report("loading rules from \"$RULESFILE\"");
+      require $RULESFILE;
+    } else {
+      #die("$RULESFILE doesn't exist");
+      report("configured rulesfile \"$RULESFILE\" doesn't exist");
+      accept_spool();
+    }
+
+  # 2. export required stuff to rules namespace
+    export_symbols();
+
+  # 3. run dispatcher
+    report("running \"rules::dispatch\"");
+    rules::dispatch();
+
+  # 4. dispatcher didn't do anything
+    report("dispatcher could not apply any filter, using default delivery");
+
+    # the default-handler: simply accept all mails and route them to "/var/spool/mail"
+    # $incoming->accept();
+
+    # if you want to reject all mails coming through to here, do a ...
+    # $incoming->reject;
+
+    # catch all mails and route them to a "DEFAULT"-inbox
+    jaccept($DEFAULT);
+
+
+
+
 
   # - - - - - - - - - - - - - - - - - - - -
-  #             tracing mail
+  #          tracing & reporting
   # - - - - - - - - - - - - - - - - - - - -
   sub s2f {
     my $str = shift;
@@ -76,9 +167,16 @@
     print FH $str, "\n";
     close(FH);
   }
-  if ($TRACE) {
-    s2f("Mail from $from to $to");
-    s2f("Subject: $subject");
+
+  sub report {
+    my $msg = shift;    
+    # TODO: tracing, debugging
+
+    print $msg, "\n" if $VERBOSE;
+    if ($TRACE) {
+      s2f($msg);
+    }
+
   }
 
   # - - - - - - - - - - - - - - - - - - - -
@@ -96,64 +194,58 @@
 
   sub jaccept {
     my $deliver_to = shift;
-    # TODO: tracing, debugging
-    if ($TRACE) {
-      s2f("deliver to: $deliver_to");
+    
+    report("delivering to: $deliver_to");
+
+    # check deliver_to path
+    if (! -e $deliver_to) {
+      report("deliver_to path \"$deliver_to\" doesn't exist");
+      accept_spool();
+      return;
     }
-    $incoming->accept($deliver_to);
-  }
 
-  # -----
-  # source-routing
-  #if ($incoming->from =~ /root\@smtp\.f7x\.net/i) {
-  #  $incoming->accept("$MAILDIR/SORTED/netfrag.org/Current/status-ns1.f7x.net");
-  #}
-  if ($incoming->from =~ /(root|admin)\@cashew\.netfrag\.org/i) {
-    jaccept("$MAILDIR/SORTED/netfrag.org/Status/cashew.netfrag.org");
-  }
-  if ($incoming->from =~ /(root|admin)\@quepasa\.netfrag\.org/i) {
-    jaccept("$MAILDIR/SORTED/netfrag.org/Status/quepasa.netfrag.org");
-  }
-  if ($incoming->from =~ /(root|service|netsaint)\@h1\.service\.netfrag\.org/i) {
-    jaccept("$MAILDIR/SORTED/netfrag.org/Status/h1.service.netfrag.org");
+    $incoming->accept($deliver_to);
   }
 
-
-  # -----
-  # source && destination - routing
-  if ($incoming->from =~ /andreas\.motl\@ilo\.de/ && compareTarget('joko\@netfrag\.org')) {
-    jaccept("$MAILDIR/SORTED/netfrag.org/Info");
+  sub accept_spool {
+    my $path = "/var/spool/mail/$USER";
+    report("defaulting to spool delivery ($path)");
+    $incoming->accept($path);
   }
 
 
-  # -----
-  # destination-routing
-  my $bool_ilo = ($incoming->to =~ m/ilo\.de/i);
-  my $bool_ilo_news1 = ($incoming->to =~ m/kritletter\@kbx\.de/i);
-  my $bool_from_kolumnen_de = ($incoming->to =~ m/kolumnen\.de/i);
-  my $bool_from_strixner = ($incoming->to =~ m/strixner\@web\.de/i);
-  if ($bool_ilo || $bool_ilo_news1 || $bool_from_kolumnen_de || $bool_from_strixner) {
-    jaccept("$MAILDIR/SORTED/ilo.de/Inbox");
-  }
+# - - - - - - - - - - - - - - - - - - - -
+#             helper functions
+# - - - - - - - - - - - - - - - - - - - -
+
+sub get_coderef {
+  my $codepack = shift;
+  my $method = shift;
+  $codepack || return '[error]';
+  $method ||= '';
+  $method && ($codepack .= '::');
+  return eval '\&' . $codepack . $method . ';';
+}
 
-  if ($incoming->to =~ /web\.de/i) {
-    jaccept("$MAILDIR/SORTED/web.de/Current/Inbox");
+sub export_symbols {
+  #  my $callpack = 'rules';
+  #  my @EXPORT = qw( incoming subject MAILDIR jaccept );
+  #  foreach my $sym (@EXPORT) {
+      no strict 'refs';
+  #    *{"${callpack}::$sym"} = get_coderef('main', $sym);
+  #  }
+  {
+    no strict 'refs';
+    *{"rules::jaccept"}       = get_coderef('main', 'jaccept');
+    *{"rules::report"}        = get_coderef('main', 'report');
+    *{"rules::compareTarget"} = get_coderef('main', 'compareTarget');
   }
-  if ($incoming->to =~ /wor\.net/i) {
-    jaccept("$MAILDIR/SORTED/wor.net/Current/Inbox");
-  }
-  if ($incoming->to =~ /netfrag\.org/i || $incoming->to =~ /archivists-talk\@yahoogroups\.com/) {
-    jaccept("$MAILDIR/SORTED/netfrag.org/Inbox");
-  }
-
-  # - - - - - - - - - - - - - - - - - - - -
-
-# the default-handler: simply accept all mails and route them to "/var/spool/mail"
-# $incoming->accept();
-
-# if you want to reject all mails coming through to here, do a ...
-# $incoming->reject;
-
-# catch all mails and route them to a "DEFAULT"-inbox
-jaccept($DEFAULT);
+  $rules::MAILDIR  = $MAILDIR;
+  $rules::incoming = $incoming;
+}
 
+sub gchomp {
+  my $str = shift;
+  chomp($str);
+  return $str;
+}