=head1 NAME
 
berkeley_ipblacklist - Check that the client ip is not in the berkeley database
 
=head1 DESCRIPTION
 
It makes the desition to accept or reject the connection of certain IP's
It uses a BerkeleyDB see L<"DABASE FORMAT"> for the description of the database format.
The client ip's can be whitelisted by the plugin L<berkeley_ipblacklist_ignore>
This plugin must be near the top of the config file.
 
=head1 DATABASE FORMAT
 
The database is a btree or a hash, and 
KEY=<IP> DATA=<TIMESTAMP>|<VALUE1>|<VALUE2>|<VALUE3>
Where TIMESTAMP is a UNIX ts, and the meaning of VALUEn is specified
by the "method" configuration parameter.
 
For example for the record with a key 123.4.5.67
1139421007|1
 
Each of the fields must be right padded with whitespace.
 KEY=123.567.901.345     sprintf(%-*s, BERKELEY_IPBLACKLIST_KEYLEN, key)
 DATA=1139421007|123     sprintf(%-*s, BERKELEY_IPBLACKLIST_DATALEN, time, data)
 
 
 
If this plugin finds a blacklisted IP, it returns DENYSOFT, DENY 
or DECLINE depending on "action" configuration parameter
 
 
This plugin, needs another plugin, or an external program to fill the BerkeleyDB
 
For example
 berkeley_tokenbucketadd ... (method tokenbucket)
 
 
=head1 CONFIGURATION
 
=over 4
 
=item filename <file>
 
The name of the berkeley file. If it does'n exists, returns DECLINED
 
This parameter is REQUIRED
 
=item type <btree|hash>
 
The type of Berkeley db. Hash or Btree. Default is btree
 
=item action [string: deny, denysoft, log]
 
What to do when matching an berkeley_ipblacklist -- the options are I<deny>,
I<denysoft> or I<log>.
 
If I<log> is specified, the connection will be allowed to proceed as normal,
and only a warning will be logged.
 
The default is I<denysoft>.
 
=item method [string: simple, tokenbucket, tokenbucketx2]
 
This is the record method, the default is 'simple'
 
=over 4
 
=item simple
 
The connection is blacklisted only if I<VALUE1> is true
 
=item tokenbucket (Algorithm::TokenBucket)
 
Token bucket parameters are serialized in I<VALUEn>. An Algorithm::TokenBucket
object is created with the serialized parameters, and the desition is made
based on $bucket->conform(1)
 
From Wikipedia:
The TokenBucket algorithm can be conceptually understood as follows:
 
* A token is added to the bucket every 1 / r seconds. (r=rate)
 
* The bucket can hold at the most b tokens. If a token arrives when the bucket is full, it is discarded.
 
* When a packet (network layer PDU) of n bytes arrives, n tokens are removed from the bucket, and the packet is sent to the network.
 
* If fewer than n tokens are available, no tokens are removed from the bucket, and the packet is considered to be non-conformant.
 
 
The algorithm allows bursts of up to b bytes, but over the long run the output of conformant packets is limited to the constant rate, r. Non-conformant packets can be treated in various ways.
 
=item tokenbucketx2 (Algorithm::TokenBucket x 2)
 
Same as ATB, but keeps 2 independent buckets, and the desition is made based on $bucket1->conform(1) && $bucket2->conform(1)
 
=back
 
=back
 
=head1 MODULE DEPENDENCIES
 
=over 4
 
=item BerkeleyDB
 
=item Algorithm::TokenBucket
 
=back
 
=head1 NOTES
 
Remember to C<db_recover -h dbname> when the system is restarted
 
 
=head1 AUTHOR
 
Written by Leonardo Helman <lhelman@pert(punto)com(punto)ar>.
Pert Consultores SRL
Argentina
 
=head1 COPYRIGHT AND LICENSE
 
Copyright (c) 2005 Leonardo Helman. Pert Consultores SRL Argentina
 
This plugin is licensed under the same terms as the qpsmtpd package itself.
Please see the LICENSE file included with qpsmtpd for details.
 
=head1 VERSION
 
$Id: berkeley_ipblacklist,v 1.14 2006/05/16 14:12:33 leoh Exp $
 
=cut
 
use warnings;
use strict;
 
use File::Basename;
use BerkeleyDB;
use Algorithm::TokenBucket;
 
# VERY IMPORTANT TO KEEP THE SAME BETWEEN ALL THE berkeleys_...
sub BERKELEY_IPBLACKLIST_KEYLEN {15}  # 123.567.901.345
 
 
sub register {
	my ($self, $qp, @args) = @_;
 
	if (@args % 2) {
		$self->log(LOGERROR, "Unrecognized/mismatched arguments");
		return undef;
	}
	$self->{_args} = {
		'filename' => 0,
		'type' => 'btree',
		'action' => 'denysoft',
		'method' => 'simple',
		@args,
		};
	if( $self->{_args}->{'filename'} ) {
		# untaint
		if( $self->{_args}->{'filename'} =~ /^([\w\:\=.\/_-]*)$/ ) {
			$self->{_args}->{'filename'}= $1;
		}
		else {
			$self->log(LOGCRIT, "The parameter 'filename' is invalid (" . $self->{_args}->{'filename'} . ")");
			return DECLINED;
		}
	}
	else {
		$self->log(LOGCRIT, "The parameter 'filename' is REQUIRED");
		return DECLINED;
	}
	$self->register_hook('connect', 'connect_handler');
	1;
}
 
sub connect_handler {
	my ($self, $transaction) = @_;
	my $ip = $self->qp->connection->remote_ip;
 
	return DECLINED
		if ($self->qp->connection->notes('berkeley_ipblacklist_ignore'));
 
	if ($self->isBlacklisted($ip)) {
		my $msg = "[$ip] is blacklisted";
		$self->log(LOGNOTICE, $msg);
		return (DENY,$msg) if $self->{_args}->{'action'} eq 'deny';
		return (DENYSOFT,$msg) if $self->{_args}->{'action'} eq 'denysoft';
	} else {
		$self->log(LOGINFO, 'remote host is not in berkeley_ipblacklist, proceeding');
	}
	return DECLINED;
}
 
sub isBlacklisted {
	my ($self, $ip)=@_;
 
	my($name,$path) = fileparse($self->{_args}->{'filename'});
 
	# TODO: Poner esto en un modulo tipo pp= new db, pp->read, pp->close
 
	# Utilizo DB_INIT_CDB 
	# esto no es 100% preciso, si hay dos conexiones desde la misma IP,
	# cada uno va a hacer un db_get, modificar los datos, y escribirlos
	# pero el lock se realiza solo en la escritura.
	# Esto puede hacer que una ip pueda mandar mas cosas sin que el
	# sistema se de cuenta.
	# Pero no es una situacion catastrofica. 
	# A lo sumo esa IP podra multiplicar sus limites por el 
	# parametro cantidad de conexiones simultaneas desde una misma IP.
	# La forma correcta es mediante DB_INIT_LOCK
	my $env = new BerkeleyDB::Env  -Home => $path,
                                	-Cachesize => 204_800,
                                	-ErrFile => "$path/error.log",
                                	-Verbose=> 255,
                                	-Flags => DB_CREATE | DB_INIT_CDB | DB_INIT_MPOOL;
 
	my $retval=0;
	my $key= sprintf( "%-*s", BERKELEY_IPBLACKLIST_KEYLEN, $ip );
 
	my $db;
	if( $self->{_args}->{'type'} eq "btree" ) {
		$db= new BerkeleyDB::Btree(
			-Filename => $name,
			-Flags => BerkeleyDB::DB_RDONLY(),
			-Env => $env );
	}
	else {
		$db= new BerkeleyDB::Hash(
			-Filename => $name,
			-Flags => BerkeleyDB::DB_RDONLY(),
			-Env => $env );
	}
	if( $db) {
		my $value;
		if( $db->db_get($key, $value) == 0 ) {
			my( $timestamp, @values )=split(/\|/, $value);
			if( $self->{_args}->{'method'} eq "tokenbucket" ) {
				$retval= $self->isBlacklistedTokenBucket(@values);
			}
			elsif( $self->{_args}->{'method'} eq "tokenbucketx2" ) {
				$retval= $self->isBlacklistedTokenBucketX2(@values);
			}
			else {
				$retval= $self->isBlacklistedSimple(@values);
			}
		}
	}
	else {
		$self->log(LOGCRIT, "Can't open BerkeleyDB file '" . $self->{_args}->{'filename'} . "' type: " . $self->{_args}->{'type'} );
	}
	return $retval;
}
 
sub isBlacklistedSimple {
	my ($self, $blacklist)=@_;
	return $blacklist;
}
 
sub isBlacklistedTokenBucket {
	my ( $self, @state )=@_;
 
	my $bucket1 = new Algorithm::TokenBucket @state;
	return !$bucket1->conform(1);
}
 
sub isBlacklistedTokenBucketX2 {
	my ( $self, @state )=@_;
 
	my $bucket1 = new Algorithm::TokenBucket @state[0..3];
	my $bucket2 = new Algorithm::TokenBucket @state[4..7];
	return !($bucket1->conform(1) && $bucket2->conform(1));
}
 
1;
 
# vim:ft=perl: