#!/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|
&nbsp;<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>
&nbsp;&nbsp;&nbsp;&nbsp;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 = '&nbsp;' 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>
&nbsp;
<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>&nbsp;</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;