Index: TODO =================================================================== RCS file: /home/localadams/.CVSROOT/software/parp/TODO,v retrieving revision 1.27 diff -u -r1.27 TODO --- TODO 24 Feb 2002 15:11:41 -0000 1.27 +++ TODO 24 Feb 2002 16:35:54 -0000 @@ -22,10 +22,6 @@ Marks the mail for delivery to @dest_folders. -**** $m->_terminate_filter(@dest_folders) - -Throws a Parp::TerminateFilter exception. - *** new higher-level filtering methods **** $m->accept($dest_folder, $reason, @details) @@ -42,44 +38,20 @@ $m->_terminate_filtering(); } -**** $m->reject_junk_mail($reason) +**** $m->reject_mail($reason) -sub reject_junk_mail { +sub reject_mail { my $self = shift; $m->accept(@_); $m->_terminate_filtering(); } -**** $m->categorize(@new_categories) and others - -Adds mail to given categories, which must be pre-registered: - -{ - my %categories = (); +**** $m->reject_junk_mail($reason) - sub register_category { - my $self = shift; - my ($category, $method) = @_; - $categories{$category}++; - if ($method) { - *{ref($self) . "::$method"} = sub { - my $mail = shift; - return $mail->{categories}{$category}; - } - } - } - - register_category('spam', 'is_spam'); - - sub categorize { - my $self = shift; - my (@new_categories) = @_; - } - - sub decategorize { - my $self = shift; - my (@existing_categories) = @_; - } +sub reject_junk_mail { + my $self = shift; + $m->accept(@_); + $m->_terminate_filtering(); } *** delivery happens *after* filtering has finished Index: parp =================================================================== RCS file: /home/localadams/.CVSROOT/software/parp/parp,v retrieving revision 1.136 diff -u -r1.136 parp --- parp 24 Feb 2002 15:11:59 -0000 1.136 +++ parp 24 Feb 2002 16:10:08 -0000 @@ -177,9 +177,7 @@ vprint "Reading $file ... "; require Mail::Box::Manager; my $mgr = Mail::Box::Manager->new; - my $folder = $mgr->open(folder => $file, - lazy_extract => 'NEVER' - ); + my $folder = $mgr->open(folder => $file, lazy_extract => 'NEVER'); vprint "done.\n"; my ($file_total, $friends) = (0, 0); @@ -194,14 +192,8 @@ next; } - my $rv = filter->process_mail($mail); - $counts->{parsed}++ if $rv; - $counts->{dups}++ if $rv =~ /IS_DUPLICATE/; - $counts->{spam}++ if $rv =~ /IS_SPAM/; - $counts->{main}++ if $rv =~ /TO_MAIN/; - $counts->{aux}++ if $rv =~ /TO_AUX/; - $counts->{special}++ if $rv =~ /IS_SPECIAL/; - $counts->{friends}++ if $rv eq 'EXTRACTED_FRIEND'; + filter->process_mail($mail); + $counts->{$_}++ foreach $mail->categories; $counts->{file_total}++; last if opt('sample') && $counts->{total} >= opt('sample'); Index: Parp/Filter.pm =================================================================== RCS file: /home/localadams/.CVSROOT/software/parp/Parp/Filter.pm,v retrieving revision 1.16 diff -u -r1.16 Filter.pm --- Parp/Filter.pm 24 Feb 2002 15:11:41 -0000 1.16 +++ Parp/Filter.pm 24 Feb 2002 17:14:06 -0000 @@ -56,17 +56,16 @@ =head2 categorize($mail) -This subroutine is the heart of the filtering strategy. It places -the mail currently being filtered into one of the following -categories: - - IS_SPAM -- spam - TO_MAIN -- good mail destined for main inbox - TO_AUX -- good mail destined for auxiliary inboxes - SPECIAL -- leave subroutines to do their own thing - -by returning a scalar containing the name of the category. -Gets passed a Parp::Mail object as the only parameter. +This subroutine is the heart of the filtering strategy. It filters +the Parp::Mail object into one or more categories (see +L) and marks it for delivery to one or more +folders (or the bit-bucket), logging the reasoning behind the +filtering logic as it goes, and whether the mail has been considered +accepted or rejected. + +Note that acceptance/rejection is actually orthogonal to where the +mail may get delivered. Also note that delivery does not actually +happen in this method. =cut @@ -90,9 +89,9 @@ # Any good signs which indicate that the mail should definitely # NOT be treated as junk? - my $grace = $m->is_passworded || - $m->is_from_good_person || - $m->is_from_good_domain || + my $grace = $m->is_passworded || + $m->is_from_friend || + $m->is_from_good_domain || $m->has_good_headers; return 'IS_SPAM' @@ -213,7 +212,12 @@ return $is_dup_or_loop if $is_dup_or_loop; } - $m->{filter_category} = $self->categorize($m); + try { + $self->categorize($m); + } + catch Parp::Terminated with { + # ?? + }; if (opt('wrong_class')) { $self->reclassify($m); @@ -341,16 +345,19 @@ my $self = shift; my ($m) = @_; - if ($m->{filter_category} eq 'TO_MAIN') { + $m->do_deliveries; + + if ($m->to_main) { $m->deliver_to_main; } - elsif ($m->{filter_category} eq 'IS_SPAM') { + elsif ($m->is_spam) { if ($m->{complain}) { # TODO: write and send a rude letter to relevant abuse@foo.com address. diagnose "Would complain\n"; } + $m->deliver_to_inbox('junk-mail'); } - elsif ($m->{filter_category} eq 'TO_AUX') { + elsif ($m->to_aux) { # list mail; already delivered to primary target # - maybe back up though $m->maybe_backup; Index: Parp/FilterTerminated.pm =================================================================== RCS file: Parp/FilterTerminated.pm diff -N Parp/FilterTerminated.pm --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ Parp/FilterTerminated.pm 24 Feb 2002 15:30:00 -0000 @@ -0,0 +1,18 @@ +package Parp::FilterTerminated; + +=head1 NAME + +Parp::FilterTerminated - exception to indicate end of filtering + +=head1 SYNOPSIS + +Internal use only. + +=cut + +use strict; +use warnings; + +use base qw(Error); + +1; Index: Parp/Mail.pm =================================================================== RCS file: /home/localadams/.CVSROOT/software/parp/Parp/Mail.pm,v retrieving revision 1.3 diff -u -r1.3 Mail.pm --- Parp/Mail.pm 24 Feb 2002 11:27:53 -0000 1.3 +++ Parp/Mail.pm 24 Feb 2002 16:15:56 -0000 @@ -28,7 +28,7 @@ use Parp::Options qw(opt); use Parp::Utils qw(vprint diagnose check_file_dir month2i error fatal); -use base qw(Parp::Mail::Deliverable Parp::Mail::Friends +use base qw(Parp::Mail::Deliverable Parp::Mail::Friends Parp::Mail::Categories Parp::Mail::Tests::Header Parp::Mail::Tests::Body); use overload '""' => \&to_string; Index: Parp/Mail/Categories.pm =================================================================== RCS file: Parp/Mail/Categories.pm diff -N Parp/Mail/Categories.pm --- /dev/null 1 Jan 1970 00:00:00 -0000 +++ Parp/Mail/Categories.pm 24 Feb 2002 16:57:35 -0000 @@ -0,0 +1,105 @@ +package Parp::Mail::Categories; + +=head1 NAME + +Parp::Mail::Categories - methods for placing mails into categories + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=cut + +use strict; +use warnings; + +=head1 METHODS + +=head2 register_category($category) + +Register a category as valid for use with the C method, +and create an accessor method, which when called on a Parp::Mail +object, will return true if the mail is in the category being +registered. The method takes the same name as the category, with +whitespace replaced by underscores. + +For example, the category C is always registered with +accessor C, so you can do things like + + $m->categorize('is spam'); + # $m->is_spam now returns true + +=cut + +my %categories = (); + +sub register_category { + my $self = shift; + my ($category) = @_; + $categories{$category}++; + + (my $method ||= $category) =~ s/\s+/_/g; + *$method = sub { + my $mail = shift; + return $mail->{categories}{$category}; + }; +} + +register_category('is spam'); +register_category('accepted'); +register_category('rejected'); +register_category('ditched'); +register_category('duplicate'); +register_category('to main'); +register_category('to aux'); +register_category('is special'); + +=head2 categorize(@new_categories) + +Add the mail to the given categories. + +=cut + +sub categorize { + my $self = shift; + my (@new) = @_; + my @bad = grep ! $categories{$_}, @new; + my @good = grep $categories{$_}, @new; + if (@bad) { + error("An attempt was made to categorize the mail into " . + "unregistered categories", + join(', ', @bad)) + } + $self->{categories}{$_}++ foreach @good; +} + +=head2 decategorize(@new_categories) + +Remove the mail from the given categories. + +=cut + +sub decategorize { + my $self = shift; + my (@existing_categories) = @_; + delete @{ $self->{categories} }{@existing_categories}; +} + +=head2 categories + +Returns a list of the categories the mail is in. + +=cut + +sub categories { + my $self = shift; + return keys %{ $self->{categories} }; +} + +=head1 BUGS + +=head1 SEE ALSO + +=cut + +1; Index: Parp/Mail/Deliverable.pm =================================================================== RCS file: /home/localadams/.CVSROOT/software/parp/Parp/Mail/Deliverable.pm,v retrieving revision 1.2 diff -u -r1.2 Deliverable.pm --- Parp/Mail/Deliverable.pm 23 Feb 2002 19:03:43 -0000 1.2 +++ Parp/Mail/Deliverable.pm 24 Feb 2002 17:01:05 -0000 @@ -18,6 +18,7 @@ =cut use Parp::Config qw(config); +use Parp::FilterTerminated; use Parp::Folders qw(append_to_folder folder_substs); use Parp::Options qw(opt delivery_mode); use Parp::Utils qw(diagnose); @@ -26,36 +27,18 @@ =cut -=head2 deliver_to_main +# We start with some low-level filtering primitives. These +# should only be used internally, i.e. not by the user. -Marks the mail for delivery to the folder specified by -the C method of C. - -=cut - -sub deliver_to_main { - my $m = shift; - $m->deliver_to(config->main_folder, @_); +sub _mark_for_delivery { + my $self = shift; + my ($folder) = @_; + $self->{dest_folders}{$folder}++; } -=head2 deliver_to_inbox($inbox) - -Marks the mail for delivery to the given inbox, contained in the inbox -directory specified by the C method of -C. - -=cut - -sub deliver_to_inbox { - my $m = shift; - my ($inbox) = @_; - $m->deliver_to(config->inbox($inbox), @_); -} - -sub maybe_backup { - my $m = shift; - - $m->deliver_to(config->backup_folder) if $m->{backup}; +sub _terminate_filter { + my $self = shift; + throw Parp::FilterTerminated; } =head2 deliver_to($mailbox) @@ -67,8 +50,6 @@ =cut sub deliver_to { - return if opt('wrong_class'); - my ($m, $folder) = @_; my $file = ($folder =~ m!^/!) ? $folder : config->mail_dir . "/$folder"; @@ -83,9 +64,11 @@ } } -sub accept_mail { - return if opt('wrong_class'); +=head2 accept +=cut + +sub accept { my $m = shift; my ($reason_ident, @details) = @_; @@ -98,24 +81,35 @@ diagnose "Accepted: $text\n"; } -sub ditch_mail { +=head2 deliver_to_inbox($inbox) + +Marks the mail for delivery to the given inbox, contained in the inbox +directory specified by the C method of +C. + +=cut + +sub deliver_to_inbox { my $m = shift; - diagnose "Delivered to /dev/null", - @_ ? " (@_)" : '', - "\n"; + my ($inbox) = @_; + $m->categorize('to aux'); + $m->deliver_to(config->inbox($inbox), @_); } -sub reject_junk_mail { - return if opt('wrong_class'); +=head2 ditch + +Ditches the mail in the bit-bucket and + +=cut + +sub ditch { my $m = shift; - $m->reject_mail(@_); -# $m->{backup} = 0; - $m->deliver_to_inbox('junk-mail'); + diagnose "Delivered to /dev/null", + @_ ? " (@_)" : '', + "\n"; } -sub reject_mail { - return if opt('wrong_class'); - +sub reject { my $m = shift; my ($reason_ident, @details) = @_; @@ -129,15 +123,22 @@ diagnose "REJECTED: $text"; } -=head2 pipe_forward($pipe_command) +sub reject_spam { + my $m = shift; + $m->reject_mail(@_); +# $m->{backup} = 0; + $m->deliver_to_inbox('junk-mail'); +} + +=head2 pipe($pipe_command) Pipes the mail to the given command. This is useful for passing the mail on to other filter programs. =cut -sub pipe_forward { - return if opt('wrong_class'); +sub pipe { + return if opt('wrong_class'); # FIXME my $m = shift; my ($pipe_command) = @_; @@ -156,6 +157,11 @@ diagnose "done.\n"; } } +} + +sub maybe_backup { + my $m = shift; + $m->deliver_to(config->backup_folder) if $m->{backup}; } sub as_mbox_string { Index: Parp/Mail/Tests/Header.pm =================================================================== RCS file: /home/localadams/.CVSROOT/software/parp/Parp/Mail/Tests/Header.pm,v retrieving revision 1.5 diff -u -r1.5 Header.pm --- Parp/Mail/Tests/Header.pm 24 Feb 2002 15:11:41 -0000 1.5 +++ Parp/Mail/Tests/Header.pm 24 Feb 2002 17:13:52 -0000 @@ -159,7 +159,7 @@ return 0; } -sub is_from_good_person { +sub is_from_friend { my $m = shift; foreach my $addr (map { $m->$_() } qw/from_addr env_from_addr/) { Index: sample-confs/adam/Filter.pm =================================================================== RCS file: /home/localadams/.CVSROOT/software/parp/sample-confs/adam/Filter.pm,v retrieving revision 1.13 diff -u -r1.13 Filter.pm --- sample-confs/adam/Filter.pm 24 Feb 2002 15:11:41 -0000 1.13 +++ sample-confs/adam/Filter.pm 24 Feb 2002 15:47:16 -0000 @@ -22,17 +22,8 @@ ## ## Once you have performed tests and determined what action you want ## to take for a given e-mail, there are some useful methods available -## for taking the action, including: -## -## $m->accept_mail($reason, @details); # tag mail as accepted -## $m->reject_mail($reason, @details); # tag mail as rejected -## $m->reject_junk_mail($reason, @details); # tag mail as rejected junk -## $m->deliver_to('foo'); # deliver to folder `foo' -## $m->deliver_to_inbox('bar'); # deliver to inbox `bar' -## $m->pipe_forward('command arg1 arg2'); # pipe mail | command arg1 arg2 -## -## Return values are also important; see the filter() and categorize() -## routines in Parp::Filter to understand how they affect filtering. +## for taking the action, for which see the Parp::Mail::Deliverable +## manual page. ## @@ -150,12 +141,12 @@ if ($m->matches('ftc', qr/\bfreshmeat-news\@.*freshmeat\.net\b/)) { $m->deliver_to_inbox('freshmeat'); -# $m->pipe_forward('fmscore >>' . config->inbox('freshmeat')); +# $m->pipe('fmscore >>' . config->inbox('freshmeat')); return 'IS_SPECIAL'; } if ($m->from =~ /(nobody|jobs|subscriber\.email)\@.*jobserve\.com/i) { - $m->pipe_forward("$ENV{HOME}/bin/jobserve"); + $m->pipe("$ENV{HOME}/bin/jobserve"); return 'IS_SPECIAL'; }