DNS::BL - Manage DNS black lists

DNS-BL documentation Contained in the DNS-BL distribution.

Index

Code Index:

NAME

Top

DNS::BL - Manage DNS black lists

SYNOPSIS

Top

  use DNS::BL;

DESCRIPTION

Top

This class provides the services required to manage DNSBL data using this module hierarchy. It does so by implementing a series of methods, that perform the required function and when called in array context, return a two-element list, whose first element is a return code and its second element, is a diagnostic message.

In scalar context, only the constant is returned.

The following constants are defined:

DNSBL_OK

Denotes a succesful operation.

DNSBL_ECONNECT

A problem related to the connection or lack of, to the backend.

DNSBL_ECOLLISSION

When inserting entries in the backend, a previous entry conflicts with this one.

DNSBL_ENOTFOUND

When looking up entries in the backend, no suitable entry has been found.

DNSBL_ESYNTAX

A syntax error was detected by a callback handler.

DNSBL_EOTHER

Some other kind of error.

The following methods are implemented by this module:

->new()

This method creates a new DNS::BL object. No parameters are required.

->parse($command)

This method tokenizes each line given in $command, loading and calling the appropiate modules to satisfy the request. As shipped, each command verb, usually the first word of a $command, will invoke a class from the DNS::BL::cmds::* hierarchy, which handles such commands. A summary of those is included in DNS::BL::cmds. Likely, you can provide your own commands by subclassing DNS::BL::cmds in your own classes.

Note that this method supports comments, by prepending a pound sign. Most Perl-ish way.

When a command is invoked for the first time, the class is use()d. For example, the "foo" command would involve loading the DNS::BL::cmds::foo class.

After this loading process, the class' execute() method is invoked. This is documented in DNS::BL::cmds.

->set($key, $value)

Set the value of a $key which is stored in the object itself, to the scalar $value.

->get($key)

Retrieve the scalar value associated to the given $key.

The following methods are really pointers meant to be replaced by the DNS::BL::cmds::connect::* classes invoked at runtime. The specific function of each function is discussed below (briefly) and in DNS::BL::cmds::connect.

The DNS::BL::cmds::connect::* classes must replace them by using the the accessors to store the reference to the function (or clusure), using the same name of the method, prepending an underscore.

->read($entry)

Given an $entry, retrieve all the DNS::BL::Entry objects contained in the IP address range denoted in its ->addr() method, stored in the connected backend. Its return value, is a list where the first element is the result code, the second is a message suitable for diagnostics. The rest of the elements, if any, are the matching entries found.

$entry should be a DNS::BL::Entry object.

->match($entry)

Given an $entry, retrieve all the DNS::BL::Entry objects that contain the IP address range denoted in its ->addr() method, stored in the connected backend. Its return value, is a list where the first element is the result code, the second is a message suitable for diagnostics. The rest of the elements, if any, are the matching entries found.

$entry should be a DNS::BL::Entry object.

->write($entry)

Store the given DNS::BL::Entry object in the connected backend.

->erase($entry)

Delete all the DNS::BL::Entries from the connected backend, whose ->addr() network range falls entirely within the one given in $entry.

->commit()

Commit all the changes to the backend. In some backends this is a no-op, but it should be invoked at the end of each command block.

EXPORT

None by default.

HISTORY

Top

0.00_01

Original version; created by h2xs 1.22

0.01

First RC

0.02

Added an index to db connection method. This improves performance. Minor changes to other components. Added regression testing for IO commands.

SEE ALSO

Top

Perl(1), DNS::BL::cmds, DNS::BL::Entry, DNS::BL::cmds::connect, DNS::BL::cmds::connect::*.

AUTHOR

Top

Luis Muņoz, <luismunoz@cpan.org>

COPYRIGHT AND LICENSE

Top

Copyright 2004 by Luis Muņoz

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

DNS-BL documentation Contained in the DNS-BL distribution. 
package DNS::BL;

use 5.006001;
use strict;
use warnings;

use Carp;

# These constans are used to specify specific error condition / result
# codes.


use constant DNSBL_OK		=> 0;
use constant DNSBL_ECONNECT	=> 1;
use constant DNSBL_ECOLLISSION	=> 2;
use constant DNSBL_ENOTFOUND	=> 4;
use constant DNSBL_ESYNTAX	=> 8;
use constant DNSBL_EOTHER	=> 16;

use constant ERR_MSG => "Must issue a 'connect' first";

our $VERSION = '0.03';
$VERSION = eval $VERSION;  # see L<perlmodstyle>

# Preloaded methods go here.


sub new($)
{
    my $class = shift;
    return bless 
    {
	k => {},		# Storage
    }, $class;
}



sub parse($$)
{
    my $self = shift;
    my $comm = shift;

    $comm =~ s/^\s+//;		# Remove leading whitespace
    $comm =~ s/\s+$//;		# Remove trailing whitespace

    my @tok = ();		# List of tokens
    my $proto = undef;		# A proto-token
    my $in_string = 0;		# State: Are we within a quoted string?
    
    # Iterate through characters in a simple automaton

    for my $c (split //, $comm)
    {
	if ($c eq '"')
	{
	    push @tok, $proto if defined $proto || $in_string;
	    $proto = undef;
	    $in_string = ! $in_string;
	    next;
	}
	elsif ($c eq '#' and ! $in_string)
	{
	    last;
	}
	elsif ($c =~ /\s/s and ! $in_string and defined $proto)
	{
	    push @tok, $proto;
	    $proto = undef;
	}
	else
	{
	    next if $c =~ /\s/s and ! $in_string;
	    $proto .= $c;
	}
    }

    # Flag trailing quoted strings
    if ($in_string)
    {
	return wantarray?(DNSBL_ESYNTAX, 
			  "End of command within a quoted string")
	    :DNSBL_ESYNTAX 
    }

    # The ending token must be considered too
    push @tok, $proto if defined $proto;

    # Trivial case: An empty line...
    unless (@tok)
    {
	return wantarray?(DNSBL_OK, "-- An empty line, huh?")
	    : DNSBL_OK;
    }

    my $verb = shift @tok;

    do {
	no strict 'refs';
	unless (*{ __PACKAGE__ . "::cmds::${verb}::execute"}{CODE})
	{
	    eval "use " . __PACKAGE__ . "::cmds::${verb};";
	    if ($@)
	    {
		return wantarray?(DNSBL_ESYNTAX, "Verb $verb undefined: $@")
		    :DNSBL_ESYNTAX;
	    }
	}

	if (*{ __PACKAGE__ . "::cmds::${verb}::execute"}{CODE})
	{			# Handler exists
	    return &{ __PACKAGE__ 
			  . "::cmds::${verb}::execute"}($self, $verb, @tok);
	}
    };
    
    return wantarray?(DNSBL_ESYNTAX, "Verb $verb is undefined")
	:DNSBL_ESYNTAX;
}


sub set { my $ret = $_[0]->{k}->{$_[1]}; $_[0]->{k}->{$_[1]} = $_[2]; 
	  return $ret; }


sub get { return $_[0]->{k}->{$_[1]}; }


sub read	{ &{$_[0]->{k}->{_read}		|| *{_io}{CODE}}(@_); }
sub match	{ &{$_[0]->{k}->{_match}	|| *{_io}{CODE}}(@_); }
sub write	{ &{$_[0]->{k}->{_write}	|| *{_io}{CODE}}(@_); }
sub erase	{ &{$_[0]->{k}->{_erase}	|| *{_io}{CODE}}(@_); }
sub commit	{ &{$_[0]->{k}->{_commit}	|| *{_io}{CODE}}(@_); }
sub _io		{ wantarray?(&DNSBL_ECONNECT, &ERR_MSG):&DNSBL_ECONNECT }

sub DNS::BL::cmds::commit::execute { $_[0]->commit(@_); }

sub DNS::BL::cmds::_dump::execute
{
    use Data::Dumper;
    my $self = shift;

    print "*** Current object $self:\n";
    print Data::Dumper->Dump([$self]); 

    if (@_)
    {
	print "*** Arguments:\n";
	print "  '$_'\n" for @_;
    }
    else
    {
	print "*** No arguments\n";
    }
    return wantarray ? (DNSBL_OK, "Debug dump done") : DNSBL_OK;
}

1;
__END__