Move karma_tool to Qpsmtpd::DB

Tested manually with karma_tool which has no test coverage
This commit is contained in:
Jared Johnson 2014-11-27 22:24:08 -06:00
parent 57c07b17b1
commit 893f45e333

View File

@ -4,13 +4,13 @@ package Karma;
use strict;
use warnings;
BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
use AnyDBM_File;
use Data::Dumper;
use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB);
use Net::IP qw(:PROC);
use POSIX qw(strftime);
use lib 'lib';
use Qpsmtpd::DB;
my $self = bless({args => {db_dir => 'config'},}, 'Karma');
my $command = $ARGV[0];
@ -57,6 +57,18 @@ EO_HELP
;
}
sub db {
my ( $self ) = @_;
return $self->{db} if $self->{db};
$self->{db} = Qpsmtpd::DB->new( name => 'karma' );
$self->{db}->dir(
$self->{args}{db_dir},
qw( /var/lib/qpsmtpd/karma ./var/db ./config . ) );
my $path = $self->{db}->path;
print "using karma db at $path\n";
return $self->{db};
}
sub capture {
my $self = shift;
my $ip = shift or return;
@ -65,16 +77,14 @@ sub capture {
return;
};
my $db = $self->get_dbm_location();
my $lock = $self->get_dbm_lock($db) or return;
my $tied = $self->get_dbm_tie($db, $lock) or return;
$self->db->lock;
my $key = $self->get_karma_key($ip);
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
$tied->{$key};
$self->db->get( $key );
$tied->{$key} = join(':', time, $naughty + 1, $nice, $connects);
return $self->cleanup_and_return($tied, $lock);
$self->db->set( $key, join(':', time, $naughty + 1, $nice, $connects) );
$self->db->unlock;
}
sub release {
@ -82,28 +92,26 @@ sub release {
my $ip = shift or return;
is_ip($ip) or do { warn "not an IP: $ip\n"; return; };
my $db = $self->get_dbm_location();
my $lock = $self->get_dbm_lock($db) or return;
my $tied = $self->get_dbm_tie($db, $lock) or return;
$self->db->lock;
my $key = $self->get_karma_key($ip);
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
$tied->{$key};
$self->db->get( $key );
$tied->{$key} = join(':', 0, 0, $nice, $connects);
return $self->cleanup_and_return($tied, $lock);
$self->db->set( $key, join(':', 0, 0, $nice, $connects) );
$self->db->unlock;
}
sub show_ip {
my $self = shift;
my $ip = shift or return;
my $db = $self->get_dbm_location();
my $lock = $self->get_dbm_lock($db) or return;
my $tied = $self->get_dbm_tie($db, $lock) or return;
$self->db->lock;
my $key = $self->get_karma_key($ip);
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
$tied->{$key};
$self->db->get( $key );
$self->db->unlock;
$naughty ||= 0;
$nice ||= 0;
$connects ||= 0;
@ -122,17 +130,15 @@ sub show_ip {
sub main {
my $self = shift;
my $db = $self->get_dbm_location();
my $lock = $self->get_dbm_lock($db) or return;
my $tied = $self->get_dbm_tie($db, $lock) or return;
$self->db->lock;
my %totals;
print
" IP Address Penalty Naughty Nice Connects Hostname\n";
foreach my $r (sort keys %$tied) {
foreach my $r ( $self->db->get_keys ) {
my $ip = ip_bintoip(ip_inttobin($r, 4), 4);
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
$tied->{$r};
$self->db->get( $r );
$naughty ||= '';
$nice ||= '';
$connects ||= '';
@ -167,6 +173,7 @@ sub main {
$totals{nice} += $nice if $nice;
$totals{connects} += $connects if $connects;
}
$self->db->unlock;
print Dumper(\%totals);
}
@ -176,114 +183,28 @@ sub is_ip {
return 1;
}
sub cleanup_and_return {
my ($self, $tied, $lock) = @_;
untie $tied;
close $lock;
}
sub get_karma_key {
my $self = shift;
my $nip = Net::IP->new(shift) or return;
return $nip->intip; # convert IP to an int
}
sub get_dbm_tie {
my ($self, $db, $lock) = @_;
tie(my %db, 'AnyDBM_File', $db, O_CREAT | O_RDWR, 0600) or do {
warn "tie to database $db failed: $!";
close $lock;
return;
};
return \%db;
}
sub get_dbm_location {
my $self = shift;
# Setup database location
my @candidate_dirs = (
$self->{args}{db_dir},
"/var/lib/qpsmtpd/karma", "./var/db", "./config", '.'
);
my $dbdir;
for my $d (@candidate_dirs) {
next if !$d || !-d $d; # impossible
$dbdir = $d;
last; # first match wins
}
my $db = "$dbdir/karma.dbm";
print "using karma db at $db\n";
return $db;
}
sub get_dbm_lock {
my ($self, $db) = @_;
return $self->get_dbm_lock_nfs($db) if $self->{_args}{nfslock};
# Check denysoft db
open(my $lock, ">$db.lock") or do {
warn "opening lockfile failed: $!";
return;
};
flock($lock, LOCK_EX) or do {
warn "flock of lockfile failed: $!";
close $lock;
return;
};
return $lock;
}
sub get_dbm_lock_nfs {
my ($self, $db) = @_;
require File::NFSLock;
### set up a lock - lasts until object looses scope
my $nfslock = new File::NFSLock {
file => "$db.lock",
lock_type => LOCK_EX | LOCK_NB,
blocking_timeout => 10, # 10 sec
stale_lock_timeout => 30 * 60, # 30 min
}
or do {
warn "nfs lockfile failed: $!";
return;
};
open(my $lock, "+<$db.lock") or do {
warn "opening nfs lockfile failed: $!";
return;
};
return $lock;
}
sub prune_db {
my $self = shift;
my $prune_days = shift;
my $db = $self->get_dbm_location();
my $lock = $self->get_dbm_lock($db) or return;
my $tied = $self->get_dbm_tie($db, $lock) or return;
my $count = keys %$tied;
$self->db->lock;
my $count = $self->db->size;
my $pruned = 0;
foreach my $key (keys %$tied) {
my ($ts, $naughty, $nice, $connects) = split /:/, $tied->{$key};
foreach my $key ( $self->db->get_keys ) {
my ($ts, $naughty, $nice, $connects) = split /:/, $self->db->get( $key );
my $days_old = (time - $ts) / 86400;
next if $days_old < $prune_days;
delete $tied->{$key};
$self->db->delete( $key );
$pruned++;
}
untie $tied;
close $lock;
$self->db->unlock;
warn "pruned $pruned of $count DB entries";
return $self->cleanup_and_return($tied, $lock);
}