I spent a number of hours this weekend creating a mysql / perl / cgi script, to accept abuse reports and file them into a database.
This is part of a (hopefully) ongoing project which users can feed spam into and get customized blacklists out of.
The prototype is at http://abusetrack.nekodojo.org/test if you want to check it out, though it doesn’t really work quite at all yet.
Create user
Paste spam in
Sign the report (doesn’t actually check pgp yet)
Actual script logged for my reference, view if you are really really bored.
#!/usr/bin/perl -w
use strict;
use DBI;
use CGI qw{:standard};
my $database = "abuse" ;
my $hostname = "localhost" ;
my $port = "3306" ;
my $username = "abuse_adm" ;
my $password = "pwgoeshere" ;
my $dbh ; # Database handle
my $debug = 0 ;
if ( param('debug') || url_param('debug') ) { $debug = 1 ; }
print header({"-type"=>"text/html"}) ;
print start_html({"-title"=>"Abusetrack test page"}) ;
if ( param('printenv') || url_param('printenv') ) { &printenv(); }
# Connect to the database.
$dbh = DBI->connect(
"DBI:mysql:database=$database;host=$hostname;port=$port",
$username, $password,
);
if ( ! $dbh ) {
print "<h2>Database currently unavailable.</h2>n" ;
print "<p>Please try again later.</p>n" ;
print "<p>Connect error: $DBI::errstr </p>n" ;
print end_html, "n" ;
exit 0 ;
}
print "n" ;
print h2("Abusetrack test page") ;
print br ;
if ( path_info() eq "/abuseinput" ) {
&process_abuse_form() ;
} elsif ( path_info() eq "/signabuse" ) {
&process_signabuse_form() ;
} elsif ( path_info() eq "/users" ) {
&users() ;
} elsif ( path_info() eq "/createuser" ) {
&process_createuser_form() ;
} elsif ( path_info() eq "/genesis" ) {
&genesis() ;
} else {
# Default action
&process_abuse_form() ;
} #end if formtype
print end_html, "n" ;
# Disconnect from the database.
$dbh->disconnect();
exit 0 ;
sub get_abuse_form($) {
my ( %abuselabels, @abusetypes, @next_url_params, $newform ) ;
$newform = 1;
if ( $_[0] && !($_[0] eq "new") ) {
print em("Form problem: $_[0]"), br() ;
$newform = 0 ;
} # end if (not new)
if ( $newform ) {
param("message", "") ;
param("recvfrom_ip", "") ;
} #end if (newform)
@next_url_params = () ;
url_param("debug") && push ( @next_url_params, "debug=".url_param("debug") ) ;
url_param("printenv") && push ( @next_url_params, "printenv=".url_param("printenv") ) ;
print start_form(
-method=>"POST",
-action=>url(-absolute=>1,path_info=>0)
."/abuseinput"
.( @next_url_params ? "?".join("&", @next_url_params) : "" )
) ;
print hidden(
-name=>'form',
-value=>'abuseinput'
);
print "Your username: " ;
print textfield(
-default=>'',
-name=>'username',
-size=>'15', -maxlength=>20,
);
print br ;
print "Received from IP: (this is the server that relayed the message to your incoming mail server)", br ;
print textfield(
-default=>'',
-name=>'recvfrom_ip',
-size=>'15', -maxlength=>15,
);
print "(leave blank if you're not sure)", br ;
print "Abuse type:" ;
@abusetypes = ('ube','bounce','virus','vwarn') ;
%abuselabels = (
'ube'=>'Unsolicited bulk email',
'bounce'=>'Improper bounce',
'virus'=>'Virus message',
'vwarn'=>'Improper virus warning',
);
print popup_menu(
-name=>'abuse_type',
-values=>@abusetypes,
-labels=>%abuselabels,
);
print br;
print "Enter email, with complete headers and body", br;
print textarea(
-name=>'message',
-default=>'',
-rows=>20,
-columns=>100,
-override=>($newform),
), br ;
print submit(
-name=>'Submit',
-value=>'Submit'
);
print end_form() ;
} # end sub get_abuse_form()
sub process_abuse_form() {
my ( $sth, $message, $recvfrom_ip, $abuse_type, $username, $userid ) ;
if ( !param("form") || !(param("form") eq "abuseinput") ) {
&get_abuse_form ("new") ;
return() ;
} #end if (not an abuseinput form)
$message = param("message") ;
if ( ! ( $message =~ /^Received:/ms ) ) {
&get_abuse_form ("Message must contain full headers, including Received: lines.") ;
return() ;
} #end if (incomplete message)
$recvfrom_ip = param("recvfrom_ip") ;
$abuse_type = param("abuse_type") ;
if ( !param("username") ) {
&get_abuse_form ("Please fill in your username.") ;
return() ;
} #end if (no username)
$userid = &finduserbyname(param("username")) ;
if ( $userid == -1 ) {
&get_abuse_form ("Can't find your username.") ;
return() ;
} #end if (nonexistent user)
$sth = $dbh->do(
"INSERT INTO abuse_reports(submit_user_id,recvfrom_ip,abuse_type,message) VALUES (?,?,?,?)",
undef,
$userid, $recvfrom_ip, $abuse_type, $message
) or do {
print em("Database update failed"), br ;
print "Error ", $dbh->err, ": ", $dbh->errstr, br ;
return() ;
} ;
print "Form accepted.", br ;
print hr() ;
&get_abuse_form("new") ;
return() ;
} #end sub process_abuse_form()
sub get_createuser_form($) {
my ( @next_url_params, $newform ) ;
$newform = 1;
if ( $_[0] && !($_[0] eq "new") ) {
print em("Form problem: $_[0]"), br() ;
$newform = 0 ;
} # end if (not new)
if ( $newform ) {
param("username", "") ;
param("fullname", "") ;
param("email", "") ;
} #end if (newform)
@next_url_params = () ;
url_param("debug") && push ( @next_url_params, "debug=".url_param("debug") ) ;
url_param("printenv") && push ( @next_url_params, "printenv=".url_param("printenv") ) ;
print start_form(
-method=>"POST",
-action=>url(-absolute=>1,path_info=>0)
."/createuser"
.( @next_url_params ? "?".join("&", @next_url_params) : "" )
) ;
print hidden(
-name=>'form',
-value=>'createuser'
);
print "New username: " ;
print textfield(
-default=>'',
-name=>'username',
-size=>'15', -maxlength=>20,
);
print br ;
print "Full name: " ;
print textfield(
-default=>'',
-name=>'fullname',
-size=>'30', -maxlength=>50,
);
print br ;
print "Email address: " ;
print textfield(
-default=>'',
-name=>'email',
-size=>'30', -maxlength=>50,
);
print br ;
print submit(
-name=>'Submit',
-value=>'Submit'
);
print end_form() ;
} # end sub get_createuser_form()
sub process_createuser_form() {
my ( $sth, $abuse_type, $userid ) ;
if ( !param("form") || !(param("form") eq "createuser") ) {
&get_createuser_form ("new") ;
return() ;
} #end if (not a createuser form)
if ( !param("username") ) {
&get_createuser_form ("Username required.") ;
return() ;
} #end if (no username)
$userid = finduserbyname(param("username")) ;
if ( $userid != -1 ) {
&get_createuser_form ("That username is already in use, try another.") ;
return() ;
} #end if (exists user)
$sth = $dbh->do(
"INSERT INTO users(username,fullname,email,active) VALUES (?,?,?,1)", undef,
param("username"), param("fullname"), param("email")
) or do {
print em("Database update failed"), br ;
print "Error ", $dbh->err, ": ", $dbh->errstr, br ;
return() ;
} ;
print "User created.", br ;
print hr() ;
&get_createuser_form("new") ;
return() ;
} #end sub process_createuser_form()
sub get_signabuse_form($) {
my ( @next_url_params, $newform, $userid, $reportid, $sth, $message ) ;
$newform = 1;
if ( $_[0] && !($_[0] eq "new") ) {
print em("Form problem: $_[0]"), br() ;
$newform = 0 ;
} # end if (not new)
if ( $newform ) {
param("recvfrom_ip", "") ;
} #end if (newform)
@next_url_params = () ;
url_param("debug") && push ( @next_url_params, "debug=".url_param("debug") ) ;
url_param("printenv") && push ( @next_url_params, "printenv=".url_param("printenv") ) ;
if ( param("username") ) {
$userid = &finduserbyname( param("username") ) ;
if ( $userid == -1 ) {
print em("Can't find that username."), br ;
param("username","") ;
&get_signabuse_form("new") ;
return() ;
} elsif ( param("reportid") ) {
$reportid = param("reportid");
$sth = $dbh->prepare("SELECT id,message,abuse_type,recvfrom_ip FROM abuse_reports WHERE submit_user_id=? AND id=? ORDER BY id");
$sth->execute($userid,$reportid);
if (my $ref = $sth->fetchrow_hashref()) {
$message = $ref->{'message'};
$reportid = $ref->{'id'};
print start_form(
-method=>"POST",
-action=>url(-absolute=>1,path_info=>0)
."/signabuse"
.( @next_url_params ? "?".join("&", @next_url_params) : "" )
) ;
print hidden(
-name=>'form',
-value=>'signabuse'
);
print hidden(
-name=>'reportid',
-value=>$reportid,
);
print hidden(
-name=>'username',
-value=>$username,
);
print "Received from IP: $ref->{'recvfrom_ip'}", br;
print "Type of abuse: $ref->{'abuse_type'}", br;
print "Original message:", br ;
print textarea(
-name=>'message',
-default=>$message,
-rows=>10,
-columns=>100,
);
print br;
print "Paste signature:", br ;
print textarea(
-name=>'signature',
-default=>'',
-rows=>10,
-columns=>100,
);
print br;
print submit(
-name=>'Submit',
-value=>'Submit'
);
} else {
print em("No report found with that reportid."), br ;
param("username","") ;
&get_signabuse_form("new") ;
return() ;
} #end if ref
} else {
$sth = $dbh->prepare("SELECT id,message,abuse_type,recvfrom_ip FROM abuse_reports WHERE submit_user_id=? ORDER BY id");
$sth->execute($userid);
if (my $ref = $sth->fetchrow_hashref()) {
$message = $ref->{'message'};
$reportid = $ref->{'id'};
print start_form(
-method=>"POST",
-action=>url(-absolute=>1,path_info=>0)
."/signabuse"
.( @next_url_params ? "?".join("&", @next_url_params) : "" )
) ;
print hidden(
-name=>'form',
-value=>'signabuse'
);
print hidden(
-name=>'reportid',
-value=>$reportid,
);
print hidden(
-name=>'username',
-value=>$username,
);
print "Received from IP: $ref->{'recvfrom_ip'}", br;
print "Type of abuse: $ref->{'abuse_type'}", br;
print "Original message:", br ;
print textarea(
-name=>'message',
-default=>$message,
-rows=>10,
-columns=>100,
);
print br;
print "Paste signature:", br ;
print textarea(
-name=>'signature',
-default=>'',
-rows=>10,
-columns=>100,
);
print br;
print submit(
-name=>'Submit',
-value=>'Submit'
);
} else {
print em("No reports found for that username."), br ;
param("username","") ;
&get_signabuse_form("new") ;
return() ;
} #end if ref
} #end if (nonexistent user, reportid, etc)
} else {
print start_form(
-method=>"POST",
-action=>url(-absolute=>1,path_info=>0)
."/signabuse"
.( @next_url_params ? "?".join("&", @next_url_params) : "" )
) ;
print hidden(
-name=>'form',
-value=>'findreports'
);
print "Your username: " ;
print textfield(
-default=>'',
-name=>'username',
-size=>'15', -maxlength=>20,
);
print br ;
print submit(
-name=>'Find reports',
-value=>'Find reports'
);
}
print end_form() ;
} # end sub get_signabuse_form()
sub process_signabuse_form() {
my ( $sth, $username, $userid ) ;
if ( param("form") && param("form") eq "findreports" ) {
&get_signabuse_form () ;
return() ;
} #end if (a findreports form)
if ( !param("form") || !(param("form") eq "signabuse") ) {
&get_signabuse_form ("new") ;
return() ;
} #end if (not a signabuse form)
if ( !param("username") ) {
&get_signabuse_form ("Can't find your username.") ;
return() ;
} #end if (no username)
$userid = &finduserbyname( param("username") ) ;
if ( $userid == -1 ) {
&get_signabuse_form ("Can't find your username.") ;
return() ;
} #end if (nonexistent user)
$sth = $dbh->do(
"INSERT INTO signatures (signing_user_id,doctype,signature) VALUES (?,?,?)",
undef,
$userid, 1, param("signature"),
) or do {
print em("Database update failed"), br ;
print "Error ", $dbh->err, ": ", $dbh->errstr, br ;
return() ;
} ;
print "Form accepted.", br ;
print hr() ;
&get_signabuse_form("new") ;
return() ;
} #end sub process_abuse_form()
sub finduserbyname ($) {
my $userid = -1 ;
my $username = $_[0] ;
my $sth ;
$sth = $dbh->prepare("SELECT id FROM users WHERE username=? AND active=1 ");
$sth->execute( $username );
while (my $ref = $sth->fetchrow_hashref()) {
if ( $userid == -1 ) {
$userid = $ref->{'id'} ;
} else {
print em("Multiple users with same username, using lower id."), br ;
if ( $ref->{'id'} < $userid ) { $userid = $ref->{'id'} ; }
} #end if (userid = -1)
} #end while
$sth->finish();
return $userid ;
}
sub users() {
my $sth ; # statement handle
print h2("Active users") ;
$sth = $dbh->prepare("SELECT id,username FROM users WHERE active=1 ORDER BY username");
$sth->execute();
while (my $ref = $sth->fetchrow_hashref()) {
print '<a href="',
url(-absolute=>1,path_info=>0)."/userinfo?id=".$ref->{'id'},
'">',
$ref->{'username'},
'</a>', br ;
} #end while
$sth->finish();
} #end sub users()
sub printenv() {
my $pp ;
print "Args:", br ;
foreach $pp ( param() ) {
print $pp, "=", param($pp), br ;
} # end foreach $pp
print br ;
print "path_info=", path_info(), br ;
print br ;
print "Env:", br ;
foreach $pp ( keys(%ENV) ) {
print $pp, "=", $ENV{$pp}, br ;
} # end foreach $pp
Dump() ;
} # end sub printenv()
sub genesis() {
# Create table 'users'.
eval { $dbh->do("DROP TABLE users") };
print "Dropping users failed: $@n" if $@;
$dbh->do( "CREATE TABLE users (id INTEGER NOT NULL AUTO_INCREMENT, username VARCHAR(20), active INTEGER(16), fullname VARCHAR(50), email VARCHAR(50), PRIMARY KEY (id) )" );
# Create table 'abuse_reports'.
eval { $dbh->do("DROP TABLE abuse_reports") };
print "Dropping abuse_reports failed: $@n" if $@;
$dbh->do( "CREATE TABLE abuse_reports (id INTEGER NOT NULL AUTO_INCREMENT, submit_user_id INTEGER, abuse_type VARCHAR(20), recvfrom_ip VARCHAR(16), message BLOB, PRIMARY KEY (id) )" );
# Create table 'signatures'
eval { $dbh->do("DROP TABLE signatures") };
print "Dropping signatures failed: $@n" if $@;
$dbh->do( "CREATE TABLE signatures (id INTEGER NOT NULL AUTO_INCREMENT, signing_user_id INTEGER, signing_key_id INTEGER, doctype INTEGER, doc_id INTEGER, signature BLOB, PRIMARY KEY (id) )" );
# Create table 'pubkeys'
eval { $dbh->do("DROP TABLE pubkeys") };
print "Dropping pubkeys failed: $@n" if $@;
$dbh->do( "CREATE TABLE pubkeys (id INTEGER NOT NULL AUTO_INCREMENT, user_id INTEGER, key_id INTEGER, keytype INTEGER, pubkey BLOB, PRIMARY KEY (id) )" );
print em("Database created."), br ;
}
sub test_db() {
# Drop table 'foo'. This may fail, if 'foo' doesn't exist.
# Thus we put an eval around it.
eval { $dbh->do("DROP TABLE foo") };
print "Dropping foo failed: $@n" if $@;
# Create a new table 'foo'. This must not fail, thus we don't
# catch errors.
$dbh->do("CREATE TABLE foo (id INTEGER, name VARCHAR(20))");
# INSERT some data into 'foo'. We are using $dbh->quote() for
# quoting the name.
$dbh->do("INSERT INTO foo VALUES (1, " . $dbh->quote("Tim") . ")");
# Same thing, but using placeholders
$dbh->do("INSERT INTO foo VALUES (?, ?)", undef, 2, "Jochen");
# Now retrieve data from the table.
my $sth = $dbh->prepare("SELECT * FROM foo");
$sth->execute();
while (my $ref = $sth->fetchrow_hashref()) {
print "Found a row: id = $ref->{'id'}, name = $ref->{'name'}n";
}
$sth->finish();
}
Yes, I know there are hardly and comments and things are kind of a mess. It’s intended to be a prototype anyway, and really should be rewritten completely, if there is interest in the idea that is.
Hey. I namedropped on you for the Nanothingysupportgroup I’m setting up — let me know if that’s a problem and I’ll pull the link.
()
-Traveller