#!/usr/bin/perl package Mail::SpamCannibal::BDBclient; use strict; use vars qw($VERSION @ISA @EXPORT_OK); use Socket; use AutoLoader 'AUTOLOAD'; require Exporter; $VERSION = do { my @r = (q$Revision: 0.03 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; @ISA = qw(Exporter); @EXPORT_OK = ('dataquery', 'retrieve', @Socket::EXPORT, @Socket::EXPORT_OK); # returns the number of bytes read on success, else undef; sub _common { my($how,$key,$name,$sockpath,$is_network,$bp) = @_; return undef if $how < 0; $how = 255 if $how > 255; my $alarmval = $is_network || 10; local $SIG{ALRM} = sub {die "timed out"}; alarm $alarmval; my $S = ($is_network) ?_sock($sockpath) : _unsock($sockpath); if ($how) { $$bp = pack("C N Z*",$how,$key,$name); } else { $$bp = pack("C a4 Z*",$how,$key,$name); } my $len = length($$bp); send($S,(pack("n",$len)),0); send($S,$$bp,0); sysread($S,$$bp,2); $len = unpack("n",$$bp); $len = sysread($S,$$bp,$len); close $S; alarm 0; return $len; } sub DESTROY {} 1; __END__ sub _unsock { my($sockpath) = @_; local *S; die "could not create socket: $!" unless socket(S,PF_UNIX,SOCK_STREAM,0); die "could not connect to Daemon" unless connect(S,sockaddr_un($sockpath)); return *S; } sub _sock { my($sockpath) = @_; local *S; my($host,$port) = split(':',$sockpath); die "not a port number '$port'" if $port =~ /\D/ && $port !~ /\d/; my $netaddr; die "could not resolve hostname '$host'" unless ($netaddr = inet_aton($host)); die "could not create socket: $!" unless socket(S,PF_INET,SOCK_STREAM,0); die "could not connect to Daemon" unless connect(S,sockaddr_in($port,$netaddr)); return *S; } =head1 NAME Mail::SpamCannibal::BDBclient -- BDBaccess client =head1 SYNOPSIS use Mail::SpamCannibal::BDBclient qw(dataquery); [constants and functions from Socket avaliable for export] ($key,$val)=dataquery($how,$cursor_key,$name,$sockpath,$is_network); $count=retrieve($howmany,$cursor,$name,\@list,$sockpath,$is_network); =head1 DESCRIPTION B<Mail::SpamCannibal::BDBclient> can retrieve either a single complete record (key + data) or a list of keys (IP addresses) from a BDBaccess daemon either on the local host via a UNIX domain socket, or on a remote host via a network connection. =over 4 =item * ($key,$val)=dataquery($how,$cursor_key,$name,$sockpath,$is_network); Query a BDBaccess daemon for a single record. $how = 0 lookup a record by key value $how = 1 lookup a record by cursor (record number) $cursor_key for $how = 0, IP address of the record of interest as returned by inet_ntoa('11.22.33.44') or for $how = 1, the cursor (record number), where the first valid record number is "1" RETRIEVING DATABASE STATISTICS and VERSION NUMBER The first record number in a Berkeley DB is record number ONE (1), there is no record ZERO (0). If the bdbaccess daemon is queried with $how = 1, for record ZERO (0), it will return the version number of the underlying database in a form that can be unpacked by inet_ntoa. The returned data record will contain the number of keys or unique records currently in the database. Both of these will be 32 bit fields. $name the name of the database from which to fetch the record (usually 'evidence') $sockpath the path to the socket filename, usually '/var/run/dbtarpit/bdbread' or a host and port to connect to in the form hostname:port or 123.11.22.10:port $is_network zero for local socket, alarm timeout > 0 if remote host. Timeout is in seconds. On a successful lookup of a record, what is returned is the access key, a packed 4 byte network address as returned by inet_aton('11.22.33.44'), and the data found for the record. The data may be either a character string or a numeric value depending on which database was accessed. In the case of the 'evidence' database, it will be an character string. If a record is not found or there is any other database error, $key will contain the value INADDR_NONE (the value returned by inet_aton('255.255.255.255') and $data will contain the error code returned by Berkeley DB. If there is a catastrophic failure, such a failure to connect to the domain socket, B<dataquery> will return 'undef' or and empty array () depending on the calling context and $@ will be set with the error. =cut sub dataquery { my($how,$key,$name,$sockpath,$is_network) = @_; my $len; my $buffer; unless ($len = eval{_common($how,$key,$name,$sockpath,$is_network,\$buffer)}) { return () if wantarray; return undef; } my $val; if ($len == 8) { ($key,$val) = unpack("a4 N4",$buffer); } else { ($key,$val) = unpack("a4 A*",$buffer); } return $key unless wantarray; return($key,$val); } =item * $count=retrieve($howmany,$cursor,$name,\@list,$sockpath,$is_network); Retrieve a list of $howmany keys from a BDBaccess daemon. $howmany = 2 -> 255 the number of keys to retrieve $cursor the starting record number $name the name of the database from which to fetch the record $listpointer array reference in which to put list $sockpath the path to the socket filename, usually '/var/run/dbtarpit/bdbread' or a host and port to connect to in the form hostname:port or 123.11.22.10:port $is_network zero for local socket, alarm timeout > 0 if remote host. Timeout is in seconds. On successful lookup, returns the number of items found (this may be zero) and the list is filled accordingly with IP addresses in the form to be decoded by inet_ntoa. On failure, returns undef. =back =cut sub retrieve { my($howmany,$start,$name,$lp,$sockpath,$is_network) = @_; my $len; my $buffer; return undef unless $len = eval{_common($howmany,$start,$name,$sockpath,$is_network,\$buffer)}; $_ = substr($buffer,0,1); my $count = unpack("C",$_); my $sp = 1; foreach(0..$count -1) { my $raw = substr($buffer,$sp,4); $lp->[$_] = unpack("a4",$raw); $sp += 4; } return $count; } =head1 EXPORT none by default =head1 EXPORT_OK dataquery retrieve all the functions and constants available from B<Socket> =head1 AUTHOR Michael Robinton <michael@bizsystems.com> =head1 COPYRIGHT Copyright 2003, 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 SEE ALSO L<Mail::SpamCannibal::BDBaccess>, L<Socket> =cut 1;