Annotation of /nfo/perl/scripts/dispatchmail/recieveMail

#!/usr/bin/perl

# ==========================================================================
#
# recieveMail v0.03
#   a simple mail filter done in perl with CPAN-module "Mail::Audit"
#
#
# 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 arrays and hashes, no "matching-code-worm")
#   - Html-Gui to define rules
#   - rule base located in LDAP (local delivery routing)
#
# ==========================================================================

use strict;
# don't use warnings;

# ----------------------------------------------------------
# declare and initialize some variables
# these are mostly directories for routing our mail to
my $HOME = "/home/joko/virtual/joko_mail";
my $MAILDIR = "$HOME/Mail";
my $LOGFILE = "$MAILDIR/recievemail.log";
my $LOCKFILE = "$HOME/.procmail.lockfile";
my $DEFAULT = "$MAILDIR/SORTED/misc/Inbox";
my $DEBUG = 0;
my $TRACE = 1;

if (! -e $HOME) {
  $LOGFILE = "log/recievemail-emerg.log";
  my $msg = "delivery failed, base directory $HOME does not exist";
  open(FH, '>>' . $LOGFILE);
  print FH $msg, "\n";
  close(FH);
  die($msg);
}

# ----------------------------------------------------------
#                       main
# ----------------------------------------------------------

  # cry for our "Auditor"
  use Mail::Audit;

  # "jump" into processing of new incoming mail and get a "handler" to this mail
  my $incoming = Mail::Audit->new;

  my $from    = $incoming->from;
  my $to      = $incoming->to;
  my $subject = $incoming->subject;

  chomp($from);
  chomp($to);
  chomp($subject);

  # - - - - - - - - - - - - - - - - - - - -
  #             tracing mail
  # - - - - - - - - - - - - - - - - - - - -
  sub s2f {
    my $str = shift;
    open(FH, '>>' . $LOGFILE);
    print FH $str, "\n";
    close(FH);
  }
  if ($TRACE) {
    s2f("Mail from $from to $to");
    s2f("Subject: $subject");
  }

  # - - - - - - - - - - - - - - - - - - - -
  #             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;
    # TODO: tracing, debugging
    if ($TRACE) {
      s2f("deliver to: $deliver_to");
    }
    $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");
  }


  # -----
  # source && destination - routing
  if ($incoming->from =~ /andreas\.motl\@ilo\.de/ && compareTarget('joko\@netfrag\.org')) {
    jaccept("$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) {
    jaccept("$MAILDIR/SORTED/ilo.de/Inbox");
  }

  if ($incoming->to =~ /web\.de/i) {
    jaccept("$MAILDIR/SORTED/web.de/Current/Inbox");
  }
  if ($incoming->to =~ /wor\.net/i) {
    jaccept("$MAILDIR/SORTED/wor.net/Current/Inbox");
  }
  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);

1	joko	1.1	#!/usr/bin/perl
2
3			# ==========================================================================
4	joko	1.2	#
5	joko	1.3	# recieveMail v0.03
6			# a simple mail filter done in perl with CPAN-module "Mail::Audit"
7			#
8	joko	1.2	#
9	joko	1.3	# 2002-10-14, joko@netfrag.org
10			# + $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	joko	1.2	# 2001-12-05, joko@netfrag.org
20	joko	1.3	# + initial internal release
21	joko	1.2	# TODO:
22			# - more sophisticated filtering
23			# - configuration-comfort (use arrays and hashes, no "matching-code-worm")
24	joko	1.3	# - Html-Gui to define rules
25			# - rule base located in LDAP (local delivery routing)
26	joko	1.2	#
27	joko	1.1	# ==========================================================================
28
29			use strict;
30	joko	1.3	# don't use warnings;
31	joko	1.1
32			# ----------------------------------------------------------
33			# declare and initialize some variables
34			# these are mostly directories for routing our mail to
35	joko	1.3	my $HOME = "/home/joko/virtual/joko_mail";
36	joko	1.1	my $MAILDIR = "$HOME/Mail";
37	joko	1.3	my $LOGFILE = "$MAILDIR/recievemail.log";
38	joko	1.1	my $LOCKFILE = "$HOME/.procmail.lockfile";
39	joko	1.2	my $DEFAULT = "$MAILDIR/SORTED/misc/Inbox";
40	joko	1.3	my $DEBUG = 0;
41			my $TRACE = 1;
42	joko	1.1
43	joko	1.3	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	joko	1.1
52			# ----------------------------------------------------------
53			# main
54			# ----------------------------------------------------------
55
56			# cry for our "Auditor"
57			use Mail::Audit;
58
59			# "jump" into processing of new incoming mail and get a "handler" to this mail
60			my $incoming = Mail::Audit->new;
61
62	joko	1.3	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			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	joko	1.1	# - - - - - - - - - - - - - - - - - - - -
85	joko	1.3	# processing mail
86	joko	1.1	# - - - - - - - - - - - - - - - - - - - -
87	joko	1.2
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	joko	1.3	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	joko	1.2	# -----
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	joko	1.3	jaccept("$MAILDIR/SORTED/netfrag.org/Status/cashew.netfrag.org");
113	joko	1.2	}
114			if ($incoming->from =~ /(root\|admin)\@quepasa\.netfrag\.org/i) {
115	joko	1.3	jaccept("$MAILDIR/SORTED/netfrag.org/Status/quepasa.netfrag.org");
116	joko	1.2	}
117			if ($incoming->from =~ /(root\|service\|netsaint)\@h1\.service\.netfrag\.org/i) {
118	joko	1.3	jaccept("$MAILDIR/SORTED/netfrag.org/Status/h1.service.netfrag.org");
119	joko	1.2	}
120
121
122			# -----
123			# source && destination - routing
124			if ($incoming->from =~ /andreas\.motl\@ilo\.de/ && compareTarget('joko\@netfrag\.org')) {
125	joko	1.3	jaccept("$MAILDIR/SORTED/netfrag.org/Info");
126	joko	1.2	}
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	joko	1.3	jaccept("$MAILDIR/SORTED/ilo.de/Inbox");
137	joko	1.1	}
138	joko	1.2
139			if ($incoming->to =~ /web\.de/i) {
140	joko	1.3	jaccept("$MAILDIR/SORTED/web.de/Current/Inbox");
141	joko	1.1	}
142	joko	1.2	if ($incoming->to =~ /wor\.net/i) {
143	joko	1.3	jaccept("$MAILDIR/SORTED/wor.net/Current/Inbox");
144	joko	1.2	}
145			if ($incoming->to =~ /netfrag\.org/i \|\| $incoming->to =~ /archivists-talk\@yahoogroups\.com/) {
146	joko	1.3	jaccept("$MAILDIR/SORTED/netfrag.org/Inbox");
147	joko	1.2	}
148
149	joko	1.1	# - - - - - - - - - - - - - - - - - - - -
150
151			# the default-handler: simply accept all mails and route them to "/var/spool/mail"
152			# $incoming->accept();
153
154			# if you want to reject all mails coming through to here, do a ...
155			# $incoming->reject;
156
157			# catch all mails and route them to a "DEFAULT"-inbox
158	joko	1.3	jaccept($DEFAULT);
159
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26