#!/usr/bin/perl
#
# spam_report.plx
#
my $version = '1.05'; # 6-28-04, michael@bizsystems.com
# GPL'd, see Copyright notice in the package README file
#
use strict;
#use diagnostics;
use Mail::SpamCannibal::SiteConfig;
my $spamcannibal = new Mail::SpamCannibal::SiteConfig;
#########################################################
######## READ THIS FILE FOR CONFIGURATION ###############
#########################################################
# SET for your system
#
my $config = {
# used for testing, overides host:post
# 'file' => '/path/to/cache',
# port to interrogate on local/remote host, REQUIRED 8686, used by LaBrea::Tarpit
'd_port' => '8687',
# host to interrogate, defaults to localhost
#
'd_host' => 'localhost',
# host response timeout, default 180 seconds
#
# 'd_timeout' => 180,
# THE REST USED TO ANALYZE syslog files, see man LaBrea::Tarpit
# /directory/path/filename.cache.file for http cache files
#
'cache' => $spamcannibal->{SPMCNBL_ENVIRONMENT}.'/labrea.cache',
# umask for cache file creation, defaults to 033
#
# 'umask' => '',
# time to keep threads that have dropped out, default 600 seconds
#
# 'cull' => 600, # default 600, seconds to keep old threads
# number of dead threads to keep in 'ESCAPED'
#
'scanners' => 100, # keep this many dead threads
};
$ENV{SCRIPT_NAME} =~ m|/[a-zA-Z0-9\._]+|; # script name to $&
# SET THESE for your system
my $look_n_feel = { # defaults shown
'face' => 'VERDANA,ARIAL,HELVETICA,SANS-SERIF',
'color' => '#ffffcc',
'bakgnd' => '#000000',
'images' => 'images/', # REQUIRED, path to images
# below are for html file caching
# the directory for the cache file MUST be writable by the web server
'html_cache_file' => './tmp/'. $& .'_page.cache', # required
'html_expire' => 300, # cache expiration, secs
'whois' => 'cannibal',
};
############### END CONFIG ##########################
# button text URL
# comment out or modify as needed for your site
my @buttons = (
'HOME' => 'http://spamcannibal.org onClick="var url = /(.*\/)/; var result = location.pathname.match(url);self.location = result[0];return false;"',
'SUMMARY' => 'summary onClick="return(please_wait(this));"',
"SOURCE IP's" => 'attackers onClick="return(please_wait(this));"',
'ACTIVE' => 'captured onClick="return(please_wait(this));"',
'ESCAPED' => 'escaped onClick="return(please_wait(this));"',
);
my @extras = ();
my $first_page = 'summary'; # from above
my $summary_days = 5; # number of days to show in capture summary
my $buttwidth = 120; # should not need to be changed
my $logo_text = q|
<img src="|. $look_n_feel->{images} . q|spamcan1.gif" height=42 width=234 alt="SpamCannibal">
|;
=pod
# add extra buttons like this...
@_ = split('\.', $0); # get file extension
$_ = pop @_;
@extras = ( # extra buttons
'' => '', # button space
'WEST SITE' => 'http://west.spamcannibal.org/spam_report.'.$_,
);
=cut
#########################################################
############ no more user setable parameters ############
#########################################################
use LaBrea::Tarpit 1.17 qw(
prep_report
restore_tarpit
);
use LaBrea::Tarpit::Report 1.09 qw(
gen_short
short_report
time2local
capture_summary
guests_by_IP
guests
got_away
my_IPs
port_stats
other_sites
get_config
get_versions
make_buttons
make_image_cache
);
use LaBrea::Tarpit::Util qw(
http_date
daemon2_cache
script_name
upd_cache
page_is_current
labrea_whoami
);
my ($image_cache,$use_cache,$error,$rpt,$sht,$html,$report,$short,$out,%tarpit);
# make keys of the commands or hrefs
@_ = (
'short' => 'short',
'ERROR' => 'error',
);
for (my $i=0; $i<=$#buttons;$i+=2) {
$buttons[$i+1] =~ /(\S+)/;
push @_,$buttons[$i],$1;
}
my %buttext = reverse @_;
# get proposed action
my $page = $ENV{QUERY_STRING};
$page = $first_page unless exists $buttext{$page};
my ($mtime,$upd);
if ( $page eq 'short' ) { # skip the main cache check
$mtime = time - $look_n_feel->{html_expire};
$use_cache = page_is_current($mtime,
$look_n_feel->{html_cache_file}.'.'.$page);
} else {
# first thing, check the cache age
($mtime,$upd) = daemon2_cache(
$look_n_feel->{html_cache_file}.'.mem',
$config,
$look_n_feel->{html_expire},
);
$error = $@;
if ($error) { # was there a timeout error
$page = 'error'; # falls through elsif's
# note that $upd & $use_cache will be false
}
else {
restore_tarpit(\%tarpit,$look_n_feel->{html_cache_file}.'.mem')
unless ($use_cache = page_is_current($mtime, # always set $use_cache
$look_n_feel->{html_cache_file}.'.'.$page)) || $page eq 'other'; # but skip restore if tarpit not needed
}
}
##############
if (! $upd && $use_cache) {
# skip the updates
}
##############
elsif ( $page eq 'summary' ) {
# print STDERR "summary\n";
my (@csdate,@csctd);
$out = {
'capture_summary' => undef,
'versions' => 'Created by: ',
# capture statistics # all fields B<REQUIRED>
'cs_days' => $summary_days,
'cs_date' => \@csdate, # epoch midnight of capt date
'cs_ctd' => \@csctd, # captured this date
};
prep_report(\%tarpit,$out);
get_versions($out,$look_n_feel,$out,'dbtarpit');
capture_summary($out,$look_n_feel,$out);
$report = q|<table cellspacing=2 cellpadding=5 border=2>
<tr><td valign=top bgcolor="| . $look_n_feel->{bakgnd} . q|">
<font face="| . $look_n_feel->{face} . q|" color="| . $look_n_feel->{color} . q|" size=3>Page last updated | .
&time2local($out->{now}, $out->{tz}) . q|
<p>
These reports show the spam / virus connection attempts to this sites mail host.
The data is provided by the log output of the Mail::SpamCannibal tarpit daemon.
For more information, download the complete package from <a
href="http://search.cpan.org/search?query=Mail::SpamCannibal">CPAN.org</a>
<p>
For complete information, read the Document link on the home page of this web site.
</td>
<td valign=top>
| . $out->{capture_summary} . q|</td></tr>
<tr><td colspan=2 bgcolor="| . $look_n_feel->{bakgnd} . q|"><font face="| .
$look_n_feel->{face} . q|" color="| . $look_n_feel->{color} . q|" size=3>
Briefly:
<br>
SpamCannibal's TCP/IP tarpit stops spam by telling the spamming server to
send very small packets. This is accomplished by reducing the transmission window
to minimum size. The result is that the spam server attempts to send over and
over - ideally bringing the spam server to a virtual halt for a long time or perhaps
indefinitely. SpamCannibal blocks spam at the source and eliminates that network
traffic to your site since the spam never leaves the originating server.
<p></font>
<table cellspacing=5 cellpadding=0 border=0 width=100%>
<tr><td><font face="| .
$look_n_feel->{face} . q|" color="| . $look_n_feel->{color} . q|" size=3>
This same strategy works equally well when SpamCannibal's tarpit daemon is configured to defend
against DoS attacks. SpamCannibal uses a continually updated database containing the IP
addresses of spam or DoS servers and blocks their ability to connect
using its TCP/IP tarpit or IP drop capability.
</font></td>
<td>| . $out->{versions} . q|</td></tr>
</table>
</td></tr></table>
|;
$rpt = \$report;
}
##############
elsif ( $page eq 'attackers' ) {
# print STDERR "attackers\n";
my (@thsip,@thnum);
$out = {
# threads per teergrubed host
'guests_by_IP' => undef,
'th_srcIP' => \@thsip,
'th_numTH' => \@thnum, # number threads this IP
};
prep_report(\%tarpit,$out);
guests_by_IP($out,$look_n_feel,$out);
$rpt = \$out->{guests_by_IP};
}
##############
elsif ( $page eq 'captured' ) {
# print STDERR "captured\n";
my (@tgsip,@tgsp,@tgdp,@tgcap,@tglst,@tgpst);
$out = {
# teergrubed hosts
'guests' => undef,
'tg_srcIP' => \@tgsip, # B<REQUIRED>
'tg_sPORT' => \@tgsp, # B<REQUIRED>
'tg_dPORT' => \@tgdp,
'tg_captr' => \@tgcap, # capture epoch time
'tg_last' => \@tglst, # last contact
'tg_prst' => \@tgpst, # persistent [true|false]
};
prep_report(\%tarpit,$out);
guests($out,$look_n_feel,$out);
$rpt = \$out->{guests};
}
##############
elsif ( $page eq 'escaped' ) {
# print STDERR "escaped\n";
my (@scsip,@scdp,@scpst,@sclst);
$out = {
# scanning hosts lost
'got_away' => undef,
'sc_srcIP' => \@scsip, # B<REQUIRED>
'sc_dPORT' => \@scdp, # attacked port
'sc_prst' => \@scpst, # persistent [true|false]
'sc_last' => \@sclst, # last contact
};
prep_report(\%tarpit,$out);
got_away($out,$look_n_feel,$out);
$rpt = \$out->{got_away};
}
##############
elsif ( $page eq 'local-ips' &&
! ($error = get_config($config,$look_n_feel)) ) { # get config file
# print STDERR "local-ips\n";
my (@phdip,@phpst);
$out = {
# phantom IP's used (from our IP block)
'my_IPs' => undef,
'ph_dstIP' => \@phdip, # B<REQUIRED>
'ph_prst' => \@phpst, # persistent [true|false]
};
prep_report(\%tarpit,$out);
my_IPs($out,$look_n_feel,$out);
$rpt = \$out->{my_IPs};
}
##############
elsif ( $page eq 'trends' ) {
# print STDERR "trends\n";
my (@ports,@portstats,);
$out = {
# port statistics
'port_intervals' => $config->{port_intvls},
'port_intvls' => $config->{port_intvls},
'ports' => \@ports, # scanned port list
'portstats' => \@portstats,
};
prep_report(\%tarpit,$out);
port_stats($out,$look_n_feel,$out);
$rpt = \$out->{port_intervals};
$image_cache = make_image_cache($look_n_feel->{images});
}
##############
elsif ( $page eq 'others' ) {
# print STDERR "others\n";
$out = {
'other_sites' => undef,
};
$report = q|<tr>
<td colspan=6 bgcolor="| . $look_n_feel->{bakgnd} . q|"><font size=3 face="| .
$look_n_feel->{face} . q|" color="| . $look_n_feel->{color} .
q|">This is the recent <b>Hacktivity</b> at other sites running<br>
LaBrea::Tarpit. To include your site in this list send an email
<blockquote>
To: <a
href="mailto:michael@bizsystems.com?Subject=LaBrea::Tarpit%20site">Michael@BizSystems.com</a><br>
Subject: LaBrea::Tarpit site
<p>
<i>containing the exact URL of your report script - i.e.</i>
<p>
http://www.foo.com/html_report.cgi
</blockquote>
To get the most recent list of sites using LaBrea::Tarpit, see:
<blockquote>
<a href="http://scans.bizsystems.net/other_sites.txt">scans.bizsystems.net/other_sites.txt</a><br>
or<br>
<a href="http://www.bizsystems.net/downloads/">www.bizsystems.net/downloads</a><br>
</blockquote></td></tr>
|;
other_sites($out,$look_n_feel,$out);
$_ = 'onClick="return(please_wait(this));"';
$out->{other_sites} =~ s|(http:[^\"]+\")|$1 $_|g;
$out->{other_sites} =~ s/<!-- INSERT MARKER -->/$report/o;
$rpt = \$out->{other_sites};
}
##############
elsif ( $page eq 'short' ) {
# print STDERR "short\n"; # prep short
$out = {};
gen_short($config,$out);
$error = $@;
$sht = \$short; # flag and pointer
short_report($sht,$out) unless $error;
undef $rpt;
}
if ( $error ) {
$upd = 1; # unconditional
undef $sht;
$page = 'error';
$report = qq|error, try again later.
<p>
The server said....
<p>
$error
|;
$rpt = \$report;
}
#elsif ( $upd && ! $sht ) { # new short report if update needed
# $sht = \$short;
# short_report($sht,$out);
#}
if ( $rpt ) { # if cache update needed
$logo_text = ' ' unless $logo_text;
## MAKE STANDARD TOP AND BUTTON BAR
$html = qq|<html><head>
<META NAME="ROBOTS" CONTENT=NOINDEX, NOFOLLOW">
<title>SpamCannibal $page</title>| .
($image_cache || '') . q|<style>
A.NU {
color: | . $look_n_feel->{color} . q|;
background: transparent;
font-family: | . $look_n_feel->{face} . q|;
font-weight: bold;
text-decoration: none;
}
</style>
<script language=javascript>
var pop_whois = null;
function popclose() {
if (pop_whois == null) return;
if (pop_whois.closed) return;
pop_whois.close();
}
var pwait = new Image();
pwait.src = "|. $look_n_feel->{images} . q|pwait01.gif";
var ref_url;
function please_wait(button) {
document.working.src = pwait.src;
ref_url = button.href;
// kludgy work around to get MSIE to display "please wait"
setTimeout("next_page()", 250);
return false;
}
function next_page() {
document.location.href = ref_url;
}
</script>
</head>
<body bgcolor="#ffffff" text="#ffcc33" vlink="#ffff00" link="#ffff00" onUnLoad="popclose();"><center>
<table border=0><tr><td valign=middle>| . $logo_text . qq|</td>
<td align=center valign=middle width=100%><font face="$look_n_feel->{face}" color="#000000" size=6>SpamCannibal $buttext{$page}</font></td></tr>
</table>
|;
# make a two column page
@_ = (@buttons,@extras);
$html .= q|<table cellspacing=0 cellpadding=5 border=0><tr><td valign=top>
| . make_buttons($look_n_feel,script_name,$page,\@_,$buttwidth) . q|<br>
<center>
<img name=working src="|. $look_n_feel->{images} . q|cleardot.gif" width=93 height=36 alt="">
</center></td><td valign=top align=center width=100%>
| . $$rpt . q|</td></tr>
<tr><td> </td><td align=center>
| . make_buttons($look_n_feel,script_name,$page,\@buttons) . q|</td></tr>
</table>
</body></html>
|;
$rpt = \$html;
}
## UPDATE CACHED PAGES
upd_cache($look_n_feel->{html_cache_file},$page,$rpt,$sht);
# the file
$_ = $look_n_feel->{html_cache_file} .'.'. $page;
$mtime = (stat($_))[9]; # file last modified
## SERVICE WEB REQUEST
local(*FH);
open(FH,$_);
my $size = (stat FH)[7];
my $ctype = ($page ne 'short') ? 'text/html' : 'text/plain';
my $xhead = 'X-LaBrea';
my $xhv = labrea_whoami;
####################################################
my $r;
eval { require Apache;
$r = Apache->request;
};
unless ($@) { # unless error, it's Apache
$r->status(200);
$r->content_type($ctype);
$r->header_out("Content-length","$size");
$r->header_out("Last-modified",http_date($mtime));
$r->header_out("Expires",http_date($mtime + $look_n_feel->{html_expire}));
$r->header_out($xhead,$xhv);
$r->send_http_header;
$r->send_fd(*FH);
close FH;
return 200; # HTTP_OK
} else { # sigh... no mod_perl
undef $/;
my $textp = <FH>; # slurp file
close FH;
$/ = "\n";
print q
|Content-type: |, $ctype, q|
Content-length: |, $size, q|
Last-modified: |, http_date($mtime), q|
Connection: close
Expires: |, http_date($mtime + $look_n_feel->{html_expire}), qq|
$xhead: $xhv
$textp|;
}
1;