# URIdb # Functions for interacting with the URI database package URIdb; use strict; use warnings; use Exporter; use DBI; use NetAddr::IP; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); $VERSION = 1.0; @ISA = qw(Exporter); @EXPORT_OK = qw( ); @EXPORT = (); # Export nothing by default. %EXPORT_TAGS = ( ALL => [qw( )] ); ## "constants" # 8 bits available # 128 is per-IP shitlist # 2 is IP hitlist # 1 not available so we don't $self->shoot(foot) our %status = ( 0 => "Don't list", 2 => "Black", 4 => "Grey", 8 => "Abused URL shortener/redirector" ); # variables our $dbh; our $err; our $errstr; # basic object subs sub new { # iff we want to start taking arguments, or doing other things on instantiation # my $self = {}; # bless $self, "DNSBL"; # return $self; bless {}; } sub DESTROY { my $self = shift; $self->dbclose() if $dbh; } # JIC someone wants to close the db but not finish the script sub dbclose { $dbh->rollback; $dbh->disconnect; } ## specific object subs: sub connect { my $self = shift; my $dbhost = shift; my $dbname = shift; my $dbuser = shift; my $dbpass = shift; ## want to NOT autocommit everything, it's unlikely we'll step on our own toes but... $dbh = DBI->connect("DBI:Pg:host=$dbhost;dbname=$dbname", $dbuser, $dbpass, { AutoCommit => 0, PrintError => 1 }) or die "database inaccessible: ".$DBI::errstr; # my $sth = $dbh->prepare("SELECT masklen,ipcount FROM autolist"); # $sth->execute; # while (my ($masklen,$ipcount) = $sth->fetchrow_array) { # $autolist{$masklen} = $ipcount; # } return $dbh; } # report a URI to the db # increments a hit counter iff the reported URI exists, otherwise it adds it # requires the uri. # can accept the listing level and a comment sub report { my $self = shift; my $uri = shift; my $list = shift || 2; my $comment = shift || ''; my $sth; my $rows = 0; $sth = $dbh->prepare("SELECT count FROM urilist WHERE uri=?"); $sth->execute($uri) or die "eep? ".$dbh->errstr."\n"; $rows = $sth->rows; if ($rows == 0) { $sth = $dbh->prepare("INSERT INTO urilist (uri,list,comment) VALUES (?,?,?)"); $sth->execute($uri,$list,$comment) or die "couldn't add $uri: ".$dbh->errstr."\n"; } elsif ($rows == 1) { $sth = $dbh->prepare("UPDATE urilist SET count=count+1 WHERE uri=?"); $sth->execute($uri) or die "couldn't update listing for $uri: ".$dbh->errstr."\n"; } else { die "db corrupt: found $rows matches on $uri\n"; } $dbh->commit; return $rows; } # end report() sub exists { my $self = shift; my $checkme = shift; my $sth = $dbh->prepare("SELECT count(*) FROM urilist WHERE uri=?"); $sth->execute($checkme); my ($count) = $sth->fetchrow_array; return $count; } # Write the data straight to a DNS server's files. # Takes a server type and open filehandle. sub export { my $self = shift; my $target = shift; my $blfh = shift; my $sth; if ($target eq 'rbldnsd') { print $blfh ":127.0.0.2:Domain found in reported missed-spam, no legitimate root or www content\n"; $sth = $dbh->prepare("SELECT uri FROM urilist WHERE list=2"); $sth->execute; while (my ($uri) = $sth->fetchrow_array) { print $blfh ".$uri\n"; } print $blfh ":127.0.0.4:Domain seen repeatedly in reported missed-spam, legitimate root or www content\n"; $sth = $dbh->prepare("SELECT uri FROM urilist WHERE list=4"); $sth->execute; while (my ($uri) = $sth->fetchrow_array) { print $blfh ".$uri\n"; } print $blfh ":127.0.0.8:Abused, not well-known URL-shortener or redirector domain\n"; $sth = $dbh->prepare("SELECT uri FROM urilist WHERE list=8"); $sth->execute; while (my ($uri) = $sth->fetchrow_array) { print $blfh ".$uri\n"; } } elsif ($target eq 'tinydns') { } elsif ($target eq 'bind') { } else { } return; } # end export() # make Perl happy 1;