#!/usr/bin/perl -w

##############################################################################
#
# File: relaydelay.pl
#
# Version: 0.05-pre(patched)
# 
# Programmer: Evan J. Harris <eharris@puremagic.com>
#
# Description:
#   Sendmail::Milter interface for active blocking of spam using the 
#   Greylisting method.  Also incorporates some additional checks and 
#   methods for better blocking spam.
#
# References:
#   For Greylisting info, see http://projects.puremagic.com/greylisting/
#   For SMTP info, see RFC821, RFC1891, RFC1893
#
# Notes:
#   - Probably should store the mail_from and rcpt_to fields in the db in 
#     reversed character order.  This would make reporting on subdomain 
#     matches be able to be indexed.

# Patches incorporated:

# From Martin Walker (maw@synesis.net) 4 Sep 2003:
#	logs to a logfile
#	runs as a daemon

# From Philip Kizer (pckizer@nostrum.com) 12 May 2004:
#	A database check to see if needs reconnecting
#	Move the SMTP AUTH check above white/blacklisting
#	Pass $verbose to db_connect rather than hardcoding 0
#	Add parameter to reverse_track to pass sendmail queue_id
#	Don't reverse_track w-listed IPs or would w/l yahoogroups/&c
#	And, of course, log data via syslog, not print, uses fac.pri:
#		mail.info [not yet configurable]

#
# Bugs:
#   None known.
#
#
# *** Copyright 2003 by Evan J. Harris --- All Rights Reserved ***
# *** No warranties expressed or implied, use at your own risk ***
#
##############################################################################

use Sendmail::Milter;
use Socket;
use POSIX qw(strftime);
use Errno qw(ENOENT);
use Sys::Syslog;

use DB_File;
use DBI;
use FileHandle;

use strict;

#############################################################################
# Our global settings file, may be overridden if passed as a command line
#   parameter to the main relaydelay.pl script.
#############################################################################
my $config_file = "/etc/mail/relaydelay.conf";


#################################################################
# Our global settings that may be overridden from the config file
#################################################################

# If you do/don't want to see debugging messages printed to stdout,
#   then set this appropriately.
my $verbose = 1;
$|=1; # Make STDOUT logs flush faster
my $run_as_daemon = 0; # Default is to still run in the foreground
my $log_file = '';     # Default is to use STDOUT for messages.
                       # A log file should be used for daemonized operation.

# Database connection params
my $database_type = 'mysql';
my $database_name = 'relaydelay';
my $database_host = 'localhost';
my $database_port = 3306;
my $database_user = 'db_user';
my $database_pass = 'db_pass';

# Set this to indicate the milter "name" that this milter will be 
#   identified by.  This must match the first parameter from the 
#   INPUT_MAIL_FILTER definition in the sendmail.mc configuration.
my $milter_filter_name = 'relaydelay';

# This parameter determines how the milter interfaces with the libmilter
#   API.  Normally, if using a milter on the same machine that is running
#   sendmail, it will be something like 'local:/var/run/relaydelay.sock', 
#   but if you want to run the milter on a different machine than is running 
#   sendmail, you will need to specify how to connect to that copy of 
#   sendmail by setting this to indicate the machine and port that the 
#   remote sendmail is listening for connections on with something 
#   similar to 'inet:2526@sendmail.server.org'.
# This parameter must match the S= option in the INPUT_MAIL_FILTER
#   definition in the sendmail.mc file.
my $milter_socket_connection = 'local:/var/run/relaydelay.sock';

# This config option specifies where sendmail's access.db file is located.  
#   If you don't want the milter to check the access.db, just set this equal 
#   to undef.
# If enabled, the access db will be checked to see if there are matching
#   ip or address entries that should make us bypass the greylist checks.
# NOTE: These checks assume that the sendmail FEATURE(`relay_hosts_only') 
#   is not enabled.  If you do have that enabled, the checks in the milter
#   will be more permissive than you want.
#   In addition, the milter will heed entries in the access db even if
#   your sendmail configuration doesn't check certain types, so make sure
#   you don't have any entries that sendmail will ignore unless you want 
#   to suffer the consequences.
#   For more information on access db options, see:
#     http://www.sendmail.org/~ca/email/doc8.12/cf/m4/anti_spam.html
#   For additional information, please also see the README file.
#
#my $sendmail_accessdb_file = undef;
my $sendmail_accessdb_file = '/etc/mail/access.db';

# Where the pid file should be stored for relaydelay
my $relaydelay_pid_file = '/var/run/relaydelay.pid';

# Set this to something nonzero to limit the number of children that the 
#   milter will spawn.  Since children are never recycled (there seems 
#   to be a problem doing that with Sendmail::Milter), threads,
#   once created, will exist until the milter is shutdown.  Each thread
#   also consumes a database connection, so limiting db connections and
#   memory footprint are both good reasons to set this.
# If your mail server handles a large amount of mail, you may need to 
#   increase this limit to avoid blocking, but the default limit is
#   already pretty high, and should be sufficient for all but very 
#   large sites.
# Setting to zero makes the number of threads unlimited.
my $maximum_milter_threads = 40;

# This determines how many seconds we will block inbound mail that is
#   from a previously unknown [ip,from,to] triplet.  If it is set to
#   zero, incoming mail associations will be learned, but no deliveries
#   will be tempfailed.  Use a setting of zero with caution, as it
#   will learn spammers as well as legitimate senders.
#   If it is set to a negative number (like -1), then the mail will
#   be tempfailed the first time it is seen, but accepted thereafter.
my $delay_mail_secs = 58 * 60;  # 58 Minutes

# This determines how many seconds of life are given to a record that is
#   created from a new mail [ip,from,to] triplet.  Note that the window
#   created by this setting for passing mails is reduced by the amount
#   set for $delay_mail_secs.
# NOTE: See Also: update_record_life and update_record_life_secs.
my $auto_record_life_secs = 5 * 3600;  # 5 hours

# True if we should update the life of a record when passing a mail
#   This should generally be enabled, unless the normal lifetime
#   defined by $auto_record_life_secs is already a large value.
my $update_record_life = 1;

# How much life (in secs) to give to a record we are updating from an
#   allowed (passed) email.  Only useful if update_record_life is
#   enabled.
# The default is 36 days, which should be enough to handle messages that
#   may only be sent once a month, or on things like the first Monday
#   of the month (which sometimes means 5 weeks).  Plus, we add a day
#   for a delivery buffer.
my $update_record_life_secs = 36 * 24 * 3600;

# If you have very large amounts of traffic and want to reduce the number of 
#   queries the db has to handle (and don't need these features), then these
#   wildcard checks can be disabled.  Just set them to 0 if so.
# If both are enabled, relay_ip is considered to take precedence, and is 
#   checked first.  A match there will ignore the rcpt checks.
my $check_wildcard_relay_ip = 1;
my $check_wildcard_rcpt_to = 1;

# Set this to a nonzero value if you want to wait until after the DATA
#   phase before issuing the TEMPFAIL for delayed messages.  If this
#   is undefined or zero, then messages will be failed after the RCPT
#   phase in the smtp session.  Setting this will cause more traffic,
#   which should be unneccessary, but increases the fault tolerance for
#   some braindead mailers that don't check the status codes except at
#   the end of a message transaction.  It does expose a couple of 
#   liabilities, in that the blocking will only occur if the LAST recipient
#   in a multi-recipient message is currently blocked.  If the last
#   recipient is not blocked, the message will go through, even if some
#   recipients are supposed to be blocked.  Generally discouraged.
my $tempfail_messages_after_data_phase = 0;

# Set this to a nonzero value if you wish to do triplet lookups disregarding
#   the last octet of the relay ip.  This helps workaround the case of
#   more than one delivering MTA being used to deliver a particular email.
#   Practically all setups that are that way have the pool of delivering
#   MTA's on the same /24 subnet, so that's what we use.
my $do_relay_lookup_by_subnet = 1;

# Set this to 0 if you wish to disable the automatic maintenance of the
#   relay_ip -> relay_name reference table.  Could save an insert 
#   and an update, depending on circumstances.
my $enable_relay_name_updates = 1;

# Enable this to do some rudimentary syntax checking on the passed mail_from
#   address.  This may exclude some valid addresses, so we leave it as an
#   option that can be disabled.
my $check_envelope_address_format = 1;

# Set this to true if you wish to disable checking and just pass
#   mail when the db connection fails.  Otherwise, we will reject
#   all the mail with a tempfail if we are unable to check the 
#   status for it in the db.
# If you are pretty good about keeping your system well maintained, then it is
#   recommended to leave this disabled.  But if it's possible that the db may go
#   down without anyone noticing for a significant amount of time, then this
#   should probably be enabled.
my $pass_mail_when_db_unavail = 0;

# Set this to true if you want to try to track locally originated mail
#   so that replies are not delayed.  This adds a couple queries to the
#   db overhead for each local mail processed, so use with caution.
#   Also considers mail sent from whitelisted IP's and authenticated
#   senders as local in case we are acting as a smarthost for them.
my $reverse_mail_tracking = 1;
  
# This controls the lifetime of the automatic reverse whitelisting of
#   senders that we have seen locally originated mail sent to.  Only 
#   used if $reverse_mail_tracking is enabled.
my $reverse_mail_life_secs = 4 * 24 * 3600;  # 4 Days

# Set this to true if you want the relaydelay milter to try to autolearn local
#   recipients and domains, and have non-primary MX's block (tempfail) mail to
#   unlearned local recipients.  This gives a mechanism for a cooperating set 
#   of mail hosts running the milter to avoid relaying (and double-bounces) 
#   for invalid recipients until at least one successful mail to that 
#   recipient has been processed by the primary MX, using the "local" mailer.
# There is no point in enabling this unless your primary MX is also the 
#   MTA that handles delivery for your domains, and you have more than one
#   MX host for some or all of the domains you handle, and they are all 
#   running the milter.
# In fact, if this is enabled and there are any rows existing in the 
#   localemail table that are in your domains, only a greylisting host
#   delivering mail with sendmail's "local" mailer will be able to accept
#   mail for any recipients that are not listed.  USE WITH CAUTION.
my $learn_local_recipients = 1;

# This parameter controls how long records for local recipients live
#   (if $learn_local_recipients is enabled).  This specifies how 
#   long secondaries will pass mail for the listed recipient without
#   the primary MX host having passed a mail for this recipient.
my $learn_local_recipients_life_secs = 30 * 24 * 3600;  # 30 Days

#############################################################
# End of options for use in external config file
#############################################################


# Global vars that should probably not be in the external config file
my $global_dbh;
my $config_loaded;


#######################################################################
# Database functions
#######################################################################

sub db_connect($) {
  my $verbose = shift;

  if (defined($global_dbh)) {
    return $global_dbh if ($global_dbh->ping);
  }

  my $dsn = "DBI:$database_type:database=$database_name:host=$database_host:port=$database_port";
  print "DBI Connecting to $dsn\n" if $verbose;
  syslog('info',"DBI connecting to $dsn");

  # Note: We do all manual error checking for db errors
  my $dbh = DBI->connect($dsn, $database_user, $database_pass, 
                         { PrintError => 0, RaiseError => $verbose });

  $global_dbh = $dbh;
  return $global_dbh;
}

sub db_disconnect {
  $global_dbh->disconnect() if (defined $global_dbh);
  $global_dbh = undef;
  return 0;
}


#############################################################################
#
# Milter Callback Functions:
#
#  Each of these callbacks is actually called with a first argument
#  that is blessed into the pseudo-package Sendmail::Milter::Context. You can
#  use them like object methods of package Sendmail::Milter::Context.
#
#  $ctx is a blessed reference of package Sendmail::Milter::Context to something
#  yucky, but the Mail Filter API routines are available as object methods
#  (sans the smfi_ prefix) from this
#
#############################################################################

# I wasn't going to originally have a envfrom callback, but since the envelope
# sender doesn't seem to be available through other methods, I use this to
# save it so we can get it later.  We also make sure the config file is loaded.

sub envfrom_callback
{
  my $ctx = shift;
  my @args = @_;

  my $mail_from = $args[0];

  if ($check_envelope_address_format) {
    # Get the mailer type
    my $mail_mailer = $ctx->getsymval("{mail_mailer}");
    
    # Only do format checks if the inbound mailer is an smtp variant.
#MLM if ($mail_mailer !~ /smtp\Z/i) 
#    {
#      # we aren't using an smtp-like mailer, so bypass checks
#      #print "Envelope From: Mail delivery is not using an smtp-like mailer.  Skipping checks.\n" if ($verbose);
#    }
#    else 
    {
      # Check the envelope sender address, and make sure is well-formed.
      #   If is invalid, then issue a permanent failure telling why.
      # NOTE: Some of these tests may exclude valid addresses, but I've only seen spammers
      #   use the ones specifically disallowed here, and they sure don't look valid.  But,
      #   since the SMTP specs do not strictly define what is allowed in an address, I
      #   had to guess by what "looked" normal, or possible.
      my $tstr = $args[0];
      if ($tstr =~ /\A<(.*)>\Z/) {  # Remove outer angle brackets
        $tstr = $1;
        # Note: angle brackets are not required, as some legitimate things seem to not use them
      }
      # Check for embedded whitespace
      if ($tstr =~ /[\s]/) {
        $ctx->setreply("501", "5.1.7", "Malformed envelope from address: contains whitespace");
        return SMFIS_REJECT;
      }
      # Check for embedded brackets, parens, quotes, slashes, pipes (doublequotes are used at yahoo)
      if ($tstr =~ /[<>\[\]\{\}\(\)'"`\/\\\|]/) {
        $ctx->setreply("501", "5.1.7", "Malformed envelope from address: invalid punctuation characters");
        return SMFIS_REJECT;
      }
      # Any chars outside of the range of 33 to 126 decimal (we check as every char being within that range)
      #   Note that we do not require any chars to be in the string, this allows the null sender
      if ($tstr !~ /\A[!-~]*\Z/) {
        $ctx->setreply("501", "5.1.7", "Malformed envelope from address: contains invalid characters");
        return SMFIS_REJECT;
      }
      # FIXME there may be others, but can't find docs on what characters are permitted in an address

      # Now validate parts of sender address (but only if it's not the null sender)
      if ($tstr ne "") {
        my ($from_acct, $from_domain) = split("@", $tstr, 2);
        if ($from_acct eq "") {
          $ctx->setreply("501", "5.1.7", "Malformed envelope from address: user part empty");
          return SMFIS_REJECT;
        }
        if ($from_domain eq "") {
          $ctx->setreply("501", "5.1.7", "Malformed envelope from address: domain part empty");
          return SMFIS_REJECT;
        }
        if ($from_domain =~ /@/) {
          $ctx->setreply("501", "5.1.7", "Malformed envelope from address: too many at signs");
          return SMFIS_REJECT;
        }
        # make sure the domain part is well-formed.
        #if ($from_domain !~ /\A[\w\-]+\.([\w\-]+\.)*[0-9a-zA-Z]+\Z/) {  # Use this to require 2 domain parts
        if ($from_domain !~ /\A([\w\-]+\.)*[\w\-]+\Z/) {
          $ctx->setreply("501", "5.1.7", "Malformed envelope from address: domain part invalid");
          return SMFIS_REJECT;
        }
      }
    }
  }

  # Save our private data (since it isn't available in the same form later)
  #   The format is a comma seperated list of rowids (or zero if none),
  #     followed by the envelope sender followed by the current envelope
  #     recipient (or empty string if none) seperated by nulls
  #   I would have really rather used a hash or other data structure, 
  #     but when I tried it, Sendmail::Milter seemed to choke on it
  #     and would eventually segfault.  So went back to using a scalar.
  my $privdata = "0\x00$mail_from\x00";
  $ctx->setpriv(\$privdata);

  return SMFIS_CONTINUE;
}


# The eom callback is called after a message has been successfully passed.
# It is also the only callback where we can change the headers or body.
# NOTE: It is only called once for a message, even if that message
#   had multiple recipients.  We have to handle updating the row for each
#   recipient here, and it takes a bit of trickery.
# NOTE: We will always get either an abort or an eom callback for any
#   particular message, but never both.

sub eom_callback
{
  my $ctx = shift;

  # Get our status and check to see if we need to do anything else
  my $privdata_ref = $ctx->getpriv();
  # Clear our private data on this context
  $ctx->setpriv(undef);

  print "  IN EOM CALLBACK - PrivData: " . ${$privdata_ref} . "\n" if ($verbose);

  my $dbh = db_connect($verbose) or goto DB_FAILURE;

  # parse and store the data
  my $rowids;
  my $mail_from;
  my $rcpt_to;

  # save the useful data
  if (${$privdata_ref} =~ /\A([\d,]+)\x00(.*)\x00(.*)\Z/) {
    $rowids = $1;
    $mail_from = $2;
    $rcpt_to = $3;
  }
  
  # If and only if this message should be delayed, but for some reason couldn't be done 
  #   at the rcpt_to stage, then do it here.  (This happens in cases where the 
  #   delivery attempt looks like it is a SMTP callback, which needs to wait for
  #   after the DATA phase to issue the tempfail)
  #   (We use a special rowid value of 00 to indicate a needed block)
  if ($rowids eq "00") {
    # Set the reply code to the normal default, but with a modified text part.
    #   I added the (TEMPFAIL) so it is easy to tell in the syslogs if the failure was due to
    #     the processing of the milter, or if it was due to other causes within sendmail
    #     or from the milter being inaccessible/timing out.
    $ctx->setreply("451", "4.7.1", "Please try again later (TEMPFAIL)");
    
    # Issue a temporary failure for this message.  Connection may or may not continue
    #   with delivering other mails.
    return SMFIS_TEMPFAIL;
  }

  # Only if we have some rowids, do we update the count of passed messages
  if (substr($rowids, 0, 1) ne '0') {
    # split up the rowids and update each in turn
    my @rowids = split(",", $rowids);
    foreach my $rowid (@rowids) {
      $dbh->do("UPDATE relaytofrom SET passed_count = passed_count + 1 WHERE id = $rowid") or goto DB_FAILURE;
      print "  * Mail successfully processed.  Incremented passed count on rowid $rowid.\n" if ($verbose);

      # If configured to do so, then update the lifetime (only on AUTO records)
      #   If this was from the null-sender, don't update, as have already expired the record, and don't want to reset.
      if ($update_record_life and $mail_from ne "<>") {
        # This is done here rather than the rcpt callback since we don't know until now that
        #   the delivery is completely successful (not spam blocked or nonexistant user, or 
        #   other failure out of our control)
        $dbh->do("UPDATE relaytofrom SET record_expires = NOW() + INTERVAL $update_record_life_secs SECOND "
          . " WHERE id = $rowid AND origin_type = 'AUTO'") or goto DB_FAILURE;
      }
    }
  }

  # Add a header to the message (if desired)
  #if (not $ctx->addheader("X-RelayDelay", "By kinison")) { print "  * Error adding header!\n"; }

  # And we handled everything successfully, so continue
  return SMFIS_CONTINUE;

  DB_FAILURE:
  # Had a DB error.  Handle as configured.
  print "ERROR: Database Call Failed!\n  $DBI::errstr\n";
  db_disconnect();  # Disconnect, so will get a new connect next mail attempt
  return SMFIS_CONTINUE if ($pass_mail_when_db_unavail);
  return SMFIS_TEMPFAIL;
}


# The abort callback is called even if the message is rejected, even if we
#   are the one that rejected it.  So we ignore it unless we were passing
#   the message and need to increment the aborted count to know something
#   other than this milter caused it to fail.
# However, there is an additional gotcha.  The abort callback may be called
#   before we have a RCPT TO.  In that case, we also ignore it, since we
#   haven't yet done anything in the database regarding the message.
# NOTE: It is only called once for a message, even if that message
#   had multiple recipients.  We have to handle updating the row for each
#   recipient here, and it takes a bit of trickery.
sub abort_callback
{
  my $ctx = shift;

  # Get the queue ID for logging
  my $queue_id    = $ctx->getsymval("{i}");
  if (!defined($queue_id)) { $queue_id="no-queue-id"; }

  # Get the remote hostname and ip in the form "[ident@][hostname] [ip]"
  my $tmp = $ctx->getsymval("{_}");  
  my ($relay_ip, $relay_name, $relay_ident, $relay_maybe_forged);
  if ($tmp =~ /\A(\S*@|)(\S*) ?\[(.*)\]( \(may be forged\)|)\Z/) {
    $relay_ident = $1;
    $relay_name = $2;
    $relay_ip = $3;
    $relay_maybe_forged = (length($4) > 0 ? 1 : 0);
  }
  $relay_ip = "no-ip-available" if (!defined($relay_ip));

  # Get our status and check to see if we need to do anything else
  my $privdata_ref = $ctx->getpriv();
  # Clear our private data on this context (but only if was set previously)
  $ctx->setpriv(undef) if (defined $privdata_ref);

  print "  IN ABORT CALLBACK - PrivData: " . ${$privdata_ref} . "\n" if ($verbose);

  # parse and store the data
  my $rowids;
  my $mail_from;
  my $rcpt_to;

  # save the useful data
  if (${$privdata_ref} =~ /\A([\d,]+)\x00(.*)\x00(.*)\Z/) {
    $rowids = $1;
    $mail_from = $2;
    $rcpt_to = $3;
  }
  
  # only increment the aborted_count if have some rowids 
  #   (this means we didn't expect/cause an abort, but something else did)
  if (substr($rowids, 0, 1) ne '0') {
    # Ok, we need to update the db, so get a handle
    my $dbh = db_connect($verbose) or goto DB_FAILURE;
  
    # split up the rowids and update each in turn
    my @rowids = split(",", $rowids);
    foreach my $rowid (@rowids) {
      $dbh->do("UPDATE relaytofrom SET aborted_count = aborted_count + 1 WHERE id = $rowid") or goto DB_FAILURE;
      print "  * Mail was aborted.  Incrementing aborted count on rowid $rowid.\n" if ($verbose);

      # Check for the special case of no passed messages, means this is probably a 
      #   spammer, and we should expire the record so they have to go through the
      #   whitelisting process again the next time they try.  BUT ONLY IF THIS
      #   IS AN AUTO RECORD.
      # If we find that it is such a record, update the expire time to now
      my $rows = $dbh->do("UPDATE relaytofrom SET record_expires = NOW() "
        . " WHERE id = $rowid AND origin_type = 'AUTO' AND passed_count = 0") or goto DB_FAILURE;
      if ($rows > 0) {
        syslog('info',"$queue_id: message aborted, no good deliveries, exiring #%d: [%s] %s %s",$rowid, $relay_ip, $mail_from, $rcpt_to);
        print "  * Mail record had no successful deliveries.  Expired record on rowid $rowid.\n" if ($verbose);
      }
    }
  }

  return SMFIS_CONTINUE;

  DB_FAILURE:
  # Had a DB error.  Handle as configured.
  print "ERROR: Database Call Failed!\n  $DBI::errstr\n";
  db_disconnect();  # Disconnect, so will get a new connect next mail attempt
  return SMFIS_CONTINUE if ($pass_mail_when_db_unavail);
  return SMFIS_TEMPFAIL;
}


# This function is called in all the instances when we want to create a reverse
#   whitelist entry for recipients of oubound mail so they will not be delayed
#   when they reply.  This is where we do the necessary checks and create
#   the record.
# If there already exists only one active record of the right type, but where 
#   the block has not yet expired, then we update it so the block expires 
#   immediately.  This is so internal people can force mail to come through by 
#   sending a mail to the sender.  It would be nice if we could update all
#   matching rows, but that is too prone to abuse by spammers who may know
#   posting patterns from mailing lists and such.
# Since we have no way of knowing if another different type of record may allow
#   the return mail to pass, sometimes the reverse record we create isn't 
#   necessary, but they'll age off fairly quickly.
# If any sql calls fail, we either ignore them or simply return, since these 
#   updates aren't critical to the mail handling process.
sub reverse_track($$$$)
{
  my $dbh = shift;
  my $queue_id = shift;
  my $mail_from = shift;
  my $rcpt_to = shift;

  my $query = "SELECT id FROM relaytofrom WHERE record_expires > NOW() AND mail_from = ? AND rcpt_to = ?";
  my $sth = $dbh->prepare($query) or return;
  # Note the reversed from and to fields! 
  $sth->execute($rcpt_to, $mail_from) or return;
  my $rowid = $sth->fetchrow_array();
  my $nextrowid;
  if (defined($rowid)) {
    $nextrowid = $sth->fetchrow_array();
  }
  $sth->finish();

  if (defined($rowid) and !defined($nextrowid)) {
    # There's only one matching row, so if it's auto, and not already unblocked, unblock it.
    my $rows = $dbh->do("UPDATE relaytofrom SET block_expires = NOW() "
      . " WHERE block_expires > NOW() AND origin_type = 'AUTO' AND id = $rowid");
    print "  Reverse tracking row updated to unblock.  rowid: $rowid\n" if ($verbose and $rows > 0);
  }
  return if (defined($rowid));

  # If got here, then need to create a reverse record
  $sth = $dbh->prepare("INSERT INTO relaytofrom "
    . " (relay_ip,mail_from,rcpt_to,block_expires,record_expires,origin_type,create_time) "
    . " VALUES (NULL,?,?,NOW(),NOW() + INTERVAL $reverse_mail_life_secs SECOND,'AUTO',NOW())");
#MLM    . " VALUES (NULL,?,?,NOW(),NOW() + INTERVAL $reverse_mail_life_secs SECOND,'AUTO',NOW())") or goto DB_FAILURE;
  # Note the reversed from and to fields! 
  $sth->execute($rcpt_to, $mail_from);
  $sth->finish;
  if ($verbose) {
    # Get the rowid for the debugging message
    $rowid = $dbh->selectrow_array("SELECT LAST_INSERT_ID()");
    syslog('info',"$queue_id: reverse record created for outgoing mail, #%d: %s %s",$rowid, $mail_from, $rcpt_to);
    print "  Reverse tracking row successfully inserted for the recipient of this mail.  rowid: $rowid\n";
  }
}


# Here we perform the bulk of the work, since here we have individual recipient
#   information, and can act on it.

sub envrcpt_callback
{
  my $ctx = shift;
  my @args = @_;

  # Get the time in seconds
  my $timestamp = time();

  # Get the hostname (needs a module that is not necessarily installed)
  #   Not used (since I don't want to depend on it)
  #my $hostname = hostname();

  print "\n", strftime('=== %Y-%m-%d %H:%M:%S ===', localtime($timestamp)), "\n" if ($verbose);

  # declare our info vars
  my $rowid;
  my $rowids;
  my $mail_from;

  # Get the stored envelope sender and rowids
  my $privdata_ref = $ctx->getpriv();
  my $rcpt_to = $args[0];

  # save the useful data
  if (${$privdata_ref} =~ /\A([\d,]+)\x00(.*)\x00(.*)\Z/) {
    $rowids = $1;
    $mail_from = $2;
  }
  if (! defined $rowids) {
    print "ERROR: Invalid privdata in envrcpt callback!\n";
    print "  PRIVDATA: " . ${$privdata_ref} . "\n";
  }
  
  print "Stored Sender: $mail_from\n" if ($verbose);
  print "Passed Recipient: $rcpt_to\n" if ($verbose);

  # Get the database handle (after got the privdata)
  my $dbh = db_connect($verbose) or goto DB_FAILURE;
  
  #print "my_envrcpt:\n";
  #print "   + args: '" . join(', ', @args) . "'\n";
  # other useful, but unneeded values
  #my $tmp = $ctx->getsymval("{j}");  print "localservername = $tmp\n";
  #my $tmp = $ctx->getsymval("{i}");  print "queueid = $tmp\n";
  #my $from_domain = $ctx->getsymval("{mail_host}");  print "from_domain = $tmp\n";
  #my $tmp = $ctx->getsymval("{rcpt_host}");  print "to_domain = $tmp\n";
  
  # Get the remote hostname and ip in the form "[ident@][hostname] [ip]"
  my $tmp = $ctx->getsymval("{_}");  
  my ($relay_ip, $relay_name, $relay_ident, $relay_maybe_forged);
  if ($tmp =~ /\A(\S*@|)(\S*) ?\[(.*)\]( \(may be forged\)|)\Z/) {
    $relay_ident = $1;
    $relay_name = $2;
    $relay_ip = $3;
    $relay_maybe_forged = (length($4) > 0 ? 1 : 0);
  }
  my $relay_name_reversed = reverse($relay_name);
        
  # Collect the rest of the info for our checks
  my $mail_mailer = $ctx->getsymval("{mail_mailer}");
  my $sender      = $ctx->getsymval("{mail_addr}");
  my $rcpt_mailer = $ctx->getsymval("{rcpt_mailer}");
  my $recipient   = $ctx->getsymval("{rcpt_addr}");
  my $queue_id    = $ctx->getsymval("{i}");
  my $authen      = $ctx->getsymval("{auth_authen}");
  my $authtype    = $ctx->getsymval("{auth_type}");
  my $ifaddr      = $ctx->getsymval("{if_addr}");

  # Sendmail seems to sometimes not pass the {if_addr} if the relay_ip is localhost, so fix that
  $ifaddr = $relay_ip if (!defined $ifaddr and $relay_ip eq "127.0.0.1");

  if ($verbose) {
    print "  Relay: $tmp - If_Addr: $ifaddr\n";
    print "  RelayIP: $relay_ip - RelayName: $relay_name - RelayIdent: $relay_ident - PossiblyForged: $relay_maybe_forged\n";
    print "  From: $sender - To: $recipient\n";
    print "  InMailer: $mail_mailer - OutMailer: $rcpt_mailer - QueueID: $queue_id\n";
  }


  # Store and maintain the dns_name of the relay if we have one
  #   Not strictly necessary, but useful for reporting/troubleshooting
  if ($enable_relay_name_updates and length($relay_name_reversed) > 0) {
    my $rows = $dbh->do("INSERT IGNORE INTO dns_name (relay_ip,relay_name) VALUES ('$relay_ip'," 
      . $dbh->quote($relay_name_reversed) . ")");
    goto DB_FAILURE if (!defined($rows));
    if ($rows != 1) {
      # Row already exists, so make sure the name is updated
      my $rows = $dbh->do("UPDATE dns_name SET relay_name = " . $dbh->quote($relay_name_reversed)
        . " WHERE relay_ip = '$relay_ip'");
      goto DB_FAILURE if (!defined($rows));
    }
  }

  # Only do our processing if the mail client is not authenticated in some way
  if (defined($authen) and $authen ne "")
  {
    syslog('info',"$queue_id: SMTP AUTH: $authen");
    print "  AuthType: $authtype - Credentials: $authen\n" if ($verbose);
    print "  Mail delivery is authenticated.  Skipping checks.\n" if ($verbose);
    reverse_track($dbh, $queue_id, $mail_from, $rcpt_to) if ($reverse_mail_tracking and $rcpt_mailer !~ /\Alocal\Z/i);
    goto PASS_MAIL;
  }


  # Check for local IP relay whitelisting from the sendmail access file
  my @relay_ip_parts;
  my @relay_name_parts;
  my @from_domain_parts;
  my $from_domain;
  my $from_username;
  my @rcpt_domain_parts;
  my $rcpt_domain;
  my $rcpt_username;
  {
    # - Generate a list of the relay_ip parts
    my $tstr = $relay_ip;
    for (my $loop = 0; $loop < 4; $loop++) {
      push @relay_ip_parts, $tstr;
      $tstr =~ s/\A(.*)\.\d+\Z/$1/;  # strip off the last octet
    }

    # - If we have dns and it is not possibly forged, generate the relay_name parts
    if (length($relay_name) and !$relay_maybe_forged) {
      $tstr = $relay_name;
      while (index($tstr, ".") > 0) {
        push @relay_name_parts, $tstr;
        $tstr =~ s/\A[^.]+\.(.*)\Z/$1/;  # strip off the leftmost domain part
      }
      push @relay_name_parts, $tstr;  # Get the last part
    }

    # - Pull out the domain of the sender
    $tstr = $mail_from;
    $tstr = $1 if ($tstr =~ /\A<(.*)>\Z/);  # Remove outer angle brackets if present
    $tstr =~ s/\A(.*)@([^@]*)\Z/$2/;  # strip off everything before and including the last @
    $from_username = $1;     # save the username part
    $from_domain = $tstr;    # save the sender subdomain
    # - Now generate the list of from_domain subparts
    while (index($tstr, ".") > 0) {
      push @from_domain_parts, $tstr;
      $tstr =~ s/\A[^.]+\.(.*)\Z/$1/;  # strip off the leftmost domain part
    }
    push @from_domain_parts, $tstr;  # Get the last part

    # - Pull out the domain of the recipient
    $tstr = $rcpt_to;
    $tstr = $1 if ($tstr =~ /\A<(.*)>\Z/);  # Remove outer angle brackets if present
    $tstr =~ s/\A(.*)@([^@]*)\Z/$2/;  # strip off everything before and including the last @
    $rcpt_username = $1;     # save the username part
    $rcpt_domain = $tstr;    # save the rcpt subdomain
    # - Now generate the list of rcpt_domain subparts
    while (index($tstr, ".") > 0) {
      push @rcpt_domain_parts, $tstr;
      $tstr =~ s/\A[^.]+\.(.*)\Z/$1/;  # strip off the leftmost domain part
    }
    push @rcpt_domain_parts, $tstr;  # Get the last part
  }


  # Check wildcard black or whitelisting based on ip address and subnet
  #   Do the check in such a way that more exact matches are returned first
  if ($check_wildcard_relay_ip) {
    my $subquery;
#MLM    my $tstr = $relay_ip;
#    for (my $loop = 0; $loop < 4; $loop++) {
#      $subquery .= " OR " if (defined($subquery));
#      $subquery .= "relay_ip = " . $dbh->quote($tstr);
#      $tstr =~ s/\A(.*)\.\d+\Z/$1/;  # strip off the last octet
    foreach my $part (@relay_ip_parts) {
      $subquery .= " OR " if (defined $subquery);
      $subquery .= "relay_ip = " . $dbh->quote($part);
    }
    my $query = "SELECT id, block_expires > NOW(), block_expires < NOW() FROM relaytofrom "
      .         "  WHERE record_expires > NOW() "
      .         "    AND mail_from IS NULL "
      .         "    AND rcpt_to   IS NULL "
      .         "    AND ($subquery) "
      .         "  ORDER BY length(relay_ip) DESC";

    my $sth = $dbh->prepare($query) or goto DB_FAILURE;
    $sth->execute() or goto DB_FAILURE;
    ($rowid, my $blacklisted, my $whitelisted) = $sth->fetchrow_array();
    goto DB_FAILURE if ($sth->err);
    $sth->finish();

    if (defined $rowid) {
      if ($blacklisted) {
        syslog('info',"$queue_id: Blacklisted relay: $relay_ip entry #$rowid");
        print "  Blacklisted Relay.  Skipping checks and rejecting the mail.  rowid: $rowid\n" if ($verbose);
        goto DELAY_MAIL;
      }
      if ($whitelisted) {
        syslog('info',"$queue_id: Whitelisted relay: $relay_ip entry #$rowid");
        print "  Whitelisted Relay.  Skipping checks and passing the mail.  rowid: $rowid\n" if ($verbose);
#        Don't reverse_track here, otherwise all remote whitelisted IPs
#        will cause each message sender/recip pair to have a row added to
#        the database, commented till I can chat with the Author:
#        reverse_track($dbh, $queue_id, $mail_from, $rcpt_to) if ($reverse_mail_tracking and $rcpt_mailer !~ /\Alocal\Z/i);
        goto PASS_MAIL;
      }
    }
  }


  # See if this recipient (or domain/subdomain) is wildcard white/blacklisted
  #   Do the check in such a way that more exact matches are returned first
  if ($check_wildcard_rcpt_to) {
    my $subquery;
    foreach my $key ("<$rcpt_username\@$rcpt_domain>", "$rcpt_username\@$rcpt_domain", "$rcpt_username\@", @rcpt_domain_parts)
    {
      $subquery .= " OR " if (defined $subquery);
      $subquery .= "rcpt_to = " . $dbh->quote($key);
    }
    my $query = "SELECT id, block_expires > NOW(), block_expires < NOW() FROM relaytofrom "
      .         "  WHERE record_expires > NOW() "
      .         "    AND relay_ip  IS NULL "
      .         "    AND mail_from IS NULL "
      .         "    AND ($subquery) "
      .         "  ORDER BY length(rcpt_to) DESC";

    my $sth = $dbh->prepare($query) or goto DB_FAILURE;
    $sth->execute() or goto DB_FAILURE;
    ($rowid, my $blacklisted, my $whitelisted) = $sth->fetchrow_array();
    goto DB_FAILURE if ($sth->err);
    $sth->finish();

    if (defined $rowid) {
      if ($blacklisted) {
        syslog('info',"$queue_id: Blacklisted RCPT: $rcpt_to entry #$rowid");
        print "  Blacklisted Recipient.  Skipping checks and rejecting the mail.  rowid: $rowid\n" if ($verbose);
        goto DELAY_MAIL;
      }
      if ($whitelisted) {
        syslog('info',"$queue_id: Whitelisted RCPT: $rcpt_to entry #$rowid");
        print "  Whitelisted Recipient.  Skipping checks and passing the mail.  rowid: $rowid\n" if ($verbose);
        goto PASS_MAIL;
      }
    }
  }

  # Store and maintain the dns_name of the relay if we have one
  #   Not strictly necessary, but useful for reporting/troubleshooting
  if ($enable_relay_name_updates and length($relay_name_reversed) > 0) 
    {
    my $rows = $dbh->do("INSERT IGNORE INTO dns_name (relay_ip,relay_name) VALUES ('$relay_ip'," 
      . $dbh->quote($relay_name_reversed) . ")");
    goto DB_FAILURE if (!defined($rows));
    if ($rows != 1) 
      {
      # Row already exists, so make sure the name is updated
      my $rows = $dbh->do("UPDATE dns_name SET relay_name = " . $dbh->quote($relay_name_reversed)
        . " WHERE relay_ip = '$relay_ip'");
      goto DB_FAILURE if (!defined($rows));
      }
    }

  # See if this sender (or domain/subdomain) is wildcard blacklisted
  # We don't check for whitelisted, since that is too prone to abuse
  #   Do the check in such a way that more exact matches are returned first
  if ($check_wildcard_rcpt_to) {
    my $subquery;
    foreach my $key ("<$from_username\@$from_domain>", "$from_username\@$from_domain", "$from_username\@", @from_domain_parts)
    {
      $subquery .= " OR " if (defined $subquery);
      $subquery .= "mail_from = " . $dbh->quote($key);
    }
    my $query = "SELECT id, block_expires > NOW(), block_expires < NOW() FROM relaytofrom "
      .         "  WHERE record_expires > NOW() "
      .         "    AND relay_ip  IS NULL "
      .         "    AND rcpt_to IS NULL "
      .         "    AND ($subquery) "
      .         "  ORDER BY length(mail_from) DESC";

    my $sth = $dbh->prepare($query) or goto DB_FAILURE;
    $sth->execute() or goto DB_FAILURE;
    ($rowid, my $blacklisted, my $whitelisted) = $sth->fetchrow_array();
    goto DB_FAILURE if ($sth->err);
    $sth->finish();

    if (defined $rowid) {
      if ($blacklisted) {
        syslog('info',"$queue_id: Blacklisted sender: %s entry #%d", $mail_from, $rowid);
        print "  Blacklisted Sender.  Skipping checks and rejecting the mail.  rowid: $rowid\n" if ($verbose);
        goto DELAY_MAIL;
      }
      #if ($whitelisted) {
        syslog('info',"$queue_id: Whitelisted sender (ignored): %s entry #%d",$mail_from, $rowid);
      #  print "  Whitelisted Sender.  Skipping checks and passing the mail.  rowid: $rowid\n" if ($verbose);
      #  goto PASS_MAIL;
      #}
    }
  }


  # We do these checks after the wildcard entry checks so that if a db entry exists, it will be 
  #   updated with the mail counts even if it matches one of the following exceptions (for statistics)
  # Only do our greylist processing if the inbound mailer is an smtp variant.
  #   This is so we won't try to check uucp and other types of mail.
  # A lot of spam is sent with the null sender address <>.  Sendmail reports 
  #   that and other "local looking" from addresses as using the local mailer, 
  #   even though they are coming from off-site.  So we have to exclude the 
  #   "local" mailer from the exemption since it lies.
  if (($mail_mailer !~ /smtp\Z/i) and ($mail_mailer !~ /\Alocal\Z/i)) 
    {
#    # we aren't using an smtp-like mailer, so bypass checks
    print "  Mail delivery is not using an smtp-like mailer.  (Not) skipping checks.\n" if ($verbose);
    reverse_track($dbh, $queue_id, $mail_from, $rcpt_to) if ($reverse_mail_tracking and $rcpt_mailer !~ /\Alocal\Z/i);
#    goto PASS_MAIL;
    }

  # Check to see if the mail is looped back on a local interface and skip checks if so
  if ($ifaddr eq $relay_ip) {
    print "  Mail delivery is sent from a local interface.  Skipping checks.\n" if ($verbose);
    reverse_track($dbh, $queue_id, $mail_from, $rcpt_to) if ($reverse_mail_tracking and $rcpt_mailer !~ /\Alocal\Z/i);
    goto PASS_MAIL;
  }


  # Check for IP relay and rcpt email/domain whitelisting from the sendmail access file
  # We bypass the checks if we are acting as a smart host for this client, or if sendmail will not
  #   accept the mail anyway and we want to let sendmail give the sender an immediate failure.
  # As strange as it seems, we do not want to bypass the checks if the value is OK or SKIP.
  # Only do the access.db checks if the var holding the file name has been defined
  if (defined $sendmail_accessdb_file) {
    if (tie (my %accessdb, 'DB_File', $sendmail_accessdb_file, O_RDONLY)) {
      # Tie was successful, now check all the variations of entries we care about
      my $bypass_checks = 0;
      my $lhs;
      my $rhs;

      # First check if this client is a host we should relay for (and therefore also not greylist)
      #   We check against both Connect: entries and generic entries without a LHS tag.
      foreach my $key (@relay_ip_parts, @relay_name_parts)
      {   
        #print "Lookup '$key'\n";
        $lhs = lc("Connect:$key");
        $rhs = $accessdb{$lhs};
        if (defined $rhs) {
          #print "  found value $rhs\n";
          $bypass_checks = 1 if ($rhs eq "RELAY");
          last;
        }
        # Now check the generic style
        $lhs = lc("$key");
        $rhs = $accessdb{$lhs};
        if (defined $rhs) {
          #print "  found value $rhs\n";
          $bypass_checks = 1 if ($rhs eq "RELAY");
          last;
        }
      }
      syslog('info',"$queue_id: Whitelisted relay from access.db: $relay_ip")
        if ($bypass_checks);
      print "  Whitelisted Relay match found in ACCESS DB.  Skipping checks and passing the mail.\n" 
        if ($verbose and $bypass_checks);

      # check to see if there is a Spam: FRIEND/HATER entry
      if (! $bypass_checks) {
        foreach my $key ("$rcpt_username\@$rcpt_domain", "$rcpt_username\@", @rcpt_domain_parts)
        {   
          $lhs = lc("Spam:$key");
          #print "Lookup '$lhs'\n";
          $rhs = $accessdb{$lhs};
          if (defined $rhs) {
            #print "  found value $rhs\n";
            $bypass_checks = 1 if ($rhs eq "FRIEND");
            last;
          }
        }
        syslog('info',"$queue_id: Whitelisted recipient from access.db: $rcpt_to")
          if ($bypass_checks);
        print "  Whitelisted Recipient match found in ACCESS DB.  Skipping checks and passing the mail.\n" 
          if ($verbose and $bypass_checks);
      }
      # We do not bypass the checks based on to from addresses, because if they are blocked, they are handled by 
      #   sendmail, and if they are RELAY or OK, we would still want to protect the recipients from spam.

      untie %accessdb;
      if ($bypass_checks) {
        reverse_track($dbh, $queue_id, $mail_from, $rcpt_to) if ($reverse_mail_tracking and $rcpt_mailer !~ /\Alocal\Z/i);
        goto PASS_MAIL;
      }
    }
    else {
      # This is not a fatal problem, so warn, but ignore
      print "ERROR: Unable to open access.db file '$sendmail_accessdb_file': $!\n";
    }
  }


  # There doesn't seem to be a wildcard entry for this mail, so do the greylisting check
  # Check to see if we already know this triplet set, and if the initial block is expired
  my $query = "SELECT id, NOW() > block_expires, origin_type, relay_ip FROM relaytofrom "
    .         "  WHERE record_expires > NOW() "
    .         "    AND mail_from = " . $dbh->quote($mail_from)
    .         "    AND rcpt_to   = " . $dbh->quote($rcpt_to);
  if ($do_relay_lookup_by_subnet) {
    # Remove the last octet for a /24 subnet, and add the .% for use in a like clause
    my $tstr = $relay_ip;
    $tstr =~ s/\A(.*)\.\d+\Z/$1.%/;
    $query .= "    AND (relay_ip LIKE " . $dbh->quote($tstr);
  }
  else {
    # Otherwise, use the relay_ip as an exact match
    $query .= "    AND (relay_ip = " . $dbh->quote($relay_ip);
  }
  # Changed to order by relay_ip being null, as this will return more specific records (matching IP) before ones with 
  #   relay_ip being null.
  # Changed to suborder by id, as this will make the query deterministic as far as which row is returned when there are 
  #   dupes.  We try to avoid dupes, but they are still theoretically possible.
  $query .= " OR relay_ip IS NULL) ORDER BY relay_ip IS NULL, id";

  my $sth = $dbh->prepare($query) or goto DB_FAILURE;
  $sth->execute() or goto DB_FAILURE;
  ($rowid, my $block_expired, my $origin_type, my $recorded_relay_ip) = $sth->fetchrow_array();
  goto DB_FAILURE if ($sth->err);
  $sth->finish();

  if (defined $rowid) {
    if ($block_expired) {
      syslog('info',"$queue_id: triplet known and block expired, passing for #%d: [%s] %s %s", $rowid, $relay_ip, $mail_from, $rcpt_to);
      print "  Email is known and block has expired.  Passing the mail.  rowid: $rowid\n" if ($verbose);
      # If this record is a reverse tracking record with unknown IP, then 
      #   update it to include the now-known IP (if tracking is enabled)
      if ($reverse_mail_tracking and !defined($recorded_relay_ip) and $origin_type eq "AUTO") {
        print "  Updating reverse tracking row with the source IP address.\n" if ($verbose);
        $dbh->do("UPDATE relaytofrom SET relay_ip = " . $dbh->quote($relay_ip) 
          . " WHERE id = $rowid AND relay_ip IS NULL");
        # This is a non-critical update, so don't bother checking if updated any rows
      }
      goto PASS_MAIL;
    }
    else {
      # the email is known, but the block has not expired.  So return a tempfail.
      syslog('info',"$queue_id: triplet known but block still active, TEMPFAIL for #%d: [%s] %s %s", $rowid, $relay_ip, $mail_from, $rcpt_to);
      print "  Email is known but block has not expired.  Issuing a tempfail.  rowid: $rowid\n" if ($verbose);
      goto DELAY_MAIL;
    }
  }

  # If got here, then this is a new and unknown triplet, so create a tracking record
  # There is a tiny race condition here that may allow two exactly concurrent mail deliveries with the exact
  #   same triplet info to two seperate MX hosts to create duplicate rows.  The real chances this will happen 
  #   are EXTREMELY small, but we still account for the possibility by doing row ordering on the query above.

  $sth = $dbh->prepare("INSERT INTO relaytofrom "
    . "        (relay_ip,mail_from,rcpt_to,block_expires,record_expires,origin_type,create_time) "
    . " VALUES (?,?,?,NOW() + INTERVAL $delay_mail_secs SECOND,NOW() + INTERVAL $auto_record_life_secs SECOND, "
    . "   'AUTO', NOW())") or goto DB_FAILURE;
  $sth->execute($relay_ip, $mail_from, $rcpt_to) or goto DB_FAILURE;
  $sth->finish;

  # Get the rowid of the row we just inserted (used later for updating)
  $rowid = $dbh->selectrow_array("SELECT LAST_INSERT_ID()");
    
  if ($delay_mail_secs == 0) {
    syslog('info',"$queue_id: triplet never seen, but delay=0, inserting #%d: [%s] %s %s", $rowid, $relay_ip, $mail_from, $rcpt_to);
    print "  New mail row successfully inserted.  Passing mail.  rowid: $rowid\n" if ($verbose);
    # and now jump to normal blocking actions
    goto PASS_MAIL;
  }

  syslog('info',"$queue_id: triplet never seen, inserting #%d: [%s] %s %s", $rowid, $relay_ip, $mail_from, $rcpt_to);
  print "  New mail row successfully inserted.  Issuing a tempfail.  rowid: $rowid\n" if ($verbose);
  # and now jump to normal blocking actions
  goto DELAY_MAIL;


  ###########################################################################
  #
  # Here we have the goto tags for finishing the mail processing
  #
  ###########################################################################

  # Predeclare privdata, since many of these gotos use it
  my $privdata;

  DELAY_MAIL:
  # Increment the blocked count (if rowid is defined)
  if (defined $rowid) {
    $dbh->do("UPDATE relaytofrom SET blocked_count = blocked_count + 1 WHERE id = $rowid") or goto DB_FAILURE;
    print "  * Mail blocked with temporary error.  Incremented blocked count on rowid $rowid\n" if ($verbose);
  }

  # FIXME - Should do mail logging?
  
  # Special handling for the null sender.  Spammers use the null sender a ton, but so do things like Exim's callback 
  #   sender verification spam checks.  If the sender is likely to be an SMTP callback, we don't want to block the 
  #   mail attempt now, but will instead block it at the eom phase.
  # UPDATE: Postfix appears to use <postmaster@some.domain> instead of the null sender for it's SMTP callbacks, 
  #   so added that as another workaround check.
  if ($mail_from eq "<>" or $mail_from =~ /\A<postmaster@/i or $tempfail_messages_after_data_phase) {
    print "  Delaying tempfail reject until eom phase.\n" if ($verbose);
  
    # save that this message needs to be blocked later in the transaction (after eom)
    $privdata = "00\x00$mail_from\x00$rcpt_to";
    # Save the changes to our privdata for the next callback
    $ctx->setpriv(\$privdata);
    
    # and let the message continue processing, since will be blocked at eom if it isn't aborted before that
    return SMFIS_CONTINUE;
  }
  
  # Save our privdata for the next callback (don't add this rowid, since have already handled it)
  $ctx->setpriv($privdata_ref);

  # Set the reply code to a unique message (for debugging) - this dsn is what is normally the default
  $ctx->setreply("451", "4.7.1", "Please try again later (TEMPFAIL)");
  # Instead, we use a better code, 450 and 4.3.2 per RFC 821 and 1893, saying the system 
  #   isn't currently accepting network messages
  # Disabled again.  For some reason, this causes aol to retry deliveries over and over with no delay.
  #   So much for giving a more informative x.x.x code.
  #$ctx->setreply("450", "4.3.2", "Please try again later (TEMPFAIL)");
 
  # Issue a temporary failure for this message.  Connection may or may not continue.
  return SMFIS_TEMPFAIL;


  BOUNCE_MAIL:
  # We don't use this anywhere yet, but may in future...
  # set privdata so later callbacks won't have problems
  $privdata = "0";
  $ctx->setpriv(\$privdata);
  # Indicate the message should be aborted (want a custom error code?)
  return SMFIS_REJECT;


  PASS_MAIL:
  # Do database bookkeeping (if rowid is defined)
  if (defined $rowid) {
    # We don't increment the passed count here because the mail may still be rejected
    #   for some reason at the sendmail level.  So we do it in the eom callback instead.

    # Here we do a special update to end the life of this record, if the sender is the null sender
    #   (Spammers send from this a lot, and it should only be used for bounces.  This
    #   Makes sure that only one (or a couple, small race) of these gets by per delay.
    if ($mail_from eq "<>") {
      # Only update the lifetime of records if they are AUTO, wouldn't want to do wildcard records
      my $rows = $dbh->do("UPDATE relaytofrom SET record_expires = NOW() "
        . " WHERE id = $rowid AND origin_type = 'AUTO'") or goto DB_FAILURE;
      print "  Mail is from null-sender.  Updated it to end its life.\n" if ($verbose and $rows > 0);
    }

    # Since we have a rowid, then set the context data to indicate we successfully 
    #   handled this message as a pass, and that we don't expect an abort without 
    #   needing further processing.  We have to keep the rcpt_to on there, since this 
    #   callback may be called several times for a specific message if it has multiple 
    #   recipients, and we need it for logging.
    # The format of the privdata is one or more rowids seperated by commas, followed by 
    #   a null, and the envelope from.
    if (substr($rowids, 0, 1) ne '0') {
       $rowids .= ",$rowid";
    } else {
      $rowids = $rowid;  
    }
  }
  # Save our privdata for the next callback
  $privdata = "$rowids\x00$mail_from\x00$rcpt_to";
  $ctx->setpriv(\$privdata);

  # FIXME - Should do mail logging?
 
  # And indicate the message should continue processing.
  return SMFIS_CONTINUE;


  DB_FAILURE:
  # Had a DB error.  Handle as configured.
  print "ERROR: Database Call Failed!\n  $DBI::errstr\n";
  db_disconnect();  # Disconnect, so will get a new connect next mail attempt
  # set privdata so later callbacks won't have problems (or if db comes back while still in this mail session)
  $privdata = "0\x00$mail_from\x00";
  $ctx->setpriv(\$privdata);
  return SMFIS_CONTINUE if ($pass_mail_when_db_unavail);
  return SMFIS_TEMPFAIL;
}


sub load_config() {

  # make sure the config is only loaded once per instance
  return if ($config_loaded);

  print "Loading Config File: $config_file\n";

  # Read and setup our configuration parameters from the config file
  my($msg);
  my($errn) = stat($config_file) ? 0 : 0+$!;
  if ($errn == ENOENT) { $msg = "does not exist" }
  elsif ($errn)        { $msg = "inaccessible: $!" }
  elsif (! -f _)       { $msg = "not a regular file" }
  elsif (! -r _)       { $msg = "not readable" }
  if (defined $msg) { die "Config file $config_file $msg" }
  eval `cat $config_file`;
  #do $config_file;
  if ($@ ne '') { die "Error in config file $config_file: $@" }

  if ($log_file) { # Keep the output in a log file
    open STDOUT, ">>$log_file" or die "Couldn't redirect STDOUT to $log_file: $!";
    STDOUT->autoflush(1);
  }

  print "Loaded Config File: $config_file\n" if $verbose;

  $config_loaded = 1;
}

sub catch_sig {
  my $signame = shift;
  print "Got a SIG$signame.\nClosing DB connection.\n" if $verbose;
  db_disconnect();
  print "Exiting relaydelay daemon process.\n";
  close(STDOUT);
  exit 0;
}

my %my_callbacks =
(
#	'connect' =>	\&connect_callback,
#	'helo' =>	\&helo_callback,
	'envfrom' =>	\&envfrom_callback,
	'envrcpt' =>	\&envrcpt_callback,
#	'header' =>	\&header_callback,
#	'eoh' =>	\&eoh_callback,
#	'body' =>	\&body_callback,
	'eom' =>	\&eom_callback,
	'abort' =>	\&abort_callback,
#	'close' =>	\&close_callback,
);

BEGIN:
{
  if (scalar(@ARGV) > 1) {
    print "Usage: perl $0 [config_file]\n\n"
      . "Please refer to documentation regarding changes to the configuration file\n"
      . "  where options that used to be specified on the command line are now\n"
      . "  set in the configuration file.\n"
      . "As an option, the path to the config file may be specified on the command line\n"
      . "  (to avoid modifying the filter script).\n";
    exit;
  }

  # If the config file was specified on the command line, use it
  if (defined($ARGV[0])) {
    $config_file = $ARGV[0];
  }

  # Make sure there are no errors in the config file before we start, and load the socket info
  load_config();

  # Record pid to file
  if (defined $relaydelay_pid_file) {
    open(PIDF, ">$relaydelay_pid_file") ||
      die "Unable to record PID to '$relaydelay_pid_file': $!\n";
    print PIDF "$$\n";
    close PIDF;
  }

  # Open syslog socket
  openlog("greylist", 'cons,pid', 'mail');
  syslog('info', "Greylist initializing");

  if (defined $sendmail_accessdb_file) {
    my %accessdb;
    # Test that we can open the accessdb file
    if (! tie (%accessdb, 'DB_File', $sendmail_accessdb_file, O_RDONLY)) {
      die "ERROR: Unable to open access.db file '$sendmail_accessdb_file': $!";
    }
    untie %accessdb;
  }

  print "Using connection '$milter_socket_connection' for filter $milter_filter_name\n" if $verbose;

  if ($milter_socket_connection =~ /^local:(.+)$/i) {
    my $unix_socket = $1;

    if (-e $unix_socket) {
      print "Attempting to unlink local UNIX socket '$unix_socket' ... " if $verbose;

      if (unlink($unix_socket) == 0) {
        print "failed.\n" if $verbose;
        exit;
      }
      print "successful.\n" if $verbose;
    }
  }

  if (not Sendmail::Milter::setconn("$milter_socket_connection")) {
    die "Failed to set up connection: $?\n";
#    exit;
  }

  # Make sure we can connect to the database 
  my $dbh = db_connect(1);
  die "$DBI::errstr\n" unless($dbh);
  # and disconnect again, since the callbacks won't have access to the handle
  db_disconnect();

  #
  #  The flags parameter is optional. SMFI_CURR_ACTS sets all of the
  #  current version's filtering capabilities.
  #

  if (not Sendmail::Milter::register("$milter_filter_name", \%my_callbacks, SMFI_CURR_ACTS)) {
    die "Failed to register callbacks for $milter_filter_name.\n";
#    exit;
  }

  if ($run_as_daemon) {
    if (not $log_file) {print "Warning: Running as a daemon, but output has not been redirected to a log file.\n";}
# I don't think we have to worry about reaping zombies since we're only 
# spawning a single child process then exiting:
#    $SIG{CHLD} = 'IGNORE'; # Automatically reap children
    defined(my $child_pid = fork()) or die "Couldn't fork daemon process:$!";
    if ($child_pid) {
      # I must be the parent:
      print "Spawned relaydelay daemon process $child_pid.\n" if $verbose;
      exit 0;
    }
  }

  # I must be the child (or using foreground operation):
  # Record pid to file
  if (defined $relaydelay_pid_file) {
    open(PIDF, ">$relaydelay_pid_file") ||
      die "Unable to record PID to '$relaydelay_pid_file': $!\n";
    print PIDF "$$\n";
    close PIDF;
  }

  if ($run_as_daemon) {
    # Be a nice daemon:
    POSIX::setsid or die "Couldn't start a new session: $!";
    chdir '/' or die "Couldn't chdir to /: $!";
    open STDIN, '/dev/null' or die "Couldn't redirect STDIN from /dev/null: $!";
    open STDERR, '>&STDOUT' or die "Couldn't dup STDOUT: $!";
    my $sigset = POSIX::SigSet->new();
    my $action = POSIX::SigAction->new('catch_sig',$sigset,&POSIX::SA_NODEFER);
    POSIX::sigaction(&POSIX::SIGQUIT, $action);
  }

  print "Starting Sendmail::Milter $Sendmail::Milter::VERSION engine.\n";
  syslog('info',"Starting Sendmail::Milter $Sendmail::Milter::VERSION engine.");

  # Parameters to main are max num of interpreters, num requests to service before recycling threads
  # We don't set it to recycle children, as that seems to cause coredumps.
  if (Sendmail::Milter::main($maximum_milter_threads, 0)) {
    print "Successful exit from the Sendmail::Milter engine.\n";
  }
  else {
    print "Unsuccessful exit from the Sendmail::Milter engine.\n";
  }
}


# Make sure when threads are recycled that we release the global db connection
END {
  if (not $run_as_daemon) { # Signal handler does this in daemon mode
    print "Closing DB connection.\n" if $verbose;
    db_disconnect();
  }
}