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.1 2003/01/22 07:45:20 root Exp $
#
# ============================================================
#  $Log: Dispatch.pm,v $
#  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}   = "$HOME/Mail";
  $self->{settings}->{RULESFILE} = "$HOME/.dispatchmailrc.pm";
  #$self->{settings}->{LOCKFILE}  = "$HOME/.procmail.lockfile";
  $self->{settings}->{LOCKFILE}  = "$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 $HOME is empty

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