bin/debbugs-spamscan-log

   1 #! /usr/bin/perl
   2 # debbugs-spamscan-log 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-spamscan-log -- Scan log files for spam and populate nnn.log.spam
  17
  18 =head1 SYNOPSIS
  19
  20 debbugs-spamscan-log [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 EXAMPLES
  52
  53 Rebuild the index.db for db-h.
  54
  55  debbugs-spamscan-log;
  56
  57 Rebuild the index.db for archive
  58
  59  debbugs-spamscan-log archive;
  60
  61
  62 =cut
  63
  64
  65 use vars qw($DEBUG);
  66
  67 use Debbugs::Log qw(record_regex);
  68 use Debbugs::Log::Spam;
  69 use Debbugs::Config qw(:config);
  70 use IPC::Open3 qw(open3);
  71
  72 my %options =
  73     (debug   => 0,
  74      help    => 0,
  75      man     => 0,
  76      verbose => 0,
  77      quiet   => 0,
  78      quick   => 0,
  79      spamc   => 'spamc',
  80      spamc_opts => [],
  81     );
  82
  83
  84 GetOptions(\%options,
  85            'quick|q',
  86            'service|s',
  87            'sysconfdir|c',
  88            'spool_dir|spool-dir=s',
  89            'spamc=s',
  90            'spamc_opts|spamc-opts=s@',
  91            'debug|d+','help|h|?','man|m');
  92
  93 pod2usage() if $options{help};
  94 pod2usage({verbose=>2}) if $options{man};
  95
  96 $DEBUG = $options{debug};
  97
  98 my @USAGE_ERRORS;
  99 $options{verbose} = $options{verbose} - $options{quiet};
 100
 101 if (not @ARGV) {
 102     push @USAGE_ERRORS,
 103         "You must provide a bug number to examine\n";
 104 }
 105
 106 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
 107
 108 if (exists $options{spool_dir} and defined $options{spool_dir}) {
 109     $config{spool_dir} = $options{spool_dir};
 110 }
 111 chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
 112
 113 for my $bug_num (@ARGV) {
 114     my $log = Debbugs::Log->new(bug_num => $bug_num) or
 115         die "Unable to open bug log for $bug_num";
 116     my $spam = Debbugs::Log::Spam->new(bug_num => $bug_num) or
 117         die "Unable to open bug log spam for $bug_num";
 118
 119     my %seen_msgids;
 120     while (my $record = $log->read_record()) {
 121         next if $record->{type} eq 'html';
 122         next if $record->{type} eq 'autocheck';
 123         my ($msg_id) = record_regex($record,
 124                                     qr/^Message-Id:\s+<(.+)>/mi);
 125         next unless defined $msg_id;
 126         if ($msg_id =~ /$config{email_domain}$/) {
 127             print STDERR "skipping $msg_id\n" if $DEBUG;
 128             next;
 129         }
 130         print STDERR "examining $msg_id: " if $DEBUG;
 131         if ($seen_msgids{$msg_id}) {
 132             print STDERR "already seen\n" if $DEBUG;
 133             next;
 134         }
 135         $seen_msgids{$msg_id}=1;
 136         if ($spam->is_spam($msg_id)) {
 137             print STDERR "already spam\n" if $DEBUG;
 138             next;
 139         }
 140         my $is_spam;
 141         eval {
 142             my ($spamc,$child_out);
 143             my $old_sig = $SIG{"PIPE"};
 144             $SIG{"PIPE"} = sub {
 145                 die "SIGPIPE in child for some reason";
 146             };
 147             my $childpid =
 148                 open3($spamc,$child_out,0,
 149                       $options{spamc},'-E',@{$options{spamc_opts}}) or
 150                           die "Unable to fork spamc: $!";
 151             if (not $childpid) {
 152                 die "Unable to fork spamc";
 153             }
 154             print {$spamc} $record->{text};
 155             close($spamc) or die "Unable to close spamc: $!";
 156             waitpid($childpid,0);
 157             if ($DEBUG) {
 158                 print STDERR "[$?;".($? >> 8)."] ";
 159                 print STDERR map {s/\n//; $_ } <$child_out>;
 160                 print STDERR " ";
 161             }
 162             close($child_out);
 163             $SIG{"PIPE"} = $old_sig;
 164             if ($? >> 8) {
 165                 $is_spam = 1;
 166             }
 167         };
 168         if ($@) {
 169             print STDERR "processing of $msg_id failed [$@]\n";
 170         } else {
 171             if ($is_spam) {
 172                 print STDERR "it's spam\n" if $DEBUG;
 173                 $spam->add_spam($msg_id);
 174             }
 175             else {
 176                 print STDERR "it's ham\n" if $DEBUG;
 177             }
 178         }
 179     }
 180     $spam->save();
 181 }
 182
 183
 184 __END__
 185
 186 # Local Variables:
 187 # cperl-indent-level: 4
 188 # indent-tabs-mode: nil
 189 # End: