| Anonymous via Panta Rhei 2007-02-25, 7:13 am |
| #!/usr/bin/perl
require 5;
$VERSION = '1.0';
use File::Slurp;
use warnings;
use Getopt::Std;
use List::Util ('shuffle');
use News::Article;
use strict 'refs';
my(%option, $inputFilename, $outputFilename, @addBody, $code);
my $ctr = 0;
my(@dropGroups) = ();
my(@followups) = ();
# generate troll alerts
# example:
# $ grep -r -l '^From: Some Idiot' /var/spool/news/alt/what/ever |xargs trollwatch
# By default this script adds Followup-To: alt.dev.null,
# X-No-Archive: Yes, and a X-Code header to keep it from replying
# to its own messages. It also copies the troll's From so that
# people who killfile him won't see these alerts.
# This script just generates messages, it's up to you how you get
# them onto usenet. Warning, if you post a lot of these so you
# can be traced, you'll probably get TOSsed!
# -G alt.foo,alt.bar
# drop some Newsgroups
# -N
# do not FU alt.dev.null
# -a
# do not set X-No-Archive: Yes
# -b FILE
# use text from FILE instead of default data
# -c
# suppress X-Code: random header
# -d DIRECTORY
# put output file here instead of pwd
# -f 'Some Name foo@bar'
# use this From header instead of copying
# from the original messages
# -u alt.foo,alt.bar
# add FUs
# -L FILE
# ignore files not newer than FILE
# This script is hereby donated to the PUBLIC DOMAIN.
getopts 'd:af:b:u:G:NcL:', \%option;
my $maxAge = $option{L} ? (-M $option{L}) : 0;
my $outputDirectory = $option{'d'} || '.';
if ($option{'G'}) {
@dropGroups = split(/,/, $option{'G'}, 0);
}
push @followups, 'alt.dev.null' unless $option{'N'};
push @followups, split(/,/, $option{'u'}, 0) if $option{'u'};
if ($option{'b'}) {
@addBody = read_file($option{'b'});
}
else {
@addBody = <DATA>;
}
foreach $inputFilename (@ARGV) {
if (($option{L}) && (-M $inputFilename >= $maxAge)) {
print "$inputFilename ignored (too old)\n";
}
else {
my $input = 'News::Article'->new($inputFilename);
if ($input->header('X-Code')) {
print "$inputFilename ignored (X-Code)\n";
}
else {
my $output = 'News::Article'->new;
my $from = $option{'f'} || $input->header('From');
$output->set_headers('Subject', reSubject($input),
'From', $from,
'References', reRefs($input));
$output->set_headers('X-No-Archive', 'Yes') unless $option{'a'};
unless ($option{'c'}) {
$code = `mcookie`;
chomp $code;
$output->set_headers('X-Code', $code);
}
$output->set_body(reBody($input));
my(@groupings) = reGroup($input);
my $groups;
while (@groupings) {
$outputFilename = getFilename($outputDirectory, $inputFilename);
$groups = shift @groupings;
$output->set_headers('Newsgroups', $groups);
$output->set_headers('Followup-To', fu($groups)) if @followups > 0;
open OUTFILE, ">$outputFilename";
$output->write(\*OUTFILE);
close OUTFILE;
print "$inputFilename --> $outputFilename\n";
}
}
}
}
sub reSubject {
my $subject = $_[0]->header('Subject');
$subject = 'Re: ' . $subject unless $subject =~ /\s*(\[.*\])?\s*Re:/i;
return $subject;
}
sub reRefs {
my(@refs) = $_[0]->header('Message-ID');
my(@oldRefs) = split(/\s+/, $_[0]->header('References') || '', 0);
unshift @refs, pop @oldRefs if @oldRefs;
unshift @refs, shift @oldRefs if @oldRefs;
return join(' ', @refs);
}
sub getFilename {
my $orig = $_[1];
$orig =~ s[^.*/][];
my $fn;
do {
$fn = $_[0] . '/' . $orig . '-' . $$ . $ctr++ . '.output'
} while -f $fn;
return $fn;
}
sub reGroup {
my(@groups) = shuffle(split(/,/, $_[0]->header('Newsgroups'), 0));
if ($option{'G'}) {
@groups = dropGroups(@groups);
}
my(@output) = ();
while (@groups > 3) {
push @output, join(',', @groups[0, 1, 2]);
shift @groups;
shift @groups;
shift @groups;
}
push @output, join(',', @groups);
return @output;
}
sub dropGroups {
my(%groups) = map({$_, 1;} @_);
foreach my $item (@dropGroups) {
delete $groups{$item};
}
return keys %groups;
}
sub fu {
my(@groups) = split(/,/, $_[0], 0);
unshift @groups, @followups;
if (@groups > 3) {
@groups = @groups[0, 1, 2];
}
return join(',', shuffle(@groups));
}
sub reBody {
my(@old) = $_[0]->body;
my $from = $_[0]->header('From');
my(@new) = map({"> $_";} grep({not $_ =~ /:\s*$/ if not $_ =~ /^\s*>/ and not $_ =~ /^\s*$/;} @old));
while (@new > 4) {
pop @new;
}
unshift @new, "$from wrote:", '';
push @new, '', @addBody;
return @new;
}
__DATA__
/| /| _____________________
||__|| | |
/ O O\__ | PLEASE DO NOT |
/ \ | FEED THE TROLLS |
/ \ \|_____________________|
/ _ \ \ ||
/ |\____\ \ ||
/ | | | |\____/ ||
/ \|_|_|/ | _||
/ / \ |____| ||
/ | | | --|
| | | |____ --|
* _ | |_|_|_| | \-/
*-- _--\ _ \ | ||
/ _ \\ | / `
* / \_ /- | | |
* ___ C_c_c_C/ \C_c_c_c____________
~~~~~~~~~~~~~~~~~~~~~
This message was posted via one or more anonymous remailing services.
The original sender is unknown. Any address shown in the From header
is unverified. You need a valid hashcash token to post to groups other
than alt.test and alt.anonymous.messages. Visit www.panta-rhei.eu.org
for abuse and hashcash info.
|