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

Diff of /nfo/perl/scripts/dispatchmail/recieveMail

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

revision 1.3 by joko, Mon Oct 21 12:22:55 2002 UTC revision 1.4 by joko, Sun Nov 10 02:44:36 2002 UTC
# Line 2  Line 2 
2    
3  # ==========================================================================  # ==========================================================================
4  #  #
5  # recieveMail v0.03  # recieveMail v0.04
6  #   a simple mail filter done in perl with CPAN-module "Mail::Audit"  #   a simple mail filter done in perl with CPAN-module "Mail::Audit"
7  #  #
8  #  #
9    # 2002-11-09, joko@netfrag.org
10    #   + recieveMail now can run globally (/etc/mail/smrsh!)
11    #     + $HOME is taken from $ENV{HOME} or $ENV{PWD}
12    #     + rules are taken from $HOME/Mail/.rules.pm
13    #     + fallback mechanism(s)
14    #   + bugfixes
15    #
16  # 2002-10-14, joko@netfrag.org  # 2002-10-14, joko@netfrag.org
17  #   + $LOGFILE is used now (recievemail.log)  #   + $LOGFILE is used now (recievemail.log)
18  #   + tracing (uses $LOGFILE)  #   + tracing (uses $LOGFILE)
# Line 18  Line 25 
25  #    #  
26  # 2001-12-05, joko@netfrag.org  # 2001-12-05, joko@netfrag.org
27  #   + initial internal release  #   + initial internal release
28  #   TODO:  #
29    #
30    # TODO:
31  #   - more sophisticated filtering  #   - more sophisticated filtering
32  #   - configuration-comfort (use arrays and hashes, no "matching-code-worm")  #   - configuration-comfort (use perl-arrays and -hashes for rule-declaration)
33  #   - Html-Gui to define rules  #   - Html-Gui to add/edit/remove rules
34  #   - rule base located in LDAP (local delivery routing)  #   - rule base located in LDAP (local delivery routing)
35    #   - completely hide away regex-stuff and provide simpler wildcarding
36    #     - hide needed quoting of dots (.) and ats (@) in addresses
37    #     - provide: beginsWith(string), endsWith(string), beginsAt(string, pos|regex)
38    #       - this could become a CPAN-module sometimes (?):
39    #       - "String"-Object to be inherited from gives these methods to you
40    #       - examples:
41    #         - routeTo("mbox:/path/to/mbox") if $to->beginsWith("hello");
42    #         - routeTo("fax:+4930123456")    if $subject->contains("gatefax");
43    #   - metadata:
44    #     - add some info about the context we are running in:
45    #       - console
46    #       - sendmail/normal
47    #       - sendmail/smrsh
48    #     - add some info about the user we are doing this for:
49    #       - username
50    #       - home-directory
51  #  #
52  # ==========================================================================  # ==========================================================================
53    
54  use strict;  use strict;
55  # don't use warnings;  # don't use warnings;
56    
57  # ----------------------------------------------------------  use Mail::Audit;
58  # declare and initialize some variables  use Data::Dumper;
59  # these are mostly directories for routing our mail to  use Getopt::Long;
60  my $HOME = "/home/joko/virtual/joko_mail";  
61  my $MAILDIR = "$HOME/Mail";  
62  my $LOGFILE = "$MAILDIR/recievemail.log";  # - - - - - - - - - - - - - - - - - - - -
63  my $LOCKFILE = "$HOME/.procmail.lockfile";  #               options
64  my $DEFAULT = "$MAILDIR/SORTED/misc/Inbox";  # - - - - - - - - - - - - - - - - - - - -
65  my $DEBUG = 0;  my $opt_base      = '';
66  my $TRACE = 1;  my $opt_rulesfile = '';
67    GetOptions(
68  if (! -e $HOME) {    'base=s'  => \$opt_base,
69    $LOGFILE = "log/recievemail-emerg.log";    'rules=s' => \$opt_rulesfile,
70    my $msg = "delivery failed, base directory $HOME does not exist";  );
71    open(FH, '>>' . $LOGFILE);  $opt_base ||= $ENV{HOME};
72    print FH $msg, "\n";  $opt_base ||= $ENV{PWD};
   close(FH);  
   die($msg);  
 }  
73    
 # ----------------------------------------------------------  
 #                       main  
 # ----------------------------------------------------------  
74    
75    # cry for our "Auditor"  # - - - - - - - - - - - - - - - - - - - -
76    use Mail::Audit;  #
77    #                targets
78    #
79    #  declare and initialize some variables
80    #      these are mostly base paths
81    #      mail should be delivered to
82    #
83    # - - - - - - - - - - - - - - - - - - - -
84    #my $HOME = "/home/joko/virtual/joko_mail";
85    my $USER      = $ENV{USER};
86    my $HOME      = $opt_base;
87    my $MAILDIR   = "$HOME/Mail";
88    my $LOGFILE   = "$MAILDIR/recievemail.log";
89    my $RULESFILE = "$MAILDIR/.rules.pm";
90    my $LOCKFILE  = "$HOME/.procmail.lockfile";
91    my $DEFAULT   = "$MAILDIR/Inbox";
92    my $DEBUG   = 0;
93    my $TRACE   = 1;
94    my $VERBOSE = 1;
95    
96    # override settings
97      # override $RULESFILE if given as option on the command line
98      $RULESFILE = $opt_rulesfile if ($opt_rulesfile);
99      # change logfile
100      $LOGFILE = "recievemail-emerg.log" if (! -e $MAILDIR);
101    
102    
103    # - - - - - - - - - - - - - - - - - - - -
104    #                 main
105    # - - - - - - - - - - - - - - - - - - - -
106    
107    # "jump" into processing of new incoming mail and get a "handler" to this mail    # "jump" into processing of new incoming mail and get a "handler" to this mail
108    my $incoming = Mail::Audit->new;    my $incoming = Mail::Audit->new;
109    
110    my $from    = $incoming->from;    # 0.a. pre flight tracing
111    my $to      = $incoming->to;      if ($TRACE) {
112    my $subject = $incoming->subject;        s2f("Mail from " . gchomp($incoming->from) . " to " . gchomp($incoming->to));
113          s2f("Subject: " . gchomp($incoming->subject));
114    chomp($from);      }
115    chomp($to);  
116    chomp($subject);    # 0.b. pre flight checks
117    
118         # TODO: check if $HOME is empty
119    
120         # check if $HOME exists
121         if (! -e $MAILDIR) {
122           my $msg = "delivery failed, base directory $MAILDIR does not exist";
123           report($msg);
124           accept_spool();
125         }
126    
127      # 1. include rules or fallback
128        # check if $RULESFILE exists
129        if (-f $RULESFILE) {
130          report("loading rules from \"$RULESFILE\"");
131          require $RULESFILE;
132        } else {
133          #die("$RULESFILE doesn't exist");
134          report("configured rulesfile \"$RULESFILE\" doesn't exist");
135          accept_spool();
136        }
137    
138      # 2. export required stuff to rules namespace
139        export_symbols();
140    
141      # 3. run dispatcher
142        report("running \"rules::dispatch\"");
143        rules::dispatch();
144    
145      # 4. dispatcher didn't do anything
146        report("dispatcher could not apply any filter, using default delivery");
147    
148        # the default-handler: simply accept all mails and route them to "/var/spool/mail"
149        # $incoming->accept();
150    
151        # if you want to reject all mails coming through to here, do a ...
152        # $incoming->reject;
153    
154        # catch all mails and route them to a "DEFAULT"-inbox
155        jaccept($DEFAULT);
156    
157    
158    
159    
160    
161    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
162    #             tracing mail    #          tracing & reporting
163    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
164    sub s2f {    sub s2f {
165      my $str = shift;      my $str = shift;
# Line 76  if (! -e $HOME) { Line 167  if (! -e $HOME) {
167      print FH $str, "\n";      print FH $str, "\n";
168      close(FH);      close(FH);
169    }    }
170    if ($TRACE) {  
171      s2f("Mail from $from to $to");    sub report {
172      s2f("Subject: $subject");      my $msg = shift;    
173        # TODO: tracing, debugging
174    
175        print $msg, "\n" if $VERBOSE;
176        if ($TRACE) {
177          s2f($msg);
178        }
179    
180    }    }
181    
182    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
# Line 96  if (! -e $HOME) { Line 194  if (! -e $HOME) {
194    
195    sub jaccept {    sub jaccept {
196      my $deliver_to = shift;      my $deliver_to = shift;
197      # TODO: tracing, debugging      
198      if ($TRACE) {      report("delivering to: $deliver_to");
199        s2f("deliver to: $deliver_to");  
200        # check deliver_to path
201        if (! -e $deliver_to) {
202          report("deliver_to path \"$deliver_to\" doesn't exist");
203          accept_spool();
204          return;
205      }      }
     $incoming->accept($deliver_to);  
   }  
206    
207    # -----      $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");  
208    }    }
209    
210      sub accept_spool {
211    # -----      my $path = "/var/spool/mail/$USER";
212    # source && destination - routing      report("defaulting to spool delivery ($path)");
213    if ($incoming->from =~ /andreas\.motl\@ilo\.de/ && compareTarget('joko\@netfrag\.org')) {      $incoming->accept($path);
     jaccept("$MAILDIR/SORTED/netfrag.org/Info");  
214    }    }
215    
216    
217    # -----  # - - - - - - - - - - - - - - - - - - - -
218    # destination-routing  #             helper functions
219    my $bool_ilo = ($incoming->to =~ m/ilo\.de/i);  # - - - - - - - - - - - - - - - - - - - -
220    my $bool_ilo_news1 = ($incoming->to =~ m/kritletter\@kbx\.de/i);  
221    my $bool_from_kolumnen_de = ($incoming->to =~ m/kolumnen\.de/i);  sub get_coderef {
222    my $bool_from_strixner = ($incoming->to =~ m/strixner\@web\.de/i);    my $codepack = shift;
223    if ($bool_ilo || $bool_ilo_news1 || $bool_from_kolumnen_de || $bool_from_strixner) {    my $method = shift;
224      jaccept("$MAILDIR/SORTED/ilo.de/Inbox");    $codepack || return '[error]';
225    }    $method ||= '';
226      $method && ($codepack .= '::');
227      return eval '\&' . $codepack . $method . ';';
228    }
229    
230    if ($incoming->to =~ /web\.de/i) {  sub export_symbols {
231      jaccept("$MAILDIR/SORTED/web.de/Current/Inbox");    #  my $callpack = 'rules';
232      #  my @EXPORT = qw( incoming subject MAILDIR jaccept );
233      #  foreach my $sym (@EXPORT) {
234          no strict 'refs';
235      #    *{"${callpack}::$sym"} = get_coderef('main', $sym);
236      #  }
237      {
238        no strict 'refs';
239        *{"rules::jaccept"}       = get_coderef('main', 'jaccept');
240        *{"rules::report"}        = get_coderef('main', 'report');
241        *{"rules::compareTarget"} = get_coderef('main', 'compareTarget');
242    }    }
243    if ($incoming->to =~ /wor\.net/i) {    $rules::MAILDIR  = $MAILDIR;
244      jaccept("$MAILDIR/SORTED/wor.net/Current/Inbox");    $rules::incoming = $incoming;
245    }  }
   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);  
246    
247    sub gchomp {
248      my $str = shift;
249      chomp($str);
250      return $str;
251    }
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed