#!/usr/bin/perl

#
# (c) 2009 Julian Field <ScamNailer@ecs.soton.ac.uk>
#          Version 2.05
#
# This file is the copyright of Julian Field <ScamNailer@ecs.soton.ac.uk>,
# and is made freely available to the entire world. If you intend to
# make any money from my work, please contact me for permission first!
# If you just want to use this script to help protect your own site's
# users, then you can use it and change it freely, but please keep my
# name and email address at the top.
#

use strict;
use File::Temp;
use Net::DNS::Resolver;
use LWP::UserAgent;
use FileHandle;
use DirHandle;

# Filename of list of extra addresses you have added, 1 per line.
# Does not matter if this file does not exist.
my $local_extras = '/etc/MailScanner/ScamNailer.local.addresses';

# Output filename, goes into SpamAssassin. Can be over-ridden by just
# adding the output filename on the command-line when you run this script.
my $output_filename = '/etc/mail/spamassassin/ScamNailer.cf';

# This is the location of the cache used by the DNS-based updates to the
# phishing database.
my $emailscurrent = '/var/cache/ScamNailer/';

# Set this next value to '' if ou are not using MailScanner.
# Or else change it to any command you need to run after updating the
# SpamAssassin rules, such as '/sbin/service spamd restart'.
my $mailscanner_restart = '/etc/init.d/mailscanner force-reload';

# The SpamAssassin score to assign to the final rule that fires if any of
# the addresses hit. Multiple hits don't increase the score.
#
# I use a score of 0.1 with this in MailScanner.conf:
# SpamAssassin Rule Actions = SCAMNAILER=>not-deliver,store,forward postmaster@my-domain.com, header "X-Anti-Phish: Was to _TO_"
# If you don't understand that, read the section of MailScanner.conf about the
# "SpamAssassin Rule Actions" setting.
my $SA_score = 4.0;

# How complicated to make each rule. 20 works just fine, leave it alone.
my $addresses_per_rule = 20;

my $quiet = 1 if grep /quiet|silent/, @ARGV;
if (grep /help/, @ARGV) {
  print STDERR "Usage: $0 [ --quiet ]\n";
  exit(1);
}

my($count, $rule_num, @quoted, @addresses, @metarules);
#local(*YPCAT, *SACF);
local(*SACF);

$output_filename = $ARGV[0] if $ARGV[0]; # Use filename if they gave one
# First do all the addresses we read from DNS and anycast and only do the
# rest if needed.
if (GetPhishingUpdate()) {
open(SACF, ">$output_filename") or die "Cannot write to $output_filename $!";

print SACF "# ScamNailer rules\n";
print SACF "# Generated by $0 at " . `date` . "\n";

# Now read all the addresses we generated from GetPhishingUpdate().
open(PHISHIN, $emailscurrent . 'phishing.emails.list')
  or die "Cannot read " . $emailscurrent . "phishing.emails.list, $!\n";
while(<PHISHIN>) {
  chomp;
  s/^\s+//g;
  s/\s+$//g;
  s/^#.*$//g;
  next if /^\s*$/;
  next unless /^[^@]+\@[^@]+$/;

  push @addresses, $_; # This is for the report
  s/[^0-9a-z_-]/\\$&/ig; # Quote every non-alnum
  s/\\\*/[0-9a-z_.+-]*/g; # Unquote any '*' characters as they map to .*
  # Find all the numbers just before the @ and replace with them digit wildcards
  s/([0-9a-z_.+-])\d{1,3}\\\@/$1\\d+\\@/i;
  #push @quoted, '(' . $_ . ')';
  push @quoted, $_;
  $count++;

  if ($count % $addresses_per_rule == 0) {
    # Put them in 10 addresses at a time
    $rule_num++;
    # Put a start-of-line/non-address character at the front,
    # and an end-of-line /non-address character at the end.
    print SACF "header __SCAMNAILER_H$rule_num ALL =~ /" .
               '(^|[;:<>\s])(?:' . join('|',@quoted) . ')($|[^0-9a-z_.+-])' .
               "/i\n";
    push @metarules, "__SCAMNAILER_H$rule_num";
    print SACF "uri __SCAMNAILER_B$rule_num /" .
               '^mailto:(?:' . join('|',@quoted) . ')$' .
               "/i\n";
    push @metarules, "__SCAMNAILER_B$rule_num";
    undef @quoted;
    undef @addresses;
  }
}
close PHISHIN;

# Put in all the leftovers, if any
if (@quoted) {
  $rule_num++;
    print SACF "header __SCAMNAILER_H$rule_num ALL =~ /" .
               '(^|[;:<>\s])(?:' . join('|',@quoted) . ')($|[^0-9a-z_.+-])' .
               "/i\n";
    push @metarules, "__SCAMNAILER_H$rule_num";
    print SACF "uri __SCAMNAILER_B$rule_num /" .
               '^mailto:(?:' . join('|',@quoted) . ')$' .
               "/i\n";
    push @metarules, "__SCAMNAILER_B$rule_num";
}

print SACF "\n# ScamNailer combination rule\n\n";
print SACF "meta     SCAMNAILER " . join(' || ',@metarules) . "\n";
print SACF "describe SCAMNAILER Mentions a spear-phishing address\n";
print SACF "score    SCAMNAILER $SA_score\n\n";
print SACF "# ScamNailer rules ($count) END\n";

close SACF;

# And finally restart MailScanner to use the new rules
$mailscanner_restart .= " >/dev/null 2>&1" if $quiet;
system($mailscanner_restart) if $mailscanner_restart;

exit 0;
}

sub GetPhishingUpdate {
  my $cache = $emailscurrent . 'cache/';
  my $status = $emailscurrent . 'status';
  my $urlbase = "http://www.mailscanner.tv/emails.";
  my $target= $emailscurrent . 'phishing.emails.list';
  my $query="emails.msupdate.greylist.bastionmail.com";

  my $baseupdated = 0;
  if (! -d $emailscurrent) {
    print "Working directory is not present - making....." unless $quiet;
    mkdir ($emailscurrent) or die "failed";
    print " ok!\n" unless $quiet;
  }
  if (! -d $cache) {
    print "Cache directory is not present - making....." unless $quiet;
    mkdir ($cache) or die "failed";
    print " ok!\n" unless $quiet;
  }
  if (! -s $target) {
    open (FILE,">$target") or die
      "Failed to open target file so creating a blank file";
    print FILE "# Wibble";
    close FILE;
  } else {
    # So that clean quarantine doesn't delete it!
    utime(time(), time(), $emailscurrent);
  }

  my ($status_base, $status_update);

  $status_base=-1;
  $status_update=-1;

  if (! -s $status) {
    print "This is the first run of this program.....\n" unless $quiet;
  } else {
    print "Reading status from $status\n" unless $quiet;
    open(STATUS_FILE, $status) or die "Unable to open status file\n";
    my $line=<STATUS_FILE>;
    close (STATUS_FILE);

    # The status file is text.text
    if ($line =~ /^(.+)\.(.+)$/) {
      $status_base=$1;
      $status_update=$2;
    }
  }

  print "Checking that $cache$status_base exists..." unless $quiet;
  if ((! -s "$cache$status_base") && (!($status_base eq "-1"))) {
    print " no - resetting....." unless $quiet;
    $status_base=-1;
  }
  print " ok\n" unless $quiet;

  print "Checking that $cache$status_base.$status_update exists..." unless $quiet;
  if ((! -s "$cache$status_base.$status_update") && ($status_update>0)) {
    print " no - resetting....." unless $quiet;
    $status_update=-1;
  }
  print " ok\n" unless $quiet;

  my $currentbase = -1;
  my $currentupdate = -1;

  # Lets get the current version
  my $res = Net::DNS::Resolver->new();
  my $RR = $res->query($query, 'TXT');
  my @result;
  if ($RR) {
    foreach my $rr ($RR->answer) {
      my $text = $rr->rdatastr;
      if ($text =~ /^"emails\.(.+)\.(.+)"$/) {
        $currentbase=$1;
        $currentupdate=$2;
        last;
      }
    }
  }

  die "Failed to retrieve valid current details\n" if $currentbase eq "-1";

  print "I am working with: Current: $currentbase - $currentupdate and Status: $status_base - $status_update\n" unless $quiet;

  my $generate=0;

  # Create a user agent object
  my $ua = LWP::UserAgent->new;
  $ua->agent("UpdateBadPhishingSites/0.1 ");
  # Patch from Heinz.Knutzen@dataport.de
  $ua->env_proxy;

  if (!($currentbase eq $status_base)) {
    print "This is base update\n" unless $quiet;
    $status_update = -1;
    $baseupdated = 1;
    # Create a request
    #print "Getting $urlbase . $currentbase\n" unless $quiet;
    my $req = HTTP::Request->new(GET => $urlbase.$currentbase);
    # Pass request to the user agent and get a response back
    my $res = $ua->request($req);
    # Check the outcome of the response
    if ($res->is_success) {
      open (FILE, ">$cache/$currentbase") or die "Unable to write base file ($cache/$currentbase)\n";
      print FILE $res->content;
      close (FILE);
    } else {
      warn "Unable to retrieve $urlbase.$currentbase :".$res->status_line, "\n";
    }
    $generate=1;
  } else {
    print "No base update required\n" unless $quiet;
  }

  # Now see if the sub version is different
  if (!($status_update eq $currentupdate)) {
    my %updates=();

    print "Update required\n" unless $quiet;
    if ($currentupdate<$status_update) {
      # In the unlikely event we roll back a patch - we have to go from the base
      print "Error!: $currentupdate<$status_update\n" unless $quiet;
      $generate = 1;
      $status_update = 0;
    }
    # If there are updates avaliable and we haven't donloaded them
    # yet we need to reset the counter
    if ($currentupdate>0) {
      if ($status_update<1) {
        $status_update=0;
      }
      my $i;
      # Loop through each of the updates, retrieve it and then add
      # the information into the update array
      for ($i=$status_update+1; $i<=$currentupdate; $i++) {
        print "Retrieving $urlbase$currentbase.$i\n" unless $quiet;
        #print "Getting $urlbase . $currentbase.$i\n" unless $quiet;
        my $req = HTTP::Request->new(GET => $urlbase.$currentbase.".".$i);
        my $res = $ua->request($req);
        warn "Failed to retrieve $urlbase$currentbase.$i"
          unless $res->is_success;
        my $line;
        foreach $line (split("\n", $res->content)) {
          # Is it an addition?
          if ($line =~ /^\> (.+)$/) {
            if (defined $updates{$1}) {
              if ($updates{$1} eq "<") {
                delete $updates{$1};
              }
            } else {
              $updates{$1}=">";
            }
          }
          # Is it an removal?
          if ($line =~ /^\< (.+)$/) {
            if (defined $updates{$1}) {
              if ($updates{$1} eq ">") {
                delete $updates{$1};
              }
            } else {
              $updates{$1}="<";
            }
          }
        }
      }
      # OK do we have a previous version to work from?
      if ($status_update>0) {
        # Yes - we open the most recent version
        open (FILE, "$cache$currentbase.$status_update") or die
          "Unable to open base file ($cache/$currentbase.$status_update)\n";
      } else {                        # No - we open the the base file
        open (FILE, "$cache$currentbase") or die
          "Unable to open base file ($cache/$currentbase)\n";
      }
      # Now open the new update file
      print "$cache$currentbase.$currentupdate\n" unless $quiet;
      open (FILEOUT, ">$cache$currentbase.$currentupdate") or die
        "Unable to open new base file ($cache$currentbase.$currentupdate)\n";

      # Loop through the base file (or most recent update)
      while (<FILE>) {
        chop;
        my $line=$_;

        if (defined ($updates{$line})) {
          # Does the line need removing?
          if ($updates{$line} eq "<") {
            $generate=1;
            next;
          }
          # Is it marked as an addition but already present?
          elsif ($updates{$line} eq ">") {
            delete $updates{$line};
          }
        }
        print FILEOUT $line."\n";
      }
      close (FILE);
      my $line;
      # Are there any additions left
      foreach $line (keys %updates) {
        if ($updates{$line} eq ">") {
          print FILEOUT $line."\n" ;
          $generate=1;
        }
      }
      close (FILEOUT);
    }

  }

  # Changes have been made
  if ($generate) {
    print "Updating live file $target\n" unless $quiet;
    my $file="";
    if ($currentupdate>0) {
      $file="$cache/$currentbase.$currentupdate";
    } else {
      $file="$cache/$currentbase";
    }
    if ($file eq "") {
      die "Unable to work out file!\n";
    }

    system ("mv -f $target $target.old");
    system ("cp $file $target");

    open(STATUS_FILE, ">$status") or die "Unable to open status file\n";
    print STATUS_FILE "$currentbase.$currentupdate\n";
    close (STATUS_FILE);
  }

  my $queuedir = new DirHandle;
  my $file;
  my $match1 = "^" . $currentbase . "\$";
  my $match2 = "^" . $currentbase . "." . $currentupdate . "\$";
  $queuedir->open($cache) or die "Unable to do clean up\n";
  while(defined($file = $queuedir->read())) {
    next if $file eq '.' || $file eq '..';
    next if $file =~ /$match1/;
    next if $file =~ /$match2/;
    print "Deleting cached file: $file.... " unless $quiet;
    unlink($cache.$file) or die "failed";
    print "ok\n" unless $quiet;
  }
  $queuedir->close();
  $generate;
}