v5/common/usr/sbin/ms-update-bad-emails

#!/usr/bin/perl

#
# (c) 2009 Julian Field <ScamNailer@ecs.soton.ac.uk>
#          Version 2.07
#
# 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.
#
# Updated July 2015 by Mark Sapiro <mark@msapiro.net> to use the data
# from <https://code.google.com/p/anti-phishing-email-reply/> instead
# of the Mailscanner data which has become unreliable.
#
# Updated 28 APR 2016 by Jerry Benton <mailscanner@mailborder.com> to
# use new $mailscanner_restart

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

# 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 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 = '/var/lib/MailScanner/init/ms-init 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;
my $SA_score = 0.1;

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

my $quiet = 0;
if (grep /-quiet|-silent/, @ARGV) {
  @ARGV = grep !/-quiet|-silent/, @ARGV;
  $quiet = 1;
}
if (grep /help/, @ARGV) {
  print STDERR "Usage: $0 [ filename ] [ --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 $target = $emailscurrent . 'phishing.emails.list';
  my $dl_file = $emailscurrent . 'phishing_reply_addresses';
  my $dl_time = $emailscurrent . 'last_mtime';
  my $dl_url = 'http://svn.code.sf.net/p/aper/code/phishing_reply_addresses';

  print "Getting $dl_file\n" unless $quiet;
  # try to avoid utf=8 encoded quotes from wget.
  if (system("cd $emailscurrent;LANG=en_US;wget -N $dl_url")) {
    print "wget failed to retrieve $dl_url: $!\n";
    return 0;
  }
  open(DLF, $dl_file) or die "Couldn't open $dl_file: $!\n";
  my $newtime = (stat(DLF))[9];
  my $oldtime;
  if ( ! open(DLT, "<", $dl_time) ) {
    $oldtime = 0;
  } else {
    $oldtime = <DLT>;
  }
  open(DLT, ">", $dl_time) or die "Couldn't write $dl_time: $!\n";
  print DLT $newtime;
  close(DLT);
  if ($newtime <= $oldtime) {
    print "New file not newer.\n" unless $quiet;
    close(DLF);
    return 0;
  } else {
    open(TF, ">", $target) or die "Couldn't optn $target: $!\n";
    while ( <DLF> ) {
      chomp;
      s/,[A-E]+,[0-9]+//;
      print TF "$_\n";
    }
    close(DLF);
    close(TF);
    print "File updated.\n" unless $quiet;
    return 1;
  }
}