--- nfo/perl/libs/Mail/Audit/Dispatch.pm	2003/01/22 07:45:20	1.1
+++ nfo/perl/libs/Mail/Audit/Dispatch.pm	2003/03/23 22:26:22	1.7
@@ -5,10 +5,29 @@
 #    with the Perl-module "Mail::Audit" 
 #    available from CPAN.
 #
-#  $Id: Dispatch.pm,v 1.1 2003/01/22 07:45:20 root Exp $
+#  $Id: Dispatch.pm,v 1.7 2003/03/23 22:26:22 root Exp $
 #
 # ============================================================
 #  $Log: Dispatch.pm,v $
+#  Revision 1.7  2003/03/23 22:26:22  root
+#  + header-field 'Message-ID' now included when tracing
+#
+#  Revision 1.6  2003/03/23 21:12:20  root
+#  + sub jerror and related modifications
+#
+#  Revision 1.5  2003/01/30 23:20:21  root
+#  + fixed and enhanced
+#
+#  Revision 1.4  2003/01/22 17:58:21  root
+#  + fixed and enhanced many things
+#  - refactored code to Data::Code
+#
+#  Revision 1.3  2003/01/22 07:55:43  joko
+#  + replaced '$HOME' with '$self->{settings}->{HOME}'
+#
+#  Revision 1.2  2003/01/22 07:54:24  joko
+#  + replaced global variables with class-variables
+#
 #  Revision 1.1  2003/01/22 07:45:20  root
 #  + initial check-in - refactored from 'dispatchmail'
 #
@@ -27,67 +46,76 @@
 use strict;
 # don't use warnings;
 
-use base qw( DesignPattern::Object );
+use base qw( 
+  DesignPattern::Object
+  DesignPattern::Bridge
+);
+#  DesignPattern::Object::Logger
 
 
 use Mail::Audit;
 use Data::Dumper;
 
 
-use org::netfrag::shortcuts qw( now );
-
-
-my $LOG     = 1;	# writes reports to logfile
-my $VERBOSE = 1;	# writes reports to STDOUT
-my $TRACE   = 1;	# writes contents of messages to logfile
+use Data::Code::Symbol qw( export_symbols );
+use Data::Storage::Handler::File qw( a2f );
+use org::netfrag::shortcuts qw( now get_chomped run_cmd );
 
 
 sub _init {
   my $self = shift;
   $self->_init_options();
+  $self->_override_options();
   $self->_init_settings();
   $self->_override_settings();
+  #$self->_run();
 }
 
 sub _init_options {
   my $self = shift;
-  $self->{options}->{base}   = $self->{base};
+  foreach (qw( user base rules LOG VERBOSE TRACE mode newsgroup )) {
+    $self->{options}->{$_} = $self->{$_};
+  }
+}
+
+sub _override_options {
+  my $self = shift;
   $self->{options}->{base} ||= $ENV{HOME};
   $self->{options}->{base} ||= $ENV{PWD};
-  $self->{options}->{rules}   = $self->{rules};
 }
 
-# - - - - - - - - - - - - - - - - - - - -
-#
-#                targets
-#
-#  declare and initialize some variables
-#      these are mostly base paths
-#      mail should be delivered to
-#
-# - - - - - - - - - - - - - - - - - - - -
-sub _init_paths {
+sub _init_settings {
+  my $self = shift;
+  $self->{settings}->{USER} = $self->{options}->{user} if $self->{options}->{user};
+  $self->{settings}->{USER} ||= '';
+  $self->{settings}->{USER} ||= $ENV{USER};
+
+  $self->{settings}->{HOME} = '../var/spool/mail/' . $self->{settings}->{USER};
+  $self->{settings}->{HOME} = $self->{options}->{base} if $self->{options}->{base};
+
+  $self->_init_settings_paths();
+}
+
+sub _init_settings_paths {
   my $self = shift;
-  $self->{settings}->{USER}      = $ENV{USER};
-  $self->{settings}->{HOME}      = $self->{options}->{base};
-  $self->{settings}->{MAILDIR}   = "$HOME/Mail";
-  $self->{settings}->{RULESFILE} = "$HOME/.dispatchmailrc.pm";
-  #$self->{settings}->{LOCKFILE}  = "$HOME/.procmail.lockfile";
-  $self->{settings}->{LOCKFILE}  = "$HOME/.dispatchmail.lockfile";
-  $self->{settings}->{LOGFILE}   = "$MAILDIR/.dispatchmail.log";
-  $self->{settings}->{DEFAULT}   = "$MAILDIR/Inbox";
+  $self->{settings}->{MAILDIR}   = "$self->{settings}->{HOME}/Mail";
+  #$self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";
+  $self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc";
+  #$self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.procmail.lockfile";
+  $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";
+  $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.mail-delivery.log";
+  $self->{settings}->{ERRLOG}    = ".mail-delivery_errors.log";
+  $self->{settings}->{DEFAULT}   = "$self->{settings}->{MAILDIR}/Inbox";
 }
 
 sub _override_settings {
   my $self = shift;
-  # override $RULESFILE if given as option on the command line
+  # override $self->{settings}->{RULESFILE} if given as option on the command line
     $self->{settings}->{RULESFILE} = 
       $self->{options}->{rules} if $self->{options}->{rules};
   # change logfile
     $self->{settings}->{LOGFILE} = 
-      "recievemail-emerg.log" if (! -e $self->{settings}->{MAILDIR});
-
-    $self->{settings}->{USER} ||= '';
+      $self->{settings}->{ERRLOG} if (! -e $self->{settings}->{MAILDIR});
 }
 
 
@@ -96,85 +124,120 @@
 #                 main
 # - - - - - - - - - - - - - - - - - - - -
 
+sub run {
+  my $self = shift;
+  
+  $self->{options}->{mode} ||= 'recieve';
+  my $call = '_' . $self->{options}->{mode};
+
   # "jump" into processing of new incoming mail and get a "handler" to this mail
-  my $incoming = Mail::Audit->new;
+  $self->{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);
-  }
+  my $result = $self->$call(@_);
+  return $result;
+
+}
 
+sub _recieve {
 
+  my $self = shift;
+  
   # 0.a. pre flight tracing
     my $now = now();
-    report("$0 running at $now for user '$USER'.");
-    traceEntry() if $TRACE;
+    $self->report("$now - $0 running for user '$self->{settings}->{USER}'.");
+    $self->traceEntry() if $self->{options}->{TRACE};
 
   # 0.b. pre flight checks
 
-     # TODO: check if $HOME is empty
+     # TODO: check if $self->{settings}->{HOME} is empty
 
-     # check if $HOME exists
-     if (! -e $MAILDIR) {
-       my $msg = "delivery failed, base directory $MAILDIR does not exist";
-       report($msg);
-       forward_delivery();
+     # check if $self->{settings}->{HOME} exists
+     if (! -e $self->{settings}->{MAILDIR}) {
+       my $msg = "ERROR: Delivery failed, base directory '$self->{settings}->{MAILDIR}' does not exist.";
+       $self->jerror($msg);
      }
 
   # 1. include rules or fallback
-    # check if $RULESFILE exists
-    if (-f $RULESFILE) {
-      report("Loading rules from \"$RULESFILE\".");
-      require $RULESFILE;
+    # check if $self->{settings}->{RULESFILE} exists
+    if (-f $self->{settings}->{RULESFILE}) {
+      $self->report("RULES:  Loading from \"$self->{settings}->{RULESFILE}\".");
+      my $evalstr = "require '$self->{settings}->{RULESFILE}';";
+      eval($evalstr);
+      if ($@) {
+        my $msg = "ERROR:  Delivery failed, '$self->{settings}->{RULESFILE}' had syntax errors:\n$@";
+        $self->jerror($msg);
+      }
     } else {
-      #die("$RULESFILE doesn't exist");
-      report("Configured rulesfile \"$RULESFILE\" doesn't exist.");
-      forward_delivery();
+      #die("$self->{settings}->{RULESFILE} doesn't exist");
+      $self->jerror("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");
     }
 
   # 2. export required stuff to rules namespace
-    export_symbols();
+    my @symbols = qw( jaccept report compareTarget accept copy ignore );
+    export_symbols(\@symbols, 'rules');
 
   # 3. run dispatcher
-    report("Running \"rules::dispatch\".");
-    rules::dispatch();
+    $self->report("RULES:  Running Perl sub \"rules::dispatch\".");
+    rules::dispatch($self);
 
   # 4. dispatcher didn't do anything
-    report("dispatcher could not apply any filter, using default delivery");
+    $self->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();
+    # $self->{incoming}->accept();
 
     # if you want to reject all mails coming through to here, do a ...
-    # $incoming->reject;
+    # $self->{incoming}->reject;
 
     # catch all mails and route them to a "DEFAULT"-inbox
-    jaccept($DEFAULT);
+    $self->jaccept($self->{settings}->{DEFAULT});
 
+}
 
+sub jerror {
+  my $self = shift;
+  my $msg = shift;
+  $self->report("ERROR: $msg");
+  $self->forward_delivery();
+}
+
+sub _mail2news {
+  my $self = shift;
+  $self->report("MAIL2NEWS: $self->{options}->{newsgroup}");
+  my $plugin = 'Newsgate';
+  $self->load($plugin);
+  $self->$plugin($self->{options}->{newsgroup});
+}
 
 
 
   # - - - - - - - - - - - - - - - - - - - -
   #          tracing & reporting
   # - - - - - - - - - - - - - - - - - - - -
-  sub s2f {
-    my $str = shift;
-    open(FH, '>>' . $LOGFILE);
-    print FH $str, "\n";
-    close(FH);
+  sub traceEntry {
+    my $self = shift;
+    $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
+    $self->appendLog("From:       " . get_chomped($self->{incoming}->from));
+    $self->appendLog("To:         " . get_chomped($self->{incoming}->to));
+    $self->appendLog("Subject:    " . get_chomped($self->{incoming}->subject));
+    $self->appendLog("Message-ID: " . get_chomped($self->{incoming}->get('Message-ID')));
+    $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
+  }
+
+  sub appendLog {
+    my $self = shift;
+    my $msg = shift;
+    a2f($self->{settings}->{LOGFILE}, $msg);
   }
 
   sub report {
+    my $self = shift;
     my $msg = shift;    
     # TODO: tracing, debugging
 
-    print $msg, "\n" if $VERBOSE;
-    if ($LOG) {
-      s2f($msg);
+    #print STDERR $msg, "\n" if $self->{options}->{VERBOSE};
+    if ($self->{options}->{LOG}) {
+      $self->appendLog($msg);
     }
 
   }
@@ -184,73 +247,81 @@
   # - - - - - - - - - - - - - - - - - - - -
 
   sub compareTarget {
+    my $self = shift;
     my $pattern = shift;
     my $ok = 0;
-    $ok = 1 if ($incoming->to =~ m/$pattern/);
-    $ok = 1 if ($incoming->cc =~ m/$pattern/);
-    $ok = 1 if ($incoming->bcc =~ m/$pattern/);
+    $ok = 1 if ($self->{incoming}->to =~ m/$pattern/);
+    $ok = 1 if ($self->{incoming}->cc =~ m/$pattern/);
+    $ok = 1 if ($self->{incoming}->bcc =~ m/$pattern/);
     return $ok;
   }
 
+  sub accept_spool {
+    my $self = shift;
+    my $path = "/var/spool/mail/$self->{settings}->{USER}";
+    $self->report("defaulting to spool delivery ($path)");
+    $self->{incoming}->accept($path);
+  }
+
+  sub forward_delivery {
+    my $self = shift;
+    $self->report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
+    return $self->{incoming}->accept;
+  }
+
+
   sub jaccept {
+    my $self = shift;
     my $deliver_to = shift;
     
-    report("ACCEPT: $deliver_to");
+    $self->report("ACCEPT: $deliver_to");
 
     # check deliver_to path
     if (! -e $deliver_to) {
-      report("deliver_to path \"$deliver_to\" doesn't exist");
-      forward_delivery();
-      return;
+      my $good = 0;
+      $self->report("ERROR:  TARGET Path/File doesn't exist.");
+      if ($self->{settings}->{AUTOCREATE_FOLDERS}) {
+        my $cmd = "touch $deliver_to";
+        $self->report("TARGET: AUTOCREATE_FOLDERS is enabled: touching TARGET.");
+        #if (mkdir $deliver_to) {
+        run_cmd($cmd);
+        # re-test TARGET - for existance now
+        if (-e $deliver_to) {
+          $good = 1;
+        } else {
+          $self->report("ERROR:  TARGET creation failed (command was: '$cmd').");
+        }
+      }
+      if (!$good) {
+        $self->forward_delivery();
+        return;
+      }
     }
 
-    $incoming->accept($deliver_to);
+    return $self->{incoming}->accept($deliver_to);
   }
 
-  sub accept_spool {
-    my $path = "/var/spool/mail/$USER";
-    report("defaulting to spool delivery ($path)");
-    $incoming->accept($path);
-  }
 
-  sub forward_delivery {
-    report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
-    $incoming->accept;
+  sub accept {
+    my $self = shift;
+    return $self->jaccept(@_);
   }
 
+  sub copy {
+    my $self = shift;
+    my $plugin = shift;
+    my $deliver_to = shift;
+    
+    $self->report("COPY: $plugin: $deliver_to");
+
+    $self->load($plugin);
+    return $self->$plugin($deliver_to);
+  }
 
-# - - - - - - - - - - - - - - - - - - - -
-#             helper functions
-# - - - - - - - - - - - - - - - - - - - -
+  sub ignore {
+    my $self = shift;
+    $self->report("IGNORE");
+    return $self->{incoming}->ignore;
+  }
 
-sub get_coderef {
-  my $codepack = shift;
-  my $method = shift;
-  $codepack || return '[error]';
-  $method ||= '';
-  $method && ($codepack .= '::');
-  return eval '\&' . $codepack . $method . ';';
-}
-
-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');
-  }
-  $rules::MAILDIR  = $MAILDIR;
-  $rules::incoming = $incoming;
-}
-
-sub gchomp {
-  my $str = shift;
-  chomp($str);
-  return $str;
-}
+1;