#!/usr/bin/perl
use warnings;
$VERSION = '1.09';
my $version = $VERSION;
use strict;
use LWP::UserAgent;
use HTML::Form;
use HTTP::Cookies;
use Getopt::Std;
use Getopt::ArgvFile qw(argvFile);
my $delay = 1; # Delay between HTTP requests. Adjust this if Spamcop.net asks!
#############################################################################
#
# Spamcup - A tool for finishing Spamcop.net reports.
#
# Copyright (C) Toni Willberg <toniw@iki.fi> http://toniw.iki.fi/
#
# Get latest version from:
# http://sourceforge.net/projects/spamcup/
#
#############################################################################
#
# * Instructions:
# Forward you spam to your Spamcop.net address given by Spamcop.net.
# Wait while Spamcop.net processes the spam.
#
# Finish reporting by using this script. The script does exactly the same
# you would do by surfing to http://spamcop.net/ and clicking spam
# reporting links and buttons. The script uses default selections of
# checkboxes that Spamcop suggests.
#
#############################################################################
#
# *** W A R N I N G ! ***
#
# The script does NOT know where the spam report will be sent so
# IT'S YOUR RESPONSIBILITY!
#
# If the script asks spamcop to send reports to wrong places
# IT'S YOUR FAULT!
#
# If the script has a bug that causes same report being sent thousand times
# IT'S YOUR MAIL ADDRESSES!
#
# DO NOT USE THIS SCRIPT IF YOU DON'T UNDERSTAND WHAT IT DOES!
# IT'S YOUR SHAME!
#
#############################################################################
#
# Copyright (C) Toni Willberg
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
#
#############################################################################
#############################################################################
#
# No user serviceable parts inside. Consult your local Perl guru if you feel
# like modifying something. Also see the GPL licence!
#
# Remember to submit all modifications to the author also!
#
#############################################################################
#############################################################################
#############################################################################
#############################################################################
# get optional parameters from configfile .spamcup
argvFile(startupFilename => '.spamcup', home=> "1" );
# get parameters from command line
my %opt;
getopts('vnac:sqdhDul:p:', \%opt);
my $SCident = shift;
my $SCpass = '';
my $footer = qq(\n* Spamcup $version - (C) Toni Willberg <toniw\@iki.fi> http://toniw.iki.fi/
* Downloads and bug reports: http://sourceforge.net/projects/spamcup/
);
if ($opt{v}) {
print $footer;
exit;
}
if ($opt{h} || (!$SCident && !$opt{l} && !$opt{c}) || ($SCident && $opt{l}) || ($SCident && $opt{c})) {
print qq(Usage: $0 [options] <Spamcop-Username>\n
$0 <options> <Spamcop-Username>
Options:
-n Does nothing, just shows if you have unreported spam or not.
-a Run in a loop untill all spam is reported.
-s Stupid. Runs without asking confirmation. Use with care.
-q Be quiet.
-c Alternate method for signifying code. (Unpaid users WITHOUT username & password)
-l Alternate method for providing username. (Paid & unpaid users with password)
-p Method for providing password. (Required for users with password)
-d Debug mode. Prints all kinds of funny things.
-D Even more debug mode. Dumps also HTML.
-v Show version and quit.
-h You are reading it.
By default the script confirms every spam its about to report. With option -s it does not
ask for confirmation.
You can combine one or more options. You MUST put options before the code.
See the README file for information about optional configuration file!
$footer
);
exit;
}
if ($opt{l}) {
$SCident=$opt{l};
} elsif ($opt{c}) {
$SCident=$opt{c};
}
if ($SCident =~ /\@/ ) {
if (!$opt{p} || $opt{p} eq '') {
print "Enter password: ";
$SCpass = <STDIN>;
chomp($SCpass);
} else {
$SCpass = $opt{p};
}
} else {
undef $SCpass;
}
# DEBUG++: option -D dumps all HTML, used with in development only
# force d if D
if ($opt{D}) {
$opt{d} = 1;
}
if ($opt{n}) {
print "* Running with -n. Not actually reporting spam, just showing what is about to happen.\n";
}
if (!$opt{q}) {
print "* Using ID '$SCident'.\n";
if ($opt{a}) {
print "* Running with -a. Runs in a loop while all spam is reported.\n";
}
if ($opt{d}) {
print "* Running with -d. Debug mode. Prints all kinds of funny things.\n";
}
if ($opt{D}) {
print "* Running with -D. Even more debug mode. Dumps also HTML.\n";
}
if ($opt{s}) {
print "* Running with -s. No report confirmation will be asked.\n* Make sure you don't post false reports!\n";
sleep $delay;
}
}
# create http client
my $ua = LWP::UserAgent->new;
$ua->agent("spamcup/$version");
$ua->cookie_jar(HTTP::Cookies->new());
my $req;
my $res;
my $lastseenspamid; # to avoid infinite loop
# BEGIN OF THE MAIN LOOP
sub mainloop {
#############################################################################
#
# Get first page that contains link to next one...
#
if ($opt{d}) { # debug
if ($SCpass) {
print "D: GET http://$SCident:******\@members.spamcop.net/\n";
} else {
print "D: GET http://www.spamcop.net/?code=$SCident\n";
}
}
if ($opt{d}) {
print "D: Sleeping for $delay seconds.\n";
}
sleep $delay;
if ($SCpass) {
$req = HTTP::Request->new(GET => 'http://members.spamcop.net/');
$req->authorization_basic($SCident, $SCpass);
} else {
$req = HTTP::Request->new(GET => 'http://www.spamcop.net/?code='.$SCident);
}
# $ua->cookie_jar->add_cookie_header($req);
$res = $ua->request($req);
# verify response
if ($res->is_success) {
if ($opt{d}) { # debug
print "D: Got HTTP response\n";
# print "D: Headers follow:\n". $res->headers->as_string ."\n\n";
}
} else {
die "E: Can\'t connect to server or invalid credentials. Please verify your username and password and try again.\n";
}
if ($opt{D}) {
print "\n--------------------------------------------------------------------------\n";
print $res->content;
print "--------------------------------------------------------------------------\n\n";
}
#############################################################################
#
# Parse id for link
#
if ($res->content =~ /\>No userid found\</i ) {
# unknown userid
die "E: No userid found. Please check that you have entered correct code. Also consider obtaining a password to Spamcop.net instead of using the old-style authorization token.\n";
}
my $fullname;
if ($res->content =~ /(Welcome, .*?)\./ ) {
# found full name, print out the greeting string
print "* $1\n";
}
my $nextid;
if ($res->content =~ /sc\?id\=(.*?)\"\>/gi) { # this is easy to parse
# userid ok, new spam available
$nextid = $1;
}
else {
# userid ok, no new spam
if (!$opt{q}) {
print "* No unreported spam found. Quitting.\n";
}
return -1; # quit
}
if (!$opt{q}) {
print "* ID of the next spam is '$nextid'.\n";
}
# avoid loops
if ($lastseenspamid && $nextid eq $lastseenspamid) {
die "E: I have seen this ID earlier. We don't want to report it again. This usually happens because of a bug in Spamcup. Make sure you use latest version! You may also want to go check from Spamcop what's happening: http://www.spamcop.net/sc?id=$nextid\n";
}
$lastseenspamid = $nextid; # store for comparison
undef $req;
undef $res;
#############################################################################
#
# Fetch the spam report form
#
if ($opt{d}) {
print "D: GET http://www.spamcop.net/sc?id=$nextid\n";
print "D: Sleeping for $delay seconds.\n";
}
sleep $delay;
$req = HTTP::Request->new(GET => 'http://www.spamcop.net/sc?id='.$nextid);
# $ua->cookie_jar->add_cookie_header($req);
$res = $ua->request($req);
if ($res->is_success) {
if ($opt{d}) {
print "D: Got HTTP response\n";
# print "D: Headers follow:\n". $res->headers->as_string ."\n\n";
}
} else {
die "E: Can't connect to server. Try again later.\n\n";
}
if ($opt{D}) {
print "\n--------------------------------------------------------------------------\n";
print $res->content;
print "--------------------------------------------------------------------------\n\n";
}
#############################################################################
#
# parse the spam
#
my $_cancel = 0;
my $base_uri = $res->base();
if (!$base_uri) {
print "E: No base uri found. Internal error? Please report this.\n";
exit;
}
# $res->content =~ /(\<form action.*?name=\"sendreport\"\>.*?\<\/form\>)/sgi;
$res->content =~ /(\<form action[^>]+name=\"sendreport\"\>.*?\<\/form\>)/sgi;
my $formdata = "<html><body>$1</body></html>";
my $form = HTML::Form->parse($formdata, $base_uri);
#
# print the header of the spam
#
my $spamhead;
if ($res->content =~ /Please make sure this email IS spam.*?size=2\>\n(.*?)\<a href\=\"\/sc\?id\=$nextid/sgi ) { # this is also quite easy...
# this is the normal case
$spamhead = $1;
if (!$opt{q} ) {
print "* Head of the spam follows >>>\n";
$spamhead =~ s/\n/\t/igs; # prepend a tab to each line
$spamhead =~ s/<br>/\n/gsi; # simplify a bit
print "\t$spamhead\n";
print "<<<\n";
}
#############################################################################
#
# parse form fields
#
# verify form
if (!$form) {
if ($opt{d}) {
print "D: Spamcop returned invalid HTML form. Usually temporary error.\n";
}
die "E: Temporary Spamcop.net error. Try again later! Quitting.\n";
}
else {
if ($opt{d}) {
print "D: Form data follows:\n". $form->dump ."\n\n";
}
# how many recepients for reports
my $max = $form->value("max");
my $willsend;
my $wontsend;
# iterate targets
for (my $i=1; $i <= $max; $i++) {
my $send = $form->value("send$i");
my $type = $form->value("type$i");
my $master = $form->value("master$i");
my $info = $form->value("info$i");
# convert %2E -style stuff back to text, if any
if ( $info =~ /%([A-Fa-f\d]{2})/g ) {
$info =~ s/%([A-Fa-f\d]{2})/chr hex $1/eg;
}
if ($send and (
($send eq 'on')
or
($type =~ /^mole/ and $send == 1 )
) ) {
$willsend .= "\t$master \t($info)\n";
}
else {
$wontsend .= "\t$master \t($info)\n";
}
}
print "Would send the report to the following addresses: (Reason in parenthesis)\n";
if ($willsend) {
print $willsend;
} else {
print "\t--none--\n";
}
print "Following addresses would not be used:\n";
if ($wontsend) {
print $wontsend;
} else {
print "\t--none--\n";
}
}
# Run without confirming each spam? Stupid. :)
if (!$opt{s}) {
print "* Are you sure this is spam? [y/N] ";
my $reply = <>; # this should be done differently!
if ($reply && $reply !~ /^y/i) {
print "* Cancelled.\n";
$_cancel = 1; # mark to be cancelled
}
elsif (!$reply) {
print "* Accepted.\n";
}
else {
print "* Accepted.\n";
}
}
else {
# little delay for automatic processing
sleep $delay;
}
print "...\n";
}
elsif ($res->content =~ /Send Spam Report\(S\) Now/gi) {
# this happens rarely, but I've seen this; spamcop does not show preview headers for some reason
if (!$opt{s}) {
print "* Preview headers not available, but you can still report this. Are you sure this is spam? [y/N] ";
my $reply = <>;
if ($reply && $reply !~ /^y/i) {
# not Y
print "* Cancelled.\n";
$_cancel = 1; # mark to be cancelled
}
else {
# Y
print "* Accepted.\n";
}
}
}
elsif ($res->content =~ /Sorry, this email is too old.*This mail was received on (.*?)\<\/.*\>/gsi) {
# perhaps it's too old then
my $ondate = $1;
if (!$opt{q}) {
print "W: This spam is too old. You must report spam within 3 days of receipt. This mail was received on $ondate. Deleted.\n";
}
return 0;
}
elsif ($res->content =~ /click reload if this page does not refresh automatically in \n(\d+) seconds/gs) {
my $delay = $1;
print "W: Spamcop seems to be currently overloaded. Trying again in $delay seconds. Wait...\n";
sleep $delay;
$lastseenspamid = 0; # fool it to avoid duplicate detector
return 1; # fake that everything is ok
}
elsif ($res->content =~ /No source IP address found, cannot proceed. Not full header/gs) {
print "W: No source IP address found. Your report might be missing headers. Skipping.\n";
return 0;
}
else {
# Shit happens. If you know it should be parseable, please report a bug!
print "W: Can't parse Spamcop.net's HTML. If this does not happen very often you can ignore this warning. Otherwise check if there's new version available. Skipping.\n";
return 0;
}
#############################################################################
#
# STOP if -n
#
if ($opt{n}) {
print "* You gave option -n, so we'll stop here. The spam was NOT reported.\n";
exit;
}
if ($opt{d}) {
print "\n\nD: Starting the parse phase...\n";
}
undef $req;
undef $res;
#############################################################################
#
# Submit the form to Spamcop OR cancel report
#
if (!$_cancel) { # SUBMIT spam
if ($opt{d}) {
print "D: Submitting form. We will use the default recipients.\n";
print "D: GET http://www.spamcop.net/sc?id=$nextid\n";
print "D: Sleeping for $delay seconds. We don't want to jam Spamcop.\n";
}
sleep $delay;
$res = LWP::UserAgent->new->request( $form->click() ); # click default button, submit
}
else { # CANCEL SPAM
if ($opt{d}) {
print "D: About to cancel report.\n";
}
$res = LWP::UserAgent->new->request( $form->click('cancel') ); # click cancel button
}
# Check the outcome of the response
if ($res->is_success) {
if ($opt{d}) {
print "D: Got HTTP response\n";
print "D: -- content follows -------------------------\n";
print $res->content;
print "D: -- content ended -------------------------\n\n";
}
} else {
die "E: Can't connect to server. Try again later. Quitting.\n";
}
if ($_cancel) {
return 1; # user decided this mail is not spam
}
# parse respond
my $report;
if ($res->content =~ /(Spam report id .*?)\<p\>/gsi) {
$report = $1 || "-none-\n";
$report =~ s/\<br\>//gi;
}
elsif ( $res->content =~ /report for mole\@devnull.spamcop.net/ ) {
$report = 'Mole report(s)';
}
else {
print "W: Spamcop.net returned unexpected content. If this does not happen very often you can ignore this. Otherwise check if there new version available. Continuing.\n";
}
#############################################################################
#
# print the report
#
if (!$opt{q}) {
print "Spamcop.net sent following spam reports:\n";
print "$report\n" if $report;
print "* Finished processing.\n";
}
return 1;
# END OF THE LOOP
}
# let's run the beast
my $retval;
if ($opt{a} && !$opt{n}) {
# run while there is more spam
while (1) { # Ugly, but does the thing...
$retval = &mainloop ();
last if ($retval == -1); # no more spam
if (!$opt{q}) {
if (!$retval) {
print "W: Error occured while processing spam. Continuing.\n";
}
print "\n-------------------------------------------------------\n* Processing next spam.\n";
}
}
}
else {
# run once
&mainloop();
}
if (!$opt{q}) {
print $footer;
}
#############################################################################
# Do not enter beyond this line
syntax highlighted by Code2HTML, v. 0.9.1