From 50372083ae0dac8ae45be227d335dae55749e847 Mon Sep 17 00:00:00 2001 From: Don Armstrong Date: Sat, 1 Jul 2017 10:45:22 -0700 Subject: [PATCH] Add new Debbugs::Log::Spam module and use it to skip log spam --- Debbugs/CGI/Bugreport.pm | 2 + Debbugs/Log/Spam.pm | 193 +++++++++++++++++++++++++++++++++++++++ cgi/bugreport.cgi | 8 ++ 3 files changed, 203 insertions(+) create mode 100644 Debbugs/Log/Spam.pm diff --git a/Debbugs/CGI/Bugreport.pm b/Debbugs/CGI/Bugreport.pm index 7dc2e5f..de7be81 100644 --- a/Debbugs/CGI/Bugreport.pm +++ b/Debbugs/CGI/Bugreport.pm @@ -436,6 +436,7 @@ sub handle_record{ elsif (defined $msg_id) { $$seen_msg_ids{$msg_id} = 1; } + return () if defined $param{spam} and $param{spam}->is_spam($msg_id); $output .= qq(

\n); $output .= 'View this message in rfc822 format

'; $output .= handle_email_message($record, @@ -455,6 +456,7 @@ sub handle_record{ elsif (defined $msg_id) { $$seen_msg_ids{$msg_id} = 1; } + return () if defined $param{spam} and $param{spam}->is_spam($msg_id); # Incomming Mail Message my ($received,$hostname) = record_regex($record,qr/Received: \(at (\S+)\) by (\S+)\;/o); $output .= qq|

Message #$msg_number received at |. diff --git a/Debbugs/Log/Spam.pm b/Debbugs/Log/Spam.pm new file mode 100644 index 0000000..9a9f216 --- /dev/null +++ b/Debbugs/Log/Spam.pm @@ -0,0 +1,193 @@ +# This module is part of debbugs, and is released under the terms of the GPL +# version 2, or any later version (at your option). See the file README and +# COPYING for more information. +# +# Copyright 2017 by Don Armstrong . + +package Debbugs::Log::Spam; + +=head1 NAME + +Debbugs::Log::Spam -- an interface to debbugs .log.spam files + +=head1 SYNOPSIS + +use Debbugs::Log::Spam; + +my $spam = Debbugs::Log::Spam->new(bug_num => '12345'); + +=head1 DESCRIPTION + + +=head1 BUGS + +None known. + +=cut + +use warnings; +use strict; +use vars qw($VERSION $DEBUG %EXPORT_TAGS @EXPORT_OK @EXPORT); +use base qw(Exporter); + +BEGIN{ + $VERSION = 1; + $DEBUG = 0 unless defined $DEBUG; + + @EXPORT = (); + %EXPORT_TAGS = (); + @EXPORT_OK = (); + Exporter::export_ok_tags(keys %EXPORT_TAGS); + $EXPORT_TAGS{all} = [@EXPORT_OK]; + +} + +use Carp; +use feature 'state'; +use Params::Validate qw(:types validate_with); +use Debbugs::Common qw(getbuglocation getbugcomponent); + +=head1 FUNCTIONS + +=over 4 + +=item new + +Creates a new log spam reader. + + my $spam_log = Debbugs::Log::Spam->new(log_spam_name => "56/123456.log.spam"); + my $spam_log = Debbugs::Log::Spam->new(bug_num => $nnn); + +Parameters + +=over + +=item bug_num -- bug number + +=item log_spam_name -- name of log + +=back + +One of the above options must be passed. + +=cut + +sub new { + my $this = shift; + state $spec = + {bug_num => {type => SCALAR, + optional => 1, + }, + log_spam_name => {type => SCALAR, + optional => 1, + }, + }; + my %param = + validate_with(params => \@_, + spec => $spec + ); + if (grep({exists $param{$_} and + defined $param{$_}} qw(bug_num log_spam_name)) ne 1) { + croak "Exactly one of bug_num or log_spam_name". + "must be passed and must be defined"; + } + + my $class = ref($this) || $this; + my $self = {}; + bless $self, $class; + + if (exists $param{log_spam_name}) { + $self->{name} = $param{log_spam_name}; + } elsif (exists $param{bug_num}) { + my $location = getbuglocation($param{bug_num},'log.spam'); + my $bug_log = getbugcomponent($param{bug_num},'log.spam',$location); + $self->{name} = $bug_log; + } + $self->_init(); + return $self; +} + + +sub _init { + my $self = shift; + + $self->{spam} = {}; + if (-e $self->{name}) { + open(my $fh,'<',$self->{name}) or + croak "Unable to open bug log spam '$self->{name}' for reading: $!"; + binmode($fh,':encoding(UTF-8)'); + while (<$fh>) { + chomp; + $self->{spam}{$_} = 1; + } + close ($fh); + } + return $self; +} + +=item save + +$self->save(); + +Saves changes to the bug log spam file. + +=cut + +sub save { + my $self = shift; + filelock($self->{name}); + open(my $fh,'>',$self->{name}.'.tmp') or + croak "Unable to open bug log spam '$self->{name}.tmp' for writing: $!"; + binmode($fh,':encoding(UTF-8)'); + for my $msgid (keys %{$self->{spam}}) { + print {$fh} $msgid."\n"; + } + close($fh) or croak "Unable to write to '$self->{name}.tmp': $!"; + rename($self->{name}.'.tmp',$self->{name}); + unfilelock(); +} + +=item is_spam + + next if ($spam_log->is_spam('12456@exmaple.com')); + +Returns 1 if this message id confirms that the message is spam + +Returns 0 if this message is not spam + +=cut +sub is_spam { + my ($self,$msgid) = @_; + $msgid =~ s/^<|>$//; + if (exists $self->{spam}{$msgid} and + $self->{spam}{$msgid} + ) { + return 1; + } + return 0; +} + +=item add_spam + + $spam_log->add_spam('123456@example.com'); + +Add a message id to the spam listing. + +You must call C<$self->save()> if you wish the changes to be written out to disk. + +=cut + +sub add_spam { + my ($self,$msgid) = @_; + $msgid =~ s/^<|>$//; + $self->{spam}{$msgid} = 1; +} + +1; + +__END__ + +# Local Variables: +# indent-tabs-mode: nil +# cperl-indent-level: 4 +# End: diff --git a/cgi/bugreport.cgi b/cgi/bugreport.cgi index 2069e80..3ff1cb5 100755 --- a/cgi/bugreport.cgi +++ b/cgi/bugreport.cgi @@ -19,6 +19,7 @@ use Debbugs::Config qw(:globals :text :config); # for read_log_records use Debbugs::Log qw(:read); +use Debbugs::Log::Spam; use Debbugs::CGI qw(:url :html :util :cache); use Debbugs::CGI::Bugreport qw(:all); use Debbugs::Common qw(buglog getmaintainers make_list bug_status); @@ -193,8 +194,10 @@ if ($need_status) { } my @records; +my $spam; eval{ @records = read_log_records(bug_num => $ref,inner_file => 1); + $spam = Debbugs::Log::Spam->new(bug_num => $ref); }; if ($@) { quitcgi("Bad bug log for $gBug $ref. Unable to read records: $@"); @@ -269,6 +272,8 @@ END $record_wanted_anyway = 1 if record_regex($record,qr/^Received: \(at control\)/); next if not $boring and not $record->{type} eq $wanted_type and not $record_wanted_anyway and @records > 1; $seen_message_ids{$msg_id} = 1 if defined $msg_id; + # skip spam messages if we're outputting more than one message + next if @records > 1 and $spam->is_spam($msg_id); my @lines; if ($record->{inner_file}) { push @lines, $record->{fh}->getline; @@ -324,6 +329,9 @@ else { trim_headers => $trim_headers, avatars => $avatars, terse => $terse, + # if we're only looking at one record, allow + # spam to be output + spam => (@records > 1)?$spam:undef, ); } } -- 2.39.2