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.3 2003/01/22 07:55:43 joko Exp $
#
# ============================================================
#  $Log: Dispatch.pm,v $
#  Revision 1.3  2003/01/22 07:55:43  joko
#  + replaced '$HOME' with '$self->{settings}->{HOME}'
#
#  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
);
#  DesignPattern::Object::Logger


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


use Data::Code::Symbol qw( export_symbols );
use Data::Storage::Handler::File qw( a2f );
use org::netfrag::shortcuts qw( now get_chomped );


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( user base rules LOG VERBOSE TRACE )) {
    $self->{options}->{$_} = $self->{$_};
  }
}

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

sub _init_settings {
  my $self = shift;
  $self->{settings}->{USER} = $self->{options}->{user} if $self->{options}->{user};
  $self->{settings}->{USER} ||= '';
  $self->{settings}->{USER} ||= $ENV{USER};

  $self->{settings}->{HOME} = '../var/spool/mail/' . $self->{settings}->{USER};
  $self->{settings}->{HOME} = $self->{options}->{base} if $self->{options}->{base};

  $self->_init_settings_paths();
}

sub _init_settings_paths {
  my $self = shift;
  $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}->{ERRLOG}    = ".dispatchmail-errors.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} = 
      $self->{settings}->{ERRLOG} if (! -e $self->{settings}->{MAILDIR});
}


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

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


sub _run {

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

  # 0.a. pre flight tracing
    my $now = now();
    $self->report("$now - $0 running for user '$self->{settings}->{USER}'.");
    $self->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.";
       $self->report($msg);
       $self->forward_delivery();
     }

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

  # 2. export required stuff to rules namespace
    my @symbols = qw( jaccept report compareTarget );
    export_symbols(\@symbols, 'rules');

  # 3. run dispatcher
    $self->report("Running \"rules::dispatch\".");
    rules::dispatch($self);

  # 4. dispatcher didn't do anything
    $self->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
    $self->jaccept($self->{settings}->{DEFAULT});

}

sub run {
  my $self = shift;
  return $self->_run(@_);
}


  # - - - - - - - - - - - - - - - - - - - -
  #          tracing & reporting
  # - - - - - - - - - - - - - - - - - - - -
  sub appendLog {
    my $self = shift;
    my $msg = shift;
    a2f($self->{settings}->{LOGFILE}, $msg);
  }

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

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

  }

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

  sub compareTarget {
    my $self = shift;
    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 $self = shift;
    my $deliver_to = shift;
    
    $self->report("ACCEPT: $deliver_to");

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

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

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

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


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