From 22c0f23226cb1cf5c4a56aedf6b00c544f930be5 Mon Sep 17 00:00:00 2001 From: Matt Simerson Date: Sun, 3 Jun 2012 19:59:07 -0400 Subject: [PATCH] imported karma_tool --- plugins/karma_tool | 250 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 250 insertions(+) create mode 100755 plugins/karma_tool diff --git a/plugins/karma_tool b/plugins/karma_tool new file mode 100755 index 0000000..eb6012c --- /dev/null +++ b/plugins/karma_tool @@ -0,0 +1,250 @@ +#!/usr/bin/perl +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); + +my $self = bless( { args => { db_dir => 'config' }, }, 'Karma' ); +my $command = $ARGV[0]; + +if ( ! $command ) { + $self->usage(); +} +elsif ( $command eq 'capture' ) { + $self->capture( $ARGV[1] ); +} +elsif ( $command eq 'release' ) { + $self->capture( $ARGV[1] ); +} +elsif ( $command eq 'prune' ) { + $self->prune_db( $ARGV[1] || 7 ); +} +elsif ( $command eq 'list' ) { + $self->main(); +}; + +exit(0); + +sub usage { + print <get_db_location(); + my $lock = $self->get_db_lock( $db ) or return; + my $tied = $self->get_db_tie( $db, $lock ) or return; + my $key = $self->get_db_key( $ip ); + + $tied->{$key} = join(':', time, 1, 0, 1); + return $self->cleanup_and_return( $tied, $lock ); +}; + +sub release { + my $self = shift; + my $ip = shift or return; + is_ip( $ip ) or do { + warn "not an IP: $ip\n"; + return; + }; + + my $db = $self->get_db_location(); + my $lock = $self->get_db_lock( $db ) or return; + my $tied = $self->get_db_tie( $db, $lock ) or return; + my $key = $self->get_db_key( $ip ); + + $tied->{$key} = join(':', 0, 1, 0, 1); + return $self->cleanup_and_return( $tied, $lock ); +}; + +sub main { + my $self = shift; + + my $db = $self->get_db_location(); + my $lock = $self->get_db_lock( $db ) or return; + my $tied = $self->get_db_tie( $db, $lock ) or return; + my %totals; + + print " IP Address Penalty Naughty Nice Connects Hostname\n"; + foreach my $r ( sort keys %$tied ) { + my $ip = ip_bintoip( ip_inttobin( $r, 4 ), 4); + my ($penalty_start_ts, $naughty, $nice, $connects) = split /:/, $tied->{$r}; + $naughty ||= ''; + $nice ||= ''; + $connects ||= ''; + my $time_human = ''; + if ( $command eq 'search' ) { + my $search = $ARGV[1]; + if ( $search eq 'nice' ) { + next if ! $nice; + } + elsif ( $search eq 'naughty' ) { + next if ! $naughty; + } + elsif ( $search eq 'both' ) { + next if ! $naughty || ! $nice; + } + elsif ( is_ip() && $search ne $ip ) { + next; + } + }; + if ( $penalty_start_ts ) { + $time_human = strftime "%a %b %e %H:%M", localtime $penalty_start_ts; + }; + my $hostname = ''; + if ( $naughty && $nice ) { + $hostname = `dig +short -x $ip`; chomp $hostname; + }; + printf(" %-18s %24s %3s %3s %3s %30s\n", $ip, $time_human, $naughty, $nice, $connects, $hostname); + $totals{naughty} += $naughty if $naughty; + $totals{nice} += $nice if $nice; + $totals{connects} += $connects if $connects; + }; + print Dumper(\%totals); +} + +sub is_ip { + my $ip = shift || $ARGV[0]; + return 1 if $ip =~ /^(\d{1,3}\.){3}\d{1,3}$/; + return; +}; + +sub cleanup_and_return { + my ($self, $tied, $lock ) = @_; + untie $tied; + close $lock; +}; + +sub get_db_key { + my $self = shift; + my $nip = Net::IP->new( shift ); + return $nip->intip; # convert IP to an int +}; + +sub get_db_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_db_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_db_lock { + my ($self, $db) = @_; + + return $self->get_db_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_db_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_db_location(); + my $lock = $self->get_db_lock( $db ) or return; + my $tied = $self->get_db_tie( $db, $lock ) or return; + my $count = keys %$tied; + + my $pruned = 0; + foreach my $key ( keys %$tied ) { + my ($ts, $naughty, $nice, $connects) = split /:/, $tied->{$key}; + my $days_old = ( time - $ts ) / 86400; + next if $days_old < $prune_days; + delete $tied->{$key}; + $pruned++; + }; + untie $tied; + close $lock; + warn "pruned $pruned of $count DB entries"; + return $self->cleanup_and_return( $tied, $lock ); +}; +