/[cvs]/nfo/perl/scripts/dispatchmail/bin/dispatchmail
ViewVC logotype

Diff of /nfo/perl/scripts/dispatchmail/bin/dispatchmail

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by root, Wed Jan 22 07:16:51 2003 UTC revision 1.5 by root, Mon Jan 27 08:52:40 2003 UTC
# Line 11  Line 11 
11  #  #
12  # ============================================================  # ============================================================
13  #  $Log$  #  $Log$
14    #  Revision 1.5  2003/01/27 08:52:40  root
15    #  + new command line arguments: "news" and "newsgroup"
16    #
17    #  Revision 1.4  2003/01/22 17:50:56  root
18    #  - refactored most code to Mail::Audit::Dispath
19    #
20  #  Revision 1.3  2003/01/22 07:16:51  root  #  Revision 1.3  2003/01/22 07:16:51  root
21  #  + sub traceEntry  #  + sub traceEntry
22  #  + further refactorings  #  + further refactorings
# Line 23  Line 29 
29  use strict;  use strict;
30  # don't use warnings;  # don't use warnings;
31    
 use Mail::Audit;  
32  use Data::Dumper;  use Data::Dumper;
33  use Getopt::Long;  use Getopt::Long;
34    use Hash::Merge qw( merge );
35    
36  use lib qw( /data/libs/nfo/perl/libs );  use lib qw( /data/libs/nfo/perl/libs );
37  use org::netfrag::shortcuts qw( now );  use Mail::Audit::Dispatch;
   
38    
39    
40  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
41  #               options  #               options
42  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
 my $opt_base      = '';  
 my $opt_rulesfile = '';  
 GetOptions(  
   'base=s'  => \$opt_base,  
   'rules=s' => \$opt_rulesfile,  
 );  
 $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  
   
 # - - - - - - - - - - - - - - - - - - - -  
 #  
 #                targets  
 #  
 #  declare and initialize some variables  
 #      these are mostly base paths  
 #      mail should be delivered to  
 #  
 # - - - - - - - - - - - - - - - - - - - -  
 my $USER      = $ENV{USER};  
 my $HOME      = $opt_base;  
 my $MAILDIR   = "$HOME/Mail";  
 my $RULESFILE = "$HOME/.dispatchmailrc.pm";  
 #my $LOCKFILE  = "$HOME/.procmail.lockfile";  
 my $LOCKFILE  = "$HOME/.dispatchmail.lockfile";  
 my $LOGFILE   = "$MAILDIR/.dispatchmail.log";  
 my $DEFAULT   = "$MAILDIR/Inbox";  
   
 # 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);  
   
   $USER ||= '';  
   
   
   
 # - - - - - - - - - - - - - - - - - - - -  
 #                 main  
 # - - - - - - - - - - - - - - - - - - - -  
   
   # "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  
     my $now = now();  
     report("$0 running at $now for user '$USER'.");  
     traceEntry() if $TRACE;  
   
   # 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);  
        forward_delivery();  
      }  
   
   # 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.");  
       forward_delivery();  
     }  
   
   # 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);  
   
   
43    
44    my $defaults = {
45      LOG     => 1,         # writes reports to logfile
46      VERBOSE => 1,         # writes reports to STDOUT
47      TRACE   => 1,         # writes contents of messages to logfile
48    };
49    
50    my $args;
51    GetOptions(
52      'user=s'      => \$args->{user},
53      'base=s'      => \$args->{base},
54      'rules=s'     => \$args->{rules},
55      'mode=s'      => \$args->{mode},
56      'newsgroup=s' => \$args->{newsgroup},
57    );
58    
59    # - - - - - - - - - - - - - - - - - - - -  my $args_dispatch = merge($defaults, $args);
   #          tracing & reporting  
   # - - - - - - - - - - - - - - - - - - - -  
   sub s2f {  
     my $str = shift;  
     open(FH, '>>' . $LOGFILE);  
     print FH $str, "\n";  
     close(FH);  
   }  
   
   sub report {  
     my $msg = shift;      
     # TODO: tracing, debugging  
   
     print $msg, "\n" if $VERBOSE;  
     if ($LOG) {  
       s2f($msg);  
     }  
   
   }  
   
   # - - - - - - - - - - - - - - - - - - - -  
   #             processing mail  
   # - - - - - - - - - - - - - - - - - - - -  
   
   sub compareTarget {  
     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/);  
     return $ok;  
   }  
   
   sub jaccept {  
     my $deliver_to = shift;  
       
     report("ACCEPT: $deliver_to");  
   
     # check deliver_to path  
     if (! -e $deliver_to) {  
       report("deliver_to path \"$deliver_to\" doesn't exist");  
       forward_delivery();  
       return;  
     }  
   
     $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;  
   }  
60    
61    #print Dumper($args_dispatch);
62    #exit;
63    
64  # - - - - - - - - - - - - - - - - - - - -  my @args_array = %$args_dispatch;
65  #             helper functions  my $dispatcher = Mail::Audit::Dispatch->new(@args_array);
66  # - - - - - - - - - - - - - - - - - - - -  $dispatcher->run();
67    
68  sub get_coderef {  1;
   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;  
 }  
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.5
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed