Mail::SpamCannibal::BDBclient - BDBaccess client


Mail-SpamCannibal documentation Contained in the Mail-SpamCannibal distribution.

Index


Code Index:

NAME

Top

Mail::SpamCannibal::BDBclient -- BDBaccess client

SYNOPSIS

Top

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

DESCRIPTION

Top

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.

* ($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, dataquery will return 'undef' or and empty array () depending on the calling context and $@ will be set with the error.

* $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.

EXPORT

Top

	none by default

EXPORT_OK

Top

	dataquery
	retrieve

	all the functions and constants
	available from B<Socket>

AUTHOR

Top

Michael Robinton <michael@bizsystems.com>

COPYRIGHT

Top

SEE ALSO

Top

Mail::SpamCannibal::BDBaccess, Socket


Mail-SpamCannibal documentation Contained in the Mail-SpamCannibal distribution.
#!/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;
}

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

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


1;