#!/usr/bin/perl -w

=head1 NAME

groupsMerge.pl

=head1 DESCRIPTION

An external filtering helper for CommuniGate Pro mail server.

Merges recipients from multiple Groups (including nested ones),
removes duplicate recipients.


=head1 INSTALLATION


Configuring the helper:
 Set the credentials for CLI login.

Configuring CommuniGate Pro:
 Create a helper:
   Name: gropusMerge
   Program Path: /usr/bin/perl groupsMerge.pl

 Then create a server-wide rule: 
   Data:
    [Any Route] [is] [LIST(*]
    [Submit Address] [is not] [PIPE*]
   Action:
    [ExternalFilter] gropusMerge

=head1 AUTHORS

Please mail your comments to support@communigatepro.ru

=cut

use strict;
use CLI;  #get one from communigatepro.ru/CGPerl/


## BEGIN CONFIG

my $CGServerAddress = "127.0.0.1";   
my $CLI_Login = "postmaster";
my $CLI_Password = "pass";

my $SubmittedDir= "Submitted";
my $useFork=1;

## END CONFIG


$SIG{CHLD}='IGNORE' if($useFork);
$| = 1;
print "* helper groupsMerge.pl started.\n";

my $counter=0;

while(<STDIN>) {
  chomp;
  my ($command,$prefix);
  my @args;             
  ($prefix,$command,@args) = split(/ /);
  if($command eq 'INTF') {
    print "$prefix INTF 3\n";

  } elsif($command eq 'QUIT') {
    print "$prefix OK\n";
    last; 
  } elsif($command eq 'KEY') {
    print "$prefix OK\n";
  } elsif($command eq 'FILE') {
    if($useFork) {  # process async
      unless(my $pid = fork) {
        die "cannot fork: $!" unless defined $pid;
        processFILE($prefix,$args[0]); 
        exit(0);  
      }
    } else {        # process synchronously 
       processFILE($prefix,$args[0]); 
    }
  } else {
    print "$prefix ERROR unexpected command: $command\n";
  }
}


print "* stoppig helper groupsMerge.pl\n";
exit(0);


my $cli;
my %newRecipients;
my %passedGroups;

sub checkAddGroup {
  my ($addr)=@_;
  $addr=lc($addr);
  return if($newRecipients{$addr});

  my $data=$cli->Route($addr,'mail');
  if($data->[2] && $data->[2] eq 'group') {
    return if($passedGroups{$addr});
    $passedGroups{$addr}=1;
    $addr=~/(\@.*)$/;
    my $groupDomain=$1 || '';
    
    my $grp=$cli->GetGroup($addr);
    unless($grp) {
      print "* Can't get the '$addr' group: ".$cli->getErrMessage."\n";
      $newRecipients{$addr}=1;
      return;
    }
    my $members=$grp->{Members};
    unless($members) {
      return;
    }
    foreach(@$members) {
      my $m=$_;
      $m.=$groupDomain unless($m=~/\@/);
      checkAddGroup($m);
    }
    return;
  }

  $newRecipients{$addr}=1;

}

sub processFILE {
  my ($prefix,$fileName) = @_;
  
  unless( open (FILE,"$fileName")) {
    print qq/$prefix REJECTED can't open $fileName: $!\n/;
    return undef;
  }
  my $returnPath="";
  my @recipients;
  while(<FILE>) {
    chomp;
    last if($_ eq '');
    my $address=(/\<(.*)\>/)[0];
    if(/^P/) {
      $returnPath=$address;
    }
    elsif(/^R/) {
      push(@recipients,$address);
    }
  }

  %newRecipients=();
  %passedGroups=();  

  $cli = new CGP::CLI( { PeerAddr => $CGServerAddress,
                          PeerPort => 106,
                          login    => $CLI_Login,
                          password => $CLI_Password } )
   || die "Can't login to CGPro 1: ".$CGP::ERR_STRING."\n";

  foreach(@recipients) {
    checkAddGroup($_);
  }
  $cli->Logout();

  $fileName=~/(\d+)\./;
  my $subFileName=$SubmittedDir.'/'.$1.".".int(rand(100000));

  
  unless( open(WFILE,">$subFileName.tmp")) {
    print qq/$prefix REJECTED can't create $subFileName.tmp: $!\n/;
    close(FILE);
    return undef;
  }
  
  print WFILE "Return-Path: <$returnPath>\n";
  
  my $line='Envelope-To: ';
  @recipients = sort keys %newRecipients;
  for(my $idx=0;$idx<@recipients;$idx++) {
    $line.=$recipients[$idx];
    if(length($line)>900) {
      print WFILE "$line\n";
      $line='Envelope-To: ';
    } else {
      $line.="," if($idx<@recipients-1);
    }
  }
  if(length($line)>14) {
    print WFILE "$line\n";
  }
  
  while(<FILE>) {
    next if(/^Envelope-to:/i);
    print WFILE $_;
  }
  
  close(WFILE);
  close(FILE);
  
  unless( rename("$subFileName.tmp","$subFileName.sub") ) {
    print qq/$prefix REJECTED can't rename open $subFileName.tmp to $subFileName.sub: $!\n/;
    unlink("$subFileName.tmp");
    return undef;
  }
  
  print qq/$prefix DISCARD\n/;
  
  undef;
}



