#!/usr/bin/perl

# Name: spamfirewall
# Description: Program to firewall spammers and their mailservers
# Version: 1.0
# 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
###########################################################################


$threshold = 3; # number of spam emails received in 1 day to trigger blockage
$offenseweight = 1;
$spamchain = 'INPUT_SPAM';
$logfile = '/var/log/spamfirewall';

use DBI;
use DBIx::Broker;

$debug = 0;

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

$allspam = $ARGV[0];
print "DEBUG: ALL INCOMING WILL BE MARKED SPAM: $allspam\n" if (($debug) && ($allspam));

$db = DBIx::Broker->new("mysql", "spamfirewall", "localhost", "3306", "root", 'PASSWARD');

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>) {
  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 "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 (/^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;
      if ($debug) {
        foreach $received (@receiveds) {
          print "DEBUG: sending server: $received\n";
        }
      }
      print "DEBUG: ---------------------------------------------------------\n" if $debug;
    }
  }
  ## Regardless if we are still searching, we need to print the message to STDOUT
  #print STDOUT $line;
}
# 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 ($subject =~ /\*\*\*\*\*SPAM\*\*\*\*\*/) {
      print "DEBUG: received matched spamassassin\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'")
  }
}

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);
  $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"); }
}

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 {
  my %importantips;

  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})/);
      print "DEBUG: address: $addr\n" if $debug;
      $importantips{$addr} = 1;
    }
  }
  close IFCONFIG;
  
  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;
}