#!/usr/bin/perl
# activeblock - daemon which blocks invalid IPs attempting access to the server
#               started by cron and uses locking of dbm to be unique
#
# Written by Stephen S. Flitman, MD, Programmer at Arms, Xenoscience Inc.
# Released under GPLv3.  
#
# 1.0 012408 Initial work
# 1.1 012608 Exclusion list
# 1.2 013008 Use File::Tail and run as a daemon if -c; drops -t option
# 1.3 082608 Exclusion list by IP, also works for class C address like 192.168.0   
# 1.4 120108 Exclusion list by host also
# 1.5 052809 -a Allow switch and -l List blocked addresses
################################################################################

use strict;
use File::Tail;
use GDBM_File;
use Getopt::Std;
use Socket;

my %opts;
my $logFile='/root/activeblock.log';
my $dbm='/root/activeblock.dbm';
my $cmdBlock  = '/sbin/iptables -I INPUT -s %s -p tcp -m tcp --dport 0:999 -j DROP';
my $cmdDelete = '/sbin/iptables -D INPUT -s %s -p tcp -m tcp --dport 0:999 -j DROP';
my $cmdList   = '/sbin/iptables -L INPUT -n';
my %exclude=('192.168.0.*'=>1);
my $dbg=0;
my $nAttempts=3;

###############################################################################

sub writelog {
   my $msg=join('',@_);
   open(FILE,'>>',$logFile) || die "Can't append to $logFile: $!";
   print FILE scalar localtime,': ',$msg,"\n";
   close FILE;
}

sub logerror {
   my $msg=join('',@_);
   writelog $msg;
   exit 1;
}

###############################################################################

getopts('abcdhluz',\%opts);
if ($opts{h} || length("$opts{a}$opts{b}$opts{l}$opts{c}")>1) {
   print <<EOT;
Usage:    activeblock [-abcdhluz] [logfile] [ip...]
          
     Peruse logfile for IPs to block using iptables.
     Additional IPs to exclude from blocking can also be supplied.

  -a      Allow (unblock) listed IPs but may be blocked again later.
  -b      Block listed IPs
  -c      Called from cron to run as a daemon.
  -d      Debug mode.
  -h      This help display.
  -l      List current blocked addresses.
  -u      Update iptables for real (with -c).
  -z      Zap database.
EOT
   exit 1;
}
$dbg++ if $opts{d};

if ($opts{a}) { # allow/unblock
    my ($res,$nDeleted,$ip);
    for $ip (@ARGV) {
       $res=sprintf($cmdDelete,$ip);
       $res=qx/$res 2>&1/;
       if ($res) {
          print "Error on deleting $ip from INPUT chain: $res\n";
       } else {
          ++$nDeleted;
       }
    }
    print $nDeleted ? "Allowed $nDeleted IPs\n" : "Those IPs were not found\n";
    exit;
}

if ($opts{b}) { # block
   my ($res,$ip);
   for $ip (@ARGV) {
      $res=sprintf($cmdBlock,$ip);
      $res=qx/$res 2>&1/;
      if ($res) {
         print "Error on blocking $ip: $res\n";
      } else {
         print "Blocked $ip\n";
      }
   }
   exit;
}

if ($opts{l}) { # list
   print qx/$cmdList/;
   exit;
}

my %ip;
my ($logSecure,@ips)=@ARGV;
map { $exclude{$_}++ } @ips;    
my $exclude=join('|',map { reify($_) } keys %exclude);
writelog "exclude: $exclude" if $dbg;
unless (tie %ip,'GDBM_File',$dbm,GDBM_WRCREAT,0666) {
   exit if $opts{c};  # I'm called by cron but another me is running already  
   die "Can't tie $dbm: $!";
}

if ($opts{z}) { # zap ip table
   %ip=();
   writelog "$dbm cleared";
}

if ($opts{c}) {
   my $ref=tie *LOG,"File::Tail",(name=>$logSecure);
   $SIG{HUP}=sub { 
      writelog 'daemon exiting';
      untie %ip; 
      exit; 
   };
   while (<LOG>) {
       process($_);
   }
   # never exits unless killed, use -HUP to make sure database is untied properly
} 

#else non-daemon behavior

open(LOG,$logSecure) || die "Can't open $logSecure: $!";
while (<LOG>) {
   process($_);
}
close LOG;

# done

untie %ip;
exit;

sub reify {
   my $ip=shift;
   if ($ip=~/^\d+/) {
      $ip=~s/\*/\\d+/g;
   } else {
      my $packed_ip=gethostbyname($ip);
      $ip=inet_ntoa($packed_ip) if defined $packed_ip;
   }
   $ip=~s/([.])/\\$1/g;
   $ip;
}

sub process {
   my $line=shift;
   register_ip($2,$1) if $line=~/Invalid user (\w+) from (\d+\.\d+\.\d+\.\d+)/;
   register_ip($2,$1) if $line=~/Failed password for (\w+) from (\d+\.\d+\.\d+\.\d+)/;
   register_ip($1)    if $line=~/reverse mapping.*\[(\d+\.\d+\.\d+\.\d+)\] failed/;
   register_ip($1)    if $line=~/Could not reverse map address (\d+\.\d+\.\d+\.\d+)/;
   register_ip($1)    if $line=~/Address (\d+\.\d+\.\d+\.\d+).*POSSIBLE BREAK/;
   register_ip($2,$1) if $line=~/Failed keyboard-interactive.pam for (\w+) from (\d+\.\d+\.\d+\.\d+)/; 
   # more patterns here
}

sub register_ip {
   my ($ip,$user)=@_;
   print "register_ip($ip,$user)\n" if $dbg;
   if ($ip=~/^($exclude)$/o) {
      writelog "Ignore $ip";
      return;
   }
   my ($res,$blk)=split(/,/,$ip{$ip});
   ++$res;
   if ($blk ne 'BLK' && ($res>=$nAttempts || $user eq 'root')) {     # nAttempts failures, or trying to login as root
      writelog "Block $ip $user";
      my $cmdline=sprintf($cmdBlock,$ip);
      my $result=$opts{u} ? `$cmdline 2>&1` : '';
      if (length $result) {  # error
         writelog "$cmdline: $result";
      } else {
         $blk='BLK';
      }
   }
   $ip{$ip}="$res,$blk";
}