/[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.1 by collector, Wed Jan 22 05:07:56 2003 UTC revision 1.5 by root, Mon Jan 27 08:52:40 2003 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2    
3  # ==========================================================================  # ============================================================
4  #  #
5  # recieveMail v0.04  #  dispatchmail v0.05
6  #   a simple mail filter done in perl with CPAN-module "Mail::Audit"  #    A simple mail filter done in perl
7    #    with the Perl-module "Mail::Audit"
8    #    available from CPAN.
9  #  #
10    #  $Id$
11  #  #
12  # 2002-11-09, joko@netfrag.org  # ============================================================
13  #   + recieveMail now can run globally (/etc/mail/smrsh!)  #  $Log$
14  #     + $HOME is taken from $ENV{HOME} or $ENV{PWD}  #  Revision 1.5  2003/01/27 08:52:40  root
15  #     + rules are taken from $HOME/Mail/.rules.pm  #  + new command line arguments: "news" and "newsgroup"
 #     + 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  
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
21    #  + sub traceEntry
22    #  + further refactorings
23    #
24    #  Revision 1.2  2003/01/22 05:38:44  collector
25    #  + prepared refactoring to 'dispatchmail'
26    #
27    # ============================================================
28    
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 );
37  # - - - - - - - - - - - - - - - - - - - -  use Mail::Audit::Dispatch;
 #               options  
 # - - - - - - - - - - - - - - - - - - - -  
 my $opt_base      = '';  
 my $opt_rulesfile = '';  
 GetOptions(  
   'base=s'  => \$opt_base,  
   'rules=s' => \$opt_rulesfile,  
 );  
 $opt_base ||= $ENV{HOME};  
 $opt_base ||= $ENV{PWD};  
38    
39    
40  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
41  #  #               options
 #                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  
42  # - - - - - - - - - - - - - - - - - - - -  # - - - - - - - - - - - - - - - - - - - -
43    
44    # "jump" into processing of new incoming mail and get a "handler" to this mail  my $defaults = {
45    my $incoming = Mail::Audit->new;    LOG     => 1,         # writes reports to logfile
46      VERBOSE => 1,         # writes reports to STDOUT
47    # 0.a. pre flight tracing    TRACE   => 1,         # writes contents of messages to logfile
48      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);  
   
   
   
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 ($TRACE) {  
       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("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);  
   }  
   
   sub accept_spool {  
     my $path = "/var/spool/mail/$USER";  
     report("defaulting to spool delivery ($path)");  
     $incoming->accept($path);  
   }  
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.1  
changed lines
  Added in v.1.5
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed