#!/usr/bin/perl -w
#
#  Journaling for CommuniGate Pro
#  See <http://old.communigatepro.ru/CGPJournaling/>
#  Edition 18.09.2017



use strict;
use CLI;  #get one from old.communigatepro.ru/CGPerl/
use Time::Local 'timelocal_nocheck';


####  YOU SHOLD REDEFINE THESE VARIABLES !!!
my $PostmasterLogin="postmaster";
my $PostmasterPassword='pass';


my $refreshPeriond=10; #re-read journal settings every N minutes

my $journalDomain='journals.local';

my $addPatternAttrib="st";
my $skipPatternAttrib="l";
my $retentionAttrib="ou";

my $SubmittedDir= "Submitted";

#### end of the customizeable variables list


my @jList;

my $secs;
my ($lastRefresh,$lastCleanup)=(0,0);

$| = 1;


print "* Journaler.pl started.\n";

my $cli= new CGP::CLI( { PeerAddr => '127.0.0.1',
                          PeerPort => 106,
                          login    => $PostmasterLogin,
                          password => $PostmasterPassword } );
unless($cli) {
  print "* Can't login to CGPro CLI: ".$CGP::ERR_STRING."\n";
  exit(1);
}
my $mainDomain=$cli->MainDomainName();
unless($mainDomain) {
  print "* error: MainDomainName: ".$cli->getErrMessage."\n";
  $cli->Logout();
  exit(1);
}

preSetup();
cycledTask();

while(<STDIN>) {
  chomp;
  my ($prefix,$command,@args) = split(/ /);
  
  cycledTask();
  
  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') {
    processFILE($prefix,$args[0]);
  } else {
    print "$prefix ERROR unexpected command: $command\n";
  }

}
$cli->Logout();

print "* Journaler.pl stopped.\n";
exit(0);


my $needCleanup;

sub cycledTask {
  
  $secs=time();
 
  if($lastRefresh + $refreshPeriond*60 < $secs) {
    readJournals();
    $lastRefresh=$secs;
  }
  
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
  if( ($hour == 0 && $needCleanup) || $lastCleanup+24*60*60<$secs ) {
    $needCleanup=0;
    foreach(@jList) {
      cleanupJournal($_->{name},$_->{retention});
    }
    $lastCleanup=$secs;
  } elsif($hour != 0) {
    $needCleanup=1;
  }

}

sub checkAddress {
  my $data=$cli->Route($_[0],"mail");
#                 || die "Error: ".$cli->getErrMessage.", quitting";
  return undef unless($data);
  return undef if($data->[0] ne 'LOCAL');
  if($data->[1]=~/\@/) {
    return $data->[1];
  } else {
    return $data->[1].'@'.$mainDomain;
  }  
}

sub matchPatterns {
  my ($str,$addP,$delP)=@_;

  if($str && $addP && $str=~/^$addP$/) {
    if($delP && $str=~/^$delP$/) {
      return 0;
    }
    return 1;
  }
  return 0;  
}

sub processFILE {
  my ($prefix,$fileName) = @_;
  my @toJournals=();
  
  unless( open (FILE,"$fileName")) {
    print qq/$prefix REJECTED can't open $fileName: $!\n/;
    return undef;
  }
  my $returnPath="";
  my $realReturnPath="";
  my @recipients;
  while(<FILE>) {
    chomp;
    last if($_ eq '');
    next unless (/\<(.*)\>/);
    my $address=lc($1);
    if(/^P/) {
      $returnPath=$address;
    }
    elsif(/^R/) {
      push(@recipients,$address) unless($address=~/\@${journalDomain}$/);
    }
  }
  my @fileData=<FILE>;
  close(FILE);
  print qq/$prefix OK\n/;
  
  return unless(scalar(@recipients) || $returnPath);
  
  if($returnPath) {
    $realReturnPath=checkAddress($returnPath);
    $returnPath="" if($realReturnPath && $realReturnPath eq $returnPath);
  }
    
  my @newRecipients;
  my @orgRecipients;
  my @extRecipients;
  foreach(@recipients) {
    my $user=checkAddress($_);
    if($user) {
      push(@newRecipients,$user);
      if($user ne $_) {
        push(@orgRecipients,$_);
      }  
    } else {
      push(@extRecipients,$_);
    }
  }

  
  foreach(@jList) {
    my $jr=$_;
    next unless($jr->{addP});
    
    foreach(@newRecipients,$realReturnPath) {
      if(matchPatterns($_,$jr->{addP},$jr->{delP}) ) {
        push(@toJournals,$jr->{name});
        last;
      }
    }
    
  }#jList
  
  return unless(scalar(@toJournals));
    
  $fileName=~/(\d+)\./;
  my $subFileName=$SubmittedDir.'/'.$1.".".int(rand(1000));
  
  unless( open(WFILE,">$subFileName.tmp")) {
    print qq/* $prefix can't create $subFileName.tmp: $!\n/;
    return undef;
  }

  print WFILE "Return-Path: <>\n";
  print WFILE "Envelope-To: ".join(",",@toJournals)."\n";

  print WFILE "X-ret: $realReturnPath\n" if($realReturnPath);
  print WFILE "X-oret: $returnPath\n" if($returnPath);
  
  foreach(sort @newRecipients) {
    print WFILE "X-rcpt: $_\n";
  }
  foreach(sort @orgRecipients) {
    print WFILE "X-orcpt: $_\n";
  }
  foreach(sort @extRecipients) {
    print WFILE "X-ercpt: $_\n";
  }
  
  foreach(@fileData) {
    print WFILE $_;
  }
  
  close(WFILE);
  
  unless( rename("$subFileName.tmp","$subFileName.sub") ) {
    print qq/* $prefix can't rename open $subFileName.tmp to $subFileName.sub: $!\n/;
    unlink("$subFileName.tmp");
    return undef;
  }
  
  
  undef;
}



sub stripComment {
  my ($data)=@_;
  return "" unless($data);
  $data=$1 if($data=~/^(.*?)#/);
  $data=~s/^\s*//; 
  $data=~s/\s*$//;
  return $data; 
}

sub readJournals {
  @jList=();
  my $accList=$cli->ListAccounts($journalDomain);
  unless($accList) {
    print "* error: ListAccounts: ".$cli->getErrMessage."\n";
    $cli->Logout();
    exit(0);
  }
  foreach(sort keys %$accList) {  
    next unless(/^j\-/);
    my $account=$_;
    my $accData=$cli->GetAccountSettings("$account\@$journalDomain");
    next unless($accData);
    my %jData;
    $jData{name}=$account.'@'.$journalDomain;
    $jData{addP}=stripComment( $accData->{$addPatternAttrib} );    
    $jData{delP}=stripComment( $accData->{$skipPatternAttrib} );
    $jData{retention}=stripComment( $accData->{$retentionAttrib} ) || 30;
    push(@jList,\%jData);
    print "* Reading journal: $jData{name}\n";
  }
}



sub cleanupJournal {
  my ($jName,$retention)=@_;
  $retention=2 if($retention<2);
  print "* Cleaning $jName ($retention)\n";  
  

  my $curDate;
  { my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($secs);
    $curDate=sprintf("%04d-%02d-%02d",$year+1900,$mon+1,$mday);
  }  
  my $curFolder="ar_$curDate";
  
  my $ruleExists=0;
  my $rr=$cli->GetAccountMailRules($jName);
  if($rr && ref($rr) eq 'ARRAY') {
    $ruleExists=1 if($rr->[0] && $rr->[0]->[1] && $rr->[0]->[1] =~ /^$curDate/);
  }

  unless($ruleExists) {
    my @rules=[5,"$curDate archiveRule",
      [],
      [ ["Store in",$curFolder],
        ['Discard']
      ],
      "",
     ];
    $cli->SetAccountMailRules($jName,\@rules);
    print "* $jName rule stored ($curDate)\n";
  }

  my $mailboxesList=$cli->ListMailboxes(accountName=>$jName);
  foreach(sort keys %$mailboxesList) {
    my $data=@$mailboxesList{$_};
    $data=@$data[0] if(ref $data eq 'ARRAY');  
    if(ref $data eq 'HASH') {
      my $folder=$_;
      if($folder=~/ar_(\d\d\d\d).(\d\d).(\d\d)/) {
        my($y,$m,$d)=($1,$2,$3);
        my $fTime = timelocal_nocheck(0,0,0, $d, $m-1, $y-1900);
        if($secs-$fTime>$retention*60*60*24) {
          print "* deleting $jName/$folder\n";
          $cli->DeleteMailbox($jName,$folder);
        }
      }
      
    }  
  }

}

sub preSetup {
  my $domains=$cli->ListDomains();
  unless($domains) {
    print "* error: ListDomains: ".$cli->getErrMessage."\n";
    $cli->Logout();
    exit(1);
  }
  my $found=0;
  foreach(@$domains) {
    if($_ eq $journalDomain) {
      $found=1; last;
    }
  }
    
  unless($found) {
    my $isCluster=0;
    if($cli->GetCurrentController()) {
      $isCluster=1;
    }
    print "* Creating domain: $journalDomain\n";
    unless($cli->CreateDomain($journalDomain,($isCluster) ? 'SHARED' : undef) ) {
      print "* error: CreateDomain $journalDomain: ".$cli->getErrMessage."\n";
      $cli->Logout();
      exit(1);
    }

    $cli->UpdateDomainSettings(domain => $journalDomain,settings => {
      CentralDirectory=>'Disabled',
    });     
    $cli->UpdateAccountDefaults(domain => $journalDomain,settings => {
      DefaultMailboxType=>'SlicedMailbox',
      MaxAccountSize=>'unlimited',MaxMailboxes=>"-1",
      MaxMessageSize=>'unlimited',
      ArchiveMessagesAfter=>'never',DeleteMessagesAfter=>'never',
      MailInpFlow=>["-1","1s"],MailOutFlow=>["0","1s"],
      UseAppPassword=>'NO',
    });
    
    $cli->CreateAccount( accountName=>"j-mydomain\@$journalDomain", settings=>{
      RealName=>"a sample journal account for mydomain.com domain",
      $addPatternAttrib=>".*\@mydomain.com #AddPattern",
      $skipPatternAttrib=>"(mailer-daemon|postmaster|abuse)\@.* #SkipPattern",
      $retentionAttrib=>"30 #days to retain",
    });
  }

}
__END__ 

