#!/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__

=head1 NAME

LaBrea::Tarpit::Report - tarpit log analysis and report

=head1 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);

B<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();

=head1 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 B<html_report.plx> or B<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 

B<sub generate> using it as a guide and the individual report
generation subroutines described below. B<sub generate> is an
example routine that encompasses all the reports created by
this module.

=over 2

=item * 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:

=cut

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

=item * gen_short(($input,\%output);

B<sub gen_short> takes similar arguments as B<generate>, however the
B<%output> array may be (usually is) empty. It will insert the minimum
information required in B<%output> prior to a call to B<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

=cut

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

=item * 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"

=cut

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);
}

=item * 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

=cut

###########
########### 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|>&nbsp;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|>&nbsp;<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">&nbsp;</td><td bgcolor="#cccc00">&nbsp;</td><td bgcolor="#aacc00">&nbsp;</td><td bgcolor="#99cc00">&nbsp;</td><td bgcolor="#66cc00">&nbsp;</td><td bgcolor="#33cc00">&nbsp;</td>
    </tr></table>
</td></tr>

<tr><td colspan=4
bgcolor="|. $tdcfg->{td_clr} . q
|"><|. $font . q|>&nbsp;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|>&nbsp;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">&nbsp;</td><td bgcolor="#cc0000">&nbsp;</td><td bgcolor="#aa0000">&nbsp;</td><td bgcolor="#990000">&nbsp;</td><td bgcolor="#660000">&nbsp;</td><td bgcolor="#330000">&nbsp;</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,'&nbsp;') . &txt2td($tdcfg,'&nbsp;') . "</tr>\n" if $col;
    $out->{guests} .= q|</table>
<!-- END GUESTS -->
|;
1; # returns true
} ## end guests report

=item * 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

=cut

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|>&nbsp;<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,'&nbsp;') . &txt2td($tdcfg,'&nbsp;');
      }
    }
    $out->{guests_by_IP} .= q|</tr></table></form>
<!-- END GUESTS BY IP -->
|;
1;
} # end guests_by_IP report

=item * 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

=cut

#######
####### 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:&nbsp;');
      } 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

=item * 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

=cut

#######
####### 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|">&nbsp;|;

    $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
|>&nbsp;<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,'&nbsp;') . &txt2td($tdcfg,'&nbsp;') . "</tr>\n" if $col;
    $out->{got_away} .= q|</table></form>
<!-- END GOT AWAY -->
|;
1;
} # end got_away report

=item * 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

=cut

#######
####### 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|>&nbsp;|;

    $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,'&nbsp;');
      }
    }
    $out->{my_IPs} .= q|</tr></table>
<!-- END LOCAL IP BLOCK -->
|;
1;
} # end my_IPs report

=item * $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

=cut

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

=item * 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 B<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

=cut

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;
}


=item * $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>

=cut

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|;
}

=item * $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'.

=cut

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>
|;
}

=item * 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...      #	#
  #   #####################  	#####################   #
  #			     				#
  #######################################################

=cut

#######
####### 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}>&nbsp;0 </font></td><td><${font1}>-&gt; &lt; 10</font></td><td>| . 
	&element($lnf->{width},20,'blue',$lnf->{images}.'bludot.gif') . qq|</td></tr>
  <tr><td><${font1}>10 </font></td><td><${font1}>-&gt; &lt; 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}>-&gt; &lt; 1000</font></td><td>| .
	&element($lnf->{width},20,'green',$lnf->{images}.'grndot.gif') . qq|</td></tr>
  <tr><td><${font1}>1000 </font></td><td><${font1}>-&gt; &lt; 10000</font></td><td>| .
	&element($lnf->{width},20,'orange',$lnf->{images}.'orgdot.gif') . qq|</td></tr>
  <tr><td><${font1}>10000 </font></td><td><${font1}>-&gt; &lt; 100000&nbsp;</font></td><td>| .
	&element($lnf->{width},20,'red',$lnf->{images}.'reddot.gif') . qq|</td></tr>
  <tr><td></td><td><${font1}>&nbsp;&nbsp;&gt;= 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>&nbsp</td></tr>
| if $col;
    $out->{port_intervals} .= q|</table>
<!-- END PORT STATISTICS -->
|;
1;
} # end of port_stats

=item * 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 B<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);

=cut

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;
}

=item * $html=make_port_graph($port,\%look_n_feel,$max,\@counts);

Return html table graph of @counts values
scaled, colored per look_n_feel for B<port>

used internally by B<port_stats> to create
individual port graphs. 

  Example 30 day shown:

  port 31337
  BackOrifice
  1	  max probes 138		30
  --------------------------------
	*	*
	*  *	*
  *	*  *	*	*  *	*
  ** *	** ***	*   *	*  * * **
  ************* ** **  *** *** ***
  ************* ****** ******* ***	
  --------------------------------

=cut

# 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 '&nbsp' 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>
|;
}

=item * $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>

=cut

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] || '&nbsp;') . 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";
}

=item * $rv = get_config(\%hash,\%look_n_feel) {

Retrieves and stores the config information about the remote B<daemon> process.
The resulting config file is used by B<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

=cut

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 ##############
#################################################

=item * $hex=age2hex($age,$scale_factor);

B<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

=cut

# 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);
}

=item * $td_string=txt2td(\%config_hash,string);

B<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>

=cut

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>";
}

=item * $time_string=time2local($epoch_time,$tz);

B<html utility>

  Convert seconds since the epoch to the form:

  13:27:56 (-0800) 11-29-01

  $tz =	time zone or blank if missing.

=cut

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);
  }
}

=item * $port_text=get_portname($port,\%trojan_list)

B<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

=cut

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;
}

=item * $port_text=Getservbyport($port,$proto);

B<html utility>

replacement for B<getservbyport>
which is broken for use in mod_perl 1.26
but works OK for plain cgi

=cut

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;
}  

=item * $image_html=element($ht,$w,$alt,$img);

B<html utility>

  create html image text of the form

 <img src=$img height=$ht width=$w hspace=1 alt="$alt">

=cut

# 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>|;
}

=item * $color=pcolor($number);

B<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

=cut

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';
}

=item * @scaled_array=scale_array($sf,@array);

B<html utility>

  scale an array of values with SF
  smallest non-zero value is 1

  returns:	@scaled_array

=cut

#
# 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;
}

=item * $max=max(@array);

B<html utility>

  return the maximum numeric value from 
  an array but not less than 1

=cut

sub max {
  my $n = 1;
  foreach (@_) {
    $n = $_ if $n < $_;
  }
  return $n;
}

=item * $scriptname = scriptname();

B<html utility>

Returns the scriptname of the caller from ENV{SCRIPT_NAME}

=back

=cut

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;
}

=head1 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

=head1 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.

=head1 AUTHOR

Michael Robinton, michael@bizsystems.com

=head1 SEE ALSO

perl(1), LaBrea::Tarpit(3), LaBrea::Codes(3), LaBrea::Tarpit::Get(3),
LaBrea::Tarpit::Util(3), LaBrea::Tarpit::DShield(3)

=cut

1;