#!/usr/local/bin/perl

#############################################################################
# A script to monitor /var/log/messages for sendmail logs looking for
# "User unknown" logs, and then using data from Linux's /proc/net/tcp
# and /proc/<pid>/fd/* tie those logs to the remote IP address that is
# responsible for them, so we can firewall it, etc. at certain thresholds.
#
# This code works only on Linux kernels version 2.4.x and 2.6.x.
#
# Authored 2005-02-23 by Lester Hightower
#  * 20050308: added kernel 2.6.x support
#              added iptables rules to firewall offenders
#  * 20050331: some cleanup in preparation for submitting to CPAN
#              added DoGetOpts() for some command-line changeable globals
#              added POD
#############################################################################

require 5.000;

use strict;
use File::Tail;
use FileHandle;
use Time::HiRes;
use Net::Subnets;
use Getopt::Long;

use constant CVS_VERSION => scalar '$Revision: 1.11 $';

# Command-line switchable globals
our $DEBUG=3;
our $DEBUG_TO_SYSLOG=0;
our $WHITE_LIST = "";
our $SYSLOG_MSGS_FILE = "/var/log/messages";
our $MAILER_IP = "";
our $MAILER_PORT = "25";
our $MAILER_SYSLOG_HOST="mail1";
our $MAILER_SYSLOG_NAME="sm-mta";
our $IPTABLES_CHAIN_NAME="SPAM_UNAME_GUESSERS";
# Global variables that are static
my $MY_MAX_RUNTIME = 3 * 24 * 60 * 60;   # Maximum num of seconds before exit
my $MAX_RUNTIME_SENDMAIL_CMD_WAIT = 15*60;  # Max # of secs
my $MAX_OFFENSES_BEFORE_FIREWALLED = 3;  # Number of offenses before firewall
my $MAX_BLOCKED_TIME = 60 * 60 * 3;      # Amount of time to firewall offenders
my $MAX_SYSLOG_READ_DELAY = 10;
# If you have lots of servers with different binary paths, you might
# consider changing these <foo>_EXE vars to "/usr/bin/env <foo>"
my $FIND_EXE="/usr/bin/find";
my $IPTABLES_EXE="/usr/sbin/iptables";
my $LOGGER_EXE="/usr/bin/logger";
#
my $IDLE_SLEEP_INTERVAL=0;	# secs, can be a float; 0 to use File::Tail
# This data structure manages routines that we run occassionally to
# perform cleanup work for us.
my %PERIODIC_CLEANSERS = (
	'UnblockOldOffenders' => {
		'frequency' => 10 * 60,	# 10 minutes
				},
	'KillSendmailsInCmdWait' => {
		'frequency' => 10 * 60,	# 10 minutes
				},
);

# Log a "hello world" message...
&Dbg(0, "Starting software, " . CVS_VERSION);
my $MY_START_TIME = time;

$|=1;

# Parse the command line options
&DoGetOpts;

# Initialize the iptables rules/chain that we need
&InitIPTablesRules();

# Load the white-list; we get back a Net::Subnets object.
my $white_list = &LoadWhiteList($WHITE_LIST);

# Open the syslog messages file with the very cool File::Tail module
my $syslog = File::Tail->new(name => $SYSLOG_MSGS_FILE, nowait => 1,
		maxinterval => 90, adjustafter => 7, tail => 100);
$syslog->nowait(1);

my $line='';
my %OffendersPID=();
my %OffendersIP=();
MAIN_LOOP: while (1) {
  my $new_lines_matched = 0;
  while (defined($line=$syslog->read) && length($line)) {
    $syslog->nowait(1);
    my $pattern = " [0-9]{2}:[0-9]{2}:[0-9]{2} " .	# Time
		"$MAILER_SYSLOG_HOST " .
		"$MAILER_SYSLOG_NAME\Q[\E([0-9]+)\Q]\E: " .
		".+\.\.\. User unknown" .
		"";
    if ($line =~ m/$pattern/) {
      $new_lines_matched++;
      my $pid=$1;
      $OffendersPID{$pid}{count}++;
      $OffendersPID{$pid}{last_offense}=time;
    }
  }

  if ($new_lines_matched < 1) {
    if ($IDLE_SLEEP_INTERVAL > 0) {
      &Dbg(6,"Sleeping.");
      sleep $IDLE_SLEEP_INTERVAL;
      &Time::HiRes::sleep($IDLE_SLEEP_INTERVAL);
    } else {
      $syslog->nowait(0);
      &Dbg(6,"Going idle with \$syslog->nowait(0)");
    }
    next MAIN_LOOP;
  }

  my @offending_pids = sort keys %OffendersPID;
  my $rSocketInodesPerPID = &get_socket_inodes();
  my $rProcNetTCP = &get_proc_net_tcp();

  OFFENDING_PID: foreach my $pid (@offending_pids) {
    # Now, use the %OffendersPID data to make %OffendersIP data.
    # Note, if you use something greater than zero in the following
    # if statement, then only PIDs that offend more then N times get
    # pushed into %OffendersIP data.
    my $offense_count = $OffendersPID{$pid}{count};
    if ($offense_count > 0) {
      &Dbg(4,"PID $pid has $offense_count offenses");
      #warn "LHHS: " . ref($rSocketInodesPerPID->{$pid}) . "\n";
      if (ref($rSocketInodesPerPID->{$pid}) eq 'ARRAY') {
        my @socket_inodes = @{$rSocketInodesPerPID->{$pid}};
        foreach my $inode (@socket_inodes) {
          if (! defined($rProcNetTCP->{$inode})) { next; }
          my $loc_ip = $rProcNetTCP->{$inode}->{loc_ip};
          my $loc_port = $rProcNetTCP->{$inode}->{loc_port};
          my $rem_ip = $rProcNetTCP->{$inode}->{rem_ip};
          # If the remote IP is hooked to $MAILER_IP:$MAILER_PORT it offends
          if ($loc_ip eq $MAILER_IP && $loc_port == $MAILER_PORT) {
            $OffendersIP{$rem_ip}{PIDs}{$pid}=$offense_count;
            # Debugging message
            my $loc_ip_port = $rProcNetTCP->{$inode}->{loc_ip_port};
            my $rem_ip_port = $rProcNetTCP->{$inode}->{rem_ip_port};
            &Dbg(8,"Hooked up: me=$loc_ip_port -> them=$rem_ip_port");
          } else {
            &Dbg(8,"$loc_ip eq $MAILER_IP && $loc_port == $MAILER_PORT");
          }
        }
      } else {
        # Remove the PID from %OffendersPID if it has no open sockets
        if (defined($OffendersPID{$pid})) { delete $OffendersPID{$pid}; }
        # If we have no socket inodes for this PID, then it really
        # can't still be running, but we'll still be paranoid and warn.
        if ( -d "/proc/$pid" ) {
          &Dbg(1,"It appears that PID $pid is still running, but I see " .
		"no get_socket_inodes() data for it!");
        }
      }
    }
  }

  my @current_offenders = sort keys %OffendersPID;
  &Dbg(6,"Currently offending PIDs: " . join(", ", @current_offenders));

  # Go through the %OffendersIP data and update data like the
  # last_offense and total number of offenses.
  foreach my $rem_ip (sort keys %OffendersIP) {
    my $total_offenses=0;
    foreach my $pid (sort keys %{$OffendersIP{$rem_ip}{PIDs}}) {
      my $rPIDS=$OffendersIP{$rem_ip}{PIDs};
      $total_offenses += $rPIDS->{$pid};
      # If the PID is still an active offender, consider his data
      if (defined($OffendersPID{$pid})) {
        my $pid_last_off = $OffendersPID{$pid}{last_offense};
        my $ip_last_off = $OffendersIP{$rem_ip}{last_offense};
        if ($pid_last_off > $ip_last_off) {
          $OffendersIP{$rem_ip}{last_offense} = $pid_last_off;
        }
      }
    }
    $OffendersIP{$rem_ip}{offenses} = $total_offenses;
  }

  # Report on the %OffendersIP.  Here is where we might install
  # firewall rules, etc. -- TODO

  foreach my $rem_ip (sort { $OffendersIP{$a}{offenses} <=> $OffendersIP{$b}{offenses} } keys %OffendersIP) {
    my $total_offenses = $OffendersIP{$rem_ip}{offenses};
    my $ip_last_off = $OffendersIP{$rem_ip}{last_offense};
    &Dbg(5,"IP=$rem_ip has $total_offenses offenses, the " .
	"latest at " . &GetYYYYMMDDHHMMSS_Pretty($ip_last_off));
    my $subnetref = $white_list->check(\$rem_ip);
    if ($total_offenses > $MAX_OFFENSES_BEFORE_FIREWALLED &&
			(ref($subnetref) ne 'SCALAR') &&
			(! ($OffendersIP{$rem_ip}{firewalled})) ) {
      $OffendersIP{$rem_ip}{firewalled} = &GetYYYYMMDDHHMMSS();
      #for my $jt (qw(LOG DROP)) {
      for my $jt (qw(DROP)) {
        my $cmd="$IPTABLES_EXE -A '$IPTABLES_CHAIN_NAME' -p tcp -s '$rem_ip' " .
					"--destination-port 25 -j '$jt'";
        $OffendersIP{$rem_ip}{firewall_cmd} = $cmd;
        &Dbg(1,"FIREWALLING: $cmd");
        my $exit_code = &SystemWithWarnOnNonZero($cmd);
      }
      # Kill and/all sendmail children that were talking to this offender
      foreach my $pid (sort keys %{$OffendersIP{$rem_ip}{PIDs}}) {
        # If the PID is still an active offender, consider his data
        if (defined($OffendersPID{$pid}) && -e "/proc/$pid") {
          &Dbg(1, "KILL -15ing SENDMAIL PID=$pid, related to IP=$rem_ip");
          kill 15, $pid;
          # Now, sleep half a second, and it PID still exists, -9 it
          &Time::HiRes::sleep(0.5);
          if (-e "/proc/$pid") {
            &Dbg(1, "KILL -9ing SENDMAIL PID=$pid, related to IP=$rem_ip");
            kill 9, $pid;
          }
        }
      }
    } elsif ($subnetref) {
      &Dbg(1,"IGNORING WHITE-LISTED OFFENDER $rem_ip from $$subnetref");
      # Remove the white-listed offender from %OffendersIP
      delete($OffendersIP{$rem_ip});
    }
  }

  # Unblock any offenders that have been blocked longer than $MAX_BLOCKED_TIME
  my $last_run = $PERIODIC_CLEANSERS{'UnblockOldOffenders'}->{'lastrun'};
  my $frequency = $PERIODIC_CLEANSERS{'UnblockOldOffenders'}->{'frequency'};
  if ( $last_run < (time - $frequency) ) {
    $PERIODIC_CLEANSERS{'UnblockOldOffenders'}->{'lastrun'} = time;
    &UnblockOldOffenders(\%OffendersIP);
  }

  # Kill any sendmail children stuck in "cmd wait" and which have been
  # running longer then $MAX_RUNTIME_SENDMAIL_CMD_WAIT seconds.
  my $last_run = $PERIODIC_CLEANSERS{'KillSendmailsInCmdWait'}->{'lastrun'};
  my $frequency = $PERIODIC_CLEANSERS{'KillSendmailsInCmdWait'}->{'frequency'};
  if ( $last_run < (time - $frequency) ) {
    $PERIODIC_CLEANSERS{'KillSendmailsInCmdWait'}->{'lastrun'} = time;
    &KillSendmailsInCmdWait($MAX_RUNTIME_SENDMAIL_CMD_WAIT);
  }

  # If I have a $MY_MAX_RUNTIME and have surpassed it, exit.
  if ($MY_MAX_RUNTIME > 0 && ((time-$MY_MAX_RUNTIME) > $MY_START_TIME) ) {
    &Dbg(0, "Exiting: I exceeded my MAX_RUNTIME of $MY_MAX_RUNTIME secs");
    exit;
  }
} # End MAIN_LOOP:

sub UnblockOldOffenders {
  my $rOffendersIP = shift @_;

  my $newest_to_free = &GetYYYYMMDDHHMMSS(time - $MAX_BLOCKED_TIME);
  FREEDOM_LOOP: foreach my $rem_ip (sort { $rOffendersIP->{$a}{firewalled} <=> $rOffendersIP->{$b}{firewalled} } keys %{$rOffendersIP}) {

    # Store the time this $rem_ip was firewalled in a convenience variable.
    my $firewalled=$rOffendersIP->{$rem_ip}{firewalled};

    # We are looping over all offenders here, not just firewalled ones,
    # so we need to skip right past the ones not firewalled.
    if (! $firewalled) {
      next FREEDOM_LOOP;
    }

    # These are sorted, so as soon as we don't match one, we can
    # last this loop...
    if ($firewalled < $newest_to_free) {
      my $cmd = $rOffendersIP->{$rem_ip}{firewall_cmd};
      # Convert the add command to a delete command
      if ($cmd =~ s/\s+-A\s+/ -D /) {
        &Dbg(1,"Unblocking offender $rem_ip, which was blocked $firewalled");
        my $exit_code = &SystemWithWarnOnNonZero($cmd);
        if ($exit_code) {
          &Dbg(0, "ERROR: UnblockOldOffenders(): my attempt to unblock " .
		"$rem_ip with $IPTABLES_EXE failed to return zero.  The " .
		"command that I ran was: $cmd");
        } else {
          # If we unblocked this IP, get it out of %OffendersIP
          delete($rOffendersIP->{$rem_ip});
        }
      } else {
        &Dbg(0,"ERROR: UnblockOldOffenders(): can't derive the firewall_cmd " .
		"needed to unblock $rem_ip!");
      }
    } else {
      last FREEDOM_LOOP;
    }
  }

}

# This function pulls all of the "sockets" from /proc/<PID/fd/* and returns
# the reference to a hash which is keyed on the PIDs of those processes, and
# the value is an array of the "inodes" of those sockets. which maps to the
# inode field of /proc/net/tcp.
sub get_socket_inodes {
  my $cmd=$FIND_EXE . ' /proc -type l -path "*[0-9]/fd/*" ' .
			'-lname "socket:*" -printf "%p\t%l\n" 2>/dev/null';

  # We need to know the major kernel version, as the /proc format differs
  # per kernel.  We assume 2.4 if we fail to ID the kernel.
  my $mjr_krnl_ver='2.4';
  my $fh_ver = new FileHandle;
  if (open($fh_ver, "< /proc/version")) {
    my $ver_line = <$fh_ver>;
    close $fh_ver;
    if ($ver_line =~ m/^Linux version ([0-9]+\.[0-9]+)\./i) {
      $mjr_krnl_ver = $1;
    }
  }

  # Regex patterns to find socket IDs per major Linux kernel version
  my %ptrn = (
    '2.4' => "/proc/([0-9]+)/fd/[0-9]+\tsocket:\Q[\E([0-9]+)\Q]\E",
    '2.6' => "/proc/([0-9]+)/task/[0-9]+/fd/[0-9]+\tsocket:\Q[\E([0-9]+)\Q]\E"
  );
  my $pipe=new FileHandle;
  if (open($pipe, "$cmd |")) {
    my @lines = <$pipe>;
    close($pipe);
    my %results = ();
    foreach my $line (@lines) {
      if ($line =~ m%$ptrn{$mjr_krnl_ver}%) {
        my $pid=$1;  my $inode=$2;
        push (@{$results{$pid}}, $inode);
      } else {
        &Dbg(0, "get_socket_inodes(): pattern match failed.");
      }
    }
    return \%results;
  } else {
    &Dbg(0, "Error in get_socket_inodes(): command failed: $cmd");
  }
return undef;
}

# This function converts the IP:PORT encoding, as found in Linux's
# /proc/net/tcp, into x.x.x.x:port notation.
sub convert_kernel_ip_port_to_dot_notation {
  my $addr=shift @_;

  my $pattern = "([0-9A-Z]{2})([0-9A-Z]{2})([0-9A-Z]{2})([0-9A-Z]{2})" .
			":([0-9A-Z]{2})([0-9A-Z]{2})";
  if ($addr =~ m/^$pattern$/) {
    my @octets_hex=($4,$3,$2,$1);
    my @port_hex=($5,$6);
    my @octets=map { hex($_) } @octets_hex;
    my $dot_ip=join('.', @octets);
    my $port = hex(join('', @port_hex));
    return "$dot_ip:$port";
  }
return undef;
}

# This function pulls the data from /proc/net/tcp and returns the
# reference to a hash that is keyed on the inode field, which is
# unique to each socket, and holds a hash with the local IP:port
# and remote IP:port of the connection.
sub get_proc_net_tcp {
  my $fh=new FileHandle;
  if (open($fh, "< /proc/net/tcp")) {
    my @lines=<$fh>;
    close $fh;
    my %result=();
    my $hdr_line = shift @lines;
    my @hdrs=split(/\s+/, trim($hdr_line));
    DATA_LINE: foreach my $line (@lines) {
      my @data = split(/\s+/, trim($line));
      my $inode=$data[9];
      my $loc_ip_port=convert_kernel_ip_port_to_dot_notation($data[1]);
      my $rem_ip_port=convert_kernel_ip_port_to_dot_notation($data[2]);
      if ($inode > 0 && length($rem_ip_port) && $rem_ip_port !~ m/^127.0.0.1/) {
        #warn "LHHD: $inode: $loc_ip_port\t$rem_ip_port\n";
        my ($loc_ip, $loc_port) = split(/:/, $loc_ip_port, 2);
        my ($rem_ip, $rem_port) = split(/:/, $rem_ip_port, 2);
        %{$result{$inode}} = ( loc_ip_port => $loc_ip_port,
				loc_ip => $loc_ip, loc_port => $loc_port,
				rem_ip_port => $rem_ip_port,
				rem_ip => $rem_ip, rem_port => $rem_port );
      }
    }
    return \%result;
  }
return undef;
}

# Trim whitespace off the head and tail of a string
sub trim {
  my $str=shift @_;
  $str =~ s/^[\s\r\n]+//;
  $str =~ s/[\s\r\n]+$//;
return $str;
}

# This returns a raw integer
sub GetYYYYMMDDHHMMSS {
  my $unix_time=shift @_ || time;
  my ($sec,$min,$hour,$mday,$mon,$yr,$wday,$yday,$isdst)=localtime($unix_time);
  my $formatted=sprintf("%04d%02d%02d%02d%02d%02d",
			1900 + $yr, $mon + 1, $mday, $hour, $min, $sec);
return($formatted);
}
# This returns a Mysql-ish format
sub GetYYYYMMDDHHMMSS_Pretty {
  my $unix_time=shift @_ || time;
  my ($sec,$min,$hour,$mday,$mon,$yr,$wday,$yday,$isdst)=localtime($unix_time);
  my $formatted=sprintf("%04d-%02d-%02d %02d:%02d:%02d",
			1900 + $yr, $mon + 1, $mday, $hour, $min, $sec);
return($formatted);
}


sub InitIPTablesRules {
  # See if chain $IPTABLES_CHAIN_NAME exists, and if not create it, and
  # if so flush the existing one.
  my $cmd = "$IPTABLES_EXE -n -L '$IPTABLES_CHAIN_NAME'";
  my $exit_code = &SystemWithWarnOnNonZero($cmd);
  if ($exit_code) {
    &Dbg(1, "The $IPTABLES_CHAIN_NAME chain needs to be created.");
    my $cmd = "$IPTABLES_EXE -N '$IPTABLES_CHAIN_NAME'";
    my $retval = system("$cmd 1>/dev/null 2>/dev/null");
    my $exit_code = &SystemWithWarnOnNonZero($cmd);
  } else {
    &Dbg(1, "The $IPTABLES_CHAIN_NAME chain needs to be flushed.");
    my $cmd = "$IPTABLES_EXE -F '$IPTABLES_CHAIN_NAME'";
    my $exit_code = &SystemWithWarnOnNonZero($cmd);
  }

  my $RULE_SPEC = "INPUT -p tcp --destination-port 25 " .
						"-j '$IPTABLES_CHAIN_NAME'";
  # Purge any/all jump rules to $IPTABLES_CHAIN_NAME
  my $MAX_LOOPS=10;
  my $exit_code=0;
  do {
    my $cmd="$IPTABLES_EXE -D $RULE_SPEC";
    $exit_code = &SystemWithWarnOnNonZero($cmd);
    $MAX_LOOPS--;
  } until ($exit_code || $MAX_LOOPS < 1);

  if ($MAX_LOOPS < 1) {
    die "Bad shit happened.  I couldn't purge rulespec: $RULE_SPEC\n";
  }

  # Add a jump rule to the chain $IPTABLES_CHAIN_NAME
  my $cmd="$IPTABLES_EXE -A $RULE_SPEC";
  my $exit_code = &SystemWithWarnOnNonZero($cmd);
}

sub SystemWithWarnOnNonZero {
  my $cmd=shift @_;
  my $retval = system("$cmd 1>/dev/null 2>/dev/null");
  my $exit_code = $retval / 256;
  if ($exit_code) {
    &Dbg(1, "$cmd exited with $exit_code");
  }
return $exit_code;
}

sub LoadWhiteList {
  my $while_list_file = shift @_;
  my $fh=new FileHandle;
  if (open($fh, "< $while_list_file")) {
    my @subnets = <$fh>;
    close($fh);
    @subnets = map { chomp $_; &trim($_); } @subnets;
    @subnets = grep(!/^#|^$/, @subnets);
    my $p_sn='^[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\/[0-9]{1,2}$';
    my @bad_subnets = grep(!/$p_sn/, @subnets);
    if (scalar(@bad_subnets) > 0) {
      &Dbg(0, "ERROR: The whilelist file, $while_list_file, holds subnet " .
		"entries that are not valid: " . join(', ', @bad_subnets));
    }
    @subnets = grep(/$p_sn/, @subnets);
    my $sn = Net::Subnets->new;
    $sn->subnets( \@subnets );
    &Dbg(1,"Whitelist: " . join(',', @subnets));
    return $sn;
  } else {
    die "Failed to load white list file: $while_list_file\n";
  }
}


############################################################################
# KillSendmailsInCmdWait() kills any sendmail children that are in the
# "cmd read" status that have been running longer than $max_runtime secs.
############################################################################
sub KillSendmailsInCmdWait {
  my $max_runtime = shift @_;

  my $cmd="/usr/bin/env ps f -w --no-headers -C sendmail O+T " .
						"--format '%p ~ %t ~ %a'";
  my @ps_lines = `$cmd 2>/dev/null`;

  my %RunningSendmailChildren = ();
  my %PIDsToKill = ();
  foreach my $line (@ps_lines) {
    my ($pid, $run_time, $cmdline) = split(/\s+~\s+/, $line, 3);
    $pid = &trim($pid);
    $cmdline = &trim($cmdline);
    my $ip_addr='';
    # We only want sendmail children, not top-level sendmail processes,
    # this the " \_" part, and then we only want ones in "cmd read" status
    if ($cmdline=~m/^\\_ sendmail: server (([^[]+) )?\[([0-9.]+)\] cmd read/) {
      $ip_addr=$3;
      my $run_time_secs=0;
      if ($run_time =~ m/^([0-9]{2})?:?([0-9]{2}):([0-9]{2})/) {
        my $hrs=$1 || 0; my $min=$2 || 0; my $sec=$3 || 0;
        $run_time_secs = $hrs*60*60 + $min*60 + $sec;
      }
      #warn "I have a match on pid=$pid/$ip_addr, run_time=$run_time_secs\n";
      if ($run_time_secs > $max_runtime) {
        $PIDsToKill{$pid}{ip_addr} = $ip_addr;
        $PIDsToKill{$pid}{cmdline} = $cmdline;
        $PIDsToKill{$pid}{run_time} = $run_time;
      }
    }
  }

  foreach my $pid (sort keys %PIDsToKill) {
    my $rt=$PIDsToKill{$pid}{run_time};
    my $cl=$PIDsToKill{$pid}{cmdline};
    my $ip=$PIDsToKill{$pid}{ip_addr};
    &Dbg(1,"KillSendmailsInCmdWait(): killing $pid, runtime=$rt, " .
						"ip_addr=$ip, cmdline=$cl");
    if (-e "/proc/$pid") {
      &Dbg(1, "KILL -15ing SENDMAIL PID=$pid, related to IP=$ip");
      kill 15, $pid;
      # Now, sleep half a second, and it PID still exists, -9 it
      &Time::HiRes::sleep(0.5);
      if (-e "/proc/$pid") {
        &Dbg(1, "KILL -9ing SENDMAIL PID=$pid, related to IP=$ip");
        kill 9, $pid;
      }
    }
  }

  my $kill_count = scalar(keys %PIDsToKill);
return $kill_count;
}

# Subroutine to handle debug/syslog-ing
sub Dbg {
  my $level=shift @_;
  my $msg = shift @_;

  # If the $DEBUG level exceeds the level at which we log this message, then...
  if ($DEBUG > $level) {
    $msg =~ s/[\r\n]+$//;
    if ($DEBUG_TO_SYSLOG) {
      my $Facility='user';
      my $Priority='info';
      my $Tag="SPAM-FW[$$]";
      $msg =~ s/[\r\n]+/ /g;
      my @args=($LOGGER_EXE,'-p',"$Facility.$Priority",'-t',$Tag,$msg);
      system @args;
    } else {
      print "$msg\n";
    }
  }
}

#
# This function parses the command-line options.
sub DoGetOpts {
  my %opts;
  my $result = &GetOptions(\%opts,
        'debug=i',
	'debug-to-syslog',
	'white-list=s',
	'syslog-msgs-file=s',
	'mailer-ip=s',
	'mailer-port=s',
	'mailer-syslog-host=s',
	'mailer-syslog-name=s',
	'iptables-chain-name=s',
        );

  # If GetOptions() ain't happy, we ain't happy
  if (! $result) { exit; }

  # Loop over global config options, assigning them using perl
  # ref-by-name magic.
  foreach my $opt (keys %opts) {
    no strict 'refs';
    my $glbl_var=uc($opt);
    $glbl_var =~ s/-/_/g;
    if (! defined(${$glbl_var})) {
      die "DoGetOpts() cannot set non-existant global variable \$$glbl_var!\n";
    } else {
      ${$glbl_var} = $opts{$opt};
    }
  }

  # Validate values
  if ($DEBUG !~ m/^[0-9]$/) {
    die "--debug must be between 0 and 9.\n";
  }
  if ($DEBUG_TO_SYSLOG !~ m/^[01]$/) {
    die "--debug-to-syslog must be 0 or 1.\n";
  }
  if (! -r $WHITE_LIST) {
    die "--white-list must refer to a readable text file.\n";
  }
  if (! -r $SYSLOG_MSGS_FILE) {
    die "--syslog-msgs-file must refer to a readable text file.\n" .
	"\t(normally /var/log/messages, or similar)\n";
  }
  if ($MAILER_IP !~ m/^(\d{1,3}\.){3}\d{1,3}$/) {
    die "--mailer-ip must be a valid IP address.\n";
  }
  if ($MAILER_PORT !~ m/^[0-9]+$/ || $MAILER_PORT > 65536) {
    die "--mailer-port must be a valid IP port.\n";
  }
  if (! length($MAILER_SYSLOG_HOST)) {
    die "--mailer-syslog-host needs the hostname your mailer sylogs as.\n";
  }
  if (! length($MAILER_SYSLOG_NAME)) {
    die "--mailer-syslog-name needs the tag that your mailer sylogs with.\n";
  }
  if ($IPTABLES_CHAIN_NAME !~ m/^[0-9a-z_]+$/i) {
    die "--iptables-chain-name needs the name of the iptables chain that\n" .
	"\tyou would like this program to manage.\n";
  }
}


__END__


# Man Page Stuff ##############################################################

=head1 NAME

spam.kill_uname_guessers.pl

=head1 SYNOPSIS

A daemon to detect spammers trying to harvest email addresses by username guessing and temporarily DROP them with iptables firewall rules.

=head1 DESCRIPTION OF USAGE

Author yourself a script like this, substituting values that make sense for your network:

 #!/bin/bash
 # Mainly because init restricts to short command lines.
 EXE="/etc/mail/spam.kill_uname_guessers.pl"
 if [ -x "$EXE" ]; then
   exec "$EXE" --debug=3 --debug-to-syslog \
        --white-list=/etc/mail/spam.kill_uname_guessers.whitelist \
        --syslog-msgs-file=/var/log/messages \
        --mailer-ip=10.100.10.200 --mailer-port=25 \
        --mailer-syslog-host=mail1 --mailer-syslog-name=sm-mta \
        --iptables-chain-name=SPAM_UNAME_GUESSERS
 fi

The white-list file holds one-entry-per line with comments marked by a pound
sign (#) in column zero, where each entry is a network address in the format
10.10.10.10/24.  The mailer-ip and mailer-port options represent the IP
address and port (should always be 25) that *external* hosts connect to in
order to deliver email to this server (for your network).  The
mailer-syslog-host and mailer-syslog-name options, respectively, are the
hostname and tag that sendmail logs its messages with on this server.  The
iptables-chain-name option is what this program is to name the iptables
table in which this script will place its DROP rules.

 And then add a line to your /etc/inittab file like this:

 # A program working to reduce spam by firewalling username guessers
 SMFW:3:respawn:/etc/mail/spam.kill_uname_guessers.10east.sh

 And then execute "init q" ...

=head1 OTHER FEATURES

This program also looks for and kills sendmail processes that have been 
stuck in "cmd read" mode for a long time.  The definition of a "long time"
is controlled by the global variable $MAX_RUNTIME_SENDMAIL_CMD_WAIT which
represents the number of seconds since a given sendmail process, that is
stuck on "cmd read" mode, started running.

=head1 CAVEATS

This program has only been tested on Linux 2.4 and 2.6 kernels and sendmail
8.12.x and 8.13.x.  It may work with other platforms, but none have been
tested by the author.

=head1 ADDENDUM

Just as information, this is what the iptables rules that this script
produces and manages will look like:

 root@mail1:# iptables -L -n | egrep ^SPAM_UNAME_GUESSERS
 SPAM_UNAME_GUESSERS  tcp  --  0.0.0.0/0    0.0.0.0/0    tcp dpt:25 

 root@mail1:# iptables -L SPAM_UNAME_GUESSERS -n
 Chain SPAM_UNAME_GUESSERS (1 references)
 target     prot opt source             destination         
 DROP       tcp  --  61.173.40.71       0.0.0.0/0       tcp dpt:25 
 DROP       tcp  --  211.162.182.2      0.0.0.0/0       tcp dpt:25 
 DROP       tcp  --  61.33.194.207      0.0.0.0/0       tcp dpt:25 

DROP rules for specific hosts are removed from the SPAM_UNAME_GUESSERS
table after the "UnblockOldOffenders" timeout has past, as specified in
the %PERIODIC_CLEANSERS global data structure.

=head1 AUTHOR

 Lester H. Hightower, Jr.

=head1 COPYRIGHT

 Copyright (c) 2005 Lester Hightower.  All rights reserved.
 This program is free software; you can redistribute it
 and/or modify it under the same terms as Perl itself.

=begin comment

=pod SCRIPT CATEGORIES

UNIX/System_administration

Mail

=pod OSNAMES

Linux

=pod README

A daemon to detect spammers trying to harvest email addresses by username
guessing and temporarily DROP them with iptables firewall rules.

=end comment

=cut