#!/usr/bin/perl
package LaBrea::Tarpit;
#
# 2-5-05, michael@bizsystems.com
#
BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN }}
$__PACKAGE__::DOWARN = 1;
use strict;
#use diagnostics;
use vars qw($VERSION @ISA @EXPORT_OK);
$VERSION = do { my @r = (q$Revision: 1.36 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
use Fcntl qw(:DEFAULT :flock);
use AutoLoader 'AUTOLOAD';
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(
recurse_hash2txt
daemon
bandwidth
midnight
timezone
tz2_sec
their_date
restore_tarpit
log2_mem
process_log
cull_threads
write_cache_file
prep_report
find_old_threads
array2_tarpit
);
use constant defaults => { # seconds
'cull' => 600, # drop threads older than this
'min_age' => 15, # don't cull for at least
'auto_cull' => 900, # cull at least every
's_timeout' => 0.1, # select timeout
'sock_timeout' => 180, # give up on socket response
};
use constant mon => {
qw(jan 0 feb 1 mar 2 apr 3 may 4 jun 5 jul 6 aug 7 sep 8 oct 9 nov 10 dec 11)
};
=head1 NAME
LaBrea::Tarpit - Utilities and web displays for
Tom Liston's LaBrea scanner/worm disruptor
See: http://sourceforge.net/projects/labrea/
=head1 SYNOPSIS
use LaBrea::Tarpit qw( [exportable functions] );
or
require LaBrea::Tarpit;
daemon(%hash or \%hash);
$bandwidth = bandwidth(\%tarpit);
$midnight = midnight($epoch_time,$tz);
$timezone = timezone($now);
$sec = $tz2_sec($tz);
$time_string = their_date($gmtime,$tz);
$rv = restore_tarpit(\%tarpit,path2cache_file);
$rv = log2_mem(\%tarpit,log_line,is_daemon,port_intvls,DShield);
$rv = process_log(\%tarpit,path2log_file,is_daemon,port_intvls);
$rv = cull_threads(\%tarpit,timeout,scanners,port_intvls,DShield);
$rv = write_cache_file(\%tarpit,path2cache_file,umask,flag);
prep_report(\%tarpit,\%hash);
$rv = find_old_threads(\%tarpit,\%report,$age);
=head1 INSTALL
=over 4
=item * Package
Untar the package
perl Makefile.PL
make
make test
make install
To use examples/daemon.pl, configure
the array at the beginning of the script
and set the locations for the cache files.
...typically /var/tmp/labrea.cache
and /var/tmp/DShield.cache
=item * Report/examples/html_report.plx
=item * Report/examples/paged_report.plx
B<html_report> and B<paged_report> will run as a cgi scripts
by simply renaming them B<xxx_report.cgi>. It is highly recommend that
you enable the file caching to minimize load on your system.
Read the comments in the file itself for configuration.
The defaults should work fine, but you must create the
temporary directory used for file caching AND it must
be writable by the web server.
B<html_report> and B<paged_report> are configured to provide B<other_site>
reporting. You must set up the cron job maintain the
B<site_stats> file for reporting. B<See webscan.pl> below:
=item * Get/examples/web_scan.pl
Run B<web_scan.pl> from a cron job hourly or daily to
update the statistics from all know sites running
LaBrea::Tarpit. A report can then be generated showing
the activity worldwide.
# MIN HOUR DAY MONTH DAYOFWEEK COMMAND
30 * * * * ./web_scan.pl ./other_sites.txt ./tmp/site_stats
Also see: LaBrea::Tarpit::Report::other_sites
=item * examples/tell_me.pl AGE
Run B<tell_me.pl> from a cron job daily to send yourself
an email detailing teergrubed hosts that have been
held longer than B<AGE> days. You might actually want
to tell the bad guys that they have a rogue machine.
# MIN HOUR DAY MONTH DAYOFWEEK COMMAND
30 * * * * ./tell_me.pl 60 # default
=item * DShield/examples/mail_dshield.pm
Configure with your DShield UserID, email address, mail agent and
the location of the daemon - DShield cache file, then run periodically from
cron to send reports to DShield.
=back
=head1 DESCRIPTION - LaBrea::Tarpit
A comprehensive Hack Attack reporting module when used in conjunction with
Tom Liston's LaBrea scanner/worm disruptor. When configured with reporting
and stat collection it provides a detailed HTML page containing:
=over 4
=item * Bandwidth consumed by attack/disruption daemon
=item * Summary of previous 5 days of attack/disruption
=item * All IP addresses currently attacking
=item * IP address, port attacked/held, attack start time
=item * As above, but history of terminated attacks
=item * By day detail graphs on port attack intensity
=item * Active summary of known LaBrea::Tarpit sites
=back
For more information on B<LaBrea> see: L<http://sourceforge.net/projects/labrea/>
or contact the author of LaBrea, Tom Liston L<tliston@hackbusters.net>.
The parsed output of either syslog data or STDOUT from LaBrea using -o or -O
options is readily turned into text reports or an html output page.
Basically there are two methods of operation. You can use the B<daemon> mode
to create an almost realtime cache that may be parsed using the report
routines, or you can use the update and report routines to parse the syslog
files on an as needed basis. If you plan to create web page reports, the
daemon model will use less system resources in the long run and avoids
running syslog with the high volume output of LaBrea.
Improvements VERSION 1.00
As of version 1.00, B<daemon.pl> uses network sockets to provide data for
the report modules. This means that the daemon can run on a remote machine
and the report scripts and web server can be somewhere else.
For those of you upgrading from older versions, you B<MUST> upgrade all of
your report scripts as well. Older versions use a pipe or FIFO and this is
no longer supported as there were problems maintaining separate sessions.
=cut
# memory records are kept in the form:
#
# %tarpit # time is kept in seconds since epoch
# {bw} -> bandwidth # bytes per second
#
# {tz} -> timezone # i.e. text string = -800
#
# {now" -> epoch time # only used when writing cache,
# # not current otherwise
# active threads
# {at} -> {srcIP_1} -> {sp1} -> {dip} -> destination IP
# . (src_port1) {dp} -> destination port
# . . {pst} -> protocol type (0,6=tcp)
# for tcp = persistent [true/false]
# . . {ct} -> capture time
# . . {lc} -> last contact time
# . .
# . -> {sp2} -> {dip} -> destination IP
# . (src_port2) {dp} -> destination port
# . {pst} -> protocol type (0,6=tcp)
# for tcp = persistent [true/false]
# . {ct} -> capture time
# . {lc} -> last contact time
# .
# {srcIP_2} -> etc...
# dead threads
# {dt} -> {srcIP} -> {dp} -> last destination port
# {lc} -> last contact time
# .
# port stats
# {ph} -> {timea} -> {port num.x} -> count
# . -> {port num.y} -> count
# . -> {port num.z} -> count
# (timeb} -> etc...
#
# {pt} -> collection_interval
=over 2
=item * recurse_hash2txt(\$txt_buffer,\%hash,$keys_so_far,flag)
Appends to txt_buffer.
Generates a text tree of a hash.
%hash{lvl1}->{lvl2}->{lvl3} = 5; this real hash
flag = 0, ksf = '' with this input
lvl1:lvl2:lvl3:5 produces this text
flag = 1, ksf = ptr this input
ptr->{lvl1}->{lvl2}->{lvl3} = 5; this txt
=cut
# input: txt out pointer, pointer to hash, keys so far, dump | debug
# if the dod flag is 0, this is normal dump mode
# else it's the fancy debug mode
sub recurse_hash2txt {
my ($txp, $p, $ksf,$dod) = @_;
foreach my $key (sort keys %{$p}) {
my $keysnow = $ksf;
$keysnow .= ($dod) ? qq|->{$key}|
: ($ksf)
? ':'. $key
: $key;
if (ref $p->{$key}) {
&recurse_hash2txt($txp,$p->{$key},$keysnow,$dod);
} else {
$keysnow .= ($dod) ? ' = ' : ':';
$keysnow .= ($p->{$key} || 0) . "\n";
$$txp .= $keysnow;
}
}
}
=item * ($LBfh,$version,$kid) = lbd_open($LaBrea,$DEBUG);
Core daemon start routine. Not exported, but can
be replaced externally with:
*LaBrea::Tarpit::lbd_open = sub { stuff };
Returns the pid of the underlying process (if any) and the version number of
that process. It also sets the command line shown by 'ps' like this:
$0 = 'stuff';
input: path to daemon,
STDERR switch
returns: LaBrea file handle,
version,
pid of kid
=cut
sub lbd_open {
my($LaBrea,$DEBUG) = @_;
local *LABREA;
$LaBrea =~ /^([^\s]+)/; # bare path to LaBrea
qx/$1 -V 2>&1/ =~ /(\d+\.[^\s]+)/; # get version
my $version = $1; # save version
# open LaBrea daemon
my $kid = open(LABREA,$LaBrea .' |');
die "Can't open $LaBrea: $!" unless $kid;
unless ($DEBUG) {
open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}
$0 = __PACKAGE__.' '.$0; # set ps(1) name to package name
return(*LABREA,$version,$kid);
}
=item * lbd_close($LBfh,$kid);
Core daemon close routine, not exported but can be
replaced externally with:
*LaBrea::Tarpit::lbd_close = sub { sutff };
Close the daemon and kill off $kid with sig 15
input: filehandle,
pid of kid
returns: nothing
=cut
sub lbd_close {
my($LBfh,$kid) = @_;
kill 15, $kid; # kill LaBrea
close $LBfh;
}
# autoload everything to keep daemon small
sub daemon;
sub bandwidth;
sub midnight;
sub timezone;
sub restore_tarpit;
sub log2_mem;
sub process_log;
sub cull_threads;
sub write_cache_file;
sub prep_report;
sub find_old_threads;
sub array2_tarpit;
# helper subroutines
#sub _cullnsquish;
sub _check4cull;
sub _init_pt;
sub _add_array;
sub _cache2txt;
sub _ex_append;
sub _get_config;
sub DESTROY {};
1;
__END__
=item * daemon(&hash | \%hash)
input parameters: from hash or pointer to hash
{
'LaBrea' => '/usr/local/bin/LaBrea -z -v -p 1000 -h -i eth0 -b -O 2>&1',
# 'd_port' => '8686', # default local comm port
'd_host' => 'localhost', # defaults to ALL interfaces
# NOT recommended
'allowed' => 'localhost,remote.com', # default is ALL
# recommend only 'localhost'
'pid' => '/path/to/pid/file_name',
'cache' => '/path/to/cache/file',
'DShield' => '/path/to/DShield/out_file',
# 'kids' => default 5 # kids to deliver net msgs
# why would you need more??
# 'umask' => default 033, # cache_file umask
# 'cull' => default 600, # seconds to keep old threads
'scanners' => 100, # keep this many dead threads
# 'port_timer' => default 86400, # seconds per collection period
'port_intvls' => 30, # keep #nintvls of port stats
# 0 or missing disables
# this can take lots of memory
# optional exclusion information (required if files exist)
'config' => '/etc/LaBreaConfig',
# or
# 'config' => 'LaBrea.cfg', # windoze (untested)
# or
# 'config' => ['/etc/LaBreaExclude','/etc/LaBreaHardExclude'],
};
=cut
# 'DEBUG' => undef, turn on STDERR in daemon
=pod
The daemon can be run on a remote host with restricted client access and
the data retrieved by another host that has web server capabilities
=back
=over 4
B<scanners> is enabled by setting to a positive number.
Since all IP's that are seen but not captured can
potentially be saved, this list could grow very large.
You can limit the amount of memory used by setting the
number of items that can be saved. There is no default,
a value <= 0 turns of this feature. Scanners are saved on
a fifo basis, when full, the oldest will be deleted first.
=back
=over 2
Signals:
HUP cull then write new cache file
TERM cull, write cache, exit
Killing the daemon with SIG_KILL (-9) will NOT write
a new cache file and will leave LaBrea running.
YOU SHOULD NOT DO THIS
B<daemon operation>:
The daemon parses the output of LaBrea in real time and
collects the information in its memory cache, periodically
pruning away threads that are no longer active to minimize
the memory footprint. Upon receiving a HUP, it immediately
prunes memory of old threads and writes its cache to file.
B<data retrieval>
Usage:
connect to TCP port 8686
send "standard" (endline)
or
send "active" (endline)
or
send "short" (endline)
or
send "config" (endline)
to receive the complete memory cache described above or
only active threads or a truncated version suitable for
making a B<short> report. B<config> sends the daemon
configuration file information to the client.
=cut
# helper routine
#
# check for time to cull cache of old threads
# this does not need to be done often because
# LaBrea holds most indefinetly unless the black
# hat guys give up. Call with a small wait time
# when dumping the cache for use in a web page
#
# input: time between culls
#
# returns: true if cull reduces thread count, else false
#
sub _check4cull {
my ($tp,$ttcp,$wait_time,$cull,$scrs,$ph,$ds) = @_;
my $now = $tp->{now} = time;
if ( $now > $$ttcp + $wait_time ) {
$$ttcp = $now; # reset wait time
return &cull_threads($tp, $cull, $scrs, $ph, $ds);
}
0;
}
# check as above and if there is a tarpit cull,
# collapse the tarpit hash to conserve memory
# 1) write out the hash to disk
# 2) set the tarpit hash to an anon empty array
# 3) reload the tarpit from the disk
#
# returns: true if cull, else false
# fails silently if there is no cache file
#sub _cullnsquish {
# my ($tp,$ttcp,$wait_time,$cull,$scrs,$ph,$ds,$pt,$cache_file,$umask,$version) = @_;
# my $rv;
# if ($rv = &_check4cull($tp,$ttcp,$wait_time,$cull,$scrs,$ph,$ds)) { # cull every few minutes
# my $cache_txt = &write_cache_file($tp,$cache_file,$umask,1); # write cache file and return cache text
# %$tp = (); # collapse tarpit hash;
# my @lines = split("\n",$cache_txt);
# &array2_tarpit($tp,\@lines); # returns true
# $tp->{LaBrea} = $version; # set version number
# $tp->{pt} = $pt || 86400; # default data collection is one day
# }
# $rv;
#}
# input: file name, mark text
# returns: lines of file with ' mark text\n' appended
#
sub _get_config {
my ($f,$mark) = @_;
$mark = ' ' . $mark if $mark;
local *F;
return '' unless open(F,$f);
@_ = (<F>); # slurp lines
close F;
chop @_;
my $rv = join("$mark\n",@_);
$rv .= "$mark\n" if $rv;
};
# make daemon
#
# KILL with signal TERM, -15
# dump cache with SIG_HUP
#
# input: %hash or \%hash above
#
sub daemon {
my $pid;
$_ = ( ref $_[0] ) ? $_[0] : {@_};
my ($LaBrea,$config,$pid_file,$max_kids,$d_port,$d_host,$allowed,$cache_file,$umask,$cull,$scrs, $ph, $pt, $ds, $DEBUG) = @{$_}{
qw(LaBrea config pid kids d_port d_host allowed cache umask cull scanners port_intvls port_timer DShield DEBUG)};
# fork and test
unless ( $pid = fork ) {
# clean up for proper daemon operation
chdir '/'; # allow root dismount
open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
unless ( $pid = fork ) {
local(*SERVER,*CLIENT);
require LaBrea::NetIO;
import LaBrea::NetIO qw(
open_listen_sock
reap_kids
set_so_linger
sockaddr_in
inet_ntoa
);
# open server port
die $_ if ($_ = open_listen_sock(*SERVER,$d_host,$d_port));
my $flags = fcntl(SERVER,F_GETFL,0) || die "can't get socket flags";
fcntl(SERVER,F_SETFL,$flags | O_NONBLOCK) || die "can't set socket non-blocking";
require POSIX;
my $tarpit = {};
&POSIX::setsid() or die "Can't start new session: $!";
my($LBfh,$version,$kid) = lbd_open($LaBrea,$DEBUG);
$umask = 033 unless $umask;
$cull = defaults->{cull} unless $cull;
$ph = 0 unless $ph;
my $time2cull = time + $cull; # first cull must wait
##### define signal services within this scope
my $run = 1;
my $hup = 0;
$__PACKAGE__::DOWARN = 0; # quite warnings about
my $quit = sub { # portability of $run, $hup
$run = 0;
};
my $dohup = sub {
$hup = 1;
};
$__PACKAGE__::DOWARN = 1;
# local $SIG{HUP} = $dohup;
# local $SIG{INT} = $dohup;
# local $SIG{TERM} = $quit;
local $SIG{HUP} = sub { $hup = 1; };
local $SIG{INT} = sub { $hup = 1; };
local $SIG{TERM} = sub { $run = 0; };
local $SIG{PIPE} = 'IGNORE';
&restore_tarpit($tarpit,$cache_file) if -e $cache_file;
$tarpit->{LaBrea} = $version; # set version number
$tarpit->{pt} = $pt || 86400; # default data collection is one day
# prepare daemon loop
my $WNOHANG = &POSIX::WNOHANG;
my $rin = '';
vec($rin,fileno($LBfh),1) = 1;
my $timeout = defaults->{s_timeout};
my ($rout,$paddr,%kids);
my @valid_clients;
foreach(split(',', $allowed)) {
(undef,undef,undef,undef,@_) = gethostbyname($_);
push @valid_clients,@_;
}
$max_kids = 5 unless $max_kids;
my $kids = 0; # number of kids alive
while($run) {
# accept for SERVER is not set for 'select', find it with the POLL
my $ready = select($rout=$rin,undef,undef,$timeout);
if ( $ready > 0 ) {
$_ = <$LBfh>; # blocks, but doesn't matter here
last unless $_; # Oops, LaBrea must have died, EXIT
&log2_mem($tarpit,$_,1,$ph,$ds);
# &_cullnsquish($tarpit,\$time2cull,defaults->{auto_cull},$cull,$scrs,$ph,$ds,$pt,$cache_file,$umask,$version);
if (&_check4cull($tarpit,\$time2cull,defaults->{auto_cull},$cull,$scrs,$ph,$ds)) { # cull every few minutes
;
# revert cull operation to previous behavior
# the code below does not seem to improve memory usage
# my $cache_txt = &write_cache_file($tarpit,$cache_file,$umask,1); # write cache file and return cache text
# $tarpit = {}; # collapse tarpit hash;
# my @lines = split("\n",$cache_txt);
# &array2_tarpit($tarpit,\@lines); # returns true
# $tarpit->{LaBrea} = $version; # set version number
# $tarpit->{pt} = $pt || 86400; # default data collection is one day
}
}
elsif ( $hup ) {
# &write_cache_file($tarpit,$cache_file,$umask,1) unless
# &_cullnsquish($tarpit,\$time2cull,defaults->{min_age},$cull,$scrs,$ph,$ds,$pt,$cache_file,$umask,$version); # cull immediate
&_check4cull($tarpit,\$time2cull,defaults->{auto_cull},$cull,$scrs,$ph,$ds); # cull immediate
&write_cache_file($tarpit,$cache_file,$umask,1); # and write cache file
$hup = 0;
}
elsif ( $kids < $max_kids && ($paddr = accept(CLIENT,SERVER)) ) { # client has connected
if ($pid = fork) {
close CLIENT; # close if parent
$kids{$pid} = ++$kids if $pid; # bump kid count, val is not used
} else { # CHILD, service request
close SERVER;
########### CHILD PROCESS #################
local $SIG{ALRM} = sub { die "child connect timeout" };
my $iaddr = (sockaddr_in($paddr))[1];
unless ( ( ! @valid_clients || # allow all
grep($_ == $iaddr,@valid_clients)) && # or small number
set_so_linger(*CLIENT,30)) { # linger 30 seconds to deliver stuff
close CLIENT;
exit 0; # exit silently if not allowed or can't set linger
}
&_check4cull($tarpit,\$time2cull,defaults->{min_age},$cull,$scrs,$ph,$ds); # cull immediate
eval {
my $cache_txt = '';
alarm defaults->{sock_timeout};
my $request = readline *CLIENT;
if ( $request =~ /^standard/ ) { # full tarpit contents
$request = $tarpit;
}
elsif ( $request =~ /^short/ ) { # short totals only
$request = { 'Tarpit' => $VERSION }; # version in format for other end
prep_report($tarpit,$request);
}
elsif ( $request =~ /^active/ ) { # only active threads
$request = { 'at' => $tarpit->{at} };
}
elsif ( $request =~ /^config/ ) { # return config info
if ( $config ) {
if (ref $config) { # if it is array format
@_ = @{$config};
} else {
@_ = ($config);
}
my ($hard_ex,$exclude,$new_config);
if ( $_[0] =~ /Exclude/ ) { # old style
if ( $_[0] =~ /Hard/ ) {
$cache_txt .= &_get_config($_[0],'hardexclude');
} else {
$cache_txt .= &_get_config($_[0],'exclude');
}
if ( @_ > 1 ) { # if second argument
if ( $_[1] =~ /Hard/ ) {
$cache_txt .= &_get_config($_[1],'hardexclude');
} elsif ( $_[1] =~ /Exclude/ ) {
$cache_txt .= &_get_config($_[1],'exclude');
}
}
} elsif ( $_[0] =~ /Config/ ||
/LaBrea\.cfg/ ) { # new style, config true
$cache_txt .= &_get_config($_[0],'');
}
} # end config file info
$cache_txt = "none\n" unless $cache_txt;
} else { # unknown
alarm 0;
close CLIENT;
exit 0;
}
&_cache2txt(\$cache_txt,$request,'daemon') unless $cache_txt;
my $len = length($cache_txt);
my $off = 0;
my $win = '';
my ($wout,$eout);
vec($win,fileno(CLIENT),1) = 1;
my $ein = $win;
while ($len) {
$ready = select(undef,$wout=$win,undef,defaults->{pipe_timeout}); # block until write or error
last unless $ready; # punt if timeout
my $wrote = syswrite(CLIENT,$cache_txt,$len,$off);
last unless defined $wrote; # only errors
# if ( ! defined $wrote ) {
# next if $! == EAGAIN; # would block
# }
$off += $wrote;
$len -= $wrote;
}
};
alarm 0;
close CLIENT;
exit 0; # child dies
}
########### END CHILD #################
}
else {
$kids = reap_kids(\%kids); # dispose of dead kids, return remaining number
}
}
lbd_close($LBfh,$kid);
&_check4cull($tarpit,\$time2cull,defaults->{min_age},$cull,$scrs,$ph,$ds); # cull threads
&write_cache_file($tarpit,$cache_file,$umask,1);
foreach $kid ( keys %kids ) {
kill 15, $kid; # kill remaining children
}
unlink $pid_file;
exit 0;
}
exit 1 unless open(PID,'>'.$pid_file);
print PID $pid, "\n";
close PID;
exit 0;
}
waitpid($pid,0);
}
=item * $bandwidth = bandwidth(\%tarpit);
Returns bandwidth reported by LaBrea or zero
if the -b option is not used or B<bw> is unknown.
=cut
# return the current bandwidth
#
# input: \%tarpit
# return: bandwidth
#
sub bandwidth {
my ($tp) = @_;
return $tp->{bw} || 0;
}
=item * $time = midnight($epoch_time,$tz);
Returns epoch time at 00:00:00 of current day
from any epoch time submitted. Time zone is
calculated (inefficently) each time if omitted.
=cut
sub midnight {
my ($et,$tz) = @_;
$tz = &timezone($et) unless $tz;
my $mn= $et - tz2_sec($tz) - ($et%86400);
if ($mn > $et) {
$mn -= 86400;
} elsif ($et - $mn >= 86400) {
$mn += 86400;
}
$mn;
}
=item * $seconds = $tz2_sec($tz);
Convert time zone into seconds
input: timezone i.e. -0800
returns: seconds i.e. -28800
=cut
sub tz2_sec {
my ($tz) = @_;
my $tza = abs $tz;
my $min = $tza % 100;
my $hr = $tza - $min;
my $sec = ($hr * 36) + $min * 60;
$sec = -$sec if $tz < 0;
$sec;
}
=item * $time_string = their_date($gmtime,$tz);
Returns date string like perl's
localtime(time)
for the specified time zone
=cut
sub their_date {
my ($time,$tz) = @_;
return gmtime($time + tz2_sec($tz)) . ' ' . $tz;
}
=item * $timezone = timezone($now);
Returns the local timezone as a text string
i.e. -0800
uses current time if $now is omitted,
this is the normal method of usage.
=cut
sub timezone {
my $t = $_[0] || time;
my $tt = $t;
my (@lt) = localtime($t);
my (@gt) = gmtime($t);
my $tzmin = ($gt[1] - $lt[1]) + ($gt[2] - $lt[2]) * 60;
if($lt[5] > $gt[5]) {
$tzmin -= 1440;
}
elsif($gt[5] > $lt[5]) {
$tzmin += 1440;
}
else {
$tzmin += ($gt[7] - $lt[7]) * 1440;
}
$tzmin += 60 if $lt[8];
my $time = $t + $tzmin * 60;
my @test = localtime($time + ($tt - $t));
$tzmin -= 60 if $test[2] != $gt[2];
my $tz = abs $tzmin;
my $min = $tz % 60;
my $hr = ($tz - $min) / 60;
$tz = ($tzmin < 0 )
? '+' : '-';
$tz .= sprintf("%02d%02d",$hr,$min);
}
=item * $rv = restore_tarpit(\%tarpit,path2cache_file);
Restore the memory cache from the file cache.
returns true if successful
false if cache_file won't open
File Cache is of the form:
_VERSION:Package::Name version daemon | static
_CACHEDUMP:date of last cache dump
# for each src host
at:ip_addr:sport:dest
at:ip_addr:sport:dport
at:ip_addr:sport:ct
at:ip_addr:sport:last
at:ip_addr:sport:persist
at:ip_addr:sport:DShield:dest:dp:time
bw:number
# for each scanning (gone) host
dt:ip_addr:sport:dport
dt:ip_addr:sport:last
dt:ip_addr:persist
ph:time:dport:count
now:1234567890
tz:-0800
=cut
# build hash from database file
#
# input: \%tarpit, $db_file_path_name
# return: true or false if fail
sub restore_tarpit {
my ($tp,$dbf) = @_;
return undef unless open(DB,$dbf);
my @lines = (<DB>);
close DB;
chop @lines; # no new-lines
&array2_tarpit($tp,\@lines); # returns true
}
=item * array2_tarpit(\%tarpit,\@array);
Restore the memory cache from an array of
lines as described for B<restore_tarpit>. The lines
must already be stripped of return characters
Always returns true;
=cut
sub array2_tarpit {
my ($tp,$ary) = @_;
foreach(@$ary) {
next unless $_ =~ /^[a-zA-Z]/; # must start with alpha tag
my @arg = split(':', $_);
next unless @arg > 1; # must be at least two items
my $inst = '$tp';
foreach(0..$#arg -1) {
$inst .= '->{$arg[' . $_ . ']}';
}
$inst .= ' = $arg[' . $#arg . '];';
eval $inst;
}
1; # return true
}
=item * $rv = log2_mem(\%tarpit,log_line,is_daemon,port_intvls,DShield);
Update memory cache from log output line. Set
B<is_daemon> if the log output is from daemon STDOUT
In order of minimum CPU overhead:
Daemon mode or logs created from STDOUT require the
least cpu overhead.
LaBrea -O is more efficient than Labrea -o.
Logs from STDOUT are more efficient than syslogs.
Standalone syslogs are more efficient than mixed.
All log lines used are of the form:
epoch time (seconds)
or
date text
followed by
[...LaBrea:] # syslog only
one of these
info text bw: bandwidth (bytes/sec)
or
info text: src_ip src_port txt dest_ip dest_port
Or more succinctly:
time text: bandwidth
or
time text: src_ip src_port txt dest_ip dest_port
Returns: true / false on success / fail
=cut
# update the tarpit cache from log line, see comments below for format
#
# input: \%tarpit, log_line, is_daemon, port_intvls, DShield_flag
#
#
sub log2_mem {
my ($tp,$line,$id,$ph,$ds) = @_;
return undef if (!$id && $line !~ /LaBrea:/);
# valid Labrea log line to parse
if ( $line =~ /.+bw:\s+(\d+)\s+/ ) { # if bandwidth line
$tp->{bw} = $1 || 0;
return 1;
}
# extract time / date
my $time;
if ( $line =~ /^(\d+)\s+/ ) {
$time = $1;
} else { # complex form
require Time::Local;
return undef unless $line =~ /(.+)\s+(\d+):(\d+):(\d+)\s+(\w+)\s+/;
@_ = split(/\s+/,$1);
my $day = pop @_;
my $mon = pop @_;
$mon = mon->{"\L$mon"};
my ($hr,$min,$sec,$yr) = ($2,$3,$4,$5);
if ($yr =~ /[^\d]/) {
my ($nowmo,$nowyr) = (localtime(time))[4,5];
$yr = ($mon > $nowmo) # roll over to new year??
? $nowyr -1
: $nowyr;
} elsif ( $yr > 1900 ) { # most likely
$yr -= 1900;
} elsif ( $yr < 70 ) { # yr 2000 or more
$yr += 100;
} # else leave as-is, 70 - 99
$time = &Time::Local::timelocal($sec,$min,$hr,$day,$mon,$yr);
}
# extract ip's and ports src sp dest dp
return undef unless $line =~ /:\s+(\d+\.\d+\.\d+\.\d+)\s+([na\d]+)[^\d]+(\d+\.\d+\.\d+\.\d+)\s+([na\d]+)/;
$tp->{now} = $time if (! $tp->{now}) || $tp->{now} < $time;
my ($src,$sp,$dest,$dp) = ($1,$2,$3,$4);
delete $tp->{dt}->{$src} if $tp->{dt}->{$src}; # remove dead soldiers
$_ = $tp->{at}->{$src}->{$sp} || ($tp->{at}->{$src}->{$sp} = {});
$_->{dip} = $dest;
$_->{dp} = $dp;
$_->{pst} = ($line =~ /Persist/i) ? 6 : 0;
$_->{ct} = $time unless exists $_->{ct};
$_->{lc} = $time;
if ( $ds && $line =~ /Initial/i ) { # mark for DShield
$_->{DShield} = {} unless $_->{DShield};
$_->{DShield}->{$dest} = {} unless $_->{DShield}->{$dest};
$_->{DShield}->{$dest}->{$dp} = $time;
}
if ( $ph ) { # if port statistics are collected
$_ = $tp->{pt} || 86400;
$time -= ($time % $_);
if (exists $tp->{ph}->{$time}->{$dp}) {
$tp->{ph}->{$time}->{$dp} += 1;
} else {
$tp->{ph}->{$time}->{$dp} = 1;
}
}
return 1;
}
=item * $rv = process_log(\%tarpit,path2log_file,is_daemon,port_intvls);
Update the memory cache from a file with lines of the
form described for B<log2_mem>
Set B<is_daemon> if the output log was created from
STDOUT of LaBrea or if you can guarantee that
there is nothing in the file except LaBrea lines.
Returns true on success, false if file fails to open
=cut
# process a log file
#
# input: \%tarpit, $log_file_path_name, is_daemon, port_intvls
# returns: true or undef on fail
#
sub process_log {
my ($tp,$logf,$id,$ph) = @_;
return undef unless open(LOG,$logf);
$ph = 0 unless $ph;
while (<LOG>) {
&log2_mem($tp,$_,$id,$ph);
}
close LOG;
1;
}
=item * $rv=cull_threads(\%tarpit,timeout,scanners,port_intvls,DShield);
Cull aged threads from memory cache. Default time is 600
seconds (10 min). On startup, no culls are done for the cull
time interval to retain old capture time information for
any lingering black hats that may fall back into the tarpit.
See B<daemon> description for B<scanners>, B<port_intvls>
cull_threads updates the time zone of the tarpit cache
appends DShield info to file specified in DShield if present
returns: true if threads removed, else false
=cut
# cull threads helper for DShield
# see docs for 'ex_open', condensed version here
#
sub _ex_append {
my ($LOCK,$fh,$fn) = @_;
umask 0111; # sorry about that, needs to be deletable by reader
return undef unless sysopen $LOCK, $fn . '.flock', O_RDWR|O_CREAT|O_TRUNC;
# die(&me . ': could not open file exclusive ' . $fn . '.flock');
unless (flock($LOCK,LOCK_EX)) {
close $LOCK;
return undef;
}
unless (sysopen $fh, $fn, O_RDWR|O_APPEND|O_CREAT) {
close $LOCK;
return undef;
}
my $tmp = select $fh;
$| = 1;
select $tmp;
return 1;
}
# cull old threads
#
# input: \%tarpit, timeout_seconds, scanners, port_intervals, DShield_file
# default 600
# returns: 1 if threads removed, else 0
sub cull_threads {
my ($tp,$timeout,$scrs,$ph,$ds) = @_;
my $rv = 0;
$scrs = ($scrs && $scrs > 0) ? int($scrs) : 0;
my %scanners; # trial dead threads
my $dso;
local (*LOCK,*DS);
$timeout = defaults->{cull} unless $timeout;
my $now = $tp->{now} || time;
$tp->{tz} = timezone($now);
my $expired = $now - $timeout;
my ($src,$sp,$destdp);
my $act = $tp->{at} || ($tp->{at} = {}); # pointer to active threads
my @src = keys %{$act}; # active threads
foreach $src (@src) {
my @sp = keys %{$act->{$src}};
foreach $sp ( sort {
$act->{$src}->{$a}->{lc} <=> $act->{$src}->{$b}->{lc}
}@sp) {
# process DShield notifications first
if ( exists $act->{$src}->{$sp}->{DShield} ) {
if (! $ds) { # dshield not active
delete $act->{$src}->{$sp}->{DShield}; # don't want these around
}
elsif ( $dso || ($dso = _ex_append(*LOCK,*DS,$ds)) ) { # DShield cache open
$_ = $tp->{tz};
substr($_,-2,0) = ':'; # insert colon in TZ string
my ($tza,$tzb) = split(':',$_); # crude but effective
my $dshield = $act->{$src}->{$sp}->{DShield};
foreach my $shieldIP (keys %{$dshield}) { # foreach dest IP
foreach my $shieldPort(keys %{$dshield->{$shieldIP}}) { # and each target port
my($sec,$min,$hr,$md,$mon,$yr) = localtime($dshield->{$shieldIP}->{$shieldPort});
$_ = sprintf ("%04d-%02d-%02d %02d:%02d:%02d %+03d:%02d\t",$yr+1900,$mon+1,$md,$hr,$min,$sec,$tza,$tzb);
print DS $_,'UserID',$tp->{LaBrea},':',$VERSION,"\t1\t$src\t$sp\t$shieldIP\t$shieldPort\tTCP\tSYN\n";
}
}
delete $act->{$src}->{$sp}->{DShield}; # printed, destroy
}
}
if ( $act->{$src}->{$sp}->{lc} < $expired ) {
@{$scanners{$src}}{'dp','lc','pst'} = @{$act->{$src}->{$sp}}{'dp','lc','pst'};
delete $act->{$src}->{$sp}; # remove active expired thread
}
}
if (keys %{$act->{$src}}) { # do threads remain for this IP?
delete $scanners{$src}; # yes, dispose of parital deaths
} else {
delete $act->{$src}; # no, delete active thread
}
$rv = 1;
}
if ( $dso ) { # dshield cache open
close *DS;
close *LOCK;
}
if ($scrs) { # if scanners are saved
my $dead = $tp->{dt} || ($tp->{dt} = {});
# add new dead threads
foreach (keys %scanners) {
@{$dead->{$_}}{'dp','lc','pst'} = @{$scanners{$_}}{'dp','lc','pst'};
}
# remove old dead threads over limit
if ((@_ = keys %{$dead}) > $scrs) {
my @dead = sort {
$dead->{$a}->{lc} <=> $dead->{$b}->{lc};
} @_;
# extract the oldest dead threads
splice(@dead,@_-$scrs);
foreach(@dead) {
delete $dead->{$_};
}
$rv = 1;
}
}
if ( $ph ) { # if port stats are present
$_ = $tp->{pt} || 86400;
my $intvls = $ph * $_;
my $end = $now - ($now % $_) - $intvls + 1;
foreach(keys %{$tp->{ph}}) {
if ($_ < $end) {
delete $tp->{ph}->{$_}; # drop old port stats
$rv = 1;
}
}
} elsif (exists $tp->{ph}) {
delete $tp->{ph}; # remove unwanted port stats
$rv = 1;
}
$rv;
}
=item * $rv = write_cache_file(\%tarpit,path2cache_file,umask,flag);
Write memory cache to file.
returns cache text on success, false if file fails to open.
umask defaults to 033 if not supplied
File Cache is of the form:
_VERSION:Package::Name version daemon | static
_CACHEDUMP:date of last cache dump
see description above in B<restore_tarpit>
flag = true, append 'daemon' to version
flag = false, append 'static' to version
=cut
# helper routine
#
# input: \$txtstring, \%tarpit, $type
# type = static or daemon
#
sub _cache2txt {
my ($txp,$tp,$type) = @_;
$tp->{now} = time unless $tp->{now};
$_ = localtime($tp->{now});
# print info
$$txp = '_VERSION:' . __PACKAGE__ .
" $VERSION $type\n_CACHEDUMP:$_\n";
$tp->{bw} = 0 unless $tp->{bw}; # must have a value
$tp->{tz} = &timezone($tp->{now});
&recurse_hash2txt($txp,$tp,'');
}
# write new db
#
# input: \%tarpit,$db_file_path_name [umask], fork
# return: cache text or false on fail
#
sub write_cache_file {
my ($tp, $dbf, $umask, $flag) = @_;
return undef unless $dbf;
local *DB;
$flag = ($flag) ? 'daemon' : 'static';
$umask = 033 unless $umask;
umask $umask;
return undef unless open(DB,'>'.$dbf.'.tmp');
$_ = select DB;
$| = 1;
select $_;
my $cache_txt = '';
&_cache2txt(\$cache_txt,$tp,$flag);
print DB $cache_txt;
close DB;
return (rename ($dbf.'.tmp', $dbf)) ? $cache_txt : undef;
}
=item * prep_report(\%tarpit,\%hash);
Prepare arrays of report values from the tarpit memory cache.
Only the values requested will be filled.
%hash values: times in seconds since epoch
{
# 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, # type / 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' => number of days to show,
'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, # type / persistent [true|false]
#
# scanning hosts lost
'sc_srcIP' => \@scsip, # B<REQUIRED>
'sc_dPORT' => \@scdp, # attacked port
'sc_prst' => \@scpst, # type / persistent [true|false]
'sc_last' => \@sclst, # last contact
#
# port statistics # all fields B<REQUIRED>
'port_intvls' => number of periods to show,
'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)
}
NOTE: B<prep_report> will fill any subset of the
specified or all if they are all specified
=cut
# helper routine
#
# input: \%hash, key
# returns: pointer to cleared array or undef
#
sub _init_pt {
my ($p,$k) = @_;
return undef unless exists $p->{$k};
@{$p->{$k}} = ();
$p->{$k};
}
# helper routine
#
# input: \@array_of_digits, $match
# return: number of matching digits
#
sub _add_array {
my ($ary, $mat) = @_;
my $sum = 0;
foreach(@{$ary}) {
++$sum if $_ == $mat;
}
return $sum;
}
sub prep_report {
my ($tp,$p) = @_;
# establish array pointers / flags
my ($tgsip,$tgsp,$tgdip,$tgdp,$tgcap,$tglst,$tgpst);
my ($thsip,$thnum);
my ($csdays,$csdate,$csctd);
my ($phdip,$phpst);
my ($scsip,$scdp,$scpst,$sclst);
my ($pintvls,$ports,$pstats);
my $TCP = 6; # persistent protcol
$p->{LaBrea} = $tp->{LaBrea} || 'unknown';
my (@now,%phantoms,%threadays);
$now[0] = $p->{now} = $tp->{now} || time;
$tp->{tz} = &timezone($now[0]) unless $tp->{tz};
my $tz = $tp->{tz};
if (exists $p->{tg_srcIP} && exists $p->{tg_sPORT}) {
$tgsip = $p->{tg_srcIP};
$tgsp = $p->{tg_sPORT};
$tgdip = &_init_pt($p,'tg_dstIP');
$tgdp = &_init_pt($p,'tg_dPORT');
$tgcap = &_init_pt($p,'tg_captr');
$tglst = &_init_pt($p,'tg_last');
$tgpst = &_init_pt($p,'tg_prst');
}
if ($thsip = &_init_pt($p,'th_srcIP')) {
$thnum = &_init_pt($p,'th_numTH');
}
if ($p->{cs_days} && exists $p->{cs_date} && exists $p->{cs_ctd}) {
$csdays = $p->{cs_days};
$csdays = ($p->{cs_days} && $p->{cs_days} > 1)
? $p->{cs_days}
: 2;
$csdate = &_init_pt($p,'cs_date');
# default 'capture this date'
$csctd = &_init_pt($p,'cs_ctd');
$now[0] = $p->{now};
foreach(1..$csdays-1) {
$now[$_] = $now[$_-1] - 86400; # previous days
}
foreach(0..$#now) {
$now[$_] = midnight($now[$_],$tz);
}
}
if (&_init_pt($p,'ph_dstIP')) {
$phdip = $p->{ph_dstIP};
$phpst = &_init_pt($p,'ph_prst');
}
if (&_init_pt($p,'sc_srcIP')) {
$scsip = $p->{sc_srcIP};
$scdp = &_init_pt($p,'sc_dPORT');
$scpst = &_init_pt($p,'sc_prst');
$sclst = &_init_pt($p,'sc_last');
}
my ($tot,$tg,$th,$cs) = (0,0,0,0); # event counters
my $act = $tp->{at} || ($tp->{at} = {});
my @src = sort keys %$act;
$p->{total_IPs} = @src; # total hosts teergrubed
foreach my $src (@src) { # each black host
my @sp = sort keys %{$act->{$src}};
$tot += @sp;
if ($thsip) {
$thnum->[$th] = @sp if $thnum;
$thsip->[$th++] = $src; # threads per IP report
}
foreach my $sp (@sp) {
$phantoms{$act->{$src}->{$sp}->{dip}} # prep phantoms report
= $act->{$src}->{$sp}->{pst} if $phdip;
if ($csdate) { # capture report
my $capt = &midnight($act->{$src}->{$sp}->{ct},$tz);
$threadays{$capt} = (exists $threadays{$capt})
? $threadays{$capt} + 1
: 1;
$cs++;
}
if ($tgsip) { # teergrube report
$tgdip->[$tg] = $act->{$src}->{$sp}->{dip} if $tgdip;
$tgdp->[$tg] = $act->{$src}->{$sp}->{dp} if $tgdp;
$tgcap->[$tg] = $act->{$src}->{$sp}->{ct} if $tgcap;
$tglst->[$tg] = $act->{$src}->{$sp}->{lc} if $tglst;
$tgpst->[$tg] = $act->{$src}->{$sp}->{pst} if $tgpst;
$tgsip->[$tg] = $src;
$tgsp->[$tg++] = $sp;
}
}
}
if ($phdip) { # complete phantoms report
$p->{phantoms} = @_ = sort keys %phantoms;
@{$phdip} = @_;
if ($phpst) {
@{$phpst} = @phantoms{@_};
$p->{ph_capt} = &_add_array($phpst,$TCP);
}
}
if ($csdate) { # finish capture report
my $k = 0;
foreach(0..$#now-1) {
$csdate->[$_] = $now[$_];
$csctd->[$_] = $threadays{$now[$_]} || 0;
$k += $csctd->[$_];
}
$csdate->[$#now] = $now[$#now];
$csctd->[$#now] = $cs - $k;
}
# build report elements
$p->{tz} = $tz;
$p->{bw} = &bandwidth($tp);
$p->{threads} = $tot;
# fill remaining conditional
$p->{tg_capt} = &_add_array($tgpst,$TCP)
if $tgsip && $tgpst;
# this one is really totally independent
if ($scsip) { # dropped scanner report
my $dead = $tp->{dt} || ($tp->{dt} = {});
$p->{sc_total} = @{$scsip} = @_= sort keys %$dead;
foreach(0..$#_) {
$scdp->[$_] = $dead->{$_[$_]}->{dp} if $scdp;
$sclst->[$_] = $dead->{$_[$_]}->{lc} if $sclst;
$scpst->[$_] = $dead->{$_[$_]}->{pst} if $scpst;
}
$p->{sc_capt} = &_add_array($scpst,$TCP) if $scpst;
}
# ports also totally independent
if (exists $p->{port_intvls} &&
$p->{port_intvls} &&
exists $p->{ports} &&
exists $p->{portstats}) { # port statistics report
$pintvls = $p->{port_intvls};
$p->{pt} = $tp->{pt} || 86400;
$ports = $p->{ports};
$pstats = $p->{portstats};
@now = $p->{now};
$now[0] -= ($now[0] % $p->{pt});
foreach(1..$pintvls-1) {
$now[$_] = $now[$_ -1] - $p->{pt}; # fill now with intvls of interest
}
# get port numbers so we have them all
my @pnums;
foreach (@now) {
push @pnums, (keys %{$tp->{ph}->{$_}})
if exists$tp->{ph}->{$_};
}
@_ = sort { $a <=> $b } @pnums;
@pnums = ();
my $lastp = 0; # no port zero
foreach (@_) { # remove duplicates
next if $_ == $lastp;
$lastp = $_;
push @pnums, $lastp;
}
@$ports = @pnums; # export ports
@$pstats = (); # clear stats
foreach(0..$#pnums) { # fill stats array
my $i = $pintvls * $_; # index into array for port
foreach my $d (0..$#now) { # get data for each time slice
${$pstats}[$i+$d] = $tp->{ph}->{$now[$d]}->{$pnums[$_]} || 0;
}
}
}
}
=item * $rv = find_old_threads(\%tarpit,\%report,$age);
Report only aged threads
input: \%tarpit, \%report, age_in_days
returns: false = fail, or nothing to report
true = number of items
and fills \%report
%report = (
[text string] [time since epoch]
ip.addr:sp -> dp => time captured,
....
=back
=cut
sub find_old_threads {
my ($tp,$rpt,$age,$testime) = @_;
$age *= 86400; # age in days
my $now = $testime || time;
my $act = $tp->{at} || ($tp->{at} = {}); # pointer to active threads
my @src = keys %{$act}; # active threads
foreach my $src (@src) {
my @sp = keys %{$act->{$src}};
foreach my $sp (@sp) {
my $ct = $act->{$src}->{$sp}->{ct};
$rpt->{"${src}:${sp} -> $act->{$src}->{$sp}->{dp}"} = $ct
if $ct + $age < $now;
}
}
return scalar keys %$rpt;
}
#=item * $rv = refresh_cache_file($path2_pid_file,$path2_cache_file,$age);
#
# DEPRECATED and REMOVED
#
# Refresh (update) the cache file from the daemon memory
# if the cache file is older than $age seconds. Ages of
# zero or less force an immediate update.
#
# Returns 0 (false) if the cache is current or when updated,
# otherwise returns the ERRNO for the fault
#
# WARNING: this only works if you have the necessary
# file and daemon permissions. Normal usage to gain access
# memory cache would be to read from the daemon pipe.
#
## conditionally refresh the cache file
##
## input: $path2_pid_file, $path2_cache_file, $age
## returns: errno or 0 on 'up 2 date'
##
#sub refresh_cache_file {
# my ($pid,$p2cf,$age) = @_;
# return ($! = ENOENT) unless -e $pid; # validate pid file
# return ($! = EACCES) unless -r $pid;
# $age = defaults->{min_age}
# unless $age &&
# int($age) > 0;
# $age = time - $age; # benchmark time
# if ( -e $p2cf ) { # cache file is present
# return ($! = EACCES) unless -r $p2cf; # validate it
# return 0 if (stat($p2cf))[9] >= $age # return if current
# }
# local(*F,*W);
# return ($! = EACCES) unless open(F,$pid);
# read(F, $pid, 100); # slurp PID file
# close F;
# return EINVAL unless ($pid =~ /(\d+)/); # pid -> $1
# return $! unless kill 0, $pid; # check for process alive
# kill 1, $1; # send HUP to daemon
# pipe(F,W); # open NULL handle
# my $rin = '';
# my $rout;
# vec($rin,fileno(F),1) = 1;
# my $timer = defaults->{s_timeout} || .1; # may not be zero
# my $hup_timeout = int(defaults->{hup_timeout} / $timer);
# while(1) {
# $_ = select($rout=$rin,undef,undef,$timer);
# read(F,$_,1) if $_; # should never happen
# if ((stat($p2cf))[9] >= $age ) {
# $! = 0;
# last;
# }
# unless ($hup_timeout-- > 0) {
# $! = ETIME;
# last;
# }
# }
# close W;
# close F;
# $!;
#}
#
=head1 DEPENDENCIES
Net::Whois::IP version 0.35
Net::Netmask version 1.8 or higher
LaBrea version 2.4b3 or higher
See the INSTALL document for complete information
=head1 EXPORT
None by default.
=head1 EXPORT_OK
recurse_hash2txt
daemon
bandwidth
midnight
timezone
tz2_sec
their_date
restore_tarpit
log2_mem
process_log
cull_threads
write_cache_file
prep_report
find_old_threads
array2_tarpit
=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::Codes(3), LaBrea::Tarpit::Get(3), LaBrea::Tarpit::Report(3),
LaBrea::Tarpit::Util(3), LaBrea::Tarpit::DShield(3)
=cut
1;