#!/usr/bin/perl -w
#
# AUTH_Backup_Checker script.
#
# When you are serving as a backup relay for some client host, spammers
# may use your server as a back door to deliver their junk to the client.
#
# To prevent this from happening you can use this script. Install it as
# external authentication program. For example, you're serving as a low
# priority MX relay for 'client.com' domain. In your CGPro setup you should
# create 'client.com' as a domain with no accounts, and in the 'Unknown Names'
# panel you should switch 'Consult External Authenticator' to 'Yes' (see more
# details at <http://www.stalker.com/CommuniGatePro/Domains.html#Unknown>).
# When someone attempt to submit a message to 'user@cleint.com' the script
# will check if the real 'client.com' is on-line, and if yes - it will cause
# your server to deny that address: it's assumed that when the client is
# alive it should receive its mail directly from senders, not through you.
# When the client is down, the script will cause the server to accept mail
# and to reroute it to a higher-priority MX of the 'client.com'.
#
#
# Known glitches:
#
# When 'client.com' is on-line your own users won't be able to mail to
# 'client.com' addresses. Instead^ they'll have to send to 'cleint.com.SMTP'
# or something.
#
# Some Perl versions don't support timeout in IO::Socket so the
# script may freeze checking the client when the client is off-line.
#
# If you backup several clients, you can't use domain aliases instead of
# real domains.
#
# The script requires CommuniGate Pro 4.1b7 or newer.
#
#
# Please send your comments to <support@stalker.com>
#

use strict;
use IO::Socket;


my %client_domains = (           
                             #specify here the client hosts and their IPs
'client1.com' => { ip => '11.22.33.44' },
'client2.com' => { ip => '55.66.77.88' },
);

my $alive_check_delay=2*60;  #check every 2 minutes if the client is on-line
my $check_timeout=3;         #wait at most 3 seconds for the client's SMTP to answer 


$| = 1;
print "* AUTH_Backup_Checker script v1.2 started\n";
while (<STDIN>) {
  chomp;
  my ( $prefix, $command, @eargs ) = split (/ /);

  if ( $command eq 'NEW' ) {
    unless ( $prefix && $command && $eargs[0] ) {
      print "$prefix ERROR Expected: nnn NEW user\@domain\n";
    }
    else {
      my ($account,$domain);
      ($account,$domain)=($eargs[0]=~/(.+)\@(.+)/);
      NewCommand($prefix,$account,$domain);
    }
  }
  elsif ( $command eq 'VRFY' ) {
    print "$prefix ERROR We do not verify passwords\n";
  }
  elsif ( $command eq 'INTF' ) {
    if($eargs[0] < 3) {
      print "* This script requires CGPro version 4.1b7 or newer\n";
      exit;
    }
    print "$prefix INTF 3\n";
  }
  elsif ( $command eq 'QUIT' ) {
    print "$prefix OK\n";
    last;
  }
  else {
    print "$prefix ERROR Only VRFY,NEW,INTF and QUIT commands supported\n";
  }
}
print "* AUTH_Backup_Checker script v1.2 ended\n";
exit;

sub NewCommand {
  my ($prefix,$account,$domain) = @_;

  unless(exists $client_domains{$domain}) {
    print "$prefix ERROR We do not serve $domain domain\n";
    return;        
  }
  if(CheckClientAlive($domain)) {
    print "$prefix FAILURE Send directly to $domain, not to us\n";
     return;        
  } else {
    #print "$prefix ROUTED $account\@$domain.SMTP\n";
    print "$prefix ROUTED $account\%$domain\@$client_domains{$domain}{ip}.25.via\n";
    return;        
  }  

}

sub CheckClientAlive {
  my $domain=$_[0];
  my $responseLine;
  if(defined $client_domains{$domain}{last_check} &&
    $client_domains{$domain}{last_check}+$alive_check_delay >= time()) {
  
    return $client_domains{$domain}{alive};
  }  
  
  my $item=$client_domains{$domain};
  my $ip=@$item{ip};
  local $SIG{__WARN__} = sub {}; #'IGNORE';
  my $smtp = new IO::Socket::INET(PeerAddr => $ip,
                                  PeerPort => 25,
                                  Timeout => $check_timeout
                                 );
  unless($smtp) {
    $client_domains{$domain}{alive}=0;
    $client_domains{$domain}{last_check}=time();
    print "* $domain found dead\n";
    return 0;
  }                               

  print "* $domain found alive\n";

  $smtp->autoflush(1);

  do {
    $responseLine = <$smtp>;
  }until($responseLine =~/^(\d\d\d) /);

  print $smtp "QUIT\015\012";
  <$smtp>;
  $client_domains{$domain}{alive}=1;
  $client_domains{$domain}{last_check}=time();
  return 1;
  
}
__END__;