#
# 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
#
#
syntax highlighted by Code2HTML, v. 0.9.1