#
#   MailScanner - SMTP E-Mail Virus Scanner
#   Copyright (C) 2002  Julian Field
#
#   $Id: CustomConfig.pm 3638 2006-06-17 20:28:07Z sysjkf $
#
#   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
#
#   The author, Julian Field, can be contacted by email at
#      Jules@JulianField.net
#   or by paper mail at
#      Julian Field
#      Dept of Electronics & Computer Science
#      University of Southampton
#      Southampton
#      SO17 1BJ
#      United Kingdom
#

package MailScanner::CustomConfig;

use strict 'vars';
use strict 'refs';
no  strict 'subs'; # Allow bare words for parameter %'s

use vars qw($VERSION);

### The package version, both in 1.23 style *and* usable by MakeMaker:
$VERSION = substr q$Revision: 3638 $, 10;

#
# These are the custom functions that you can write to produce a value
# for any configuration keyword that you want to do clever things such
# as retrieve values from a database.
#
# Your function may be passed a "message" object, and must return
# a legal value for the configuration parameter. No checking will be
# done on the result, for extra speed. If you want to find out what
# there is in a "message" object, look at Message.pm as they are all
# listed there.
#
# You must handle the case when no "message" object is passed to your
# function. In this case it should return a sensible default value.
#
# Return value: You must return the internal form of the result values.
#               For example, if you are producing a yes or no value,
#               you return 1 or 0. To find all the internal values
#               look in ConfigDefs.pl.
#
# For each function "FooValue" that you write, there needs to be a
# function "InitFooValue" which will be called when the configuration
# file is read. In the InitFooValue function, you will need to set up
# any global state such as create database connections, read more
# configuration files and so on.
#

##
## This is a trivial example function to get you started.
## You could use it in the main MailScanner configuration file like
## this:
##      VirusScanning = &ScanningValue
##
#sub InitScanningValue {
#  # No initialisation needs doing here at all.
#  MailScanner::Log::InfoLog("Initialising ScanningValue");
#}
#
#sub EndScanningValue {
#  # No shutdown code needed here at all.
#  # This function could log total stats, close databases, etc.
#  MailScanner::Log::InfoLog("Ending ScanningValue");
#}
#
## This will return 1 for all messages except those generated by this
## computer.
#sub ScanningValue {
#  my($message) = @_;
#
#  return 1 unless $message; # Default if no message passed in
#
#  return 0 if $message->{subject} =~ /jules/i;
#  return 1;
#
#  #my($IPAddress);
#  #$IPAddress = $message->{clientip};
#  #return 0 if $IPAddress eq '127.0.0.1';
#  #return 1;
#}

#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************

#
# This set of functions provides per-domain simple spam whitelists and
# blacklists. Each of the 2 directories set below contains 1 file for
# each domain, with the domain name being the filename. The file contains
# a list of entries, 1 per line, each one either being a full address:
#    user@domain.com
# or an entire domain:
#    domain.com
# The addresses contained in the file for a domain make up the entire
# spam whitelist or blacklist for that domain.
#
# For example, say you had /etc/MailScanner/spam.bydomain/whitelist/jules.fm
# which included the lines
#	soton.ac.uk
#	ecs.soton.ac.uk
#	jules@julianfield.net
#	123.234.45.56
# Then all mail from anything@soton.ac.uk, anything@ecs.soton.ac.uk or
# jules@julianfield.net would be whitelisted if it was heading to any
# address @jules.fm. Also all mail from IP address 123.234.45.56 would be
# whitelisted if it was heading to any address @jules.fm.
# The same thing works for the blacklist directory.
# For per user per domain use the file name username@domainname.com.
#
# Overall white and blacklists should be put in a file in each directory
# called 'default'.
#
# To enable these functions, set the following in your MailScanner.conf file:
#   Is Definitely Not Spam = &ByDomainSpamWhitelist
#   Is Definitely Spam     = &ByDomainSpamBlacklist
#

# Set these to be the location of your whitelist files and blacklist files
my $WhitelistDir = '/etc/MailScanner/spam.bydomain/whitelist';
my $BlacklistDir = '/etc/MailScanner/spam.bydomain/blacklist';


use DirHandle;
use FileHandle;

my(%Whitelist, %Blacklist);

#
# Initialise by-domain spam whitelist and blacklist
#
sub InitByDomainSpamWhitelist {
  MailScanner::Log::InfoLog("Starting up by-domain spam whitelist, " .
                            "reading from %s", $WhitelistDir);
  my $domains = CreateByDomainList($WhitelistDir, \%Whitelist);
  MailScanner::Log::InfoLog("Read whitelist for %d domains", $domains);
}

sub InitByDomainSpamBlacklist {
  MailScanner::Log::InfoLog("Starting up by-domain spam blacklist, " .
                            "reading from %s", $BlacklistDir);
  my $domains = CreateByDomainList($BlacklistDir, \%Blacklist);
  MailScanner::Log::InfoLog("Read blacklist for %d domains", $domains);
}


#
# Lookup a message in the by-domain whitelist and blacklist
#
sub ByDomainSpamWhitelist {
  my($message) = @_;

  return LookupByDomainList($message, \%Whitelist);
}

sub ByDomainSpamBlacklist {
  my($message) = @_;

  return LookupByDomainList($message, \%Blacklist);
}


#
# Close down the by-domain whitelist and blacklist
#
sub EndByDomainSpamWhitelist {
  MailScanner::Log::InfoLog("Closing down by-domain spam whitelist");
}

sub EndByDomainSpamBlacklist {
  MailScanner::Log::InfoLog("Closing down by-domain spam blacklist");
}


#
# Setup the per-domain spam white or black list.
# Note this doesn't do anything much in the way of syntax-checking the
# files, so they better be right! If there are duff lines in the files,
# they just won't produce any matches, they can't actually cause any harm.
#
sub CreateByDomainList {
  my($dirname, $BlackWhite) = @_;

  my($dir, $filename, $fh, $domains);

  $dir = new DirHandle;
  $dir->open($dirname) or return 0;
  $domains = 0; # Count the number of domains we have read
  while ($filename = $dir->read()) {
    next if $filename =~ /^\./;
    next unless -f "$dirname/$filename";

    $fh = new FileHandle;
    $fh->open("$dirname/$filename") or next;
    $filename = lc($filename); # Going to store the name in lower case
    while(<$fh>) {
      chomp;
      #print STDERR "Line is \"$_\"\n";
      s/#.*$//; # Strip comments
      s/\S*:\S*//g; # Strip any words with ":" in them
      s/^\s+//g; # Strip leading whitespace
      s/^(\S+)\s.*$/$1/; # Use only the 1st word
      s/^\*\@//; # Strip any leading "*@" they might have put in
      #print STDERR "Line is \"$_\"\n";
      next if /^$/; # Strip blank lines
      $BlackWhite->{$filename}{lc($_)} = 1; # Store the whitelist entry
    }
    $fh->close();
    $domains++;
  }
  $dir->close();

  return $domains;
}


#
# Based on the address it is going to, choose the right spam white/blacklist.
# Return 1 if the "from" address is white/blacklisted, 0 if not.
#
sub LookupByDomainList {
  my($message, $BlackWhite) = @_;

  return 0 unless $message; # Sanity check the input

  # Find the "from" address and the first "to" address
  my($from, $fromdomain, @todomain, $todomain, @to, $to, $ip);
  $from       = $message->{from};
  $fromdomain = $message->{fromdomain};
  @todomain   = @{$message->{todomain}};
  $todomain   = $todomain[0];
  @to         = @{$message->{to}};
  $to         = $to[0];
  $ip         = $message->{clientip};

  # It is in the list if either the exact address is listed,
  # or the domain is listed
  return 1 if $BlackWhite->{$to}{$from};
  return 1 if $BlackWhite->{$to}{$fromdomain};
  return 1 if $BlackWhite->{$to}{$ip};
  return 1 if $BlackWhite->{$todomain}{$from};
  return 1 if $BlackWhite->{$todomain}{$fromdomain};
  return 1 if $BlackWhite->{$todomain}{$ip};
  return 1 if $BlackWhite->{'default'}{$from};
  return 1 if $BlackWhite->{'default'}{$fromdomain};
  return 1 if $BlackWhite->{'default'}{$ip};

  # It is not in the list
  return 0;
}



#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************

###########################################################################
#
# Handy little feature to let you use the same MailScanner.conf file on
# lots of different hosts, where the only difference is the hostname.
# Just uncomment the "use Sys::Hostname" line and then set
#   Hostname = &Hostname
# in your MailScanner.conf to use this.
#
# Many thanks to Tony Finch for this.
#
###########################################################################

# Uncomment this line: use Sys::Hostname;

my $hostname2;

sub InitHostname {
  $hostname2 = hostname;
}

sub Hostname {
  return $hostname2;
}

sub EndHostname {
  # nothing to do
}


#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************

###########################################################################
#
# This is a setup to do logging to an SQL database.
# For speed, the per-message logs are written to a tab-separated file
# during execution.
# When the child process dies of old age (or is politely killed), the
# log file is read and inserted into a database table.
#
# If you want to use this code, you must:
# 1. uncomment the "use DBI;" line just below this comment.
# 2. Read the README.sql-logging file in the docs directory
#    of the distribution.
#
###########################################################################

use IO::File;
# UNCOMMENT THIS LINE: use DBI;

my($logfile1, $logfile2, $logfile3);

# Initialise. All we need to do is create the temporary log files. These
# are created using tmpfile() to avoid security problems caused by any
# other process on the system being able to read (or even write!) to
# the log files. The files created are not accessible to any other processes
# at all, as they don't have an entry in a directory.

sub InitSQLLogging {
  MailScanner::Log::InfoLog("Initialising SQL Logging temp files");
  $logfile1 = IO::File->new_tmpfile or die "IO::File->new_tmpfile: $!";
  $logfile2 = IO::File->new_tmpfile or die "IO::File->new_tmpfile: $!";
  $logfile3 = IO::File->new_tmpfile or die "IO::File->new_tmpfile: $!";
  #$logfile->autoflush(1);
}

# Shutdown. Write all the log entries to the SQL database, then close
# the temporary log files. Closing them will also delete them as they were
# created with tmpfile().
sub EndSQLLogging {
  my(@fields);

  MailScanner::Log::InfoLog("Ending SQL Logging temp output " .
                            "and flushing to database");

  # Create database connection
  my($dbh);
  $dbh = DBI->connect("DBI:mysql:mailscanner:192.168.0.51",
                      "mailscanner", "",
                      {'PrintError' => 0})
   or MailScanner::Log::DieLog("Cannot connect to the database: %s",
                                $DBI::errstr);

  # Rewind to start of logfile1
  $logfile1->flush();
  seek($logfile1, 0, 0)
    or MailScanner::Log::DieLog("EndSQLLogging seek: %s", $!);

  while(<$logfile1>) {
    chomp;
    @fields = split(/\t/);
    # Work through each field protecting any special characters such as '
    # The line below replaces ' with \'
    map { s/\'/\\'/g } @fields;

    next unless $fields[1]; # The primary key must not be blank!

    # Set any empty strings to NULL so the SQL insert works correctly
    @fields = map { ($_ eq '')?'NULL':"$_" } @fields;

    # Insert @fields into a database table
    my($sth) = $dbh->prepare("INSERT INTO maillog_mail (time, msg_id, size, from_user, from_domain, subject, clientip, archives, isspam, ishighspam, sascore, spamreport) VALUES (?,?,?,?,?,?,?,?,?,?,?,?)");
    $sth->execute($fields[0],$fields[1],$fields[2],$fields[3],$fields[4],$fields[5],$fields[6],$fields[7],$fields[8],$fields[9],$fields[10],$fields[11]) or MailScanner::Log::DieLog("Cannot insert row: %s", $DBI::errstr);
  }

  # Rewind to start of logfile2
  $logfile2->flush();
  seek($logfile2, 0, 0)
    or MailScanner::Log::DieLog("EndSQLLogging seek: %s", $!);

  while(<$logfile2>) {
    chomp;
    @fields = split(/\t/);
    # Work through each field protecting any special characters such as '
    # The line below replaces ' with \'
    map { s/\'/\\'/g } @fields;

    # Insert @fields into a database table
    my($sth) = $dbh->prepare("INSERT INTO maillog_report (msg_id, filename, filereport) VALUES (?,?,?)");
    $sth->execute($fields[0],$fields[1],$fields[2]) or MailScanner::Log::DieLog("Cannot insert row: %s", $DBI::errstr);
  }

  # Rewind to start of logfile3
  $logfile3->flush();
  seek($logfile3, 0, 0)
    or MailScanner::Log::DieLog("EndSQLLogging seek: %s", $!);

  while(<$logfile3>) {
    chomp;
    @fields = split(/\t/);
    # Work through each field protecting any special characters such as '
    # The line below replaces ' with \'
    map { s/\'/\\'/g } @fields;

    # Insert @fields into a database table
    my($sth) = $dbh->prepare("INSERT INTO maillog_recipient (msg_id, to_user, to_domain) VALUES (?,?,?)");
    $sth->execute($fields[0],$fields[1],$fields[2]) or MailScanner::Log::DieLog("Cannot insert row: %s", $DBI::errstr);
  }


  # Close database connection
  $dbh->disconnect();

  # Close and delete the temporary files (deletion is done automatically)
  $logfile1->close();
  $logfile2->close();
  $logfile3->close();
  MailScanner::Log::InfoLog("Database flush completed");
}

# Write all the log information for 1 message to the temporary file.
# For messages with reports, write 1 line for each report.
sub SQLLogging {
  my($message) = @_;

  my $id = $message->{id};
  my $size = $message->{size};
  my $from = $message->{from};
  my ($from_user, $from_domain);

  # split the from address into user and domain bits.
  # This may be unnecessary for you; we use it to more easily determine
  # inbound vs outbound email in a multi-domain environment.
  # HINT: refine queries using SQL 'join' with a table containing local 
  # domains.

  ($from_user, $from_domain) = split /\@/, $from;

  my @to   = @{$message->{to}};
  my $subject = $message->{subject};
  my $clientip = $message->{clientip};
  my $archives = join(',', @{$message->{archiveplaces}});
  my $isspam = $message->{isspam};
  my $ishighspam = $message->{ishigh};
  my $sascore = $message->{sascore};
  my $spamreport = $message->{spamreport};

  # Get rid of control chars and tidy-up SpamAssassin report
  $spamreport =~ s/\n/ /g;
  $spamreport =~ s/\t//g;

  # Get timestamp, and format it so it is suitable to use with MySQL
  my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
  my($timestamp) = sprintf("%d-%02d-%02d %02d:%02d:%02d",
			   $year+1900,$mon+1,$mday,$hour,$min,$sec);

  # Print 1 line for each message.

  $subject =~ s/\t//g; # Remove stray tab characters
  print $logfile1 join("\t", $timestamp, $id, $size, $from_user, $from_domain,
			 $subject, $clientip, $archives, $isspam, $ishighspam,
			 $sascore, $spamreport) . "\n";

  # Generate one line in logfile2 for each report. This logfile includes
  # the message ID, attachment filename and report.

  my($file, $text);
  while(($file, $text) = each %{$message->{allreports}}) {
    $file = "the entire message" if $file eq "";
    # Use the sanitised filename to avoid problems caused by people forcing
    # logging of attachment filenames which contain nasty SQL instructions.
    $file = $message->{file2safefile}{$file} || $file;
    $text =~ s/\n/ /;  # Make sure text report only contains 1 line
    $text =~ s/\t/ /; # and no tab characters
    print $logfile2 join("\t", $id, $file, $text) . "\n";
  }
 
  # Now print the recipients in logfile3.
 
  for (@to) {

    # again, split the recipient's email into user and domain halves first.
    # see comment above about splitting the email like this.

    my ($to_user, $to_domain);
    ($to_user, $to_domain) = split /\@/, $_;
    print $logfile3 join ("\t", $id, $to_user, $to_domain) . "\n";
  }
}


#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************


#
# This Custom Function provides a facility whereby some internal-only
# accounts can only send mail to other "internal" domain names, and cannot
# send mail to any other addresses apart from those domains.
#
# To use it, specify
#    Non Spam Actions          = &InternalActions
#    Spam Actions              = &InternalActions
#    High Scoring Spam Actions = &InternalActions
# in your MailScanner.conf file, having added this code to
#    /usr/lib/MailScanner/MailScanner/CustomConfig.pm
#
# It uses a configuration file whose path is
my($InternalAccountList) = '/etc/MailScanner/internal.accounts.conf';
# to read lines that look like one of these
#   domain         yourdomain.com
#   account        local-only1
# These 2 lines in the file would define that a local email account
# "local-only1" could not send mail to any address except addresses
# @yourdomain.com.
# There can be many domains and many accounts specified, one per line.
#
# Mail from the internal-only accounts to external domains will have the
my($InternalFailAction) = 'delete';
# action applied to it. This can be any of the legal "spam actions" as
# defined in the MailScanner.conf file.
#

use FileHandle;

my(%InternalDomains, %InternalAccounts);

sub InitInternalActions {
  MailScanner::Log::InfoLog("Initialising Internal account list");
  my $listfile = new FileHandle;

  unless($listfile->open("<$InternalAccountList")) {
    MailScanner::Log::WarnLog("Could not read list of internal accounts " .
                              "from %s", $InternalAccountList);
    return;
  }

  my($keyword, $value);
  my $line = 0;
  my $domains = 0;
  my $accounts = 0;
  while(<$listfile>) {
    $line++;
    chomp;
    s/^#.*$//;
    s/^\s*//g;
    s/\s*$//g;
    next if /^$/;

    $keyword = undef;
    $value   = undef;
    /^([^\s]+)\s*([^\s]+)$/;
    ($keyword, $value) = (lc($1), lc($2));
    $value =~ s/\@.*$//; # Delete the @ and everything after it
    if ($keyword =~ /domain/i) {
      #print STDERR "Storing domain $value\n";
      $InternalDomains{$value} = 1;
      $domains++;
    } elsif ($keyword =~ /account|user/i) {
      #print STDERR "Storing account $value\n";
      $InternalAccounts{$value} = 1;
      $accounts++;
    } else {
      MailScanner::Log::WarnLog("Syntax error in %s at line %d",
                                $InternalAccountList, $line);
    }
  }
  $listfile->close();
  MailScanner::Log::InfoLog("Internal Account List read %d domains and %d " .
                            "accounts", $domains, $accounts);
}

sub EndInternalActions {
  # No shutdown code needed here at all.
  MailScanner::Log::InfoLog("Shutting down internal accounts list");
}

# This will return 1 for all messages except those generated by this
# computer.
# This will return "deliver" for all internal mail as requested,
# and $InternalFailAction for everything else.
sub InternalActions {
  my($message) = @_;

  return 'deliver' unless $message; # Default if no message passed in
  return 'deliver' unless $message->{from}; # Default if duff message

  my($fromac, $fromdomain, $todomain);
  $fromac = lc($message->{from});
  $fromdomain = $fromac;
  $fromac =~ s/\@.*$//;   # Leave everything before @
  $fromdomain =~ s/^.*\@//; # Leave everything after  @

  # Is it coming from inside?
  #print STDERR "Testing $fromdomain\n";
  #print STDERR "Answer is " . $InternalDomains{$fromdomain} . "\n";
  return 'deliver' unless $InternalDomains{$fromdomain};
  #print STDERR "$fromdomain passed internaldomains test\n";
  # and is it coming from an internal-only address?
  return 'deliver' unless $InternalAccounts{$fromac};
  #print STDERR "$fromac passed internalaccounts test\n";

  # Fail if it is being delivered to *any* external addresses
  foreach $todomain (@{$message->{todomain}}) {
    $todomain = lc($todomain);
    #print STDERR "Testing $todomain\n";
    unless ($InternalDomains{$todomain}) {
      MailScanner::Log::WarnLog("Internal-only account %s attempted to " .
                   "send mail to external address \@%s", $fromac, $todomain);
      return $InternalFailAction;
    }
  }

  # Passed that, so it must be only going to internal addresses
  return 'deliver';
}



#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************

#
# This Custom Function provides a facility whereby you have multiple
# outgoing mail queues, each handled by a separate sendmail queue-runner.
# In addition to enabling this code, you will need to run a queue-runner
# process for each new queue you add, so for this code as written here,
# you will need
#    sendmail -q30m -OQueueDirectory=/var/spool/mqueue.spam
#    sendmail -q60m -OQueueDirectory=/var/spool/mqueue.highspam
# You will of course also need to create the directories
#    mkdir /var/spool/mqueue.spam
#    mkdir /var/spool/mqueue.highspam
#
# To use this code from MailScanner.conf, set this in MailScanner.conf:
#    Outgoing Queue Dir = &MultipleQueueDir
#

sub InitMultipleQueueDir {
  ;
}

sub EndMultipleQueueDir {
  ;
}

sub MultipleQueueDir {
  my($message) = @_;

  return '/var/spool/mqueue' unless $message; # catch-all if message is duff
  return '/var/spool/mqueue.highspam' if $message->{ishigh};
  return '/var/spool/mqueue.spam'     if $message->{isspam};
  return '/var/spool/mqueue';
}



#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************


#
# This Custom Function provides a facility whereby IP addresses that send
# us more than a certain number of messages per hour are blocked for the
# rest of that hour. The number of messages per hour for each IP addresses
# is configurable in a config file. A default value is also supplied in
# the config file.
# This does not take any account of whether the messages are plain, spam,
# viruses or anything else. It simply counts the number of messages in
# the current hour.
# It is currently only designed to work with sendmail.
#
# The config file is stored in /etc/MailScanner/IPBlock.conf.  You
# should set high default numbers for 127.0.0.1 and the IP number
# of your mail server(s).  First match in the list defines the number
# for a particular IP.  If you have the rules:
#
# 152.123.34.0/24 1000
# 152.123.34.36   100
#
# then machine 152.123.34.36 will have a setting of 1000 messages per
# hour.  If you want it to have a smaller limit than the rest of the
# class-C netblock, then code the rules like this:
#
# 152.123.34.36   100
# 152.123.34.0/24 1000
#
# Other examples:
# 10.11.12.13	100000	# Known good site
# 152.123.34.45	100	# Known spammer, throttle to 100 messages per hour
# 152.123.      100
# 152.123       100
# 152.123/255.255.0.0 100
# 152.123.34/24 100
# 152.123.34.0-152.123.37.255 100
# default	1000	# Default limit is 1000 messages per hour
#
# To use this, configure the variables defined immediately below this
# comment and set
# Always Looked Up Last = &IPBlock
# in MailScanner.conf.
# You will also need to look at the end of this file for the contents
# of an hourly cron job to clear out old entries from the database.
#
# NOTE: Postfix Users
# ===================
# To be able to use IPBlock make sure that you have the
# smtpd_client_restrictions entry with /etc/postfix/access.
#
# Your entry should look some thing like this
# smtpd_client_restrictions = check_client_access hash:/etc/postfix/access
#			      ......... other checks for client restrictions			      


# Import the flock names
use Fcntl qw(:DEFAULT :flock);
use FileHandle;
use Net::CIDR;
use Socket;
use POSIX qw(:signal_h); # For Solaris 9 SIG bug workaround
use IO;
BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File SDBM_File) }
use AnyDBM_File;

# You may need to configure these for your site:
my $WhitelistFile= '/etc/MailScanner/IPBlock.conf';
my $LockFile     = '/var/spool/MailScanner/IPBlock.lock';
#my $LogFile     = '/var/spool/MailScanner/IPBlock.log';
my $BlockDB      = '/var/spool/MailScanner/IPBlock.db';
my $DefaultMaxMessagesPerHour = 1000; # 999999999
my $FailCode     = '550';

my(%IP2Limit, %IPBWhiteCIDR);
my(%CIDRtoLimit); # Map CIDR onto limit
my(@CIDRlist);    # Ordered list of rules, all in CIDR form
my($hostname);

my $ConfFile = $ARGV[0];
$ConfFile = $ARGV[1] if $ConfFile =~ /^-+v/i;

my ($AccessDB, $Refusal, $my_mta); # Generalized here for Multiple MTA support
$my_mta = lc(MailScanner::Config::QuickPeek($ConfFile, 'mta')) if $ConfFile &&
                                                               -f $ConfFile;
if ($my_mta eq "postfix") { 
  $AccessDB = "/etc/postfix/access.db";
  $Refusal = "$FailCode Site blocked by MailScanner due to excessive email";

} elsif ($my_mta eq "sendmail") {
  $AccessDB = "/etc/mail/access.db";
  $Refusal = "\"$FailCode Site blocked by MailScanner due to excessive email\"";
} else {
  $AccessDB = "";
  $Refusal = "";
}


sub InitIPBlock {
  my($LimitsH, $cidr, $limit, $counter);

  # Skip IP block initialization if not postfix or sendmail
  if ($my_mta !~ /postfix|sendmail/) {
    MailScanner::Log::ErrorLog("IPBlock Currently not supported " .
                               "for your MTA %s", $my_mta);
    return 1;
  }

  MailScanner::Log::InfoLog("Initialising IP blocking");
  my $LimitsH = new FileHandle;
  unless ($LimitsH->open($WhitelistFile)) {
    MailScanner::Log::WarnLog("Could not read IPBlock configuration from %s",
                              $WhitelistFile);
    return;
  }
  $counter = 0;
  while(<$LimitsH>) {
    chomp;
    s/#.*$//;
    s/^\s*//g;
    s/\s*$//g;
    next if /^$/;
    ($cidr, $limit) = split;
    $cidr =~ s/\s//g;
    $limit = 0 unless defined $limit;

    my @cidrlist = undef;
    if ($cidr =~ /-/) {
      # It looks like 152.78.67.0-152.78.69.255
      @cidrlist = Net::CIDR::range2cidr($cidr);
    } elsif ($cidr =~ /\//) {
      # It looks like 152.78.0.0/16 or 152.78/16 or 152.78/255.255.0.0
      my($network, $bits, $count);
      ($network, $bits) = split(/\//, $cidr);
      $network =~ s/\.$//; # Delete any trailing dot
      $count = split(/\./, $network);
      $network .= '.0' x (4-$count); # Fill out the CIDR for Net::CIDR
      # 152.78 now looks like 152.78.0.0
      if ($bits =~ /\./) {
        # It's like 152.78.0.0/255.255.0.0
        push @cidrlist, Net::CIDR::addrandmask2cidr($network, $bits);
      } else {
        # It's like 152.78.0.0/16
        push @cidrlist, "$network/$bits";
      }
    } elsif ($cidr =~ /default/i) {
      # It is the default value used when nothing else matches
      $DefaultMaxMessagesPerHour = $limit;
    } else {
      # Must just be an IP address or look like 152.78 or 152.78.
      $cidr =~ s/\.$//; # Delete any trailing dot
      my $count = split(/\./, $cidr);
      $cidr .= '.0' x (4-$count);
      push @cidrlist, "$cidr/" . ($count*8);
    }

    # Build the map from CIDR to message limit
    foreach (@cidrlist) {
      next unless $_;
      #print STDERR "IPBlock: adding $_\n";
      $CIDRtoLimit{$_} = $limit;
      push @CIDRlist, $_;
    }
    $counter++;
  }
  close($LimitsH);
  MailScanner::Log::InfoLog("Read %d IP blocking entries from %s",
                            $counter, $WhitelistFile);
}

sub EndIPBlock {
  MailScanner::Log::InfoLog("Closing down IP blocking");
}

sub IPBlock {
  my($message) = @_;

  # Skip IPblock if not sendmail or postfix

  if ($my_mta !~ /postfix|sendmail/) {
    MailScanner::Log::ErrorLog("IPBlock Currently not supported for " .
                               "your MTA %s", $my_mta);
    return 1;
  }

  return 1 unless $message; # Default if no message passed in

  my $ip = $message->{clientip};
  return 1 unless $ip;

  # Work out which (if any) CIDR this IP address is in.
  my($cidrkey, $foundcidr, $foundit, $limit);
  $foundit = 0;
  foreach $cidrkey (@CIDRlist) {
    #print STDERR "Looking for $ip in $cidrkey\n";
    if (Net::CIDR::cidrlookup($ip, $cidrkey)) {
      #print STDERR "Found it\n";
      $foundit = 1;
      $foundcidr = $cidrkey;
      last;
    }
  }
  # If we didn't find it, use the default value
  $limit = $foundit ? $CIDRtoLimit{$foundcidr} : $DefaultMaxMessagesPerHour;

  #print STDERR "Limit of $foundcidr is $limit\n";

  # If there is already a counter for this IP address and it's zero
  # then return, as this IP is unlimited.
  return 1 if $limit == 0;

  #
  # Lock $LockFile exclusively to block out all other processes
  #
  my $LockFileH = new FileHandle;
  IPBopenlock($LockFileH, ">$LockFile");

  ## Add this IP address to the log file.
  ## It is faster to always write it than to check if it needs to be written.
  #my $LogH = new FileHandle;
  #unless ($LogH->open(">+$LogFile")) {
  #  MailScanner::Log::WarnLog("IPBlock: Cannot open %s for writing", $LogFile);
  #  return 1;
  #}
  #print $LogH $ip . "\n";
  #$LogH->close;

  # Update the counter of the number of messages this IP
  # has sent in the last hour
  #Bind to BlockDB
  my %BlockDB;
  unless (tie %BlockDB, "AnyDBM_File", $BlockDB, O_RDWR|O_CREAT, 0644) {
    MailScanner::Log::WarnLog("IPBlock: Could not open/create %s", $BlockDB);
    IPBunlockclose($LockFileH);
    return 0;
  }
  #Look up $ip and increment counter
  my($record, $hostname, $counter, $time, $donealready);
  $record = $BlockDB{$ip};
  if ($record) {
    ($hostname, $counter, $time, $donealready) = split (/,/, $record);
    $counter++;
    #print STDERR "Found IP in BlockDB, counter=$counter time=$time done=$donealready\n";
  } else {
    $counter = 1;
    $time = time();
    $donealready = 0;
    $hostname = IPBlockIP2Hostname($ip);
    #print STDERR "Not found IP in BlockDB, creating new record\n";
  }

  # If there is already a limit for this IP then use it, else create it
  my($thislimit, $MaxMessagesPerHour);
  $thislimit = $IP2Limit{$ip};
  if (defined $thislimit) {
    $MaxMessagesPerHour = $thislimit;
  } else {
    $MaxMessagesPerHour = $limit;
    $IP2Limit{$ip} = $limit;
  }
  #print STDERR "Messages per hour limit for $ip is $limit\n";

  #
  # This IP address has gone over its limit,
  # so add it to the access DB for sendmail.
  #
  if ($counter > $MaxMessagesPerHour && !$donealready) {
    #print STDERR "Adding record for $ip to accessdb\n";
    my %AccessDB;
    unless (tie %AccessDB, "AnyDBM_File", $AccessDB, O_RDWR, 0644) {
      MailScanner::Log::WarnLog("IPBlock: Could not open access database %s",
                                $AccessDB);
      #Close files and unlock $LockFile
      untie %BlockDB;
      IPBunlockclose($LockFileH);
      return 0;
    }
    MailScanner::Log::NoticeLog("IPBlock: Adding block for %s", $ip);
    $AccessDB{$ip} = $Refusal;
    $AccessDB{$hostname} = $Refusal;
    $donealready = 1; # Mark it so we don't try to waste CPU setting it twice
    untie %AccessDB;
  }

  #Write back counter + timestamp
  $BlockDB{$ip} = "$hostname,$counter,$time,$donealready";
  #Unbind BlockDB
  untie %BlockDB;

  #Unlock $LockFile
  IPBunlockclose($LockFileH);
  
  return 1;
}

sub IPBopenlock {
  my($fh, $fn) = @_;

  if (open($fh, $fn)) {
    flock($fh, LOCK_EX);
  } else {
    MailScanner::Log::NoticeLog("Could not open file $fn: %s", $!);
  }
}

sub IPBunlockclose {
  my($fh) = @_;

  flock($fh, LOCK_UN);
  close ($fh);
}

# Convert an IP address to a hostname, with timeout protection.
# Return "" if it times out or I can't get a name at all.
sub IPBlockIP2Hostname {
  my($IPstring) = @_;

  return "" unless $IPstring =~ /[0-9.]+/;

  my($pipe);

  unless ($pipe = new IO::Pipe) {
    MailScanner::Log::WarnLog('IPBlock: Could not create pipe, %s', $!);
    return "";
  }

  my $PipeReturn = 0;
  my $GotAHit = 0;

  my $pid = fork();
  unless (defined($pid)) {
    MailScanner::Log::WarnLog('IPBlock: Could not fork process, %s', $!);
    return "";
  }

  if ($pid == 0) {
    # In the child
    $pipe->writer();
    #POSIX::setsid();

    # Switch to line buffering
    $pipe->autoflush();

    # Work out the hostname and print it to the parent
    my $ipaddr = inet_aton($IPstring);
    my $claimed_name = gethostbyaddr($ipaddr, AF_INET);
    print $pipe "$claimed_name\n";

    $pipe->close();
    exit 0;
  }

  # Now for the parent code
  eval {
    $pipe->reader();
    local $SIG{ALRM} = sub { die "Command Timed Out" };
    alarm MailScanner::Config::Value('spamlisttimeout');
    $hostname = <$pipe>;
    chomp $hostname;
    $pipe->close();
    waitpid $pid, 0;
    $PipeReturn = $?;
    alarm 0;
    $pid = 0;
  };
  alarm 0;
  # Workaround for bug in perl shipped with Solaris 9,
  # it doesn't unblock the SIGALRM after handling it.
  eval {
    my $unblockset = POSIX::SigSet->new(SIGALRM);
    sigprocmask(SIG_UNBLOCK, $unblockset)
      or die "Could not unblock alarm: $!\n";
  };

  # Note to self: I only close the KID in the parent, not in the child.

  # Catch failures other than the alarm
  MailScanner::Log::WarnLog("IPBlock: Hostname lookup for %s failed with real error: %s", $IPstring, $@)
    if $@ and $@ !~ /Command Timed Out/;

  # In which case any failures must be the alarm
  #($@ or $pid>0)
  if ($pid>0) {
    MailScanner::Log::WarnLog("IPBlock: Hostname lookup for %s timed out and was killed", $IPstring);
    # Kill the running child process
    my($i);
    kill 15, $pid; # Was -15
    for ($i=0; $i<5; $i++) {
      sleep 1;
      waitpid($pid, &POSIX::WNOHANG);
      ($pid=0),last unless kill(0, $pid);
      kill 15, $pid; # Was -15
    }
    # And if it didn't respond to 11 nice kills, we kill -9 it
    if ($pid) {
      kill 9, $pid; # Was -9
      waitpid $pid, 0; # 2.53
    }
  }

  return $hostname;
}

#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************
#**************************************************************************

#
# This set of functions provide the ability for a great speed improvement
# in the processing of rules files for the "Spam List" and "Spam Domain
# List" settings. It assumes that the addresses to match against in the
# rules file are all of the kind
# To: user@domain rbl1 rbl2 rbl3....
# To: domain rbl1 rbl2 rbl3....
#
# To use this, set
# Spam List = &FastSpamList
# Spam Domain List = &FastSpamDomainList
# in /etc/MailScanner/MailScanner.conf
# and put the rules in these 2 files:
my $Spamlistfile   = '/etc/MailScanner/rules/spam.list.rules';
my $Spamdomainlistfile = '/etc/MailScanner/rules/spam.domain.list.rules';

my $Codebasefile   = '/etc/MailScanner/rules/codebase.tags.rules';
my $Externalfile   = '/etc/MailScanner/rules/external.message.bodies.rules';
my $Filenamefile   = '/etc/MailScanner/rules/filename.rules';
my $Htmltotextfile = '/etc/MailScanner/rules/html.to.text.rules';
my $Iframefile     = '/etc/MailScanner/rules/iframe.tags.rules';
my $Partialfile    = '/etc/MailScanner/rules/partial.message.rules';


use FileHandle;
my(%Fastspamlist, %Fastspamdomainlist, %Fastcodebase, %Fastexternal,
   %Fastfilename, %Fasthtmltotext, %Fastiframe, %Fastpartial);

#-----------------------
# All the Init functions
#-----------------------

sub InitFastSpamList {
  my($dir, $address, $result);

  my $fh = new FileHandle;
  unless ($fh->open($Spamlistfile)) {
    MailScanner::Log::WarnLog("Could not read fast spam list rules from %s",
                              $Spamlistfile);
    return;
  }

  my $counter = 0;
  while(<$fh>) {
    chomp;
    s/#.*$//;     # Remove comments
    s/\s+$//;     # and trailing whitespace
    s/^\s+//;     # and leading whitespace
    next if /^$/; # and blank lines
    ($dir, $address, $result) = split(" ", $_, 3);
    $Fastspamlist{$address} = $result;
    $counter++;
  }

  MailScanner::Log::InfoLog("Read %d fast spam list rules", $counter);
  #print STDERR "Read $counter rules\n";
}


sub InitFastSpamDomainList {
  my($dir, $address, $result);

  my $fh = new FileHandle;
  unless ($fh->open($Spamdomainlistfile)) {
    MailScanner::Log::WarnLog("Could not read fast spam domain list rules " .
                              "from %s", $Spamdomainlistfile);
    return;
  }

  my $counter = 0;
  while(<$fh>) {
    chomp;
    s/#.*$//;     # Remove comments
    s/\s+$//;     # and trailing whitespace
    s/^\s+//;     # and leading whitespace
    next if /^$/; # and blank lines
    ($dir, $address, $result) = split(" ", $_, 3);
    $Fastspamdomainlist{$address} = $result;
    $counter++;
  }

  MailScanner::Log::InfoLog("Read %d fast spam domain list rules", $counter);
  #print STDERR "Read $counter rules\n";
}


sub InitFastCodebase {
  my($dir, $address, $result);

  my $fh = new FileHandle;
  unless ($fh->open($Codebasefile)) {
    MailScanner::Log::WarnLog("Could not read fast codebase tags rules " .
                              "from %s", $Codebasefile);
    return;
  }

  my $counter = 0;
  while(<$fh>) {
    chomp;
    s/#.*$//;     # Remove comments
    s/\s+$//;     # and trailing whitespace
    s/^\s+//;     # and leading whitespace
    next if /^$/; # and blank lines
    ($dir, $address, $result) = split(" ", $_, 3);
    $Fastcodebase{$address} = $result;
    $counter++;
  }

  MailScanner::Log::InfoLog("Read %d fast codebase tags rules", $counter);
  #print STDERR "Read $counter rules\n";
}


sub InitFastExternal {
  my($dir, $address, $result);

  my $fh = new FileHandle;
  unless ($fh->open($Externalfile)) {
    MailScanner::Log::WarnLog("Could not read fast external bodies rules " .
                              "from %s", $Externalfile);
    return;
  }

  my $counter = 0;
  while(<$fh>) {
    chomp;
    s/#.*$//;     # Remove comments
    s/\s+$//;     # and trailing whitespace
    s/^\s+//;     # and leading whitespace
    next if /^$/; # and blank lines
    ($dir, $address, $result) = split(" ", $_, 3);
    $Fastexternal{$address} = $result;
    $counter++;
  }

  MailScanner::Log::InfoLog("Read %d fast external bodies rules", $counter);
  #print STDERR "Read $counter rules\n";
}


sub InitFastFilename {
  my($dir, $address, $result);

  my $fh = new FileHandle;
  unless ($fh->open($Filenamefile)) {
    MailScanner::Log::WarnLog("Could not read fast filename-rules rules " .
                              "from %s", $Filenamefile);
    return;
  }

  my $counter = 0;
  while(<$fh>) {
    chomp;
    s/#.*$//;     # Remove comments
    s/\s+$//;     # and trailing whitespace
    s/^\s+//;     # and leading whitespace
    next if /^$/; # and blank lines
    ($dir, $address, $result) = split(" ", $_, 3);
    $Fastfilename{$address} = $result;
    $counter++;
  }

  MailScanner::Log::InfoLog("Read %d fast filename-rules rules", $counter);
  #print STDERR "Read $counter rules\n";
}


sub InitFastHtmlToText {
  my($dir, $address, $result);

  my $fh = new FileHandle;
  unless ($fh->open($Htmltotextfile)) {
    MailScanner::Log::WarnLog("Could not read fast HTML To Text rules " .
                              "from %s", $Htmltotextfile);
    return;
  }

  my $counter = 0;
  while(<$fh>) {
    chomp;
    s/#.*$//;     # Remove comments
    s/\s+$//;     # and trailing whitespace
    s/^\s+//;     # and leading whitespace
    next if /^$/; # and blank lines
    ($dir, $address, $result) = split(" ", $_, 3);
    $Fasthtmltotext{$address} = $result;
    $counter++;
  }

  MailScanner::Log::InfoLog("Read %d fast HTML To Text rules", $counter);
  #print STDERR "Read $counter rules\n";
}


sub InitFastIframe {
  my($dir, $address, $result);

  my $fh = new FileHandle;
  unless ($fh->open($Iframefile)) {
    MailScanner::Log::WarnLog("Could not read fast IFrame Tags rules " .
                              "from %s", $Iframefile);
    return;
  }

  my $counter = 0;
  while(<$fh>) {
    chomp;
    s/#.*$//;     # Remove comments
    s/\s+$//;     # and trailing whitespace
    s/^\s+//;     # and leading whitespace
    next if /^$/; # and blank lines
    ($dir, $address, $result) = split(" ", $_, 3);
    $Fastiframe{$address} = $result;
    $counter++;
  }

  MailScanner::Log::InfoLog("Read %d fast IFrame Tags rules", $counter);
  #print STDERR "Read $counter rules\n";
}


sub InitFastPartial {
  my($dir, $address, $result);

  my $fh = new FileHandle;
  unless ($fh->open($Partialfile)) {
    MailScanner::Log::WarnLog("Could not read fast partial message rules " .
                              "from %s", $Partialfile);
    return;
  }

  my $counter = 0;
  while(<$fh>) {
    chomp;
    s/#.*$//;     # Remove comments
    s/\s+$//;     # and trailing whitespace
    s/^\s+//;     # and leading whitespace
    next if /^$/; # and blank lines
    ($dir, $address, $result) = split(" ", $_, 3);
    $Fastpartial{$address} = $result;
    $counter++;
  }

  MailScanner::Log::InfoLog("Read %d fast partial message rules", $counter);
  #print STDERR "Read $counter rules\n";
}


#---------------------------------
# Now for all the lookup functions
#---------------------------------

# Get the list of unique RBLs for a given message that has lots of
# recipients. For each recipient, add the list for that user (or for
# that domain if there is no user-specific rule). Add these lists
# together and remove all the repeated entries.
sub FastSpamList {
  my($message) = @_;

  return "" unless $message; # Default if no message passed in

  my(%rbls, $rbllist, @rbllist, $to, $user, $domain);

  $rbllist = "";
  foreach $to (@{$message->{to}}, $message->{from}) {
    ($user, $domain) = split(/\@/, $to, 2);
    # Add the rbl list for the user if it exists,
    # otherwise add the rbl list for the domain.
    if ($Fastspamlist{$to}) {
      $rbllist .= " " . $Fastspamlist{$to};
    } else {
      $rbllist .= " " . $Fastspamlist{$domain};
    }
    #print STDERR "RBLList is now $rbllist\n";
  }
  # And the default
  $rbllist = $Fastspamlist{'default'} if $rbllist =~ /^\s*$/;

  @rbllist = split(" ", $rbllist);
  foreach (@rbllist) {
    $rbls{$_} = 1;
  }
  #print STDERR "Result is " . join(' ', keys %rbls) . "\n";
  return join(' ', keys %rbls);
}

sub FastSpamDomainList {
  my($message) = @_;

  return "" unless $message; # Default if no message passed in

  my(%rbls, $rbllist, @rbllist, $to, $user, $domain);

  $rbllist = "";
  foreach $to (@{$message->{to}}, $message->{from}) {
    ($user, $domain) = split(/\@/, $to, 2);
    # Add the rbl list for the user if it exists,
    # otherwise add the rbl list for the domain.
    if ($Fastspamlist{$to}) {
      $rbllist .= " " . $Fastspamdomainlist{$to};
    } else {
      $rbllist .= " " . $Fastspamdomainlist{$domain};
    }
  #print STDERR "RBLList is now $rbllist\n";
  }
  # And the default
  $rbllist = $Fastspamdomainlist{'default'} if $rbllist =~ /^\s*$/;

  @rbllist = split(" ", $rbllist);
  foreach (@rbllist) {
    $rbls{$_} = 1;
  }
  #print STDERR "Result is " . join(' ', keys %rbls) . "\n";
  return join(' ', keys %rbls);
}


sub FastCodebase {
  my($message) = @_;

  return 0 unless $message; # Default if no message passed in

  my($to, $user, $domain);
  my($codebase, $found);

  $codebase = 1; # Start by allowing it
  $found    = 0;

  # Test each of the exact addresses
  foreach $to (@{$message->{to}}, $message->{from}) {
    ($user, $domain) = split(/\@/, $to, 2);
    if (exists $Fastcodebase{$to}) {
      $found = 1;
      $codebase = $codebase && $Fastcodebase{$to};
      next; # Don't check domain default if exact address matched
    }
    if (exists $Fastcodebase{$domain}) {
      $found = 1;
      $codebase = $codebase && $Fastcodebase{$domain};
    }
  }
  return $codebase if $found;

  return $Fastcodebase{'default'} + 0; # Make it 0 if it's undef
}


sub FastExternal {
  my($message) = @_;

  return 0 unless $message; # Default if no message passed in

  my($to, $user, $domain);
  my($external, $found);

  $external = 1; # Start by allowing it
  $found    = 0;

  # Test each of the exact addresses
  foreach $to (@{$message->{to}}, $message->{from}) {
    ($user, $domain) = split(/\@/, $to, 2);
    if (exists $Fastexternal{$to}) {
      $found = 1;
      $external = $external && $Fastexternal{$to};
      next; # Don't check domain default if exact address matched
    }
    if (exists $Fastexternal{$domain}) {
      $found = 1;
      $external = $external && $Fastexternal{$domain};
    }
  }
  return $external if $found;

  return $Fastexternal{'default'} + 0; # Make it 0 if it's undef
}

sub FastFilename {
  my($message) = @_;

  return "" unless $message; # Default if no message passed in

  my(%filenames, $filenamelist, @filenamelist, $to, $user, $domain);

  $filenamelist = "";
  foreach $to (@{$message->{to}}, $message->{from}) {
    ($user, $domain) = split(/\@/, $to, 2);
    # Add the filename list for the user if it exists,
    # otherwise add the filename list for the domain.
    if ($Fastfilename{$to}) {
      $filenamelist .= " " . $Fastfilename{$to};
    } else {
      $filenamelist .= " " . $Fastfilename{$domain};
    }
  #print STDERR "Filenamelist is now $filenamelist\n";
  }
  # And the default
  $filenamelist = $Fastfilename{'default'} if $filenamelist =~ /^\s*$/;

  @filenamelist = split(" ", $filenamelist);
  foreach (@filenamelist) {
    $filenames{$_} = 1;
  }
  #print STDERR "Result is " . join(' ', keys %filenames) . "\n";
  return join(' ', keys %filenames);
}

sub FastHtmlToText {
  my($message) = @_;

  return 0 unless $message; # Default if no message passed in

  my($to, $user, $domain);
  my($htmltotext, $found);

  $htmltotext = 1; # Start by allowing it
  $found      = 0;

  # Test each of the exact addresses
  foreach $to (@{$message->{to}}, $message->{from}) {
    ($user, $domain) = split(/\@/, $to, 2);
    if (exists $Fasthtmltotext{$to}) {
      $found = 1;
      $htmltotext = $htmltotext && $Fasthtmltotext{$to};
      next; # Don't check domain default if exact address matched
    }
    if (exists $Fasthtmltotext{$domain}) {
      $found = 1;
      $htmltotext = $htmltotext && $Fasthtmltotext{$domain};
    }
  }
  return $htmltotext if $found;

  return $Fasthtmltotext{'default'} + 0; # Make it 0 if it's undef
}


sub FastIframe {
  my($message) = @_;

  return 0 unless $message; # Default if no message passed in

  my($to, $user, $domain);
  my($iframe, $found);

  $iframe = 1; # Start by allowing it
  $found  = 0;

  # Test each of the exact addresses
  foreach $to (@{$message->{to}}, $message->{from}) {
    ($user, $domain) = split(/\@/, $to, 2);
    if (exists $Fastiframe{$to}) {
      $found = 1;
      $iframe = $iframe && $Fastiframe{$to};
      next; # Don't check domain default if exact address matched
    }
    if (exists $Fastiframe{$domain}) {
      $found = 1;
      $iframe = $iframe && $Fastiframe{$domain};
    }
  }
  return $iframe if $found;

  return $Fastiframe{'default'} + 0; # Make it 0 if it's undef
}


sub FastPartial {
  my($message) = @_;

  return 0 unless $message; # Default if no message passed in

  my($to, $user, $domain);
  my($partial, $found);

  $partial = 1; # Start by allowing it
  $found   = 0;

  # Test each of the exact addresses
  foreach $to (@{$message->{to}}, $message->{from}) {
    ($user, $domain) = split(/\@/, $to, 2);
    if (exists $Fastpartial{$to}) {
      $found = 1;
      $partial = $partial && $Fastpartial{$to};
      next; # Don't check domain default if exact address matched
    }
    if (exists $Fastpartial{$domain}) {
      $found = 1;
      $partial = $partial && $Fastpartial{$domain};
    }
  }
  return $partial if $found;

  return $Fastpartial{'default'} + 0; # Make it 0 if it's undef
}


#----------------------------------
# Lastly all the shutdown functions
#----------------------------------

sub EndFastSpamList {
  # No shutdown code needed here at all.
  MailScanner::Log::InfoLog("Ending SpamList");
}

sub EndFastSpamDomainList {
  # No shutdown code needed here at all.
  MailScanner::Log::InfoLog("Ending SpamDomainList");
}

sub EndFastCodebase {
  # No shutdown code needed here at all.
  MailScanner::Log::InfoLog("Ending Codebase");
}

sub EndFastExternal {
  # No shutdown code needed here at all.
  MailScanner::Log::InfoLog("Ending External");
}

sub EndFastFilename {
  # No shutdown code needed here at all.
  MailScanner::Log::InfoLog("Ending Filename");
}

sub EndFastHtmlToText {
  # No shutdown code needed here at all.
  MailScanner::Log::InfoLog("Ending HtmlToText");
}

sub EndFastIframe {
  # No shutdown code needed here at all.
  MailScanner::Log::InfoLog("Ending Iframe");
}

sub EndFastPartial {
  # No shutdown code needed here at all.
  MailScanner::Log::InfoLog("Ending Partial");
}


1;

__DATA__

#
#
# This is the start of the IPBlock cron job, run this once an hour.
#
#

#!/usr/bin/perl -I/usr/lib/MailScanner

#
#   MailScanner - SMTP E-Mail Virus Scanner
#   Copyright (C) 2002  Julian Field
#
#   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
#
#   The author, Julian Field, can be contacted by email at
#      Jules@JulianField.net
#   or by paper mail at
#      Julian Field
#      Dept of Electronics & Computer Science
#      University of Southampton
#      Southampton
#      SO17 1BJ
#      United Kingdom
#
push @INC,"/usr/lib/MailScanner","/opt/MailScanner/lib";
use FileHandle;
use Fcntl qw(:DEFAULT :flock);
use Sys::Syslog;
BEGIN { @AnyDBM_File::ISA = qw(DB_File GDBM_File NDBM_File SDBM_File) }
use AnyDBM_File;
require MailScanner::Config;
use strict 'vars';
use strict 'refs';
no  strict 'subs'; # Allow bare words for parameter %'s

my $FailCode = '550';

my $ConfFile = $ARGV[0];
die "Usage : <scriptname> /path/to/MailScanner.conf\n" if($ConfFile eq "");

my ($AccessDB, $Refusal, $my_mta); # Generalized here for Multiple MTA support
$my_mta = lc(MailScanner::Config::QuickPeek($ConfFile, 'mta'));
if( $my_mta eq "postfix" ) {

	$AccessDB = "/etc/postfix/access.db";
	$Refusal = "$FailCode Site blocked by MailScanner due to excessive email";

}elsif( $my_mta eq "sendmail"){

	$AccessDB = "/etc/mail/access.db";
	$Refusal = "\"$FailCode Site blocked by MailScanner due to excessive email\"";

}else{
# Set some values for these variables	
	$AccessDB = "";
	$Refusal = "";
	print STDERR "IPBlock is currently not supported for your MTA\n";
	exit 0; # No need to do further processing if I don't know the MTA
}



my $OneHour      = 3600; # seconds
my $LockFile     = '/var/spool/MailScanner/IPBlock.lock';
#my $LogFile     = '/var/spool/MailScanner/IPBlock.log';
my $BlockDB      = '/var/spool/MailScanner/IPBlock.db';
#my $AccessDB     = '/etc/mail/access.db';
#my $Refusal      = '"451 Site blocked by MailScanner due to excessive email"';

# Start logging
Sys::Syslog::openlog("IPBlock", 'pid, nowait', 'mail');

#
# Lock out everything else for the whole of this script
#
my $LockFileH = new FileHandle;
openlock($LockFileH, ">$LockFile");

#
# Find all the entries to be deleted from the BlockDB file.
#

#Bind to BlockDB
my(%BlockDB, %AccessDB);
tie %BlockDB, "AnyDBM_File", $BlockDB, O_RDWR, 0644
  or BailOut("Failed to open $BlockDB, it may not exist yet, $!");
  
tie %AccessDB, "AnyDBM_File", $AccessDB, O_RDWR, 0644
  or BailOut("Failed to open $AccessDB, have you got the path wrong? $!");

# Read through the entire DB finding all the old records
my $now = time;
my(%DeleteMe, $ip, $value, $hostname, $count, $time, $donealready);
my $countrec = 0;
my $countdel = 0;
my $maxcount = 0;
my $maxip    = 'undefined';
while(($ip, $value) = each %BlockDB) {
  ($hostname, $count, $time, $donealready) = split(/,/, $value);
  # Is it more than an hour old, or has time_t wrapped (happens in year 2036)
  #print STDERR "Examining record for $ip, $count, $time\n";
  $countrec++;
  if ($count > $maxcount) {
    $maxcount = $count;
    $maxip = $ip;
  }
  if ($time>$now || $now>=$time+$OneHour) {
    $DeleteMe{$ip} = 1;
    $DeleteMe{$hostname} = 1;
    #print STDERR "Deleting old record for $ip\n";
    $countdel++;
  }
}

print STDERR "IPBlock cronjob: $countrec DB records examined, $countdel " .
             "old records deleted\n";
print STDERR "IPBlock cronjob: maximum: $maxcount emails from $maxip\n";

# Delete all the old db entries
my $counter = 0;
while(($ip, $value) = each %DeleteMe) {
  #print STDERR "Studying IP \"$ip\"\n";
  next unless $ip;
  #print STDERR "AccessDB is \"" . $AccessDB{$ip} . "\"\n";
  delete $BlockDB{$ip};
  if ($AccessDB{$ip} eq $Refusal) {
    delete $AccessDB{$ip};
    $counter++;
  }
  #delete $AccessDB{$hostname} if $AccessDB{$hostname} eq $Refusal;
}

# Unlock and close the DB file
untie %BlockDB;
untie %AccessDB;

Sys::Syslog::syslog('info', "Deleted $counter entries from sendmail access database");

unlockclose($LockFileH);

Sys::Syslog::closelog();
exit 0;

sub openlock {
  my($fh, $fn) = @_;

  if (open($fh, $fn)) {
    flock($fh, LOCK_EX) or die;
  } else {
    die "Died opening $fn, $!";
  }
}

sub unlockclose {
  my($fh) = @_;

  flock($fh, LOCK_UN);
  close ($fh);
}

sub BailOut {
  Sys::Syslog::syslog('err', @_);
  Sys::Syslog::closelog();
  warn "@_, $!";
  exit 1;
}

#---SNIP---

#
#
# This is the end of the IPBlock cron job
#
#