#!/usr/bin/perl

# Name: spamfirewall
# Description: Program to firewall spammers and their mailservers
# Version: 1.2
# Authors: Jason Jorgensen <jasonj@innominatus.com>
# Copyright (C) 2003  Jason Jorgensen
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
###########################################################################
# User Variables
$threshold = 2;            # number of spam emails received in 1 day to trigger blockage
$offenseweight = 1;        # how much weight to apply against a server that has sent a message that the rules say is spam, this number adds toward $threshold
$spamchain = 'INPUT_SPAM'; # iptables chain to put the spam blocks
$logfile = '/var/log/spamfirewall';
$dbuser = 'root';
$dbhost = '127.0.0.1';
$dbport = 3306;
$dbpassword = 'PASSWARD';
$dbtype = 'mysql';
$dbname = 'spamfirewall';


###########################################################################
use DBI;
use DBIx::Broker;
use NetAddr::IP;

$debug = 0;

$search = 1;
$header = 1; # this becomes 0 when we are not in the header but are in the body

# if an argument of '1' is giving to spamfirewall it will assume all messages passing through it are spam regardless of the other rules.
if ($ARGV[0] == 1) { $allspam = $ARGV[0]; }
print "DEBUG: ALL INCOMING WILL BE MARKED SPAM: $allspam\n" if (($debug) && ($allspam));

$db = DBIx::Broker->new($dbtype, $dbname, $dbhost, $dbport, $dbuser, $dbpassword);

my %importantips = &importantips();

# stay in loop as until we come to a blank line, this should be the end of the headers in an rfc compliant message
while (<STDIN>) {
  ## Regardless if we are still searching, we need to print the message to STDOUT
  print STDOUT $_;
  #if ($debug) { print DUMP $_; }
  if ($search) {
    $line = $_;
    chomp $line;
    if ($header) {
      print "DEBUG: LINE: $line\n" if $debug;
      if (/^\s+$/) { $header = 0; }
      if (/^\S+\:\s+/) { $current = ""; }
      if ($current eq "from") { $current = "from"; $from .= $line;}
      if ($current eq "to") { $current = "to"; $to .= $line;}
      if ($current eq "subject") { $current = "subject"; $subject .= $line;}
      #if ($current eq "xspamstatus") { $current = "xspamstatus"; $xspamstatus .= $line;} # dont need to do this line since the response is only on 1 line
      if ($current eq "received") { 
        $current = "received";
        @line = split /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/, $line;

        foreach $seg (@line) {
          print "DEBUG: line segment: $seg\n" if $debug;
            if ($seg =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {
            print "DEBUG: segment matched IP, adding $seg to received list\n" if $debug;
            push @receiveds, $seg;
          }
        }
      }
      if (/^from:/i) { $current = "from"; ($from) = ($line =~ /from: (.*)/i);}
      if (/^to:/i) { $current = "to"; ($to) = ($line =~ /to: (.*)/i);}
      if (/^subject:/i) { $current = "subject"; ($subject) = ($line =~ /subject: (.*)/i);}
      if (/^X-Spam-Status:/i) { $current = "xspamstatus"; ($xspamstatus) = ($line =~ /X-Spam-Status: ([^,]*),/i);}
      if (/^received:/i) { 
        $current = "received";
        @receiveds = ();
        @line = split /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/, $line;

        foreach $seg (@line) {
          print "DEBUG: line segment: $seg\n" if $debug;
            if ($seg =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/) {
            print "DEBUG: segment matched IP, adding $seg to received list\n" if $debug;
            push @receiveds, $seg;
          }
        }
      }
      print "DEBUG: current header: $current\n" if $debug;
      print "DEBUG: from: $from\n" if $debug;
      print "DEBUG: to: $to\n" if $debug;
      print "DEBUG: subject: $subject\n" if $debug;
      print "DEBUG: xspamstatus: $xspamstatus\n" if $debug;
      if ($debug) {
        foreach $received (@receiveds) {
          print "DEBUG: sending server: $received\n";
        }
      }
      print "DEBUG: ---------------------------------------------------------\n" if $debug;
    }
  }
}
# remove any duplicates in the receiveds
@receiveds = &removedups(@receiveds);

foreach $received (@receiveds) {
  if (($received =~ /(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/) && (! $importantips{$received})){ 
    print "DEBUG: Processing received: $received\n" if $debug;
    if ($allspam) {
      print "DEBUG: all received are spam\n" if $debug;
      $offenseweight = $threshold;
      &process($received);
      $search = 0;
    }
#    elsif ($subject =~ /([\!\@\#\$\%\^\&\*\(\)\_\+\-\=\\\/]+.*?){5,}/) {
#      print "DEBUG: received matched !@#%%$^ spam\n" if $debug;
#      &process($received);
#      $search = 0;
#    }
    elsif ($xspamstatus =~ /yes/i) {
      print "DEBUG: received matched spamassassin X-Spam-Status\n" if $debug;
      &process($received);
      $search = 0;
    }
    elsif ($subject =~ /\*\*\*\*\*SPAM\*\*\*\*\*/) {
      print "DEBUG: received matched spamassassin ****SPAM**** subject line\n" if $debug;
      &process($received);
      $search = 0;
    }
  }
}

if ($debug) { close DUMP; }
exit;

sub process {
  my $address = shift;
  $inqueue = $db->count('queue', "WHERE address='$address'");
  $inblocked = $db->count('blocked', "WHERE address='$address'");
  print "DEBUG: exist in queue db: $inqueue\n" if $debug;
  print "DEBUG: exist in blocked db: $inblocked\n" if $debug;
  if ((! $inblocked) && (! $inqueue) && (! $importantips{$address})){
    print "DEBUG: Address not queued or blocked, queueing now: $address\n" if $debug;
    my %data = (
                "count", $offenseweight,
                "address", $address,
                "time", time,
               );
    $db->insert('queue', \%data);
  }
  if (($inqueue) && (! $inblocked)){
    my $count = $db->select_one_value('count', 'queue', "WHERE address='$address'");
    print "DEBUG: count: $count\n" if $debug;
    if ($count < $threshold) {
      $count+=$offenseweight;
      my %data = (
                  "count", $count,
                 );
      print "DEBUG: count + offenseweight: $count\n" if $debug;
      $db->update('queue', \%data, "WHERE address='$address'")
    }
    if ($count >= $threshold) {
      print "DEBUG: Address not yet blocked, blocking now: $address\n" if $debug;
      &block($address)
    }
  }
  # the following circumstance should be rare. maybe an iptables oops or a message already received being manually run through the system
  elsif ($inblocked){
    my %data = (
                "time", time,
               );
    $db->update('blocked', \%data, "WHERE address='$address'")
  }

  # check to see if they are a repeat offender, if so then reset the time in the record so we dont lower there offender level  
  if ($db->count('repeatoffenders', "WHERE address='$address'")) {
    $level = $db->select_one_value('level', 'repeatoffenders', "WHERE address='$address'", 0);
    print "DEBUG: $address is/'is now' a repeat offender, setting their time to NOW\n" if $debug;
     my %data = (
              "time", time,
             );
    $db->update('repeatoffenders', \%data, "WHERE address='$address'");
  }

}

sub block {
  my $address = shift;
  print "iptables -I $spamchain 1 -s $address/32 -j DROP\n" if $debug;
  my %data = (
              "address", $address,
              "time", time,
             );
  $db->insert('blocked', \%data);

  # if they are a repeat offender we increase the 'level' of offense variable, which will be multipled by the expire time for block duration
  $level = 0;
  if ($db->count('repeatoffenders', "WHERE address='$address'")) {
    $level = $db->select_one_value('level', 'repeatoffenders', "WHERE address='$address'", 0);
  }
  $level++;
  %data = (
              "address", $address,
              "level", $level,
              "time", time,
             );
  print "DEBUG: updating repeat offender with level of '$level' and time of current time\n" if $debug;
  if ($level ==  1) { $db->insert('repeatoffenders', \%data) }
  else { $db->update('repeatoffenders', \%data, "WHERE address='$address'"); }

  $returncode = system "iptables -I $spamchain 1 -s $address -j DROP\n";
  if ($returncode) { &logtofile("iptables block UNsuccessful: 'iptables -I $spamchain 1 -s $address -j DROP': $returncode"); }
  else { &logtofile("iptables block successful: 'iptables -I $spamchain 1 -s $address -j DROP'"); }
}

sub logtofile {
  $error = shift;
  open LOG, ">>$logfile";
  print LOG localtime()." spamfirewall: $error\n";
  close LOG;
}


sub removedups {
  @duparray = @_;

  my @dups=();
  my %temphash;
  @dups = @duparray;
  @temphash{@dups} = (1) x @dups;
  print "dups: ".join(',',@dups)." no dups: ".join(',',keys(%temphash))."\n" if $debug;
  @cleanarray=keys(%temphash);

  return @cleanarray;
}

sub importantips {
  # grab some important ip addresses that we should never block
  my %importantips;

  # grab the ip networks of the currently running interfaces
  open IFCONFIG, "ifconfig|";
  while (my $line = <IFCONFIG>) {
    if ($line =~ /inet\ addr/) {
      ($addr) = ($line =~ /inet addr:(\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3})/);
      ($mask) = ($line =~ /mask:(\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3})/);
      if (!$mask) { $mask = '255.255.255.255'; }
      print "DEBUG: address:     $addr\n" if $debug;
      print "DEBUG: subnet mask: $mask\n" if $debug;
      my $ipman = new NetAddr::IP "$addr/$mask";
      $importantips{$ipman->prefix} = 1;
    }
  }
  close IFCONFIG;
  
  # grab the ip of the default gateway
  open ROUTE, "route -n|";
  while (my $line = <ROUTE>) {
    if ($line =~ /^0.0.0.0\ /) {
      ($addr) = ($line =~ /^0.0.0.0\s+(\d{1,3}.\d{1,3}.\d{1,3}.\d{1,3})/);
      print "DEBUG: address: $addr\n" if $debug;
      $importantips{$addr} = 1;
    }
  }
  close ROUTE;

  return %importantips;
}