LaBrea::Tarpit::Report - tarpit log analysis and report
Index
- NAME
- SYNOPSIS
- DESCRIPTION - LaBrea::Tarpit::Report
-
- * generate($input,\%look_n_feel,\%output)
- * gen_short(($input,\%output);
- * syslog2_cache($input,\%config);
- * guests(\%report,\%look_n_feel,\%output);
- * guests_by_IP(\%report,\%look_n_feel,\%output);
- * capture_summary(\%report,\%look_n_feel,\%output);
- * got_away(\%report,\%look_n_feel,\%output);
- * my_IPs(\%report,\%look_n_feel,\%output);
- * $html=get_versions($report,\%look_n_feel,\%output,$dname);
- * other_sites(undef,\%look_n_feel,\%output);
- * $html=make_image_cache($pre,@images);
- * $html=make_jsPOP_win($name,$width,$height);
- * port_stats(\%report,\%look_n_feel,\%output);
- * short_report(\$report,\%out);
- * $html=make_port_graph($port,\%look_n_feel,$max,\@counts);
- * $html=make_buttons(\%look_n_feel,$url,$active,\@buttons,$xtra);
- * $rv = get_config(\%hash,\%look_n_feel) {
- * $hex=age2hex($age,$scale_factor);
- * $td_string=txt2td(\%config_hash,string);
- * $time_string=time2local($epoch_time,$tz);
- * $port_text=get_portname($port,\%trojan_list)
- * $port_text=Getservbyport($port,$proto);
- * $image_html=element($ht,$w,$alt,$img);
- * $color=pcolor($number);
- * @scaled_array=scale_array($sf,@array);
- * $max=max(@array);
- * $scriptname = scriptname();
- EXPORT_OK
- COPYRIGHT
- AUTHOR
- SEE ALSO
Code Index:
NAME
LaBrea::Tarpit::Report - tarpit log analysis and report
SYNOPSIS
use LaBrea::Tarpit::Report qw( ... );
generate($input,\%look_n_feel,\%output);
gen_short($input,\%output);
syslog2_cache($input,\%config);
guests(\%report,\%look_n_feel,\%output);
guests_by_IP(\%report,\%look_n_feel,\%output);
capture_summary(\%report,\%look_n_feel,\%output);
got_away(\%report,\%look_n_feel,\%output);
my_IPs(\%report,\%look_n_feel,\%output);
get_config(\%hash,\%look_n_feel);
get_versions($report,\%look_n_feel,\%output,$dname);
port_stats(\%report,\%look_n_feel,\%output);
short_report(\$report,\%out);
$html=make_buttons(\%look_n_feel,$url,$active,\@buttons,$xtra);
$html=make_port_graph($port,\%look_n_feel,$max,\@counts);
$html=make_image_cache($pre,@images);
$html=make_jsPOP_win($name,$width,$height);
utility subroutines (not exported)
$hex = age2hex($age,$scale_factor);
$td_string=txt2td(\%config_hash,string);
$time_string=time2local($epoch_time,$tz);
$port_text=get_portname($port,\%trojan_list)
$port_text=Getservbyport($port,$proto);
$image_html=element($ht,$w,$alt,$img);
$color=pcolor($number);
@scaled_array=scale_array($sf,@array);
$max=max(@array);
$scriptname=scriptname();
DESCRIPTION - LaBrea::Tarpit::Report
This modules provides a simple interface to the data generated by
the LaBrea::Tarpit reporting module. It is intended as an example
of how to interface to LaBrea::Tarpit and was patched together
hastily. When used with html_report.plx or paged_report.plx
found in the examples directory, it will produce an html pages
showing all the capabilities of LaBrea and the LaBrea::Tarpit module.
You should write your own version of
sub generate using it as a guide and the individual report
generation subroutines described below. sub generate is an
example routine that encompasses all the reports created by
this module.
- * generate($input,\%look_n_feel,\%output)
-
Returns false on success, error message $@ on failure.
Likely cause of failure is dameon not running
when attempting to open a connection to the daemon
input = '/path/to/cache_file'
or
hash->{d_host} [optional]
hash->{d_port} [optional]
hash->{d_timeout} [optional]
%look_n_feel ( # defaults shown
'face' => 'VERDANA,ARIAL,HELVETICA,SANS-SERIF',
'color' => '#ffffcc',
'bakgnd' => '#000000',
# below are all for port_intervals
'images' => 'path/to/images/', # REQUIRED
'height' => 72, # default
'width' => 7, # default
'legend' => 'text for graph', # optional
'threshold' => 2, # ignore below this count
'trojans' => \%trojans, # optional
# where %trojans is of the form
# ( # info not in /etc/services
# # port text
# 555 => 'phAse zero',
# 1243 => 'Sub-7',
# # etc....
# );
# SEE: examples/localTrojans.pl
# required html cache control
'html_cache_file' => './tmp/html_report.cache',# optional
'html_expire' => '5', # cache expiration, secs
# optional other_sites stats cache location
'other_sites' => './tmp/site_stats',
# optional whois action name
'whois' => 'whois', (as in whois.cgi)
);
Output hash, fills the values with html text if the
key->value pair exists, otherwise it's skipped.
%output ( # hash of the form:
'guests' => undef,
'guests_by_IP' => undef,
'capture_summary' => 5, # days to show
'got_away' => undef,
'my_IPs', => undef,
'date' => (is always inserted)
'port_intervals' => 30, num intervals to show
'versions' => header || 'undef',
'other_sites' => undef,
);
where the above hash will be filled with text
for the keys that you provide. Text generated
is of the form:
- * gen_short(($input,\%output);
-
sub gen_short takes similar arguments as generate, however the
%output array may be (usually is) empty. It will insert the minimum
information required in %output prior to a call to short_report.
Returns false on success, error message $@ on failure.
Likely cause of failure is dameon not running
when attempting to open the daemon fifo.
It produces the same results as:
prep_report(\%tarpit,\%out);
return $@;
for an empty %out starting hash
- * syslog2_cache($input,\%config);
-
Returns true, false on failure. Likely cause of
failure is a missing input log file or missing
or not writeable cache file.
$input path/to/log_file
%config same as Tarpit::daemon(\%hash)
except that 'LaBrea' and 'pid'
'pipe' are not required.
The cache file (if present) will be read
prior to adding the information from the log file
and will be created if not present at the end of
the log analysis. The cache file can then be used
by the generate routine (above) to create a report.
This is a demonstration routine. All of this can be
accomplished in one fell swoop using LaBrea::Tarpit
subroutine calls. Your are encouraged to write your
own versions of "generate" and "syslog2_cache"
- * guests(\%report,\%look_n_feel,\%output);
-
html table
4 lines of explanation
-
-
-
IP:Port->destPort | Held Since | IP:Port->destPort | Held Since
fills: %output{guests} with html table
returns: true on success
- * guests_by_IP(\%report,\%look_n_feel,\%output);
-
html table
2 lines of explanation
-
IP addr | # Threads | IP addr | # Threads | IP addr | # Threads |
fills: %output{guests_by_IP} with html table
returns true on success
- * capture_summary(\%report,\%look_n_feel,\%output);
-
html table
bandwidth
today
yesterday
-
prior days
fills: %output{capture_summary} with html table
returns: true on success
- * got_away(\%report,\%look_n_feel,\%output);
-
html table
3 lines of explanation
-
-
IP -> destPort | Last Scan | IP -> destPort | Last Scan
fills: %output{got_away} with html table
returns: undef or html text
- * my_IPs(\%report,\%look_n_feel,\%output);
-
input: \%report, pointer to report
\%look_n_feel, pointer to look and feel
\%output, pointer to output
html table
5 lines of explanation
-
-
-
-
IP | IP | IP | IP | IP
fills: %output{my_IPs} with html table
returns: true on success
- * $html=get_versions($report,\%look_n_feel,\%output,$dname);
-
Return html table of versions numbers, no border
$header
$dname nn.nn
Tarpit nn.nn
Report nn.nn
Util nn.nn
$dname defaults to 'LaBrea' if false
fills: %output{versions} with html table
returns: true on success
- * other_sites(undef,\%look_n_feel,\%output);
-
Generate a synopsis report of activity at
all sites using LaBrea::Tarpit that issue
a short_report. Report is a 6 column html
table with a marker comment at the beginning of the form:
<table ....>
<!-- INSERT MARKER -->
-----------------------------------------------------
| hyper-linked nmbr nmbr current last LaBrea |
| URL threads IP's bandwidth update version |
-----------------------------------------------------
| www.foo.com 323 106 118 string string |
-----------------------------------------------------
| etc.... |
-----------------------------------------------------
input: first parameter is "don't care"
to maintain compatibility with other
reports of the form:
\%report,\%look_n_feel,\%output
fills: %output{other_sites} with html table
returns: true on success
- * $html=make_image_cache($pre,@images);
-
Generate javascript code to cache a list of images
input: path to images,
list of images in addition to standard
returns: html for javascript
i.e.
<script language=javascript1.1>
var images=new Array(n);
for(var i = 0; i < n; n++) {
image[i] = new Image();
}
image[0] = "pre/image0";
.
.
</script>
- * $html=make_jsPOP_win($name,$width,$height);
-
This function makes the javascript code to generate a pop-up window. The
function name created is 'popwin', the name and size
are arguments to the function call.
input: window name,
width [optional - 500 def]
height [optional - 400 def]
returns: html text
The javascript function returns 'false'.
- * port_stats(\%report,\%look_n_feel,\%output);
-
generate html port statistics tables sorted by decending
port activity then ascending port numbers of the form:
(see &make_port_graph for details)
#######################################################
# #
# ##################### ##################### #
# # description # # example # #
# ##################### ##################### #
# #
# ##################### ##################### #
# # graph1 # # graph2 # #
# ##################### ##################### #
# #
# ##################### ##################### #
# # graph3 # # etc... # #
# ##################### ##################### #
# #
#######################################################
- * short_report(\$report,\%out);
-
Generate summary text of the form:
LaBrea=2.4b3
Tarpit=0.18
Report=0.14
Util=0.02
now=1018832056 *note:
tz=-0700
threads=462
total_IPs=243
bw=230
First call sub prep_report with %out, %out may be empty.
always returns true
Note: now is time since epoch at the site. To properly represent it at the origin
site do:
LaBrea::Tarpit::Util::their_date($now,$tz);
- * $html=make_port_graph($port,\%look_n_feel,$max,\@counts);
-
Return html table graph of @counts values
scaled, colored per look_n_feel for port
used internally by port_stats to create
individual port graphs.
Example 30 day shown:
port 31337
BackOrifice
1 max probes 138 30
--------------------------------
* *
* * *
* * * * * * *
** * ** *** * * * * * **
************* ** ** *** *** ***
************* ****** ******* ***
--------------------------------
- * $html=make_buttons(\%look_n_feel,$url,$active,\@buttons,$xtra);
-
Return the html text for a button bar
input: \%look and feel
url (if @buttons url !~ m|/|)
active button value (not text)
\@button array
xtra,
true = width of bar
false = horizontal and
$active = anchor tag
returns: html for button bar
@buttons is a list of the form = (
# text command
'BUTT1' => 'command1',
'BUTT2' => 'command2',
'' => '',
'BUTT3' => 'http://somewhere.com',
# buttons may include other text to include in the
# <a .... > tag separated by spaces
'BUTT4' => 'command onClick="somefunction();"',
#which will result in an atag containing the onClick function
);
If the button text is false,
a spacer is inserted in the button bar
NOTE: class NU must be defined
example:
<style>
A.NU {
color: red;
background: transparent;
font-family: "Helvetica";
font-weight: bold;
text-decoration: none;
}
</style>
- * $rv = get_config(\%hash,\%look_n_feel) {
-
Retrieves and stores the config information about the remote daemon process.
The resulting config file is used by my_IPs.
input: $hash->{d_host} [optional]
$hash->{d_port} [optional]
default is localhost:8686
$hash->{d_timeout} default 180
$look_n_feel->{html_cache_file}
returns: false on success
else error message
html_cache_file updated
Note: silently skips if %hash is
configured for file service
- * $hex=age2hex($age,$scale_factor);
-
html utility
Convert an age in seconds to a hex number
represented in ascii, range 00 -> FF
i.e.
with a scale factor of one,
0 -> FF
255 -> 00
The default scale factor, if omitted, is 3
- * $td_string=txt2td(\%config_hash,string);
-
html utility
Convert a string into a formated table
entry of the form:
<td align=xx bgcolor=yy>
<font face=aa size=nn color=RGB>
string
</font></td>
input: \%hash, text
where %hash = (
'face' => font face,
'size' => font size,
'f_clr' => font color,
'td_clr'=> table background color,
'align' => alignment statement,
);
missing items are not inserted into the table
returns: <td options>txt</td>
- * $time_string=time2local($epoch_time,$tz);
-
html utility
Convert seconds since the epoch to the form:
13:27:56 (-0800) 11-29-01
$tz = time zone or blank if missing.
- * $port_text=get_portname($port,\%trojan_list)
-
html utility
Looks up a port number first in %trojan_list
if present, then /etc/services (tcp then udp)
%trojans = ( # optional
port number => text description
);
returns: description
- * $port_text=Getservbyport($port,$proto);
-
html utility
replacement for getservbyport
which is broken for use in mod_perl 1.26
but works OK for plain cgi
- * $image_html=element($ht,$w,$alt,$img);
-
html utility
create html image text of the form
<img src=$img height=$ht width=$w hspace=1 alt="$alt">
- * $color=pcolor($number);
-
html utility
return color text based on input number
0 -> <10 blu
10 -> <100 ltb
100 -> <1000 grn
1000 -> <10000 org
10000 -> <100000 red
>= 100000 mag
- * @scaled_array=scale_array($sf,@array);
-
html utility
scale an array of values with SF
smallest non-zero value is 1
returns: @scaled_array
- * $max=max(@array);
-
html utility
return the maximum numeric value from
an array but not less than 1
- * $scriptname = scriptname();
-
html utility
Returns the scriptname of the caller from ENV{SCRIPT_NAME}
EXPORT_OK
capture_summary
generate
gen_short
get_config
get_versions
got_away
guests
guests_by_IP
make_buttons
make_image_cache
make_port_graph
make_jsPOP_win
my_IPs
other_sites
port_stats
short_report
syslog2_cache
time2local
valid_request
COPYRIGHT
Copyright 2002 - 2008, Michael Robinton & BizSystems
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.
AUTHOR
Michael Robinton, michael@bizsystems.com
SEE ALSO
perl(1), LaBrea::Tarpit(3), LaBrea::Codes(3), LaBrea::Tarpit::Get(3),
LaBrea::Tarpit::Util(3), LaBrea::Tarpit::DShield(3)
#!/usr/bin/perl
package LaBrea::Tarpit::Report;
#
use strict;
#use diagnostics;
use vars qw(
$VERSION
@ISA
@EXPORT_OK
$geek1
$geek2
$geek3
$hard_font_clr
$scan_font_clr
$h_ex_font_clr
$TCP
@std_images
);
$VERSION = do { my @r = (q$Revision: 1.16 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
use AutoLoader 'AUTOLOAD';
use LaBrea::Tarpit qw(
their_date
array2_tarpit
prep_report
process_log
cull_threads
write_cache_file
);
use LaBrea::Tarpit::Util qw(
ex_open
script_name
);
use LaBrea::NetIO qw(
fetch
);
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw (
capture_summary
generate
gen_short
get_versions
got_away
guests
guests_by_IP
make_image_cache
make_port_graph
my_IPs
port_stats
short_report
syslog2_cache
time2local
other_sites
make_buttons
get_config
make_jsPOP_win
);
# package variables
# address of GEEKS whois lookup
$geek1 = q|<a href="#top" onClick="popwin();whois.query.value='|;
$geek2 = q|';whois.submit();return false;" onMouseOut="status='';return true;" onMouseOver="status='|;
$geek3 = q|';return true;">|;
# colors
$hard_font_clr = '#ffffcc'; # hard captured font color
$scan_font_clr = '#990000'; # new arrival font color
$h_ex_font_clr = '#000099'; # hard exclude font color
# persistent protocol
$TCP = 6;
# standard images
@std_images = qw(
bludot.gif
cleardot.gif
grndot.gif
ltbdot.gif
magdot.gif
orgdot.gif
reddot.gif
yeldot.gif
);
# autoload declarations
sub generate;
sub gen_short;
sub syslog2_cache;
sub port_stats;
sub guests;
sub guests_by_IP;
sub capture_summary;
sub got_away;
sub my_IPs;
sub make_port_graph;
sub age2hex;
sub txt2td;
sub time2local;
sub get_portname;
sub Getservbyport;
sub element;
sub pcolor;
sub scale_array;
sub max;
sub get_versions;
sub init_lnf;
sub init_tdcfg;
sub tdcfg_font;
sub lnf_font;
sub inc255;
sub inc_ipv4;
sub next_ipv4;
sub range_ipv4;
sub short_report;
sub make_buttons;
sub other_sites;
sub make_image_cache;
sub get_config;
sub make_jsPOP_win;
sub scriptname;
sub DESTROY {};
1;
__END__
sub generate {
my ($input,$lnf,$out,$dname) = @_;
return "LaBrea::Tarpit::xxx_report: missing cache file"
unless exists $lnf->{html_cache_file} &&
$lnf->{html_cache_file} =~ m|(.*/)| &&
-d $1;
&init_lnf($lnf); # insert default font stuff if needed
my (%tarpit,@response);
my $err = fetch($input,\@response,'standard');
return "LaBrea::Tarpit::xxx_report: $err" if $err;
chop @response;
array2_tarpit(\%tarpit,\@response);
undef @response; # save space
if ( exists $out->{my_IPs} ) {
$err = get_config($input,$lnf);
return "LaBrea::Tarpit::xxx_report: $err" if $err;
}
my ( @tgsip,@tgsp,@tgdp,@tgcap,@tglst,@tgpst,
@thsip,@thnum,
@csdate,@csctd,
@phdip,@phpst,
@scsip,@scdp,@scpst,@sclst,
@ports,@portstats,
);
my $report = {
# teergrubed hosts
'tg_srcIP' => \@tgsip, # B<REQUIRED>
'tg_sPORT' => \@tgsp, # B<REQUIRED>
# 'tg_dstIP' => \@tgdip,
'tg_dPORT' => \@tgdp,
'tg_captr' => \@tgcap, # capture epoch time
'tg_last' => \@tglst, # last contact
'tg_prst' => \@tgpst, # persistent [true|false]
#
# threads per teergrubed host
'th_srcIP' => \@thsip, # B<REQUIRED>
'th_numTH' => \@thnum, # number threads this IP
#
# capture statistics # all fields B<REQUIRED>
'cs_days' => $out->{capture_summary} || undef,
'cs_date' => \@csdate, # epoch midnight of capt date
'cs_ctd' => \@csctd, # captured this date
#
# phantom IP's used (from our IP block)
'ph_dstIP' => \@phdip, # B<REQUIRED>
'ph_prst' => \@phpst, # persistent [true|false]
#
# scanning hosts lost
'sc_srcIP' => \@scsip, # B<REQUIRED>
'sc_dPORT' => \@scdp, # attacked port
'sc_prst' => \@scpst, # persistent [true|false]
'sc_last' => \@sclst, # last contact
#
# port statistics # all fields B<REQUIRED>
'port_intvls' => $out->{port_intervals} || undef,
'ports' => \@ports, # scanned port list
'portstats' => \@portstats,
# where @portstats = @stats_port1, @stats_port2, etc...
# always returned
# $hash{tz} = timezone, always filled if not present
# $hash{now} = epoch time of last load from cache
# $hash{bw} = bandwidth always filled
# $hash{total_IPs} = total teergrubed hosts
# $hash{threads} = total # of threads
# conditionally returned
# $hash{LaBrea} = version if known
# $hash{pt} = port activity collection interval
# $hash{tg_capt} = active hard captured (need tg_prst)
# $hash{phantoms} = total phantoms
# $hash{ph_capt} = phantoms that were hard captures
# $hash{sc_total} = total dropped scans
# $hash{sc_capt} = dropped hard capture (need sc_prst)
};
delete $report->{tg_srcIP} unless exists $out->{guests};
delete $report->{th_srcIP} unless exists $out->{guests_by_IP};
delete $report->{ph_dstIP} unless exists $out->{my_IPs};
delete $report->{sc_srcIP} unless exists $out->{got_away};
prep_report(\%tarpit,$report); # get stuff to display
$out->{date} = &time2local($report->{now}, $report->{tz});
%tarpit = (); # recover memory
&guests($report,$lnf,$out); # make tarpit guest list
&guests_by_IP($report,$lnf,$out); # make threads by IP with GEEKS hot link
&capture_summary($report,$lnf,$out); # make capture by day report
&got_away($report,$lnf,$out); # make lost threads and scanners report
&fetch($input,\@response,'config'); # fetch config file for next subroutine
&my_IPs($report,$lnf,$out); # make report for our IP block
&port_stats($report,$lnf,$out); # make port activity report
&get_versions($report,$lnf,$out,$dname); # make versions report
&other_sites($report,$lnf,$out); # make other site report
$out->{tz} = $report->{tz}; # insert values for short report
$out->{now} = $report->{now};
$out->{bw} = $report->{bw};
$out->{total_IPs} = $report->{total_IPs};
$out->{threads} = $report->{threads};
$out->{LaBrea} = $report->{LaBrea};
0;
} # end generate
sub gen_short {
my ($input,$out) = @_;
my (%tarpit,@response);
my $err = fetch($input,\@response,'short');
return "LaBrea::Tarpit::xxx_report: $err" if $err;
chop @response;
array2_tarpit($out,\@response);
undef @response; # save space
0;
} # end gen_short
sub syslog2_cache {
my ($input,$config) = @_;
my ($cache_file,$umask,$cull,$scrs,$ph,$pt) =
@{$config}{qw(cache umask cull scanners port_intvls port_timer)};
return undef if $input && ! -e $input && ! -r $input;
if ( $cache_file ) {
return undef if -e $cache_file && ! -r $cache_file && ! -w $cache_file;
};
$umask = 033 unless $umask;
$cull = LaBrea::Tarpit::defaults->{cull} unless $cull;
$ph = 0 unless $ph;
my %tarpit = (
'pt' => $pt,
);
return undef unless &process_log(\%tarpit,$input,0,$ph);
&cull_threads(\%tarpit, $cull, $scrs, $ph);
return write_cache_file(\%tarpit,$cache_file,$umask,0);
}
###########
########### make the tarpit guest list
###########
#
# input: \%report,\%look_n_feel,\%output
# fills: %output{guests} with html table
# returns: undef or html text
#
sub guests {
my ($report,$lnf,$out) = @_;
return undef unless exists $out->{guests};
&init_lnf($lnf); # insert default font stuff if needed
my $tdcfg = {};
&init_tdcfg($lnf,$tdcfg);
my $col = 0; # left or right column
my $font = &tdcfg_font($tdcfg);
# headers first
$out->{guests} = q|<!-- GUESTS -->
<a name="GUESTS"></a>
<table cellspacing=1 cellpadding=2 border=2>
<tr><td colspan=4
bgcolor="|. $tdcfg->{td_clr} . q
|"><|. $font . q|> IP addresses shown in <font
color="#ffcc00"><b>ORANGE</b></font> thru <font
color="#00cc00"><b>GREEN</b></font> have just dipped their toe in the Tarpit.</font></td>
<tr><td colspan=3
bgcolor="|. $tdcfg->{td_clr} . q
|"><|. $font . q|> <font
color="#aacc00"><b>FADING</b></font> color shows they've not sent WIN probes and may escape</font></td>
<td bgcolor="|. $tdcfg->{td_clr} . q
|"><table cellspacing=0 cellpadding=0 border=0 width=100%>
<tr><td bgcolor="#ffcc00"> </td><td bgcolor="#cccc00"> </td><td bgcolor="#aacc00"> </td><td bgcolor="#99cc00"> </td><td bgcolor="#66cc00"> </td><td bgcolor="#33cc00"> </td>
</tr></table>
</td></tr>
<tr><td colspan=4
bgcolor="|. $tdcfg->{td_clr} . q
|"><|. $font . q|> IP addresses shown in shades of <b><font
color="#ff0000">RED</b></font> are captured and held in a persistent state.</font></td>
<tr><td colspan=3
bgcolor="|. $tdcfg->{td_clr} . q
|"><|. $font . q|> The brighter the <b><font
color="#ff0000">RED</b></font> the more recently they've sent a WIN probe</font></td>
<td bgcolor="|. $tdcfg->{td_clr} . q
|"><table cellspacing=0 cellpadding=0 border=0 width=100%>
<tr><td bgcolor="#ff0000"> </td><td bgcolor="#cc0000"> </td><td bgcolor="#aa0000"> </td><td bgcolor="#990000"> </td><td bgcolor="#660000"> </td><td bgcolor="#330000"> </td>
</tr></table>
</td></tr>
|;
$out->{guests} .= '<tr>' .
&txt2td($tdcfg,'<b>IP:Port->destPort</b>').
&txt2td($tdcfg,'<b>Held Since</b>').
&txt2td($tdcfg,'<b>IP:Port->destPort</b>').
&txt2td($tdcfg,'<b>Held Since</b>'). q|</tr>
|;
# adjust configuration for body of table
$tdcfg->{size} = 2;
delete $tdcfg->{align};
# generate list of IP's and aging
foreach(0..$#{$report->{tg_srcIP}}) {
$tdcfg->{td_clr} = '#'. &age2hex($report->{now} - $report->{tg_last}->[$_]);
if ($report->{tg_prst}->[$_] == $TCP) { # if hard captured
$tdcfg->{f_clr} = $hard_font_clr;
$tdcfg->{td_clr} .= '0000';
} else {
$tdcfg->{f_clr} = $scan_font_clr;
$tdcfg->{td_clr} .= 'cc00';
}
$out->{guests} .= '<tr>' unless $col;
$out->{guests} .= &txt2td($tdcfg,$report->{tg_srcIP}->[$_] .
':'.$report->{tg_sPORT}->[$_].'->'.$report->{tg_dPORT}->[$_]);
$out->{guests} .= &txt2td($tdcfg,time2local($report->{tg_captr}->[$_], $report->{tz}));
$col = !$col;
$out->{guests} .= "</tr>\n" unless $col;
}
$tdcfg->{td_clr} = $lnf->{bakgnd};
$out->{guests} .= &txt2td($tdcfg,' ') . &txt2td($tdcfg,' ') . "</tr>\n" if $col;
$out->{guests} .= q|</table>
<!-- END GUESTS -->
|;
1; # returns true
} ## end guests report
sub _geek2whois {
my($formname) = @_;
# whois form names
(my $g1 = $geek1) =~ s/whois/$formname/g;
(my $g2 = $geek2) =~ s/whois/$formname/g;
(my $g3 = $geek3) =~ s/whois/$formname/g;
return($g1,$g2,$g3);
}
########
######## generate threads by IP with GEEKS hot link
########
# input: \%report,\%look_n_feel,\%output
# fills: %output{guests_by_IP} with html table
# returns undef or html text
#
sub guests_by_IP {
my ($report,$lnf,$out) = @_;
return undef unless exists $out->{guests_by_IP};
my $col = 0; # left or right column
# whois name
my $whois = $lnf->{whois} || 'whois';
# whois form names
my($g1,$g2,$g3) = _geek2whois('whoisg');
# get page extension
scriptname() =~ /\.([a-zA-Z_-]+)/;
my $ext = $1;
# headers first
&init_lnf($lnf); # insert default font stuff if needed
my $tdcfg = {};
&init_tdcfg($lnf,$tdcfg);
$tdcfg->{size} = 2;
my $font = &tdcfg_font($tdcfg);
$out->{guests_by_IP} = q|<!-- GUESTS BY IP -->
<a name="GUESTS BY IP"></a><form name=whoisg action="|. $whois .'.'. $ext .q|" method=GET target=pop_whois>
<input type=hidden name=query value="">
<table cellspacing=1 cellpadding=2 border=2>
<tr align=center><td colspan=6
bgcolor="|. $tdcfg->{td_clr} . q
|"><|. $font . q|> <b><font size=+1>| .
$report->{threads} . q
|</font> total threads captured, from these <font size=+1>| . $report->{total_IPs} . q
|</font> IP addresses</b></font></td></tr>
<tr align=center><td colspan=6
bgcolor="|. $tdcfg->{td_clr} .q
|"><|. $font .q|<b><i>Click on an IP for WHOIS information</i></b></font>|.
make_jsPOP_win('pop_whois') .q|</td></tr>
|;
$tdcfg->{size} = 3;
$tdcfg->{align} = 'center';
$out->{guests_by_IP} .= q|<tr>|.
&txt2td($tdcfg,'<b>IP</b>') .
&txt2td($tdcfg,'<b>Threads</b>') .
&txt2td($tdcfg,'<b>IP</b>') .
&txt2td($tdcfg,'<b>Threads</b>') .
&txt2td($tdcfg,'<b>IP</b>') .
&txt2td($tdcfg,'<b>Threads</b>') . q|</tr>
|;
$col = 0;
foreach(0..$#{$report->{th_srcIP}}) {
delete $tdcfg->{align};
$out->{guests_by_IP} .= '<tr>' unless $col;
$out->{guests_by_IP} .= &txt2td($tdcfg,$g1 .
$report->{th_srcIP}->[$_] . $g2 .
$report->{th_srcIP}->[$_] . $g3 .
$report->{th_srcIP}->[$_] . '</a>');
$tdcfg->{align} = 'center';
$out->{guests_by_IP} .= &txt2td($tdcfg,$report->{th_numTH}->[$_]);
unless ( ++$col < 3 ) {
$out->{guests_by_IP} .= "</tr>\n";
$col = 0;
}
}
if ( $col ) {
while ($col++ < 3) {
$out->{guests_by_IP} .= &txt2td($tdcfg,' ') . &txt2td($tdcfg,' ');
}
}
$out->{guests_by_IP} .= q|</tr></table></form>
<!-- END GUESTS BY IP -->
|;
1;
} # end guests_by_IP report
#######
####### generate capture by day report
#######
#
# input: \%report,\%look_n_feel,\%output
# fills: %output{capture_summary} with html table
# returns: undef or html text
#
sub capture_summary {
my ($report,$lnf,$out) = @_;
return undef unless exists $out->{capture_summary};
my $tdcfg = {};
&init_lnf($lnf); # insert default font stuff if needed
&init_tdcfg($lnf,$tdcfg);
$tdcfg->{size} = 2;
my $font = &tdcfg_font($tdcfg);
$out->{capture_summary} = q|<!-- CAPTURE SUMMARY -->
<a name="CAPTURE SUMMARY"></a>
<table cellspacing=1 cellpadding=2 border=2 width=100%>
<tr><td colspan=2 align=center
bgcolor="|. $tdcfg->{td_clr} . q
|"><|. $font . q
|>Current bandwidth <b><font size=+1>| . $report->{bw} . q|</font> (bytes/sec)</font></td></tr>
|;
foreach(0..$#{$report->{cs_date}}) {
my ($day,$mon,$year) = (localtime($report->{cs_date}->[$_]))[3,4,5];
$mon++;
$year %= 100;
delete $tdcfg->{align};
if ( $_ == $#{$report->{cs_date}} ) {
$out->{capture_summary} .= '<tr>'. &txt2td($tdcfg,'Captured on previous days: ');
} else {
$out->{capture_summary} .= '<tr>'. &txt2td($tdcfg,sprintf("Threads captured %02.0f-%02.0f-%02.0f",$mon,$day,$year));
}
$tdcfg->{align} = 'center';
$out->{capture_summary} .= &txt2td($tdcfg,$report->{cs_ctd}->[$_]) . "</tr>\n";
}
$out->{capture_summary} .= q|</table>
<!-- END CAPTURE SUMMARY -->
|;
1;
} # end capture_summary report
#######
####### generate report for lost threads and scanners
#######
#
# input: \%report,\%look_n_feel,\%output
# fills: %output{got_away} with html table
# returns: true on success
#
sub got_away {
my ($report,$lnf,$out) = @_;
return undef unless exists $out->{got_away};
# whois name
my $whois = $lnf->{whois} || 'whois';
# whois geeks
my($g1,$g2,$g3) = _geek2whois('whoisa');
# get page extension
scriptname() =~ /\.([a-zA-Z_-]+)/;
my $ext = $1;
my $tdcfg = {};
&init_lnf($lnf); # insert default font stuff if needed
&init_tdcfg($lnf,$tdcfg);
my $font = &tdcfg_font($tdcfg);
my $scanned = $report->{sc_total} - $report->{sc_capt};
$_ = q|<tr><td colspan=4 border=0 bgcolor="|. $tdcfg->{td_clr} . q|"> |;
$out->{got_away} = q|<!-- GOT AWAY -->
<a name="GOT AWAY"></a><form name=whoisa action="|. $whois .'.'. $ext .q|" method=GET target=pop_whois>
<input type=hidden name=query value="">
<table cellspacing=1 cellpadding=2 border=2>
| . $_ . q|These IP addresses have scanned our IP block recently but are no longer probing.</td></tr>
| . $_ . ($report->{sc_capt}) . q
| IP addresses in: <font size=+1 color="#ff0000"><b>RED</b></font> were persistent, then gave up or were detached by the owner.</td></tr>
| . $_ . $scanned . q
| IP addresses in: <font size=+1 color="#00aa00"><b>GREEN</b></font> briefly scanned our IP block and escaped.</font>
</td></tr>
<tr align=center><td colspan=4 bgcolor="|. $tdcfg->{td_clr} . q|"><|. $font . q
|> <b><i>Click on an IP for WHOIS information</i></b></font>|.
make_jsPOP_win('pop_whois') .q|</td></tr>
|;
$out->{got_away} .= '<tr>' .
&txt2td($tdcfg,'<b>IP -> destPort</b>').
&txt2td($tdcfg,'<b>Last Scan</b>').
&txt2td($tdcfg,'<b>IP -> destPort</b>').
&txt2td($tdcfg,'<b>Last Scan</b>'). q|</tr>
|;
$tdcfg->{size} = 2;
delete $tdcfg->{align};
my $col = 0;
foreach(0..$#{$report->{sc_srcIP}}) {
$out->{got_away} .= '<tr>' unless $col;
$tdcfg->{td_clr} = ($report->{sc_prst}->[$_] == $TCP) ? '#cc0000' : '#009900';
$out->{got_away} .= &txt2td($tdcfg,$g1 .
$report->{sc_srcIP}->[$_] . $g2 .
$report->{sc_srcIP}->[$_] . $g3 .
$report->{sc_srcIP}->[$_] . '</a>'.' -> '. $report->{sc_dPORT}->[$_]);
$out->{got_away} .= &txt2td($tdcfg,time2local($report->{sc_last}->[$_], $report->{tz}));
$col = !$col;
$out->{got_away} .= "</tr>\n" unless $col;
}
$tdcfg->{td_clr} = $lnf->{bakgnd};
$out->{got_away} .= &txt2td($tdcfg,' ') . &txt2td($tdcfg,' ') . "</tr>\n" if $col;
$out->{got_away} .= q|</table></form>
<!-- END GOT AWAY -->
|;
1;
} # end got_away report
#######
####### generate report for our IP block
#######
#
# input: \%report,\%look_n_feel,\%output
# fills: %output{my_IPs} with html table
# returns: undef or html text
#
sub my_IPs {
my ($report,$lnf,$out) = @_;
return undef unless exists $out->{my_IPs};
my $tdcfg = {};
&init_lnf($lnf); # insert default font stuff if needed
&init_tdcfg($lnf,$tdcfg);
$tdcfg->{size} = 2;
my $font = &tdcfg_font($tdcfg);
local *F;
my %phantoms;
@phantoms{@{$report->{ph_dstIP}}} = @{$report->{ph_prst}};
# check for excluded IP's
# set %phantom values
# 0 = scanned only
# 1 = captured last thread
# 2 = excluded from hard, scanner present
# 3 = excluded
# 4 = inactive hard capture excluded
# 5 = ERROR, IP hard captured but in hard exclusion list
# 6 = ERROR, IP in exclusion list appears in phantom report
while(my($key,$val) = each %phantoms) {
$phantoms{$key} = ($val == $TCP) ? 1:0; # preset initial state
}
my $exclusions = 0;
my $h_exclusions = 0;
my $h_empty = 0;
my ($lo,$hi,@exclude, @hard_x);
my $exclude = '/etc/LaBreaExclude'; # preset defaults
my $hard_ex = '/etc/LaBreaHardExclude';
my $config = 0;
# find any preset config file info
if ( exists $lnf->{html_cache_file} &&
-e $lnf->{html_cache_file}.'.config' &&
open(F,$lnf->{html_cache_file}.'.config')) {
while (<F>) {
next unless $_ =~ /exclude/; # find lines with exclusion info
if ( $_ =~ /(\d+\.\d+\.\d+\.\d+)\s*\-\s*(\d+\.\d+\.\d+\.\d+)/ ) { # if range
$lo = $1;
$hi = $2;
} elsif ( $_ =~ /(\d+\.\d+\.\d+\.\d+)/ ) {
$lo = $hi = $1;
} else {
next;
}
if ( $_ =~ /hard/ ) { # if hard exclude
push @hard_x, &range_ipv4($lo,$hi);
} else {
push @exclude, &range_ipv4($lo,$hi);
}
}
close F;
}
# create array entries for exclusions
foreach(@exclude) {
$phantoms{$_} = (exists $phantoms{$_})
? 6 # should not happen
: 3;
++$exclusions;
}
foreach(@hard_x) {
if (exists $phantoms{$_}) {
if ($phantoms{$_}) { # error if hard capture found
$phantoms{$_} = 5;
} else {
$phantoms{$_} = 2;
}
++$h_exclusions;
} else {
++$h_empty; # not in current list
}
}
my $hard_captures = $report->{ph_capt} || 0;
my $soft_phantoms = ($report->{phantoms} || 0) - $hard_captures - $h_exclusions;
$_ = q|<tr><td colspan=5 bgcolor="|. $tdcfg->{td_clr} . q|"><|. $font . q|> |;
$out->{my_IPs} = q|<!-- LOCAL IP BLOCK -->
<a name="LOCAL IP BLOCK"></a>
<table cellspacing=1 cellpadding=2 border=2>
|. $_ . $exclusions . q| IP addresses excluded (plain background)</td></tr>
|. $_ . $h_empty . q| inactive IP's excluded from persistent capture (<font size+1 color="#0000ff"><b>BLUE</b></font>)
|. $_ . $h_exclusions . q| probed IP's active but excluded from persistent capture (<font size+1 color="#00cc00"><b>GREEN</b></font>)
|. $_ . $soft_phantoms . q| probed IP's that have been recently scanned (<font size+1 color="#ffcc00"><b>ORANGE</b></font>)
|. $_ . $hard_captures . q| probed IP's that have persistent trapped a scanner (<font size+1 color="#FF0000"><b>RED</font>)
</font></td></tr>
|;
$tdcfg->{size} = 3;
$tdcfg->{align} = 'center';
$out->{my_IPs} .= '<tr>';
foreach(0..4) {
$out->{my_IPs} .= &txt2td($tdcfg,'<b>IP</b>');
}
$out->{my_IPs} .= "</tr>\n";
delete $tdcfg->{align};
my %sortip;
foreach (keys %phantoms) {
@_ = split('\.',$_);
$sortip{sprintf("%03d%03d%03d%03d",@_)} = $_;
}
my $col = 0;
foreach (sort keys %sortip) {
# 0 = scanned only
# 1 = captured last thread
# 2 = excluded from hard, scanner present
# 3 = excluded
# 4 = inactive hard capture excluded
# 5 = ERROR, IP hard captured but in hard exclusion list
# 6 = ERROR, IP in exclusion list appears in phantom report
$_ = $sortip{$_};
my $state = $phantoms{$_};
if (!$state) { # 0 = scanned only
$tdcfg->{td_clr} = '#ffcc00'; # ORANGE
$tdcfg->{f_clr} = $scan_font_clr;
}
elsif ( $state == 1 ) { # 1 = captured last thread
$tdcfg->{td_clr} = '#cc0000'; # RED
$tdcfg->{f_clr} = $hard_font_clr;
}
elsif ( $state == 2 ) { # 2 = excluded from hard, scanner present
$tdcfg->{td_clr} = '#00cc00'; # GREEN
$tdcfg->{f_clr} = $hard_font_clr;
}
elsif ( $state == 3 ) { # 3 = excluded
$tdcfg->{td_clr} = $lnf->{bakgnd};
$tdcfg->{f_clr} = $lnf->{color};
}
elsif ( $state == 4 ) { # 4 = inactive hard capture excluded
$tdcfg->{td_clr} = '#000099'; # BLUE
$tdcfg->{f_clr} = $hard_font_clr;
}
elsif ( $state == 5 ) { # 5 = ERROR, IP hard captured but in hard exclusion list
$tdcfg->{td_clr} = '#AA00AA'; # INDIGO
$tdcfg->{f_clr} = $hard_font_clr;
}
else { # 6 = ERROR, IP in exclusion list appears in phantom report
$tdcfg->{td_clr} = '#ff00ff'; # VIOLET
$tdcfg->{f_clr} = $hard_font_clr;
# $_ = ($state < 6)
# ? 'prog ERROR, hard exclude IP'
# : 'prog ERROR, excluded IP';
}
$out->{my_IPs} .= '<tr>' unless $col;
$out->{my_IPs} .= &txt2td($tdcfg,$_);
unless ( ++$col < 5 ) {
$out->{my_IPs} .= "</tr>\n";
$col = 0;
}
}
$tdcfg->{td_clr} = $lnf->{bakgnd};
if ( $col ) {
while ($col++ < 5) {
$out->{my_IPs} .= &txt2td($tdcfg,' ');
}
}
$out->{my_IPs} .= q|</tr></table>
<!-- END LOCAL IP BLOCK -->
|;
1;
} # end my_IPs report
#######
####### generate versions report
#######
#
# input: \%report,\%look_n_feel,\%output
# fills: %output{versions} with html table
# returns: true on success
#
#
sub get_versions {
my ($p,$lnf,$out,$dname) = @_;
return undef unless exists $out->{versions};
$dname = 'LaBrea' unless $dname;
my $comment = $out->{versions} || ' ';
&init_lnf($lnf); # insert default font stuff if needed
my $font = &lnf_font($lnf,3);
$out->{versions} = q|<!-- VERSIONS -->
<a name="VERSIONS"></a>
<table cellspacing=0 cellpadding=0 border=0>
<tr><td align=center bgcolor=| . $lnf->{bakgnd} .
qq|><tr><td colspan=3 align=center><${font}>${comment}</font></td></tr>
<tr>
<td bgcolor=| . $lnf->{bakgnd} . qq|><${font}>$dname<br>
Tarpit<br>
Report<br>
Util</font></td>
<td width=10> </td>
<td align=center bgcolor=| . $lnf->{bakgnd} . qq|><${font}>| . ($p->{LaBrea} || 'unknown') . q|<br>
| . $LaBrea::Tarpit::VERSION . q|<br>
| . $LaBrea::Tarpit::Report::VERSION . q|<br>
| . $LaBrea::Tarpit::Util::VERSION . q|</font></td></tr>
</table>
<!-- END VERSIONS -->
|;
1;
}
sub other_sites {
my ($report,$lnf,$out) = @_;
local *F;
return undef unless
exists $out->{other_sites} && # report wanted?
exists $lnf->{other_sites} && # stats present
$lnf->{other_sites} &&
-e $lnf->{other_sites} &&
-r $lnf->{other_sites} &&
open(F,$lnf->{other_sites});
# file exists, generate the report frame
#
my $not_available = 1;
&init_lnf($lnf); # insert default font stuff if needed
my $font = &lnf_font($lnf,2);
$out->{other_sites} = q|<!-- OTHER SITES -->
<a name="OTHER SITES"></a>
<table cellspacing=0 cellpadding=2 border=2>
<!-- INSERT MARKER -->
<tr align=center>
|;
foreach('click for<br>detailed report','# of<br>threads',"# of<br>IP's", 'BW<br>bytes','last<br>update','Tarpit<br>version') {
$out->{other_sites} .= q|<td bgcolor="| . $lnf->{bakgnd} . qq|"><${font}>$_</font></td>\n|;
}
$out->{other_sites} .= qq|</tr>\n|;
my ($url,$link,$threads,$ips,$bw,$time,$tz,$ver,$err);
while ($_ = <F>) { # read the site list
$err = '';
# url threads ips bw time timezone version
if ( $_ =~ m|^http://([^\s]+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+([\+\-\d]+)\s+([^\s]+)|i ) {
$url = $1;
$threads = $2;
$ips = $3;
$bw = $4;
$time = $5;
$tz = $6;
$ver = $7;
$time = their_date($time,$tz);
} # url error
elsif ( $_ =~ m|^http://([^\s]+)\s+(.*)| ) {
$url = $1;
$err = $2 || 'unknown error';
}
elsif ( $_ !~ m|^http://([^\s]+)|i ) {
next; # must be a comment
} else { # matched
$url = $1;
$err = 'unknown ERROR';
}
$not_available = 0;
$url =~ m|([^:/]+)|;
$link = $1; # extract link text
if ($err) {
$out->{other_sites} .= q|<tr>
<td bgcolor="| . $lnf->{bakgnd} . qq|"><${font}><a href="http://$url">$link</a></font></td>
<td align=center colspan=5 bgcolor="| . $lnf->{bakgnd} . qq|"><${font}>$err</font></td>
</tr>
|;
} else {
$out->{other_sites} .= q|<tr align=center>
<td align=left bgcolor="| . $lnf->{bakgnd} . qq|"><${font}><a href="http://$url">$link</a></font></td>
<td bgcolor="| . $lnf->{bakgnd} . qq|"><${font}>$threads</font></td>
<td bgcolor="| . $lnf->{bakgnd} . qq|"><${font}>$ips</font></td>
<td bgcolor="| . $lnf->{bakgnd} . qq|"><${font}>$bw</font></td>
<td bgcolor="| . $lnf->{bakgnd} . qq|"><${font}>$time</font></td>
<td bgcolor="| . $lnf->{bakgnd} . qq|"><${font}>$ver</font></td>
</tr>
|;
}
}
close F;
$out->{other_sites} .= q|<tr><td colspan=6 align=center bgcolor="| . $lnf->{bakgnd} . qq|"><${font}>Not Available</font></td></tr>
| if $not_available;
$out->{other_sites} .= q|</table>
<!-- END OTHER SITES -->
|;
1;
}
sub make_image_cache {
my $pre = shift;
my @images = (@std_images,@_);
my $html = q|
<script language=javascript1.1>
var images = new Array(| . @images . q|);
for (var i = 0; i < | . @images . q|; i++) {
images[i] = new Image();
}
|;
foreach(0..$#images) {
$html .= qq|images[$_] = "${pre}$images[$_]";\n|;
}
$html .= qq|</script>\n|;
}
sub make_jsPOP_win {
my($name,$width,$height) = @_;
$width = 500 unless $width;
$height = 400 unless $height;
my $html = q|
<script language=javascript1.1>
function popwin() {
|. $name .q| = window.open ( "","|. $name .q|",
"toolbar=no,menubar=no,location=no,scrollbars=yes,status=yes,resizable=yes," +
"width=|. $width .q|,height=|. $height .q|");
if (|. $name .q|.opener == null ) |. $name .q|.opener = self;
|. $name .q|.document.open();
|. $name .q|.document.writeln('<html><body bgcolor="#ffffcc"></body></html>');
|. $name .q|.document.close();
|. $name .q|.focus();
return false;
}
</script>
|;
}
#######
####### generate ip hits by port
#######
#
# input: \%report,\%look_n_feel,\%output
# fills: %output{port_intervals} with html table
# returns: true on success
#
sub port_stats {
my ($report,$lnf,$out) = @_;
return undef unless exists
$out->{port_intervals} &&
$out->{port_intervals}; # non zero
# unless ( $images_checked ) { # mod perl remembers
# $images_checked = 1;
# my $err = '';
# if ( $lnf->{images} ) {
# foreach(0..$#std_images) {
# $_ = $lnf->{images} . $std_images[$_];
# $err .= $_ . "<br>\n" unless -e $_;
# }
# } else {
# $err = 'image directory';
# }
# return ($out->{port_intervals} = "LaBrea::Tarpit::Report, can't find<br>\n$err")
# if $err;
# }
my $pintvl = $out->{port_intervals};
&init_lnf($lnf); # insert default font stuff if needed
$lnf->{width} = 7 unless $lnf->{width}; # set default
my $threshold = $lnf->{threshold} || 2; # set default
# create ordering hash's
my %ports; # order to present ports
# of the form
# (
# port => data => @data
# max => max value
# );
my @null; # null array
$#null = $pintvl -1; # empty
foreach(0..$#{$report->{ports}}) {
my $i = $_ * $pintvl; # index into data
my $port = $report->{ports}->[$_];
# port number
@{$ports{$port}->{data}} =
splice(@{$report->{portstats}},$i,$pintvl,@null);
$ports{$port}->{max} = &max(@{$ports{$port}->{data}});
delete $ports{$port}
if $ports{$port}->{max} < $threshold;
}
delete $report->{portstats}; # recover memory
delete $report->{ports};
# explaination and example first, then headers
# return color text based on input number
#
# 0 -> <10 blu
# 10 -> <100 ltb
# 100 -> <1000 grn
# 1000 -> <10000 org
# 10009 -> <100000 red
# >= 100000 mag
my @xary; # value
foreach (0..$pintvl -1) {
$xary[$_] = 1;
}
# mag mag red org grn ltb blu
@_ = (100007,100007,50004,9999, 999, 99); # the rest are blu
foreach(0..$#_) {
$xary[$_] = $_[$_];
}
$xary[$#xary] = 8; # marker, still blu
my $max = $xary[0];
my %xlnf = %$lnf;
$xlnf{trojans} = {12345 => 'trojan or port service description'};
$xlnf{legend} = 'maximum probes';
my $desc = 'day';
my $int = $report->{pt} / 86400;
if ( $report->{pt} < 3600 ) {
$desc = 'minute';
$int = $report->{pt} / 60;
} elsif ( $report->{pt} < 86400 ) {
$desc = 'hour';
$int = $report->{pt} / 3600;
}
$int = sprintf("%d",$int);
my $notation = q| align=left><font color="| .
$lnf->{color} . q|" size=2 face="| .
$lnf->{face} . qq|">$pintvl, $int $desc bars scaled to max<br>|;
my $trailer = q|><br>newest ... to ... oldest</font>|;
my $example = &make_port_graph(12345,\%xlnf,$max,\@xary);
# insert clear dot
$example =~ s/magdot/cleardot/;
$example =~ s/72/80/; # make table taller
$example =~ s/height/HEIGHT/; # ignore cleardot
$example =~ s/height=[^\>]+/HEIGHT=36/; # mag
$example =~ s/height=[^\>]+/HEIGHT=25/; # red
$example =~ s/height=[^\>]+/HEIGHT=18/; # org
$example =~ s/height=[^\>]+/HEIGHT=12/; # grn
$example =~ s/height=[^\>]+/HEIGHT=8/; # light blue
$example =~ s/height=[^\>]+/HEIGHT=4/; # 1st blu
$example =~ s/height=[^\>]+/HEIGHT=2/; # 2nd blu
# insert body notation and trailer
# $example =~ s/hspace=1\s+width=[^\s]+/hspace=1 width=1/;
$example =~ s/(alt=[^\>]+)>/$1$notation/;
$example =~ s/(alt=.*8[^\>]+)>/${1}$trailer/;
my $font1 = &lnf_font($lnf,1);
my $font2 = &lnf_font($lnf,2);
my $twidth = ($lnf->{width} + 2) * $pintvl;
my $explain = q|<table cellspacing=0 cellpadding=2 border=3>
<tr><td bgcolor="| . $lnf->{bakgnd} . qq|" align=center width=$twidth><${font2}>
Port activity of $threshold or more probes per<br>
interval normalized to the maximum<br>
value and color coded for frequency</font></td></tr>
<tr><td bgcolor=| . $lnf->{bakgnd} . q| valign=middle align=center><img src=| .
$lnf->{images} . qq|cleardot.gif height=80 width=1 alt="" align=left>
<table cellspacing=0 cellpadding=0 border=0>
<tr><td><${font1}> 0 </font></td><td><${font1}>-> < 10</font></td><td>| .
&element($lnf->{width},20,'blue',$lnf->{images}.'bludot.gif') . qq|</td></tr>
<tr><td><${font1}>10 </font></td><td><${font1}>-> < 100</font></td><td>| .
&element($lnf->{width},20,'light blue',$lnf->{images}.'ltbdot.gif') . qq|</td></tr>
<tr><td><${font1}>100 </font></td><td><${font1}>-> < 1000</font></td><td>| .
&element($lnf->{width},20,'green',$lnf->{images}.'grndot.gif') . qq|</td></tr>
<tr><td><${font1}>1000 </font></td><td><${font1}>-> < 10000</font></td><td>| .
&element($lnf->{width},20,'orange',$lnf->{images}.'orgdot.gif') . qq|</td></tr>
<tr><td><${font1}>10000 </font></td><td><${font1}>-> < 100000 </font></td><td>| .
&element($lnf->{width},20,'red',$lnf->{images}.'reddot.gif') . qq|</td></tr>
<tr><td></td><td><${font1}> >= 100000</font></td><td>| .
&element($lnf->{width},20,'magenta',$lnf->{images}.'magdot.gif') . q|</td></tr>
</table></td>
</tr>
</table>
|;
$out->{port_intervals} = q|<!-- PORT STATISTICS -->
<a name="PORT STATISTICS"></a>
<table cellspacing=20 cellpadding=0 border=0>
<tr><td>| . $explain . q|</td><td>| . $example . q|</td></tr>
|;
my $col = 0; # left or right column
foreach my $port (sort {
if ( $ports{$a}->{max} == $ports{$b}->{max} ) {
$a <=> $b;
} else {
$ports{$b}->{max} <=> $ports{$a}->{max};
}
} keys %ports ) {
if ( $col++ ) {
$col = 0;
} else {
$out->{port_intervals} .= q|<tr align=center valign=middle>
|;
}
$out->{port_intervals} .= q|<td>| .
&make_port_graph($port,$lnf,$ports{$port}->{max},$ports{$port}->{data}) .
q|</td>
|;
$out->{port_intervals} .= q|</tr>
| unless $col;
}
$out->{port_intervals} .= q|<td> </td></tr>
| if $col;
$out->{port_intervals} .= q|</table>
<!-- END PORT STATISTICS -->
|;
1;
} # end of port_stats
sub short_report {
my($report,$out) = @_;
$out->{Tarpit} = $LaBrea::Tarpit::VERSION
unless $out->{Tarpit};
$out->{Report} = $LaBrea::Tarpit::Report::VERSION;
$out->{Util} = $LaBrea::Tarpit::Util::VERSION;
$$report = '';
foreach (qw(LaBrea Tarpit Report Util now tz threads total_IPs bw)) {
$$report .= "$_=$out->{$_}\n";
}
1;
}
# make port activity graph
#
# input: port number
# \%look_n_feel
# max
# \@array_of_activity_vals
#
# returns: html table
#
sub make_port_graph {
my ($port,$lnf,$max,$ary) = @_;
return ' ' unless $port && scalar @$ary;
&init_lnf($lnf); # insert default font stuff if needed
my $height = $lnf->{height} || 72;
my $width = $lnf->{width} || 7;
my $legend = $lnf->{legend} || 'max probes';
my $font1 = &lnf_font($lnf,1);
my $font2 = &lnf_font($lnf,2);
my $html = q|<table cellspacing=0 cellpadding=2 border=3>
<tr><td bgcolor=| . $lnf->{bakgnd} .
qq| align=center><table cellspacing=0 cellpadding=0 border=0 width=100%>
<tr>
<td colspan=3><${font2}>port $port<br>| .
&get_portname($port,$lnf->{trojans}) .
qq|</td></tr>
<tr><td valign=bottom><${font1}>1</font></td><td align=center><${font2}>| . $legend . q| = | . $max .
qq|</font></td><td valign=bottom align=right><${font1}>| . @$ary . q|</font></td></tr></table></td>
<tr valign=bottom align=center><td bgcolor=| . $lnf->{bakgnd} .
q|>|;
my @bar = &scale_array($height/$max,@$ary);
foreach(0..$#bar) {
$html .= &element($bar[$_] || 1,$width,$ary->[$_],$lnf->{images} . &pcolor($ary->[$_]) . 'dot.gif');
}
$html .= q|</td></tr></table>
|;
}
sub make_buttons {
my ($lnf,$url,$act,$but,$xtra) = @_;
my $vertical = '';
my $aname = '';
if ($xtra ) {
$vertical = ' width=' . $xtra;
} else {
$aname = ' <a name="' . $act . '"></a>' . "\n" if $act;
}
&init_lnf($lnf);
my $butbar = qq|${aname}<table cellspacing=0 cellpadding=0 border=0 $vertical>
<tr align=center>
|;
for (my $i=0; $i<= $#{$but}; $i+=2) {
my ($cmd, @more) = split(/\s+/,$but->[$i+1]);
if ( $act && (! $cmd || $cmd =~ /$act/)) {
$butbar .= q|<td><table cellspacing=0 cellpadding=2 width=100%><tr><td align=center><font size=2 face="| .
$lnf->{face} . q|">| . ($but->[$i] || ' ') . q|</font></td></tr></table></td>|;
} else {
my $href = ($cmd =~ m|/|)
? $cmd
: ($cmd =~ /^#/)
? $url . $cmd
: $url .'?'. $cmd;
my $more = '';
foreach(@more) {
$more .= $_ . ' ';
}
$butbar .= q|<td><table cellspacing=0 cellpadding=2 border=2 width=100%><tr><td align=center bgcolor="| .
$lnf->{bakgnd} . qq|"><font size=2><a class=NU href="$href" $more>$but->[$i]</a></font></td></tr></table></td>|;
}
$butbar .= "</tr>\n<tr align=center>\n" if $vertical;
}
$butbar .= "</tr>\n" unless $vertical; # already done if vertical
$butbar .= "</table>\n";
}
sub get_config {
my ($in,$lnf) = @_;
return 'input is not a hash ref'
unless ref $in eq 'HASH';
return undef if exists $in->{file}; # fail silently for file service
my ($err,@response);
return $err if ($err = fetch($in,\@response,'config'));
return undef if $response[0] =~ /none/; # exit if empty
local (*LOCK,*OUT);
return 'failed to open config file for write'
unless ex_open(*LOCK,*OUT,$lnf->{html_cache_file}.'.config.tmp',-1);
foreach(@response) {
print OUT $_;
}
close OUT;
rename
$lnf->{html_cache_file}.'.config.tmp',
$lnf->{html_cache_file}.'.config';
return undef;
close LOCK;
}
#################################################
############# NON-EXPORT UTILITIES ##############
#################################################
# convert age in seconds to graduated hex number represented in ascii 00->FF
#
# input: seconds, scale factor (default 3);
# return: 00->FF
#
sub age2hex {
my ($t,$sf) = @_;
$sf = 3 unless $sf;
$t = $t || 0;
$t = -$t if $t < 0;
$t /= $sf;
$t = 255 if $t > 255;
$t = 255 - $t;
return sprintf("%02X",$t);
}
sub txt2td {
my ($cfg,$txt) = @_;
my $face = (exists $cfg->{face}) ? 'face="'.$cfg->{face}.'"' : '';
my $size = (exists $cfg->{size}) ? 'size="'.$cfg->{size}.'"' : '';
my $fclr = (exists $cfg->{f_clr}) ? 'color="'.$cfg->{f_clr}.'"' : '';
my $tclr = (exists $cfg->{td_clr}) ? 'bgcolor="'.$cfg->{td_clr}.'"' : '';
my $algn = (exists $cfg->{align}) ? 'align="'.$cfg->{align}.'"' : '';
my $font = '';
my $nfont = '';
if ($face || $size || $fclr) {
$font = "<font $face $size $fclr>";
$nfont = '</font>';
}
return "<td $tclr $algn>${font}${txt}${nfont}</td>";
}
sub time2local {
my ($et,$tz) = @_;
my ($sec,$min,$hr,$day,$mon,$year) = localtime($et);
$year %= 100;
if ( $tz ) {
return sprintf("%02.0f:%02.0f ($tz) %02.0f-%02.0f-%02.0f",$hr,$min,$mon+1,$day,$year);
} else {
return sprintf("%02.0f:%02.0f %02.0f-%02.0f-%02.0f",$hr,$min,$mon+1,$day,$year);
}
}
sub get_portname {
my ($port,$troj) = @_;
my $name = ($troj && exists $troj->{$port})
? $troj->{$port}
: undef;
unless ($name) {
my $gsbp = (exists $ENV{GATEWAY_INTERFACE} &&
$ENV{GATEWAY_INTERFACE} =~ /perl/i)
? \&Getservbyport
: sub { getservbyport($_[0],$_[1]) };
foreach my $proto ('tcp','udp') {
last if ($name = &$gsbp($port, $proto));
}
}
$name = 'no service name' unless $name;
return $name;
}
sub Getservbyport {
my ($port,$proto) = @_;
my $services = '/etc/services';
local *SERVICES;
return undef unless -e $services &&
open(SERVICES,$services);
while(my $line = <SERVICES> ) {
next if $line =~ /^#/;
next unless ($line =~ m|^(\w+)\s+(\d+)/(\w+)|i);
my $rv = $1;
next unless $port == $2;
close SERVICES;
return $rv;
}
close SERVICES;
return undef;
}
# generate bar
# input: height, width, alt, image
# output: text <img....>
#
sub element {
my($h,$w,$alt,$i) = @_;
return qq|<img src=$i alt="$alt" hspace=1 width=$w
height=$h>|;
}
sub pcolor {
my ($n) = @_;
return 'blu' if $n < 10;
return 'ltb' if $n < 100;
return 'grn' if $n < 1000;
# return 'yel' if $n < 10000;
return 'org' if $n < 10000;
return 'red' if $n < 100000;
return 'mag';
}
#
# input: SF, @array
# returns: @scaled_array
#
sub scale_array {
my($sf,@ary) = @_;
return @ary unless $sf;
return @ary if $sf == 1;
foreach (0..$#ary) {
if ($ary[$_]) {
$ary[$_] *= $sf;
$ary[$_] = int($ary[$_] + 0.5) || 1;
}
}
return @ary;
}
sub max {
my $n = 1;
foreach (@_) {
$n = $_ if $n < $_;
}
return $n;
}
sub scriptname {
$ENV{SCRIPT_NAME} =~ /([a-zA-Z_-]+\.[a-zA-Z_-]+)/;
return $1;
}
#### helper routines
# insert default font values into %look_n_feel if absent;
# input: \%look_n_feel
#
sub init_lnf {
my ($lnf) = @_;
# insert defaults
$lnf->{face} = 'VERDANA,ARIAL,HELVETICA,SANS-SERIF' unless $lnf->{face};
$lnf->{color} = '#ffffcc' unless $lnf->{color};
$lnf->{bakgnd} = '#000000' unless $lnf->{bakgnd};
}
# make configure table characteristics, these will be changed throughout the report
#
# input: \%look_n_feel, \%tbl_data_cfg
# returns: %tbl_data_cfg initialized
#
sub init_tdcfg {
my ($lnf,$tdcfg) = @_;
%$tdcfg = (
'face' => $lnf->{face},
'size' => 3,
'f_clr' => $lnf->{color},
'td_clr' => $lnf->{bakgnd},
'align' => 'center',
);
}
# return font statement from $tdcfg
#
# input: $tdcfg
# return: font size=$size face=$face color=$f_clr
#
sub tdcfg_font {
my ($tdcfg) = @_;
return 'font size=' . $tdcfg->{size} . ' face="' . $tdcfg->{face} . '" color="' . $tdcfg->{f_clr} . '"';
}
# return font statement from $lnf
#
# input: $lnf, [$size]
# return: font [size=xx] face=$face color=$color
#
sub lnf_font {
my ($lnf,$size) = @_;
$size = ' size='.$size || '';
return qq|font${size} face="| . $lnf->{face} . '"color="' . $lnf->{color} . '"';
}
# points to number
# increment 255 -> 0 returns 1
# otherwise returns 0
#
sub inc255 {
my($np) = @_;
return 0 unless ++$$np > 255;
$$np = 0;
return 1;
}
# pointer to array
# increment a dot quad ip address array
#
sub inc_ipv4 {
my($dqp) = @_; # pointer to quad array
for(my $i=$#{$dqp};$i>=0;--$i) {
return unless &inc255(\$dqp->[$i]);
}
}
# pointer to dot quad pair
# increments lower pair until lo > hi
# returns false if lo > hi
#
sub next_ipv4 {
my($lp,$hp) = @_;
&inc_ipv4($lp);
my $end = @{$lp};
foreach(0..$#{$lp}) {
return 1 if $lp->[$_] < $hp->[$_];
--$end if $lp->[$_] == $hp->[$_];
}
! $end; # return 1 if $lp == $hp
}
# input = 2 - dot quad addresses
# return an array of the range between addresses
#
sub range_ipv4 {
my($ad1,$ad2) = @_;
return ($ad1) unless $ad2;
my @ad1 = split('\.', $ad1);
my @ad2 = split('\.', $ad2);
my @ra;
do {
push @ra, join('.',@ad1);
} while &next_ipv4(\@ad1,\@ad2);
@ra;
}
1;