HTTPD::ADS - Perl module for Abuse Detection and Prevention System
Index
Code Index:
NAME

HTTPD::ADS - Perl module for Abuse Detection and Prevention System
SYNOPSIS

DESCRIPTION

USAGE

BUGS

SUPPORT

AUTHOR

Dana Hudes
CPAN ID: DHUDES
dhudes@hudes.org
http://www.hudes.org
COPYRIGHT

This program is free software licensed under the...
The General Public License (GPL)
Version 2, June 1991
The full text of the license can be found in the
LICENSE file included with this module.
SEE ALSO

_init
Usage : private function
Purpose : for initializing the object
Returns : nothing direct, normalizedIDSTimeWindowSize by side effect
Argument : IDSTimeWindowSize, ISDEventThresholdLevel
Throws : nothing
Comments: called by mk_constructor
See Also :
event_recorder
Usage : $ads->event_recorder(%args}
Purpose : for recording an event and dispatching based on status code
Returns : nothing direct, lots of side effects such as on the database
Argument : time,ip,username, request_string, status code
Throws : die if parameters missing/invalid
Comments: main entry for driving the ADS
See Also :
package HTTPD::ADS;
use strict;
use warnings;
use vars qw ($VERSION @ISA );
$VERSION = 0.8;
use base qw/ Class::Constructor Class::Accessor /;
use HTTPD::ADS::DBI;
use HTTPD::ADS::Times; #time-related subroutines
use CLASS;
use CGI::Carp qw(cluck carpout);
use IO::Socket::UNIX;
use HTTP::Date qw/str2time time2isoz/ ;
use constant MAX_REQUEST_STRING_LENGTH =>64;
use constant MAX_REQUEST_STRING_COLUMN => 63;
BEGIN {
#this is supposed to have been done by use base...
use vars qw ( @ISA);
require Class::Accessor;
require Class::Constructor;
push @ISA, 'Class::Accessor','Class::Constructor';
}
########################################### main pod documentation begin ##
# Below is the documentation for this module.
############################################# main pod documentation end ##
my @Accessors = qw (
IDSDatabase
IDSDataUser
IDSDataPassword
IDSEventsThresholdLevel
IDSTimeWindowSize
normalizedIDSTimeWindowSize
msgQ
);
CLASS->mk_accessors(@Accessors);
CLASS->mk_constructor(
Name => 'new',
Auto_Init => \@Accessors,
Init_Methods => '_init',
Disable_Case_Mangling => 1
);
################################################ subroutine header begin ##
################################################## subroutine header end ##
use Date::Calc qw(Normalize_DHMS);
sub _init {
#_init sets up the db connection and prepares the SQL we'll need for insert and retrieve
my $self = shift;
$self->IDSTimeWindowSize(defined $self->IDSTimeWindowSize? -$self->IDSTimeWindowSize: -300);
$self->IDSEventsThresholdLevel(10) unless defined $self->IDSEventsThresholdLevel;
$self->normalizedIDSTimeWindowSize( \[0,0,Normalize_DHMS(0,0,0,$self->IDSTimeWindowSize)] );
}
use HTTPD::ADS::AbuseNotify;
################################################ subroutine header begin ##
################################################## subroutine header end ##
my %switch = ( 401 => \&HTTPD::ADS::analyze401);
sub event_recorder {
# put the status, ip address and time into database. If time isn't supplied, use the postgresql now() function
#If the status is 401, see if we should blacklist this ip address unless it is whitelisted
my $self=shift;
my %args=@_;
my ($eventrecord,$hostentry,$arg_string,$username,$request_string,$whitelist_entry);
my $max_request_length=64; #not max column number, which is one less
$args{time}=(defined $args{time}? time2isoz( str2time($args{time}) ): $self->gmttimestamp );
my $ip = $args{ip} || confess "no ip address supplied";
confess "no status supplied" unless defined $args{status};
my @ipaddr = split /\s+/,$ip,2; #sometimes another field gets stuck on, get rid of it.;
$ip = $ipaddr[0];
$args{ip}=$ip;
$whitelist_entry = HTTPD::ADS::Whitelist->retrieve($ip);
if (!$whitelist_entry) {
substr($args{request},MAX_REQUEST_STRING_COLUMN)='' if ((length $args{request}) > MAX_REQUEST_STRING_LENGTH); #a clever way to trim to maximum length
$hostentry= HTTPD::ADS::Hosts->find_or_create(ip => $ip);
# $arg_string = '-' unless (defined $args{arg_string});
# $arg_string = HTTPD::ADS::Arg_strings->find_or_create({arg_string => $args{arg_string}});
$request_string = HTTPD::ADS::Request_strings->cached_find_or_create({request_string =>$args{request}});
$username = HTTPD::ADS::Usernames->cached_find_or_create({username => $args{user}});
$eventrecord = HTTPD::ADS::Eventrecords->create(
{
ts =>$args{time},
ip=> $ip,
status => $args{status},
userid => $username->userid,
requestid => $request_string->requestid,
# argid => $arg_string->argid
}
);
my $handler = $switch{$args{status}};
&$handler($self, \%args) if defined $handler;#there's gotta be a 'right' way to make this a method call...
} else {
use Sys::Syslog;
my $program = $ARGV[0];
openlog("$program $$",'pid','local6');
syslog('warning',"%s event received for whitelisted host %s",$args{status},$args{ip});
closelog;
}
}
use HTTPD::ADS::OpenProxyDetector;
sub analyze401 {
my ($self,$args) = @_;
#Class::DBI::AbstractSearch format which is to say SQL::AbstractSearch WHERE my $eventcount;
my $open_proxy_test;
my $proxyrecord;
my $ip = $$args{ip};
my $eventcount =HTTPD::ADS::Eventrecords->count_errors($ip,$self->pgtimewindow);
if ($eventcount == 4) {
my $notify;
$proxyrecord = HTTPD::ADS::proxy_tested->find_or_create(ip =>$ip);
unless ($proxyrecord->open_proxy eq 't' || $proxyrecord->open_proxy_tested_at )
{ #come back later, think about a time window for retesting...
$open_proxy_test = HTTPD::ADS::OpenProxyDetector->new($ip);
print "proxy test for $ip returns ".$open_proxy_test->code."\n";
$proxyrecord->set(open_proxy =>($open_proxy_test->guilty? 't':'f'), open_proxy_tested_at => gmttimestamp, proxy_test_result => $open_proxy_test-> code);
$proxyrecord->update;
$notify = HTTPD::ADS::AbuseNotify->new(ip => $ip,type =>'PROXY') if $open_proxy_test->guilty;
}
$self->blacklist(
ip=>$ip, first_event => $self->first_eventid($ip),block_reason => 401
)
if ( $proxyrecord->open_proxy eq 't');
}
$self->blacklist(
ip=>$ip, first_event => $self->first_eventid($ip),block_reason => 401
)
if ($eventcount >= $self->IDSEventsThresholdLevel);
}
{
my %blocked_list;
sub blacklist {
my ($self,%args) = @_;
unless ($blocked_list{$args{ip}}++ > 0) {
my $fifo = "/tmp/BlackList";
my $Blacklisted;
die "socket file $fifo present and I can't write to it" unless(-w $fifo) ;
my $sock = IO::Socket::UNIX->new(Peer => $fifo) or confess "$!";
$sock->print("B ".$args{ip}); #we use line-oriented i/o, its simpler...
$args{active}= 'true'; #true...
$args{blocked_at}=$self->gmttimestamp;
$Blacklisted = HTTPD::ADS::Blacklist->create(\%args) ;
}
}
}
sub first_eventid {
my $self = shift @_;
my $ip = shift @_;
my $event= HTTPD::ADS::Eventrecords->first_error_event( $ip, $self->pgtimewindow );
my $eventid = $event->eventid;
return $eventid;
}
1; #this line is important and will help the module return a true value
__END__