bin/debbugs-spam

   1 #! /usr/bin/perl
   2 # debbugs-spam is part of debbugs, and is released
   3 # under the terms of the GPL version 2, or any later version, at your
   4 # option. See the file README and COPYING for more information.
   5 # Copyright 2012 by Don Armstrong <don@donarmstrong.com>.
   6
   7
   8 use warnings;
   9 use strict;
  10
  11 use Getopt::Long qw(:config no_ignore_case);
  12 use Pod::Usage;
  13
  14 =head1 NAME
  15
  16 debbugs-spam -- Scan log files for spam and populate nnn.log.spam
  17
  18 =head1 SYNOPSIS
  19
  20 debbugs-spam [options] bugnumber [[bugnumber2]..]
  21
  22  Options:
  23   --spool-dir debbugs spool directory
  24   --debug, -d debugging level (Default 0)
  25   --help, -h display this help
  26   --man, -m display manual
  27
  28 =head1 OPTIONS
  29
  30 =over
  31
  32 =item B<--spool-dir>
  33
  34 Debbugs spool directory; defaults to the value configured in the
  35 debbugs configuration file.
  36
  37 =item B<--debug, -d>
  38
  39 Debug verbosity.
  40
  41 =item B<--help, -h>
  42
  43 Display brief useage information.
  44
  45 =item B<--man, -m>
  46
  47 Display this manual.
  48
  49 =back
  50
  51 =head1 SUBCOMMANDS
  52
  53 =over
  54
  55 =item B<auto-scan>
  56
  57 Automatically scan messages using spamassassin and mark messages as
  58 spam which hit the threshold, and those that are highly negative as
  59 ham.
  60
  61 =item B<score>
  62
  63 Output the score of all of the messages in a bug
  64
  65 =item B<mark-spam>
  66
  67 Mark messages as spam if there is a regex match to subject or message
  68 id
  69
  70 =item B<mark-ham>
  71
  72 Mark messages as ham if there is a regex match to subject or message
  73 id
  74
  75 =back
  76
  77
  78 =head1 EXAMPLES
  79
  80
  81 =cut
  82
  83
  84 use vars qw($DEBUG);
  85
  86 use Debbugs::Log qw(record_regex);
  87 use Debbugs::Log::Spam;
  88 use Debbugs::Config qw(:config);
  89 use Debbugs::Command qw(:all);
  90 use IPC::Open3 qw(open3);
  91 use Carp;
  92
  93 my %options =
  94     (debug   => 0,
  95      help    => 0,
  96      man     => 0,
  97      verbose => 0,
  98      quiet   => 0,
  99      quick   => 0,
 100      spamc   => 'spamc',
 101      spamc_opts => [],
 102     );
 103
 104 handle_main_arguments(\%options,
 105                       'quick|q',
 106                       'service|s',
 107                       'sysconfdir|c',
 108                       'spamc=s' => 0,
 109                       'spamc_opts|spamc-opts=s@' => 0,
 110                       'spool_dir|spool-dir=s',
 111                       'debug|d+','help|h|?','man|m');
 112
 113 my %subcommands =
 114     ('auto-scan' => {function => \&auto_spamscan,
 115                      arguments => {'ham_threshold=s' => -5,
 116                                   },
 117                     },
 118      'score' => {function => \&score_bug,
 119                 },
 120      'mark-spam' => {function => \&mark_spam,
 121                     },
 122      'mark-ham' => {function => \&mark_ham,
 123                    },
 124      'help' => {function => sub {pod2usage({verbose => 2});}}
 125     );
 126
 127 pod2usage() if $options{help};
 128 pod2usage({verbose=>2}) if $options{man};
 129
 130 $DEBUG = $options{debug};
 131
 132 my @USAGE_ERRORS;
 133 $options{verbose} = $options{verbose} - $options{quiet};
 134
 135 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 136
 137 my ($subcommand) = shift @ARGV;
 138 if (not defined $subcommand) {
 139     $subcommand = 'help';
 140     print STDERR "You must provide a subcommand; displaying usage.\n";
 141     pod2usage();
 142 } elsif (not exists $subcommands{$subcommand}) {
 143     print STDERR "$subcommand is not a valid subcommand; displaying usage.\n";
 144     pod2usage();
 145 }
 146
 147 if (exists $options{spool_dir} and defined $options{spool_dir}) {
 148     $config{spool_dir} = $options{spool_dir};
 149 }
 150 if ($subcommand ne 'help') {
 151     chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
 152 }
 153 my $opts =
 154     handle_subcommand_arguments(\@ARGV,$subcommands{$subcommand}{arguments});
 155 $subcommands{$subcommand}{function}->(\%options,$opts,\%config,\@ARGV);
 156
 157
 158 sub mark_ham {
 159     mark_it('ham',@_);
 160 }
 161
 162 sub mark_spam {
 163     mark_it('spam',@_);
 164 }
 165
 166 sub mark_it {
 167     my ($spam_ham,$options,$opts,$config,$argv) = @_;
 168     my $regex = shift @{$argv};
 169     for my $bug_num (@{$argv}) {
 170         my $spam = Debbugs::Log::Spam->new(bug_num => $bug_num) or
 171             die "Unable to open bug log spam for $bug_num";
 172         foreachmsg(sub {
 173                        my ($bn,$rec,$mid) = @_;
 174                        my $body = $rec->{text};
 175                        my ($subject) = $body =~ /^Subject: *(.+)$/mi;
 176                        my $is_match = 0;
 177                        if ($subject =~ /\Q$regex\E/) {
 178                            $is_match = 1;
 179                        }
 180                        if ($mid =~ /\Q$regex\E/) {
 181                            $is_match = 1;
 182                        }
 183                        if ($spam_ham eq 'spam') {
 184                            $spam->add_spam($mid);
 185                        } else {
 186                            $spam->add_ham($mid);
 187                        }
 188                    },
 189                    $bug_num
 190                   );
 191     }
 192 }
 193
 194
 195 sub score_bug {
 196     my ($options,$opts,$config,$argv) = @_;
 197     for my $bug_num (@{$argv}) {
 198         my @bug_score =
 199             spam_score_bug($bug_num,
 200                            $opts->{spamc},
 201                            $opts->{spamc_opts});
 202         print "$_->{score} $_->{message_id} $_->{subject}\n"
 203             foreach @bug_score;
 204     }
 205 }
 206
 207 sub auto_spamscan {
 208     my ($options,$opts,$config,$argv) = @_;
 209
 210     for my $bug_num (@{$argv}) {
 211         my $spam = Debbugs::Log::Spam->new(bug_num => $bug_num) or
 212             die "Unable to open bug log spam for $bug_num";
 213         foreachmsg(sub {
 214                        my ($bn,$rec,$mid) = @_;
 215                        if ($spam->is_spam($mid)) {
 216                            print STDERR "already spam\n" if $DEBUG;
 217                            return;
 218                        }
 219                        if ($spam->is_ham($mid)) {
 220                            print STDERR "already ham\n" if $DEBUG;
 221                            return;
 222                        }
 223                        my ($score,$is_spam,$report,$threshold) =
 224                            spam_score($rec,
 225                                       $options->{spamc},
 226                                       $options->{spamc_opts},
 227                                      );
 228                        if ($is_spam) {
 229                            print STDERR "it's spam ($score)\n" if $DEBUG;
 230                            $spam->add_spam($mid);
 231                        } elsif ($score < $options->{ham_threshold}) {
 232                            print STDERR "it's really ham ($score)\n" if $DEBUG;
 233                            $spam->add_ham($mid);
 234                        }
 235                        else {
 236                            print STDERR "it's ham ($score)\n" if $DEBUG;
 237                        }
 238                    },
 239                    $bug_num,
 240                   );
 241         $spam->save();
 242     }
 243 }
 244
 245 sub spam_score_bug {
 246     my ($bug,$spamc,$spamc_opts) = @_;
 247
 248     my @records;
 249     foreachmsg(sub {
 250                    my ($bn,$rec,$mid) = @_;
 251                    my $score =
 252                        spam_score($rec,$spamc,$spamc_opts);
 253                    push @records,
 254                       {message_id => $mid,
 255                        score => $score,
 256                        subject => ($rec->{text} =~ /^Subject: *(.+)/i)[0],
 257                       };
 258                },
 259                $bug
 260               );
 261     return @records;
 262 }
 263
 264 sub spam_score {
 265     my ($record,$spamc,$spamc_opts) = @_;
 266     my ($score,$threshold,$report);
 267     my $is_spam = 0;
 268     eval {
 269         my ($spamc_in,$spamc_out);
 270         my $old_sig = $SIG{"PIPE"};
 271         $SIG{"PIPE"} = sub {
 272             die "SIGPIPE in child for some reason";
 273         };
 274         my $childpid =
 275             open3($spamc_in,$spamc_out,0,
 276                   $spamc,'-E',@{$spamc_opts}) or
 277                       die "Unable to fork spamc: $!";
 278         if (not $childpid) {
 279             die "Unable to fork spamc";
 280         }
 281         print {$spamc} $record->{text};
 282         close($spamc) or die "Unable to close spamc: $!";
 283         waitpid($childpid,0);
 284         if ($DEBUG) {
 285             print STDERR "[$?;".($? >> 8)."] ";
 286             print STDERR map {s/\n//; $_ } <$spamc_out>;
 287             print STDERR " ";
 288         }
 289         close($spamc_out);
 290         $SIG{"PIPE"} = $old_sig;
 291         if ($? >> 8) {
 292             $is_spam = 1;
 293         }
 294         my ($first_line,@report) = <$spamc_out>;
 295         if (defined $first_line) {
 296             chomp $first_line;
 297             ($score,$threshold) = $first_line =~ m{^(-?[\d\.]+)/(-?[\d\.]+)$};
 298             $report = join('',@report);
 299         }
 300     };
 301     if ($@) {
 302         carp "processing of message failed [$@]\n";
 303         return undef;
 304     }
 305     return wantarray?($score,$is_spam,$report):$score;
 306 }
 307
 308 sub foreachmsg {
 309     my ($sub,$bug_num) = @_;
 310     my $log = Debbugs::Log->new(bug_num => $bug_num) or
 311         die "Unable to open bug log for $bug_num";
 312     my %seen_msgids;
 313     while (my $record = $log->read_record()) {
 314         next if $record->{type} eq 'html';
 315         next if $record->{type} eq 'autocheck';
 316         my ($msg_id) = record_regex($record,
 317                                     qr/^Message-Id:\s+<(.+)>/mi);
 318         next unless defined $msg_id;
 319         if ($msg_id =~ /$config{email_domain}$/) {
 320             print STDERR "skipping $msg_id\n" if $DEBUG;
 321             next;
 322         }
 323         print STDERR "examining $msg_id: " if $DEBUG;
 324         if ($seen_msgids{$msg_id}) {
 325             print STDERR "already seen\n" if $DEBUG;
 326             next;
 327         }
 328         $seen_msgids{$msg_id}=1;
 329         $sub->($bug_num,$record,$msg_id);
 330     }
 331 }
 332
 333
 334 __END__
 335
 336 # Local Variables:
 337 # cperl-indent-level: 4
 338 # indent-tabs-mode: nil
 339 # End: