Mail/Audit/Dispatch.pm

# ============================================================
#
#  Mail::Audit::Dispatch v0.05
#    A simple mail filter done in perl 
#    with the Perl-module "Mail::Audit" 
#    available from CPAN.
#
#  $Id: Dispatch.pm,v 1.2 2003/01/22 07:54:24 joko Exp $
#
# ============================================================
#  $Log: Dispatch.pm,v $
#  Revision 1.2  2003/01/22 07:54:24  joko
#  + replaced global variables with class-variables
#
#  Revision 1.1  2003/01/22 07:45:20  root
#  + initial check-in - refactored from 'dispatchmail'
#
#  Revision 1.3  2003/01/22 07:16:51  root
#  + sub traceEntry
#  + further refactorings
#
#  Revision 1.2  2003/01/22 05:38:44  collector
#  + prepared refactoring to 'dispatchmail'
#
# ============================================================


package Mail::Audit::Dispatch;

use strict;
# don't use warnings;

use base qw( DesignPattern::Object );


use Mail::Audit;
use Data::Dumper;


use org::netfrag::shortcuts qw( now );


my $LOG     = 1;        # writes reports to logfile
my $self->{options}->{VERBOSE} = 1;     # writes reports to STDOUT
my $self->{options}->{TRACE}   = 1;     # writes contents of messages to logfile


sub _init {
  my $self = shift;
  $self->_init_options();
  $self->_override_options();
  $self->_init_settings();
  $self->_override_settings();
  $self->_run();
}

sub _init_options {
  my $self = shift;
  foreach (qw( base rules LOG VERBOSE TRACE )) {
    $self->{options}->{$_} = $self->{$_};
  }
}

sub _override_options {
  my $self = shift;
  $self->{options}->{base} ||= $ENV{HOME};
  $self->{options}->{base} ||= $ENV{PWD};
}

# - - - - - - - - - - - - - - - - - - - -
#
#                targets
#
#  declare and initialize some variables
#      these are mostly base paths
#      mail should be delivered to
#
# - - - - - - - - - - - - - - - - - - - -
sub _init_settings {
  my $self = shift;
  $self->{settings}->{USER}      = $ENV{USER};
  $self->{settings}->{HOME}      = $self->{options}->{base};
  $self->{settings}->{MAILDIR}   = "$self->{settings}->{HOME}/Mail";
  $self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";
  #$self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.procmail.lockfile";
  $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";
  $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.dispatchmail.log";
  $self->{settings}->{DEFAULT}   = "$self->{settings}->{MAILDIR}/Inbox";
}

sub _override_settings {
  my $self = shift;
  # override $self->{settings}->{RULESFILE} if given as option on the command line
    $self->{settings}->{RULESFILE} = 
      $self->{options}->{rules} if $self->{options}->{rules};
  # change logfile
    $self->{settings}->{LOGFILE} = 
      "recievemail-emerg.log" if (! -e $self->{settings}->{MAILDIR});

    $self->{settings}->{USER} ||= '';
}


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

sub _run {
  my $self = shift;
  
  # "jump" into processing of new incoming mail and get a "handler" to this mail
  $self->{incoming} = Mail::Audit->new();

}

  sub traceEntry {
  my $self = shift;
    s2f('-' x 40 . '  TRACE  ' . '-' x 10);
    s2f("From:    " . gchomp($self->{incoming}->from));
    s2f("To:      " . gchomp($self->{incoming}->to));
    s2f("Subject: " . gchomp($self->{incoming}->subject));
    s2f('-' x 40 . '  TRACE  ' . '-' x 10);
  }


  # 0.a. pre flight tracing
    my $now = now();
    report("$0 running at $now for user '$USER'.");
    traceEntry() if $self->{options}->{TRACE};

  # 0.b. pre flight checks

     # TODO: check if $self->{settings}->{HOME} is empty

     # check if $self->{settings}->{HOME} exists
     if (! -e $self->{settings}->{MAILDIR}) {
       my $msg = "delivery failed, base directory $self->{settings}->{MAILDIR} does not exist";
       report($msg);
       forward_delivery();
     }

  # 1. include rules or fallback
    # check if $self->{settings}->{RULESFILE} exists
    if (-f $self->{settings}->{RULESFILE}) {
      report("Loading rules from \"$self->{settings}->{RULESFILE}\".");
      require $self->{settings}->{RULESFILE};
    } else {
      #die("$self->{settings}->{RULESFILE} doesn't exist");
      report("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");
      forward_delivery();
    }

  # 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"
    # $self->{incoming}->accept();

    # if you want to reject all mails coming through to here, do a ...
    # $self->{incoming}->reject;

    # catch all mails and route them to a "DEFAULT"-inbox
    jaccept($self->{settings}->{DEFAULT});


  # - - - - - - - - - - - - - - - - - - - -
  #          tracing & reporting
  # - - - - - - - - - - - - - - - - - - - -
  sub s2f {
    my $str = shift;
    open(FH, '>>' . $self->{settings}->{LOGFILE});
    print FH $str, "\n";
    close(FH);
  }

  sub report {
    my $msg = shift;    
    # TODO: tracing, debugging

    print $msg, "\n" if $self->{options}->{VERBOSE};
    if ($LOG) {
      s2f($msg);
    }

  }

  # - - - - - - - - - - - - - - - - - - - -
  #             processing mail
  # - - - - - - - - - - - - - - - - - - - -

  sub compareTarget {
    my $pattern = shift;
    my $ok = 0;
    $ok = 1 if ($self->{incoming}->to =~ m/$pattern/);
    $ok = 1 if ($self->{incoming}->cc =~ m/$pattern/);
    $ok = 1 if ($self->{incoming}->bcc =~ m/$pattern/);
    return $ok;
  }

  sub jaccept {
    my $deliver_to = shift;
    
    report("ACCEPT: $deliver_to");

    # check deliver_to path
    if (! -e $deliver_to) {
      report("deliver_to path \"$deliver_to\" doesn't exist");
      forward_delivery();
      return;
    }

    $self->{incoming}->accept($deliver_to);
  }

  sub accept_spool {
    my $path = "/var/spool/mail/$USER";
    report("defaulting to spool delivery ($path)");
    $self->{incoming}->accept($path);
  }

  sub forward_delivery {
    report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
    $self->{incoming}->accept;
  }


# - - - - - - - - - - - - - - - - - - - -
#             helper functions
# - - - - - - - - - - - - - - - - - - - -

sub get_coderef {
  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  = $self->{settings}->{MAILDIR};
  $rules::incoming = $self->{incoming};
}

sub gchomp {
  my $str = shift;
  chomp($str);
  return $str;
}

1;
1	root	1.1	# ============================================================
2			#
3			# Mail::Audit::Dispatch v0.05
4			# A simple mail filter done in perl
5			# with the Perl-module "Mail::Audit"
6			# available from CPAN.
7			#
8	joko	1.3	# $Id: Dispatch.pm,v 1.2 2003/01/22 07:54:24 joko Exp $
9	root	1.1	#
10			# ============================================================
11	joko	1.2	# $Log: Dispatch.pm,v $
12	joko	1.3	# Revision 1.2 2003/01/22 07:54:24 joko
13			# + replaced global variables with class-variables
14			#
15	joko	1.2	# Revision 1.1 2003/01/22 07:45:20 root
16			# + initial check-in - refactored from 'dispatchmail'
17			#
18	root	1.1	# Revision 1.3 2003/01/22 07:16:51 root
19			# + sub traceEntry
20			# + further refactorings
21			#
22			# Revision 1.2 2003/01/22 05:38:44 collector
23			# + prepared refactoring to 'dispatchmail'
24			#
25			# ============================================================
26
27
28			package Mail::Audit::Dispatch;
29
30			use strict;
31			# don't use warnings;
32
33			use base qw( DesignPattern::Object );
34
35
36			use Mail::Audit;
37			use Data::Dumper;
38
39
40			use org::netfrag::shortcuts qw( now );
41
42
43			my $LOG = 1; # writes reports to logfile
44	joko	1.2	my $self->{options}->{VERBOSE} = 1; # writes reports to STDOUT
45			my $self->{options}->{TRACE} = 1; # writes contents of messages to logfile
46	root	1.1
47
48			sub _init {
49			my $self = shift;
50			$self->_init_options();
51	joko	1.2	$self->_override_options();
52	root	1.1	$self->_init_settings();
53			$self->_override_settings();
54	joko	1.2	$self->_run();
55	root	1.1	}
56
57			sub _init_options {
58			my $self = shift;
59	joko	1.2	foreach (qw( base rules LOG VERBOSE TRACE )) {
60			$self->{options}->{$_} = $self->{$_};
61			}
62			}
63
64			sub _override_options {
65			my $self = shift;
66	root	1.1	$self->{options}->{base} \|\|= $ENV{HOME};
67			$self->{options}->{base} \|\|= $ENV{PWD};
68			}
69
70			# - - - - - - - - - - - - - - - - - - - -
71			#
72			# targets
73			#
74			# declare and initialize some variables
75			# these are mostly base paths
76			# mail should be delivered to
77			#
78			# - - - - - - - - - - - - - - - - - - - -
79	joko	1.2	sub _init_settings {
80	root	1.1	my $self = shift;
81			$self->{settings}->{USER} = $ENV{USER};
82			$self->{settings}->{HOME} = $self->{options}->{base};
83	joko	1.3	$self->{settings}->{MAILDIR} = "$self->{settings}->{HOME}/Mail";
84			$self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";
85			#$self->{settings}->{LOCKFILE} = "$self->{settings}->{HOME}/.procmail.lockfile";
86			$self->{settings}->{LOCKFILE} = "$self->{settings}->{HOME}/.dispatchmail.lockfile";
87	joko	1.2	$self->{settings}->{LOGFILE} = "$self->{settings}->{MAILDIR}/.dispatchmail.log";
88			$self->{settings}->{DEFAULT} = "$self->{settings}->{MAILDIR}/Inbox";
89	root	1.1	}
90
91			sub _override_settings {
92			my $self = shift;
93	joko	1.2	# override $self->{settings}->{RULESFILE} if given as option on the command line
94	root	1.1	$self->{settings}->{RULESFILE} =
95			$self->{options}->{rules} if $self->{options}->{rules};
96			# change logfile
97			$self->{settings}->{LOGFILE} =
98			"recievemail-emerg.log" if (! -e $self->{settings}->{MAILDIR});
99
100			$self->{settings}->{USER} \|\|= '';
101			}
102
103
104
105			# - - - - - - - - - - - - - - - - - - - -
106			# main
107			# - - - - - - - - - - - - - - - - - - - -
108
109	joko	1.2	sub _run {
110			my $self = shift;
111
112	root	1.1	# "jump" into processing of new incoming mail and get a "handler" to this mail
113	joko	1.2	$self->{incoming} = Mail::Audit->new();
114
115			}
116	root	1.1
117			sub traceEntry {
118	joko	1.2	my $self = shift;
119	root	1.1	s2f('-' x 40 . ' TRACE ' . '-' x 10);
120	joko	1.2	s2f("From: " . gchomp($self->{incoming}->from));
121			s2f("To: " . gchomp($self->{incoming}->to));
122			s2f("Subject: " . gchomp($self->{incoming}->subject));
123	root	1.1	s2f('-' x 40 . ' TRACE ' . '-' x 10);
124			}
125
126
127			# 0.a. pre flight tracing
128			my $now = now();
129			report("$0 running at $now for user '$USER'.");
130	joko	1.2	traceEntry() if $self->{options}->{TRACE};
131	root	1.1
132			# 0.b. pre flight checks
133
134	joko	1.3	# TODO: check if $self->{settings}->{HOME} is empty
135	root	1.1
136	joko	1.3	# check if $self->{settings}->{HOME} exists
137	joko	1.2	if (! -e $self->{settings}->{MAILDIR}) {
138			my $msg = "delivery failed, base directory $self->{settings}->{MAILDIR} does not exist";
139	root	1.1	report($msg);
140			forward_delivery();
141			}
142
143			# 1. include rules or fallback
144	joko	1.2	# check if $self->{settings}->{RULESFILE} exists
145			if (-f $self->{settings}->{RULESFILE}) {
146			report("Loading rules from \"$self->{settings}->{RULESFILE}\".");
147			require $self->{settings}->{RULESFILE};
148	root	1.1	} else {
149	joko	1.2	#die("$self->{settings}->{RULESFILE} doesn't exist");
150			report("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");
151	root	1.1	forward_delivery();
152			}
153
154			# 2. export required stuff to rules namespace
155			export_symbols();
156
157			# 3. run dispatcher
158			report("Running \"rules::dispatch\".");
159			rules::dispatch();
160
161			# 4. dispatcher didn't do anything
162			report("dispatcher could not apply any filter, using default delivery");
163
164			# the default-handler: simply accept all mails and route them to "/var/spool/mail"
165	joko	1.2	# $self->{incoming}->accept();
166	root	1.1
167			# if you want to reject all mails coming through to here, do a ...
168	joko	1.2	# $self->{incoming}->reject;
169	root	1.1
170			# catch all mails and route them to a "DEFAULT"-inbox
171	joko	1.2	jaccept($self->{settings}->{DEFAULT});
172	root	1.1
173
174
175
176
177			# - - - - - - - - - - - - - - - - - - - -
178			# tracing & reporting
179			# - - - - - - - - - - - - - - - - - - - -
180			sub s2f {
181			my $str = shift;
182	joko	1.2	open(FH, '>>' . $self->{settings}->{LOGFILE});
183	root	1.1	print FH $str, "\n";
184			close(FH);
185			}
186
187			sub report {
188			my $msg = shift;
189			# TODO: tracing, debugging
190
191	joko	1.2	print $msg, "\n" if $self->{options}->{VERBOSE};
192	root	1.1	if ($LOG) {
193			s2f($msg);
194			}
195
196			}
197
198			# - - - - - - - - - - - - - - - - - - - -
199			# processing mail
200			# - - - - - - - - - - - - - - - - - - - -
201
202			sub compareTarget {
203			my $pattern = shift;
204			my $ok = 0;
205	joko	1.2	$ok = 1 if ($self->{incoming}->to =~ m/$pattern/);
206			$ok = 1 if ($self->{incoming}->cc =~ m/$pattern/);
207			$ok = 1 if ($self->{incoming}->bcc =~ m/$pattern/);
208	root	1.1	return $ok;
209			}
210
211			sub jaccept {
212			my $deliver_to = shift;
213
214			report("ACCEPT: $deliver_to");
215
216			# check deliver_to path
217			if (! -e $deliver_to) {
218			report("deliver_to path \"$deliver_to\" doesn't exist");
219			forward_delivery();
220			return;
221			}
222
223	joko	1.2	$self->{incoming}->accept($deliver_to);
224	root	1.1	}
225
226			sub accept_spool {
227			my $path = "/var/spool/mail/$USER";
228			report("defaulting to spool delivery ($path)");
229	joko	1.2	$self->{incoming}->accept($path);
230	root	1.1	}
231
232			sub forward_delivery {
233			report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
234	joko	1.2	$self->{incoming}->accept;
235	root	1.1	}
236
237
238			# - - - - - - - - - - - - - - - - - - - -
239			# helper functions
240			# - - - - - - - - - - - - - - - - - - - -
241
242			sub get_coderef {
243			my $codepack = shift;
244			my $method = shift;
245			$codepack \|\| return '[error]';
246			$method \|\|= '';
247			$method && ($codepack .= '::');
248			return eval '\&' . $codepack . $method . ';';
249			}
250
251			sub export_symbols {
252			# my $callpack = 'rules';
253			# my @EXPORT = qw( incoming subject MAILDIR jaccept );
254			# foreach my $sym (@EXPORT) {
255			no strict 'refs';
256			# *{"${callpack}::$sym"} = get_coderef('main', $sym);
257			# }
258			{
259			no strict 'refs';
260			*{"rules::jaccept"} = get_coderef('main', 'jaccept');
261			*{"rules::report"} = get_coderef('main', 'report');
262			*{"rules::compareTarget"} = get_coderef('main', 'compareTarget');
263			}
264	joko	1.2	$rules::MAILDIR = $self->{settings}->{MAILDIR};
265			$rules::incoming = $self->{incoming};
266	root	1.1	}
267
268			sub gchomp {
269			my $str = shift;
270			chomp($str);
271			return $str;
272			}
273	joko	1.2
274			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26