/[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.1 by joko, Mon Oct 21 12:03:53 2002 UTC revision 1.3 by joko, Mon Oct 21 12:22:55 2002 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2    
3  # ==========================================================================  # ==========================================================================
4  # a simple mail filter done in perl with CPAN-module "Mail::Audit"  #
5  # more to come ...  # recieveMail v0.03
6  # TODO:  #   a simple mail filter done in perl with CPAN-module "Mail::Audit"
7  # - more sophisticated filtering  #
8  # - configuration-comfort (use arrays and hashes, no "matching-code-worm")  #
9  # - Html-Gui  # 2002-10-14, joko@netfrag.org
10  # 2001-12-05, amo@netfrag.org  #   + $LOGFILE is used now (recievemail.log)
11    #   + tracing (uses $LOGFILE)
12    #   + checks delivery path for existance,
13    #     changes $LOGFILE if needed
14    #  
15    # 2002-07-17, joko@netfrag.org
16    #   + added filtering by target (destination-routing)
17    #     (looks in "to", "cc" and "bcc")
18    #  
19    # 2001-12-05, joko@netfrag.org
20    #   + initial internal release
21    #   TODO:
22    #   - more sophisticated filtering
23    #   - configuration-comfort (use arrays and hashes, no "matching-code-worm")
24    #   - Html-Gui to define rules
25    #   - rule base located in LDAP (local delivery routing)
26    #
27  # ==========================================================================  # ==========================================================================
28    
   
 # variables have to be declared!  
29  use strict;  use strict;
30    # don't use warnings;
31    
32  # ----------------------------------------------------------  # ----------------------------------------------------------
33  # declare and initialize some variables  # declare and initialize some variables
34  # these are mostly directories for routing our mail to  # these are mostly directories for routing our mail to
35  my $HOME = "/home/amo/virtual/home/amo_mail/";  my $HOME = "/home/joko/virtual/joko_mail";
36  my $MAILDIR = "$HOME/Mail";  my $MAILDIR = "$HOME/Mail";
37  my $LOGFILE = "$MAILDIR/procmail.log";  my $LOGFILE = "$MAILDIR/recievemail.log";
38  my $LOCKFILE = "$HOME/.procmail.lockfile";  my $LOCKFILE = "$HOME/.procmail.lockfile";
39  my $DEFAULT = "$MAILDIR/UNSORTED/Current/Inbox";  my $DEFAULT = "$MAILDIR/SORTED/misc/Inbox";
40    my $DEBUG = 0;
41    my $TRACE = 1;
42    
43    if (! -e $HOME) {
44      $LOGFILE = "log/recievemail-emerg.log";
45      my $msg = "delivery failed, base directory $HOME does not exist";
46      open(FH, '>>' . $LOGFILE);
47      print FH $msg, "\n";
48      close(FH);
49      die($msg);
50    }
51    
52  # ----------------------------------------------------------  # ----------------------------------------------------------
53  #                       main  #                       main
# Line 34  my $DEFAULT = "$MAILDIR/UNSORTED/Current Line 59  my $DEFAULT = "$MAILDIR/UNSORTED/Current
59    # "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
60    my $incoming = Mail::Audit->new;    my $incoming = Mail::Audit->new;
61    
62      my $from    = $incoming->from;
63      my $to      = $incoming->to;
64      my $subject = $incoming->subject;
65    
66      chomp($from);
67      chomp($to);
68      chomp($subject);
69    
70      # - - - - - - - - - - - - - - - - - - - -
71      #             tracing mail
72    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
73    #             process mail    sub s2f {
74        my $str = shift;
75        open(FH, '>>' . $LOGFILE);
76        print FH $str, "\n";
77        close(FH);
78      }
79      if ($TRACE) {
80        s2f("Mail from $from to $to");
81        s2f("Subject: $subject");
82      }
83    
84    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
85    if ($incoming->to =~ /ilo\.de/) {    #             processing mail
86      $incoming->accept("$MAILDIR/SORTED/ilo.de/Current/Inbox");    # - - - - - - - - - - - - - - - - - - - -
87    
88      sub compareTarget {
89        my $pattern = shift;
90        my $ok = 0;
91        $ok = 1 if ($incoming->to =~ m/$pattern/);
92        $ok = 1 if ($incoming->cc =~ m/$pattern/);
93        $ok = 1 if ($incoming->bcc =~ m/$pattern/);
94        return $ok;
95      }
96    
97      sub jaccept {
98        my $deliver_to = shift;
99        # TODO: tracing, debugging
100        if ($TRACE) {
101          s2f("deliver to: $deliver_to");
102        }
103        $incoming->accept($deliver_to);
104      }
105    
106      # -----
107      # source-routing
108      #if ($incoming->from =~ /root\@smtp\.f7x\.net/i) {
109      #  $incoming->accept("$MAILDIR/SORTED/netfrag.org/Current/status-ns1.f7x.net");
110      #}
111      if ($incoming->from =~ /(root|admin)\@cashew\.netfrag\.org/i) {
112        jaccept("$MAILDIR/SORTED/netfrag.org/Status/cashew.netfrag.org");
113    }    }
114    if ($incoming->to =~ /web\.de/) {    if ($incoming->from =~ /(root|admin)\@quepasa\.netfrag\.org/i) {
115      $incoming->accept("$MAILDIR/SORTED/web.de/Current/Inbox");      jaccept("$MAILDIR/SORTED/netfrag.org/Status/quepasa.netfrag.org");
116    }    }
117      if ($incoming->from =~ /(root|service|netsaint)\@h1\.service\.netfrag\.org/i) {
118        jaccept("$MAILDIR/SORTED/netfrag.org/Status/h1.service.netfrag.org");
119      }
120    
121    
122      # -----
123      # source && destination - routing
124      if ($incoming->from =~ /andreas\.motl\@ilo\.de/ && compareTarget('joko\@netfrag\.org')) {
125        jaccept("$MAILDIR/SORTED/netfrag.org/Info");
126      }
127    
128    
129      # -----
130      # destination-routing
131      my $bool_ilo = ($incoming->to =~ m/ilo\.de/i);
132      my $bool_ilo_news1 = ($incoming->to =~ m/kritletter\@kbx\.de/i);
133      my $bool_from_kolumnen_de = ($incoming->to =~ m/kolumnen\.de/i);
134      my $bool_from_strixner = ($incoming->to =~ m/strixner\@web\.de/i);
135      if ($bool_ilo || $bool_ilo_news1 || $bool_from_kolumnen_de || $bool_from_strixner) {
136        jaccept("$MAILDIR/SORTED/ilo.de/Inbox");
137      }
138    
139      if ($incoming->to =~ /web\.de/i) {
140        jaccept("$MAILDIR/SORTED/web.de/Current/Inbox");
141      }
142      if ($incoming->to =~ /wor\.net/i) {
143        jaccept("$MAILDIR/SORTED/wor.net/Current/Inbox");
144      }
145      if ($incoming->to =~ /netfrag\.org/i || $incoming->to =~ /archivists-talk\@yahoogroups\.com/) {
146        jaccept("$MAILDIR/SORTED/netfrag.org/Inbox");
147      }
148    
149    # - - - - - - - - - - - - - - - - - - - -    # - - - - - - - - - - - - - - - - - - - -
150    
151  # the default-handler: simply accept all mails and route them to "/var/spool/mail"  # the default-handler: simply accept all mails and route them to "/var/spool/mail"
# Line 52  my $DEFAULT = "$MAILDIR/UNSORTED/Current Line 155  my $DEFAULT = "$MAILDIR/UNSORTED/Current
155  # $incoming->reject;  # $incoming->reject;
156    
157  # catch all mails and route them to a "DEFAULT"-inbox  # catch all mails and route them to a "DEFAULT"-inbox
158  $incoming->accept($DEFAULT);  jaccept($DEFAULT);
159    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
MailToCvsAdmin">MailToCvsAdmin
 ViewVC Help
Powered by ViewVC 1.1.26 RSS 2.0 feed