#!/usr/bin/perl -w
#
# AUTH_Backup_Checker2 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.
# Often the backup server receives mails for accounts that don't exist
# in the cleint server, which causes more traffic and the backup server
# could become blacklisted by 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 'client.com' is on-line and the 'user@client.com' doesn't
# exist, and if so - it will cause your server to deny that address; in all
# other cases, when the client is off-line or when it's on-line and the user
# exists, the mail will be accepted and rerouted to a higher-priority MX of
# the 'client.com'.
#
#
# Known glitches:
#
# 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 $cgpro_main_domain="domain.net"; # This will be used in HELO

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' },

);




$| = 1;
my $version="2.2";
print "* AUTH_Backup_Checker2 script v$version started\n";

foreach(keys %client_domains) {
  $client_domains{$_}{last_check}=0;
  $client_domains{$_}{alive}=0;
}

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_Checker2 script v$version 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(CheckAccount($account,$domain)) {
    print "$prefix ERROR username not found\n";
    return;        
  } else {
    #print "$prefix ROUTED $account\@$domain.SMTP\n";
    print "$prefix ROUTED $account\%$domain\@$client_domains{$domain}{ip}.25.via\n";
    return;        
  }  

}

sub CheckAccount {
  my ($account,$domain)=@_;
  my $wasError=0;
  my $responseLine;
  my $statusCode;
  my $smtp;
  
  local $SIG{__WARN__} = sub { $wasError=1; }; 
  

  if($client_domains{$domain}{last_check}+(4*60+45) < time()) {
    print "* connection to $domain had timed out\n";
    $client_domains{$domain}{alive}=0;
  }  
  
  $client_domains{$domain}{last_check}=time();
  
  unless($client_domains{$domain}{alive}) { 

    $smtp=new IO::Socket::INET(
                PeerAddr => $client_domains{$domain}{ip},
                PeerPort => 25,
                Timeout  => 3
               );

    unless($smtp) {
      print "* $domain found dead\n";
      return 0;
    }                       
    $client_domains{$domain}{smtp}=$smtp;
    $client_domains{$domain}{alive}=1;
    print "* $domain found alive\n";
    do {
      $responseLine = <$smtp>;
    }until($responseLine =~/^\d\d\d /);

    print $smtp "HELO $cgpro_main_domain\015\012";
    do {
      $responseLine = <$smtp>;
    }until($responseLine =~/^\d\d\d /);

  }  

  $wasError=0;
  
  $smtp=$client_domains{$domain}{smtp};
  
  print $smtp "MAIL FROM:<>\015\012";
  do {
    $responseLine = <$smtp>;
  }until($responseLine =~/^\d\d\d /);

  print $smtp "RCPT TO:<$account\@$domain>\015\012";
  do {
    $responseLine = <$smtp>;
  }until($responseLine =~/^(\d)\d\d /);
  $statusCode=$1;
  print "* $domain answer: $responseLine";

  print $smtp "RSET\015\012";
  do {
    $responseLine = <$smtp>;
  }until($responseLine =~/^\d\d\d /);
  
  if($wasError) {
    print "* $domain had died\n";
    $client_domains{$domain}{alive}=0;
    return 0;  
  }  
  return 0 if($statusCode eq '2' || $statusCode eq '4');
  
  return 1;
  
}


__END__;