/[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.2 by joko, Mon Oct 21 12:16:31 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.02  # recieveMail v0.04
 #  
 # 2001-12-05, joko@netfrag.org  
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"
 #   more to come ...  
 #   TODO:  
 #   - more sophisticated filtering  
 #   - configuration-comfort (use arrays and hashes, no "matching-code-worm")  
 #   - Html-Gui  
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
17    #   + $LOGFILE is used now (recievemail.log)
18    #   + tracing (uses $LOGFILE)
19    #   + checks delivery path for existance,
20    #     changes $LOGFILE if needed
21    #  
22  # 2002-07-17, joko@netfrag.org  # 2002-07-17, joko@netfrag.org
23  #   + added filtering by target (looks in "to", "cc" and "bcc")  #   + added filtering by target (destination-routing)
24    #     (looks in "to", "cc" and "bcc")
25  #    #  
26    # 2001-12-05, joko@netfrag.org
27    #   + initial internal release
28    #
29    #
30    # TODO:
31    #   - more sophisticated filtering
32    #   - configuration-comfort (use perl-arrays and -hashes for rule-declaration)
33    #   - Html-Gui to add/edit/remove rules
34    #   - 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;
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/home/joko_mail/";  
61  my $MAILDIR = "$HOME/Mail";  
62  my $LOGFILE = "$MAILDIR/procmail.log";  # - - - - - - - - - - - - - - - - - - - -
63  my $LOCKFILE = "$HOME/.procmail.lockfile";  #               options
64  my $DEFAULT = "$MAILDIR/SORTED/misc/Inbox";  # - - - - - - - - - - - - - - - - - - - -
65    my $opt_base      = '';
66    my $opt_rulesfile = '';
67  # ----------------------------------------------------------  GetOptions(
68  #                       main    'base=s'  => \$opt_base,
69  # ----------------------------------------------------------    'rules=s' => \$opt_rulesfile,
70    );
71    $opt_base ||= $ENV{HOME};
72    $opt_base ||= $ENV{PWD};
73    
74    # cry for our "Auditor"  
75    use Mail::Audit;  # - - - - - - - - - - - - - - - - - - - -
76    #
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      # 0.a. pre flight tracing
111        if ($TRACE) {
112          s2f("Mail from " . gchomp($incoming->from) . " to " . gchomp($incoming->to));
113          s2f("Subject: " . gchomp($incoming->subject));
114        }
115    
116      # 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    #             process mail    #          tracing & reporting
163      # - - - - - - - - - - - - - - - - - - - -
164      sub s2f {
165        my $str = shift;
166        open(FH, '>>' . $LOGFILE);
167        print FH $str, "\n";
168        close(FH);
169      }
170    
171      sub report {
172        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      # - - - - - - - - - - - - - - - - - - - -
183      #             processing mail
184    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
185    
186    sub compareTarget {    sub compareTarget {
# Line 52  my $DEFAULT = "$MAILDIR/SORTED/misc/Inbo Line 192  my $DEFAULT = "$MAILDIR/SORTED/misc/Inbo
192      return $ok;      return $ok;
193    }    }
194    
195    # -----    sub jaccept {
196    # source-routing      my $deliver_to = shift;
197    #if ($incoming->from =~ /root\@smtp\.f7x\.net/i) {      
198    #  $incoming->accept("$MAILDIR/SORTED/netfrag.org/Current/status-ns1.f7x.net");      report("delivering to: $deliver_to");
199    #}  
200    if ($incoming->from =~ /(root|admin)\@cashew\.netfrag\.org/i) {      # check deliver_to path
201      $incoming->accept("$MAILDIR/SORTED/netfrag.org/Status/cashew.netfrag.org");      if (! -e $deliver_to) {
202    }        report("deliver_to path \"$deliver_to\" doesn't exist");
203    if ($incoming->from =~ /(root|admin)\@quepasa\.netfrag\.org/i) {        accept_spool();
204      $incoming->accept("$MAILDIR/SORTED/netfrag.org/Status/quepasa.netfrag.org");        return;
205    }      }
206    if ($incoming->from =~ /(root|service|netsaint)\@h1\.service\.netfrag\.org/i) {  
207      $incoming->accept("$MAILDIR/SORTED/netfrag.org/Status/h1.service.netfrag.org");      $incoming->accept($deliver_to);
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);
     $incoming->accept("$MAILDIR/SORTED/netfrag.org/Info");  
   }  
   
   
   # -----  
   # 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) {  
     $incoming->accept("$MAILDIR/SORTED/ilo.de/Inbox");  
   }  
   
   if ($incoming->to =~ /web\.de/i) {  
     $incoming->accept("$MAILDIR/SORTED/web.de/Current/Inbox");  
214    }    }
   if ($incoming->to =~ /wor\.net/i) {  
     $incoming->accept("$MAILDIR/SORTED/wor.net/Current/Inbox");  
   }  
   if ($incoming->to =~ /netfrag\.org/i || $incoming->to =~ /archivists-talk\@yahoogroups\.com/) {  
     $incoming->accept("$MAILDIR/SORTED/netfrag.org/Inbox");  
   }  
   
   # - - - - - - - - - - - - - - - - - - - -  
   
 # the default-handler: simply accept all mails and route them to "/var/spool/mail"  
 # $incoming->accept();  
215    
 # if you want to reject all mails coming through to here, do a ...  
 # $incoming->reject;  
216    
217  # catch all mails and route them to a "DEFAULT"-inbox  # - - - - - - - - - - - - - - - - - - - -
218  $incoming->accept($DEFAULT);  #             helper functions
219    # - - - - - - - - - - - - - - - - - - - -
220    
221    sub get_coderef {
222      my $codepack = shift;
223      my $method = shift;
224      $codepack || return '[error]';
225      $method ||= '';
226      $method && ($codepack .= '::');
227      return eval '\&' . $codepack . $method . ';';
228    }
229    
230    sub export_symbols {
231      #  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      $rules::MAILDIR  = $MAILDIR;
244      $rules::incoming = $incoming;
245    }
246    
247    sub gchomp {
248      my $str = shift;
249      chomp($str);
250      return $str;
251    }
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.4
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed