File Coverage

blib/lib/DNS/BL/cmds/add.pm

Criterion	Covered	Total	%
statement	45	50	90.0
branch	11	32	34.3
condition	2	5	40.0
subroutine	10	10	100.0
pod	1	1	100.0
total	69	98	70.4

package DNS::BL::cmds::add;

use DNS::BL;

use 5.006001;
use strict;
use warnings;

use NetAddr::IP;
use DNS::BL::cmds;
use DNS::BL::Entry;

use vars qw/@ISA/;

@ISA = qw/DNS::BL::cmds/;

use Carp;

our $VERSION = '0.00_01';
$VERSION = eval $VERSION;  # see L

# Preloaded methods go here.

=pod

=head1 NAME

DNS::BL::cmds::add - Add an  entry to the database

=head1 SYNOPSIS

  use DNS::BL::cmds::add;

=head1 DESCRIPTION

This module implements the B command, used to include entries
into a DNSBL managed by L. The general syntax of this
command, is as follows

  add ip  [code ] [text ] [time ]

where each argument has the following function:

=over 4

=item Bip-addressE>

Specifies which IP address or network this command refers
to. Essentially, anything that L will understand.

=item Breturn-codeE>

The value returned by the DNSBL when a match with this entry is
found. Usually, this is something that can be returned in a DNS A RR,
an IP address. If not specified, '127.0.0.1' will be used as a
default.

=item BtextE>

The text associated with this entry in the DNSBL. Usually this is
associated with a DNS TXT RR. Defaults to an empty string.

=item BtimestampE>

The time associated with this entry in seconds since the
epoch. Defaults to the current time. Some converters might add this
item to the text description.

=back

This functionality is provided by the following method:

=over

=item C<-Eexecute()>

See L for information on this method's general purpose
and calling convention.

This method implements the behavior specified above.

=cut

sub execute
{
    my $bl	= shift;
    my $command	= shift;
    my %args	= @_;

    my @known 	= qw/ip code text time/;

    my @r = __PACKAGE__->arg_check($bl, 'add', $command,
		       [ qw/ip code text time without/ ], \%args);
    return wantarray ? (@r) : $r[0]
	if $r[0] != &DNS::BL::DNSBL_OK;

    my $e = new DNS::BL::Entry;
    my $ip;

    unless (exists $args{ip} and $ip = new NetAddr::IP $args{ip})
    {
	return wantarray ? (&DNS::BL::DNSBL_ESYNTAX(),
			    "'add' requires a valid 'ip' address")
	    : &DNS::BL::DNSBL_ESYNTAX();
    }

    $e->addr($args{ip});

    # Check wether we can add this entry to the database or not

    if (!exists $args{without})
    {
	@r = $bl->read($e);
	return wantarray ?
	    (&DNS::BL::DNSBL_ECOLLISSION,
	     "Collision with existing entry - Use 'print' to locate") :
	     &DNS::BL::DNSBL_ECOLLISSION
	     if $r[0] != &DNS::BL::DNSBL_ENOTFOUND;

	@r = $bl->match($e);
	return wantarray ?
	    (&DNS::BL::DNSBL_ECOLLISSION,
	     "Collision with existing entry - Use 'print' to locate") :
	     &DNS::BL::DNSBL_ECOLLISSION
	     if $r[0] != &DNS::BL::DNSBL_ENOTFOUND;
    }
    elsif ($args{without} ne 'checking')
    {
	return wantarray ?
	    (&DNS::BL::DNSBL_ESYNTAX(),
	     "'add' checks can be spared using 'without checking'")
	    : &DNS::BL::DNSBL_ESYNTAX();
    }

    $e->desc($args{text}) if exists $args{text};
    $e->time($args{time}) if exists $args{time};
    $e->value($args{code} || '127.0.0.1');

    # At this point, we should store the entry in the database
    @r = $bl->write($e);

    return wantarray ? ($r[0], "'add' failed on write: $r[1]") : $r[0]
	if $r[0] != &DNS::BL::DNSBL_OK;

    return wantarray ? (&DNS::BL::DNSBL_OK, "Entry added") :
	&DNS::BL::DNSBL_OK;
};

1;
__END__