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>.
11 use Getopt::Long qw(:config no_ignore_case);
16 debbugs-spamscan-log -- Scan log files for spam and populate nnn.log.spam
20 debbugs-spamscan-log [options] bugnumber [[bugnumber2]..]
23 --spool-dir debbugs spool directory
24 --debug, -d debugging level (Default 0)
25 --help, -h display this help
26 --man, -m display manual
34 Debbugs spool directory; defaults to the value configured in the
35 debbugs configuration file.
43 Display brief useage information.
53 Rebuild the index.db for db-h.
57 Rebuild the index.db for archive
59 debbugs-spamscan-log archive;
67 use Debbugs::Log qw(record_regex);
68 use Debbugs::Log::Spam;
69 use Debbugs::Config qw(:config);
70 use IPC::Open3 qw(open3);
88 'spool_dir|spool-dir=s',
90 'spamc_opts|spamc-opts=s@',
91 'debug|d+','help|h|?','man|m');
93 pod2usage() if $options{help};
94 pod2usage({verbose=>2}) if $options{man};
96 $DEBUG = $options{debug};
99 $options{verbose} = $options{verbose} - $options{quiet};
103 "You must provide a bug number to examine\n";
106 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
108 if (exists $options{spool_dir} and defined $options{spool_dir}) {
109 $config{spool_dir} = $options{spool_dir};
111 chdir($config{spool_dir}) or die "chdir $config{spool_dir} failed: $!";
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";
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;
130 print STDERR "examining $msg_id: " if $DEBUG;
131 if ($seen_msgids{$msg_id}) {
132 print STDERR "already seen\n" if $DEBUG;
135 $seen_msgids{$msg_id}=1;
136 if ($spam->is_spam($msg_id)) {
137 print STDERR "already spam\n" if $DEBUG;
142 my ($spamc,$child_out);
143 my $old_sig = $SIG{"PIPE"};
145 die "SIGPIPE in child for some reason";
148 open3($spamc,$child_out,0,
149 $options{spamc},'-E',@{$options{spamc_opts}}) or
150 die "Unable to fork spamc: $!";
152 die "Unable to fork spamc";
154 print {$spamc} $record->{text};
155 close($spamc) or die "Unable to close spamc: $!";
156 waitpid($childpid,0);
158 print STDERR "[$?;".($? >> 8)."] ";
159 print STDERR map {s/\n//; $_ } <$child_out>;
163 $SIG{"PIPE"} = $old_sig;
169 print STDERR "processing of $msg_id failed [$@]\n";
172 print STDERR "it's spam\n" if $DEBUG;
173 $spam->add_spam($msg_id);
176 print STDERR "it's ham\n" if $DEBUG;
187 # cperl-indent-level: 4
188 # indent-tabs-mode: nil