Move karma_tool to Qpsmtpd::DB
Tested manually with karma_tool which has no test coverage
This commit is contained in:
parent
57c07b17b1
commit
893f45e333
@ -4,13 +4,13 @@ package Karma;
|
|||||||
use strict;
|
use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File) }
|
|
||||||
use AnyDBM_File;
|
|
||||||
use Data::Dumper;
|
use Data::Dumper;
|
||||||
use Fcntl qw(:DEFAULT :flock LOCK_EX LOCK_NB);
|
|
||||||
use Net::IP qw(:PROC);
|
use Net::IP qw(:PROC);
|
||||||
use POSIX qw(strftime);
|
use POSIX qw(strftime);
|
||||||
|
|
||||||
|
use lib 'lib';
|
||||||
|
use Qpsmtpd::DB;
|
||||||
|
|
||||||
my $self = bless({args => {db_dir => 'config'},}, 'Karma');
|
my $self = bless({args => {db_dir => 'config'},}, 'Karma');
|
||||||
my $command = $ARGV[0];
|
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 {
|
sub capture {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $ip = shift or return;
|
my $ip = shift or return;
|
||||||
@ -65,16 +77,14 @@ sub capture {
|
|||||||
return;
|
return;
|
||||||
};
|
};
|
||||||
|
|
||||||
my $db = $self->get_dbm_location();
|
$self->db->lock;
|
||||||
my $lock = $self->get_dbm_lock($db) or return;
|
|
||||||
my $tied = $self->get_dbm_tie($db, $lock) or return;
|
|
||||||
my $key = $self->get_karma_key($ip);
|
my $key = $self->get_karma_key($ip);
|
||||||
|
|
||||||
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
|
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
|
||||||
$tied->{$key};
|
$self->db->get( $key );
|
||||||
|
|
||||||
$tied->{$key} = join(':', time, $naughty + 1, $nice, $connects);
|
$self->db->set( $key, join(':', time, $naughty + 1, $nice, $connects) );
|
||||||
return $self->cleanup_and_return($tied, $lock);
|
$self->db->unlock;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub release {
|
sub release {
|
||||||
@ -82,28 +92,26 @@ sub release {
|
|||||||
my $ip = shift or return;
|
my $ip = shift or return;
|
||||||
is_ip($ip) or do { warn "not an IP: $ip\n"; return; };
|
is_ip($ip) or do { warn "not an IP: $ip\n"; return; };
|
||||||
|
|
||||||
my $db = $self->get_dbm_location();
|
$self->db->lock;
|
||||||
my $lock = $self->get_dbm_lock($db) or return;
|
|
||||||
my $tied = $self->get_dbm_tie($db, $lock) or return;
|
|
||||||
my $key = $self->get_karma_key($ip);
|
my $key = $self->get_karma_key($ip);
|
||||||
|
|
||||||
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
|
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
|
||||||
$tied->{$key};
|
$self->db->get( $key );
|
||||||
|
|
||||||
$tied->{$key} = join(':', 0, 0, $nice, $connects);
|
$self->db->set( $key, join(':', 0, 0, $nice, $connects) );
|
||||||
return $self->cleanup_and_return($tied, $lock);
|
$self->db->unlock;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub show_ip {
|
sub show_ip {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $ip = shift or return;
|
my $ip = shift or return;
|
||||||
my $db = $self->get_dbm_location();
|
$self->db->lock;
|
||||||
my $lock = $self->get_dbm_lock($db) or return;
|
|
||||||
my $tied = $self->get_dbm_tie($db, $lock) or return;
|
|
||||||
my $key = $self->get_karma_key($ip);
|
my $key = $self->get_karma_key($ip);
|
||||||
|
|
||||||
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
|
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
|
||||||
$tied->{$key};
|
$self->db->get( $key );
|
||||||
|
$self->db->unlock;
|
||||||
$naughty ||= 0;
|
$naughty ||= 0;
|
||||||
$nice ||= 0;
|
$nice ||= 0;
|
||||||
$connects ||= 0;
|
$connects ||= 0;
|
||||||
@ -122,17 +130,15 @@ sub show_ip {
|
|||||||
sub main {
|
sub main {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
|
|
||||||
my $db = $self->get_dbm_location();
|
$self->db->lock;
|
||||||
my $lock = $self->get_dbm_lock($db) or return;
|
|
||||||
my $tied = $self->get_dbm_tie($db, $lock) or return;
|
|
||||||
my %totals;
|
my %totals;
|
||||||
|
|
||||||
print
|
print
|
||||||
" IP Address Penalty Naughty Nice Connects Hostname\n";
|
" 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 $ip = ip_bintoip(ip_inttobin($r, 4), 4);
|
||||||
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
|
my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/,
|
||||||
$tied->{$r};
|
$self->db->get( $r );
|
||||||
$naughty ||= '';
|
$naughty ||= '';
|
||||||
$nice ||= '';
|
$nice ||= '';
|
||||||
$connects ||= '';
|
$connects ||= '';
|
||||||
@ -167,6 +173,7 @@ sub main {
|
|||||||
$totals{nice} += $nice if $nice;
|
$totals{nice} += $nice if $nice;
|
||||||
$totals{connects} += $connects if $connects;
|
$totals{connects} += $connects if $connects;
|
||||||
}
|
}
|
||||||
|
$self->db->unlock;
|
||||||
print Dumper(\%totals);
|
print Dumper(\%totals);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -176,114 +183,28 @@ sub is_ip {
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub cleanup_and_return {
|
|
||||||
my ($self, $tied, $lock) = @_;
|
|
||||||
untie $tied;
|
|
||||||
close $lock;
|
|
||||||
}
|
|
||||||
|
|
||||||
sub get_karma_key {
|
sub get_karma_key {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $nip = Net::IP->new(shift) or return;
|
my $nip = Net::IP->new(shift) or return;
|
||||||
return $nip->intip; # convert IP to an int
|
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 {
|
sub prune_db {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $prune_days = shift;
|
my $prune_days = shift;
|
||||||
|
|
||||||
my $db = $self->get_dbm_location();
|
$self->db->lock;
|
||||||
my $lock = $self->get_dbm_lock($db) or return;
|
my $count = $self->db->size;
|
||||||
my $tied = $self->get_dbm_tie($db, $lock) or return;
|
|
||||||
my $count = keys %$tied;
|
|
||||||
|
|
||||||
my $pruned = 0;
|
my $pruned = 0;
|
||||||
foreach my $key (keys %$tied) {
|
foreach my $key ( $self->db->get_keys ) {
|
||||||
my ($ts, $naughty, $nice, $connects) = split /:/, $tied->{$key};
|
my ($ts, $naughty, $nice, $connects) = split /:/, $self->db->get( $key );
|
||||||
my $days_old = (time - $ts) / 86400;
|
my $days_old = (time - $ts) / 86400;
|
||||||
next if $days_old < $prune_days;
|
next if $days_old < $prune_days;
|
||||||
delete $tied->{$key};
|
$self->db->delete( $key );
|
||||||
$pruned++;
|
$pruned++;
|
||||||
}
|
}
|
||||||
untie $tied;
|
$self->db->unlock;
|
||||||
close $lock;
|
|
||||||
warn "pruned $pruned of $count DB entries";
|
warn "pruned $pruned of $count DB entries";
|
||||||
return $self->cleanup_and_return($tied, $lock);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user