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.6 2003/03/23 21:12:20 root Exp $
#
# ============================================================
#  $Log: Dispatch.pm,v $
#  Revision 1.6  2003/03/23 21:12:20  root
#  + sub jerror and related modifications
#
#  Revision 1.5  2003/01/30 23:20:21  root
#  + fixed and enhanced
#
#  Revision 1.4  2003/01/22 17:58:21  root
#  + fixed and enhanced many things
#  - refactored code to Data::Code
#
#  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::Bridge
);
#  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 run_cmd );


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 mode newsgroup )) {
    $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}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc";
  #$self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.procmail.lockfile";
  $self->{settings}->{LOCKFILE}  = "$self->{settings}->{HOME}/.dispatchmail.lockfile";
  $self->{settings}->{LOGFILE}   = "$self->{settings}->{MAILDIR}/.mail-delivery.log";
  $self->{settings}->{ERRLOG}    = ".mail-delivery_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 run {
  my $self = shift;
  
  $self->{options}->{mode} ||= 'recieve';
  my $call = '_' . $self->{options}->{mode};

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

  my $result = $self->$call(@_);
  return $result;

}

sub _recieve {

  my $self = shift;
  
  # 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 = "ERROR: Delivery failed, base directory '$self->{settings}->{MAILDIR}' does not exist.";
       $self->jerror($msg);
     }

  # 1. include rules or fallback
    # check if $self->{settings}->{RULESFILE} exists
    if (-f $self->{settings}->{RULESFILE}) {
      $self->report("RULES:  Loading from \"$self->{settings}->{RULESFILE}\".");
      my $evalstr = "require '$self->{settings}->{RULESFILE}';";
      eval($evalstr);
      if ($@) {
        my $msg = "ERROR:  Delivery failed, '$self->{settings}->{RULESFILE}' had syntax errors:\n$@";
        $self->jerror($msg);
      }
    } else {
      #die("$self->{settings}->{RULESFILE} doesn't exist");
      $self->jerror("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");
    }

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

  # 3. run dispatcher
    $self->report("RULES:  Running Perl sub \"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 jerror {
  my $self = shift;
  my $msg = shift;
  $self->report("ERROR: $msg");
  $self->forward_delivery();
}

sub _mail2news {
  my $self = shift;
  $self->report("MAIL2NEWS: $self->{options}->{newsgroup}");
  my $plugin = 'Newsgate';
  $self->load($plugin);
  $self->$plugin($self->{options}->{newsgroup});
}


  # - - - - - - - - - - - - - - - - - - - -
  #          tracing & reporting
  # - - - - - - - - - - - - - - - - - - - -
  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("Message-ID: " . get_chomped($self->{incoming}->get('Message-ID')));
    $self->appendLog('-' x 40 . '  TRACE  ' . '-' x 10);
  }

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


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

    # check deliver_to path
    if (! -e $deliver_to) {
      my $good = 0;
      $self->report("ERROR:  TARGET Path/File doesn't exist.");
      if ($self->{settings}->{AUTOCREATE_FOLDERS}) {
        my $cmd = "touch $deliver_to";
        $self->report("TARGET: AUTOCREATE_FOLDERS is enabled: touching TARGET.");
        #if (mkdir $deliver_to) {
        run_cmd($cmd);
        # re-test TARGET - for existance now
        if (-e $deliver_to) {
          $good = 1;
        } else {
          $self->report("ERROR:  TARGET creation failed (command was: '$cmd').");
        }
      }
      if (!$good) {
        $self->forward_delivery();
        return;
      }
    }

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


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

  sub copy {
    my $self = shift;
    my $plugin = shift;
    my $deliver_to = shift;
    
    $self->report("COPY: $plugin: $deliver_to");

    $self->load($plugin);
    return $self->$plugin($deliver_to);
  }

  sub ignore {
    my $self = shift;
    $self->report("IGNORE");
    return $self->{incoming}->ignore;
  }

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.7	# $Id: Dispatch.pm,v 1.6 2003/03/23 21:12:20 root Exp $
9	root	1.1	#
10			# ============================================================
11	joko	1.2	# $Log: Dispatch.pm,v $
12	root	1.7	# Revision 1.6 2003/03/23 21:12:20 root
13			# + sub jerror and related modifications
14			#
15	root	1.6	# Revision 1.5 2003/01/30 23:20:21 root
16			# + fixed and enhanced
17			#
18	root	1.5	# Revision 1.4 2003/01/22 17:58:21 root
19			# + fixed and enhanced many things
20			# - refactored code to Data::Code
21			#
22	root	1.4	# Revision 1.3 2003/01/22 07:55:43 joko
23			# + replaced '$HOME' with '$self->{settings}->{HOME}'
24			#
25	joko	1.3	# Revision 1.2 2003/01/22 07:54:24 joko
26			# + replaced global variables with class-variables
27			#
28	joko	1.2	# Revision 1.1 2003/01/22 07:45:20 root
29			# + initial check-in - refactored from 'dispatchmail'
30			#
31	root	1.1	# Revision 1.3 2003/01/22 07:16:51 root
32			# + sub traceEntry
33			# + further refactorings
34			#
35			# Revision 1.2 2003/01/22 05:38:44 collector
36			# + prepared refactoring to 'dispatchmail'
37			#
38			# ============================================================
39
40
41			package Mail::Audit::Dispatch;
42
43			use strict;
44			# don't use warnings;
45
46	root	1.4	use base qw(
47			DesignPattern::Object
48	root	1.5	DesignPattern::Bridge
49	root	1.4	);
50			# DesignPattern::Object::Logger
51	root	1.1
52
53			use Mail::Audit;
54			use Data::Dumper;
55
56
57	root	1.4	use Data::Code::Symbol qw( export_symbols );
58			use Data::Storage::Handler::File qw( a2f );
59	root	1.5	use org::netfrag::shortcuts qw( now get_chomped run_cmd );
60	root	1.1
61
62			sub _init {
63			my $self = shift;
64			$self->_init_options();
65	joko	1.2	$self->_override_options();
66	root	1.1	$self->_init_settings();
67			$self->_override_settings();
68	root	1.4	#$self->_run();
69	root	1.1	}
70
71			sub _init_options {
72			my $self = shift;
73	root	1.5	foreach (qw( user base rules LOG VERBOSE TRACE mode newsgroup )) {
74	joko	1.2	$self->{options}->{$_} = $self->{$_};
75			}
76			}
77
78			sub _override_options {
79			my $self = shift;
80	root	1.1	$self->{options}->{base} \|\|= $ENV{HOME};
81			$self->{options}->{base} \|\|= $ENV{PWD};
82			}
83
84	joko	1.2	sub _init_settings {
85	root	1.1	my $self = shift;
86	root	1.4	$self->{settings}->{USER} = $self->{options}->{user} if $self->{options}->{user};
87			$self->{settings}->{USER} \|\|= '';
88			$self->{settings}->{USER} \|\|= $ENV{USER};
89
90			$self->{settings}->{HOME} = '../var/spool/mail/' . $self->{settings}->{USER};
91			$self->{settings}->{HOME} = $self->{options}->{base} if $self->{options}->{base};
92
93			$self->_init_settings_paths();
94			}
95
96			sub _init_settings_paths {
97			my $self = shift;
98	joko	1.3	$self->{settings}->{MAILDIR} = "$self->{settings}->{HOME}/Mail";
99	root	1.5	#$self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc.pm";
100			$self->{settings}->{RULESFILE} = "$self->{settings}->{HOME}/.dispatchmailrc";
101	joko	1.3	#$self->{settings}->{LOCKFILE} = "$self->{settings}->{HOME}/.procmail.lockfile";
102			$self->{settings}->{LOCKFILE} = "$self->{settings}->{HOME}/.dispatchmail.lockfile";
103	root	1.7	$self->{settings}->{LOGFILE} = "$self->{settings}->{MAILDIR}/.mail-delivery.log";
104			$self->{settings}->{ERRLOG} = ".mail-delivery_errors.log";
105	joko	1.2	$self->{settings}->{DEFAULT} = "$self->{settings}->{MAILDIR}/Inbox";
106	root	1.1	}
107
108			sub _override_settings {
109			my $self = shift;
110	joko	1.2	# override $self->{settings}->{RULESFILE} if given as option on the command line
111	root	1.1	$self->{settings}->{RULESFILE} =
112			$self->{options}->{rules} if $self->{options}->{rules};
113			# change logfile
114			$self->{settings}->{LOGFILE} =
115	root	1.4	$self->{settings}->{ERRLOG} if (! -e $self->{settings}->{MAILDIR});
116	root	1.1	}
117
118
119
120			# - - - - - - - - - - - - - - - - - - - -
121			# main
122			# - - - - - - - - - - - - - - - - - - - -
123
124	root	1.5	sub run {
125			my $self = shift;
126
127			$self->{options}->{mode} \|\|= 'recieve';
128			my $call = '_' . $self->{options}->{mode};
129
130			# "jump" into processing of new incoming mail and get a "handler" to this mail
131			$self->{incoming} = Mail::Audit->new();
132
133			my $result = $self->$call(@_);
134			return $result;
135	root	1.4
136	root	1.5	}
137	root	1.4
138	root	1.5	sub _recieve {
139	root	1.4
140	joko	1.2	my $self = shift;
141
142	root	1.1	# 0.a. pre flight tracing
143			my $now = now();
144	root	1.4	$self->report("$now - $0 running for user '$self->{settings}->{USER}'.");
145			$self->traceEntry() if $self->{options}->{TRACE};
146	root	1.1
147			# 0.b. pre flight checks
148
149	joko	1.3	# TODO: check if $self->{settings}->{HOME} is empty
150	root	1.1
151	joko	1.3	# check if $self->{settings}->{HOME} exists
152	joko	1.2	if (! -e $self->{settings}->{MAILDIR}) {
153	root	1.5	my $msg = "ERROR: Delivery failed, base directory '$self->{settings}->{MAILDIR}' does not exist.";
154	root	1.6	$self->jerror($msg);
155	root	1.1	}
156
157			# 1. include rules or fallback
158	joko	1.2	# check if $self->{settings}->{RULESFILE} exists
159			if (-f $self->{settings}->{RULESFILE}) {
160	root	1.5	$self->report("RULES: Loading from \"$self->{settings}->{RULESFILE}\".");
161	root	1.6	my $evalstr = "require '$self->{settings}->{RULESFILE}';";
162			eval($evalstr);
163			if ($@) {
164			my $msg = "ERROR: Delivery failed, '$self->{settings}->{RULESFILE}' had syntax errors:\n$@";
165			$self->jerror($msg);
166			}
167	root	1.1	} else {
168	joko	1.2	#die("$self->{settings}->{RULESFILE} doesn't exist");
169	root	1.6	$self->jerror("Configured rulesfile \"$self->{settings}->{RULESFILE}\" doesn't exist.");
170	root	1.1	}
171
172			# 2. export required stuff to rules namespace
173	root	1.5	my @symbols = qw( jaccept report compareTarget accept copy ignore );
174	root	1.4	export_symbols(\@symbols, 'rules');
175	root	1.1
176			# 3. run dispatcher
177	root	1.5	$self->report("RULES: Running Perl sub \"rules::dispatch\".");
178	root	1.4	rules::dispatch($self);
179	root	1.1
180			# 4. dispatcher didn't do anything
181	root	1.4	$self->report("dispatcher could not apply any filter, using default delivery");
182	root	1.1
183			# the default-handler: simply accept all mails and route them to "/var/spool/mail"
184	joko	1.2	# $self->{incoming}->accept();
185	root	1.1
186			# if you want to reject all mails coming through to here, do a ...
187	joko	1.2	# $self->{incoming}->reject;
188	root	1.1
189			# catch all mails and route them to a "DEFAULT"-inbox
190	root	1.4	$self->jaccept($self->{settings}->{DEFAULT});
191	root	1.1
192	root	1.4	}
193	root	1.1
194	root	1.6	sub jerror {
195			my $self = shift;
196			my $msg = shift;
197			$self->report("ERROR: $msg");
198			$self->forward_delivery();
199			}
200	root	1.5
201			sub _mail2news {
202	root	1.4	my $self = shift;
203	root	1.5	$self->report("MAIL2NEWS: $self->{options}->{newsgroup}");
204			my $plugin = 'Newsgate';
205			$self->load($plugin);
206			$self->$plugin($self->{options}->{newsgroup});
207	root	1.4	}
208	root	1.1
209
210	root	1.5
211	root	1.1	# - - - - - - - - - - - - - - - - - - - -
212			# tracing & reporting
213			# - - - - - - - - - - - - - - - - - - - -
214	root	1.5	sub traceEntry {
215			my $self = shift;
216			$self->appendLog('-' x 40 . ' TRACE ' . '-' x 10);
217	root	1.7	$self->appendLog("From: " . get_chomped($self->{incoming}->from));
218			$self->appendLog("To: " . get_chomped($self->{incoming}->to));
219			$self->appendLog("Subject: " . get_chomped($self->{incoming}->subject));
220			$self->appendLog("Message-ID: " . get_chomped($self->{incoming}->get('Message-ID')));
221	root	1.5	$self->appendLog('-' x 40 . ' TRACE ' . '-' x 10);
222			}
223
224	root	1.4	sub appendLog {
225			my $self = shift;
226			my $msg = shift;
227			a2f($self->{settings}->{LOGFILE}, $msg);
228	root	1.1	}
229
230			sub report {
231	root	1.4	my $self = shift;
232	root	1.1	my $msg = shift;
233			# TODO: tracing, debugging
234
235	root	1.4	#print STDERR $msg, "\n" if $self->{options}->{VERBOSE};
236			if ($self->{options}->{LOG}) {
237			$self->appendLog($msg);
238	root	1.1	}
239
240			}
241
242			# - - - - - - - - - - - - - - - - - - - -
243			# processing mail
244			# - - - - - - - - - - - - - - - - - - - -
245
246			sub compareTarget {
247	root	1.4	my $self = shift;
248	root	1.1	my $pattern = shift;
249			my $ok = 0;
250	joko	1.2	$ok = 1 if ($self->{incoming}->to =~ m/$pattern/);
251			$ok = 1 if ($self->{incoming}->cc =~ m/$pattern/);
252			$ok = 1 if ($self->{incoming}->bcc =~ m/$pattern/);
253	root	1.1	return $ok;
254			}
255
256	root	1.5	sub accept_spool {
257			my $self = shift;
258			my $path = "/var/spool/mail/$self->{settings}->{USER}";
259			$self->report("defaulting to spool delivery ($path)");
260			$self->{incoming}->accept($path);
261			}
262
263			sub forward_delivery {
264			my $self = shift;
265			$self->report("Forwarding delivery to next handler in queue (probably /var/spool/mail).");
266			return $self->{incoming}->accept;
267			}
268
269
270	root	1.1	sub jaccept {
271	root	1.4	my $self = shift;
272	root	1.1	my $deliver_to = shift;
273
274	root	1.4	$self->report("ACCEPT: $deliver_to");
275	root	1.1
276			# check deliver_to path
277			if (! -e $deliver_to) {
278	root	1.5	my $good = 0;
279			$self->report("ERROR: TARGET Path/File doesn't exist.");
280			if ($self->{settings}->{AUTOCREATE_FOLDERS}) {
281			my $cmd = "touch $deliver_to";
282			$self->report("TARGET: AUTOCREATE_FOLDERS is enabled: touching TARGET.");
283			#if (mkdir $deliver_to) {
284			run_cmd($cmd);
285			# re-test TARGET - for existance now
286			if (-e $deliver_to) {
287			$good = 1;
288			} else {
289			$self->report("ERROR: TARGET creation failed (command was: '$cmd').");
290			}
291			}
292			if (!$good) {
293			$self->forward_delivery();
294			return;
295			}
296	root	1.1	}
297
298	root	1.5	return $self->{incoming}->accept($deliver_to);
299	root	1.1	}
300
301	root	1.5
302			sub accept {
303	root	1.4	my $self = shift;
304	root	1.5	return $self->jaccept(@_);
305	root	1.1	}
306
307	root	1.5	sub copy {
308	root	1.4	my $self = shift;
309	root	1.5	my $plugin = shift;
310			my $deliver_to = shift;
311
312			$self->report("COPY: $plugin: $deliver_to");
313
314			$self->load($plugin);
315			return $self->$plugin($deliver_to);
316	root	1.1	}
317
318	root	1.5	sub ignore {
319			my $self = shift;
320			$self->report("IGNORE");
321			return $self->{incoming}->ignore;
322			}
323	joko	1.2
324			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26