#!/usr/bin/perl -w
 
=head1 NAME
 
berleley_operation - This program, operate on the berkeley_operation database
 
=head1 SYNOPSIS
 
This module can delete the old items of a BerkeleyDB, or add new items manually
 
 
=head1 OPTIONS
 
=over 4
 
=item --help
 
This text
 
=item --action <clean|add>
 
This is the required action
 
If you use clean, you should specify the timeout value whith L<--time>.
 
If you use add, you must give the new registers with L<--addfile>.
 
=item --dbfilename <file>
 
The name of the berkeley file. If it does'n exists, It creates the DB
 
This parameter is REQUIRED
 
=item --type <btree|hash>
 
The type of Berkeley db. Hash or Btree. Default is btree
 
=item --debug <0|1|2 or'ed mask>
 
This is the debug level. Use 2=read items 1=deleted items, 0=no debug
 
The default is 0 (no debug)
 
=item --time <SECONDS>
 
This is for clean action
 
Deletes the elements modified more than SECONDS ago.
 
The default is 600 seconds
 
=item --addfile <FILENAME>
 
This is a file with values to add to de Berkeley database.
 
If this parameter is C<->, the parameters are read from I<STDIN>
 
 
The file format is:
IP|TIMESTAMP|value_1|value_i|...|value_n
 
The lenght should be fixed for better performance/sizeing.
 
See in L<berkeley_tokenbucketadd>
 
For example, to print the IP, use C<%-15s>
 
The default in C<->
 
=back
 
=head1 EXAMPLE
 
To clean the database, in the /etc/cron.d/qpsmtpd
 
C<*/5 * * * * qpsmtpd_user /path/to/this/program/berkeley_operation --clean --dbfilename=/tmp/tokenbucket.bdb --type btree --time 300>
 
=head1 NOTES
 
Remember to C<db_recover -h dbname> when the system is restarted
 
 
=head1 BUGS
 
 
=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_operation,v 1.4 2006/05/16 14:12:33 leoh Exp $
 
=cut
 
use warnings;
use strict;
 
use Pod::Usage;
use Getopt::Long;
use File::Basename;
use BerkeleyDB;
 
my $config= {
		'action' => "",
		'dbfilename' => "",
		'type' => 'btree',
		'time' => 600,
		'debug' => 0,
		'help' => 0,
		'addfile' => "-",
		};
 
unless( GetOptions( 	
			"action=s" => \$config->{'action'},
			"dbfilename=s" => \$config->{'dbfilename'},
			"type=s" => \$config->{'type'},
			"time=i" => \$config->{'time'},
			"debug=i" => \$config->{'debug'},
			"addfile=s" => \$config->{'addfile'},
			"help" => \$config->{'help'},
			) ) {
	die "No puedo procesar las opciones\n";
}
 
chkconfig( $config );
 
if( $config->{'action'} eq "clean" ) {
	cleanBDB( $config );
}
elsif( $config->{'action'} eq "add" ) {
	addRegisters( $config );
 
}
 
 
exit 0;
 
sub cleanBDB {
	my ($config) = @_;
 
	my $db= openBDB($config->{'dbfilename'}, $config->{'type'});
	unless( $db ) {
		print STDERR "No pude abrir la base de datos\n";
		exit 3;
	}
 
	my @workaround_c_del=();
	my $cursor = $db->db_cursor() ;
	if( $cursor ) {
		my ($key, $value)=("","");
		my $time= time;
		while ($cursor->c_get($key, $value, DB_NEXT) == 0) {
			my ($timestamp, $dumyvalues)=split(/\s*\|\s*/, $value,2);
			($config->{'debug'} & 2) && print "DEBUG2: Read $key/n";
			if( ($time - $timestamp) > $config->{'time'} ) {
				# Esto es lo correcto, pero por el bug
				# http://rt.cpan.org/Public/Bug/Display.html?id=5853
				# tengo que hacer un workaround
				#$cursor->c_del();
				push @workaround_c_del, $key;
			}
		}
		undef $cursor;
	}
	else {
		print STDERR "No pude abrir un cursor\n";
		exit 7;
	}
	if( @workaround_c_del ) {
		for my $key (@workaround_c_del) {
			($config->{'debug'} & 1) && print "DEBUG1: del $key\n";
			$db->db_del($key);
		}
	}
 
	return 1;
}
 
sub addRegisters {
	my ($config) = @_;
	my $fp;
	if( open( $fp, "<". $config->{'addfile'} ) ) {
		my $db= openBDB($config->{'dbfilename'}, $config->{'type'});
		unless( $db ) {
			print STDERR "No pude abrir la base de datos\n";
			exit 3;
		}
		while( <$fp> ) {
			chomp;
			my @keyvalue=split( /\|/, $_, 2 );
			if( @keyvalue == 2 ) {
				$db->db_put( @keyvalue );
			}
			else {
				print STDERR "El formato de los datos es incorrecto. Salgo\n";
				exit 3;
			}
		}
		close( $fp );
	}
	else {
		print STDERR "No puedo abrir '" . $config->{'addfile'} . "' para lectura [$!]\n";
		exit 3;
	}
	return 1;
}
 
 
sub openBDB  {
	my ($filename, $type)=@_;
 
	my($name,$path) = fileparse($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 $db;
	if( $type eq "btree" ) {
		$db= new BerkeleyDB::Btree(
			-Filename => $name,
			-Flags => BerkeleyDB::DB_CREATE(),
			-Env => $env );
	}
	else {  
		$db= new BerkeleyDB::Hash(
			-Filename => $name,
			-Flags => BerkeleyDB::DB_CREATE(),
			-Env => $env );
	}
	unless( $db ) {
		print STDERR "Can't open database " . $filename . " failed: $!\n";
		exit 6;
	}
	return $db;
}
 
sub chkconfig {
	my( $config )=@_;
 
	if( $config->{'help'} ) {
		pod2usage( -message => "HELP:", -exitval => 1, -verbose => 1 );
	}
 
	unless( $config->{'action'} eq "add" || $config->{'action'} eq "clean" ) {
		pod2usage( -message => "The parameter 'action' is invalid or the (" . $config->{'action'} . ")", -exitval => 2, -verbose => 1 );
	}
	unless( $config->{'type'} eq "btree" || $config->{'type'} eq "hash" ) {
		pod2usage( -message => "The parameter 'action' is invalid or the (" . $config->{'action'} . ")", -exitval => 2, -verbose => 1 );
	}
	if( $config->{'dbfilename'} ) {
		my($name,$path) = fileparse($config->{'dbfilename'});
		unless( -d $path ) {
			pod2usage( -message => "Cant access to path '$path' in dbfilename '" . $config->{'dbfilename'} . "'", -exitval => 2, -verbose => 1 );
		}
	}
	else {
		pod2usage( -message => "You MUST specify a parameter 'dbfilename'", -exitval => 2, -verbose => 1 );
	}
	if( $config->{'action'} eq "add" ) {
		if( $config->{'addfile'} ne '-' ) {
			unless( -f $config->{'addfile'} ) {
				pod2usage( -message => "The file used in --addfile (" . $config->{'addfile'} . ") doesn't exist", -exitval => 2, -verbose => 1 );
			}
		}
	}
}
 
 
1;
 
# vim:ft=perl: