#!/usr/bin/perl -w
#
# findLongLines.pl
#
# Finds and fixes "mailbox has a very long line" errors in mailboxes of .mbox and .mslc formats.
# Finds (but not fixes) "wrong UID sequence" errors.
#
#
# Revision: 11-Jan-2023
# Revision:  2-Mar-2023
#
# Mail your comments to support@communigate.ru
#

#use strict;

use strict;
use lib ".";
use CLI;  #get one from www.communigate.ru/CGPerl/


####  YOU SHOLD REDEFINE THESE VARIABLES !!!

my $Login='postmaster';
my $Password='pass';

my $fixIfBad=0;    # fix or reprot

my $disableUser=0; # disable logins and receiving mail during fixing
                   # set this to 0 if the domain is suspended



my ($BaseDir);
if($^O eq 'MSWin32') {
  $BaseDir      = "C:/CommuniGatePro/";
} else {
  $BaseDir      = "/var/CommuniGate/";
}

my $maxLineLength = 10*1024;


# also un-commend one of the lines below to choose between all domains/one domain/one account

#### end of the customizeable variables list




my $cli = new CGP::CLI( { PeerAddr => '127.0.0.1',
                          PeerPort => 106,
                          login    => $Login,
                          password => $Password } )
   || die "*** Can't login to CGPro CLI: ".$CGP::ERR_STRING."\n";


# un-comment one of the below lines

my $uidSeq = 0;
#processAccount('user@company.com');
processDomain('company.com');
#processAllDomains();
#processFile('accountList.txt');



print "Done\n";
$cli->Logout();
exit;

sub processFile {
  my ($fname)=@_;
  open(FILE,$fname) || die "can't open $fname: $!\n";
  while(<FILE>) {
    chomp;
    next if(/^#/);
    my $account=$_;
    if(length($account)>3) {
      processAccount($account);
    }
  }
  close(FILE);
}

sub processAllDomains {
  my $DomainList = $cli->ListDomains()
               || die "*** Can't get the domain list: ".$cli->getErrMessage.", quitting";
  foreach(@$DomainList) {
    processDomain($_);
  }
}         

sub processDomain {
  my $domain=$_[0];
  my $DomainPath=$cli->GetDomainLocation($domain);
  unless($DomainPath) {
    print "*** Can't get domain location for $domain: ".$cli->getErrMessage."\n";
    return;
  }
  $DomainPath=~s/\\\\/\//g;
  $DomainPath = $DomainPath . '/';
  print "Domain: $domain ($DomainPath)\n";

  my $cookie="";
  do {
    my $data=$cli->ListDomainObjects($domain,5000,undef,'ACCOUNTS',$cookie);
    unless($data) {
      print "*** Can't get accounts for $domain: ".$cli->getErrMessage."\n";
      return;
    }
    $cookie=$data->[4];

    foreach(keys %{$data->[1]} ) {
      processAccountEx($domain,$_,$DomainPath);
    }
  }while($cookie ne '');
 
}

sub processAccount {
  my ($account)=@_;
  my ($user,$domain)=($account=~/(.*)\@(.*)/)[0,1];
  
  my $DomainPath=$cli->GetDomainLocation($domain);
  unless($DomainPath) {
    print "*** Can't get domain location for $domain: ".$cli->getErrMessage."\n";
    return;
  }
  $DomainPath=~s/\\\\/\//g;
  $DomainPath = $DomainPath . '/';
  processAccountEx($domain,$user,$DomainPath);
}

sub processAccountEx {
  my ($Domain,$Account,$DomainPath) = @_;


  my $AccLocation = $cli->GetAccountLocation("$Account\@$Domain");
  unless($AccLocation) {
    print "*** Can't get location for $Account\@$Domain: ".$cli->getErrMessage."\n";
    return;
  }  
  $AccLocation=~s/\\\\/\//g;
  print "Account: $Account\@$Domain ($AccLocation)\n";

  if($AccLocation !~/\..acnt$/) {
    #processMBox($BaseDir.$DomainPath,$AccLocation,"$Account\@$Domain",1); 
    print "*** won't convert a single-mailbox account\n";
    return;
  }
  
  my $oldAccessModes;
  if($disableUser && $fixIfBad) {
    my $data=$cli->GetAccountSettings("$Account\@$Domain");
    unless($data) {
      print "*** Can't get settings for $Account: ".$cli->getErrMessage."\n";
      return;
    }
    $oldAccessModes=$data->{'AccessModes'} || 'Default';
    $cli->UpdateAccountSettings("$Account\@$Domain",{ AccessModes=>'None' });  
  }
  
  processAccountEx2($Domain,$Account,$DomainPath,$AccLocation);

  if($disableUser && $fixIfBad) {
    $cli->UpdateAccountSettings("$Account\@$Domain",{ AccessModes=>$oldAccessModes });  
  }

} 

sub processAccountEx2 {
  my ($Domain,$Account,$DomainPath,$AccLocation) = @_;
  
  if($disableUser) {
    unless($cli->KillAccountSessions("$Account\@$Domain")) {
      print "*** Can't kill sessions for $Account\@$Domain: ".$cli->getErrMessage."\n";
      return;
    }
  }
  $cli->SendCommand("ClearAccountCache $Account\@$Domain");

  checkDir($BaseDir.$DomainPath.$AccLocation,"","$Account\@$Domain");

  $cli->SendCommand("ClearAccountCache $Account\@$Domain");
}


sub checkDir {
  my ($b,$path,$account)=@_;
  #  print "Checking dir: $b/$path\n";
  unless(opendir(DIR,"$b/$path")) {
    print "*** Can't opendir '$b/$path': $!\n";
    return;
  }  
  my @files = readdir(DIR);
  closedir DIR;

  foreach(sort @files) {
    my $fullPath="$b/".(($path) ? "$path/$_" : $_);
    if(/\.mbox$/ && -f $fullPath) {
      processMBox($b,($path) ? "$path/$_" : $_,$account,0);
#    }elsif(/\.mdir$/ && -d $fullPath) {
#      processMDir($b,($path) ? "$path/$_" : $_,$account,0);
    }elsif(/\.mslc$/ && -d $fullPath) {
      processSliced($b,($path) ? "$path/$_" : $_,$account,0);
    }elsif(/\.folder$/ && -d $fullPath) {
      checkDir($b,($path) ? "$path/$_" : $_,$account);
    }
  } 
}




sub checkFixFile {
  my ($fName,$tempName)=@_;
  my $INF;
  unless(open($INF,"$fName")) {
    print "*** can't open '$fName': $!\n";
    return;
  } 
  my $isBad = 0;
  my $line;
  while(!eof($INF)) {
    $line = <$INF>;
    if($line =~/\000/) {
      print "$fName: zeros found\n";
      $isBad = 1;
      last;
    } elsif(length($line)>$maxLineLength) {
      print "$fName: very long line\n";
      $isBad = 1;
      last;
    } elsif($line !~ /\n$/) {
      print "$fName: not ended with EOL\n";
      $isBad = 1;
      last;
    } elsif($line =~/^From <>\((.*)\)/) {  #mbox
      my $ln = $1;
      my $s=$uidSeq;
      if($ln=~/-(\d+)-(\d+)/) {
        $s=$2;
      }elsif($ln=~/-(\d+)/) {
        $s=$1;
      }
      if($s<=$uidSeq) {
        print "$fName: wrong UID sequence $s\n";
      } else {
        $uidSeq = $s;
      }
    } elsif($line =~/^\001\001\001(.*)/) {  #mslc
      my $ln = $1;
      $ln=~/^0 (\d+) (\d+) /;
      my $s=$1;
      if($s<=$uidSeq) {
        print "$fName: wrong UID sequence $s\n";
      } else {
        $uidSeq = $s;
      }
      
    }

  }
  close($INF);
  return 0 unless($isBad);
  return 0 unless($fixIfBad);

  my $OUTF;
  unless(open($OUTF,">$tempName")) {
    print "*** can't create '$tempName': $!\n";
    return 0;
  }
  unless(open($INF,"$fName")) {
    print "*** can't open '$fName': $!\n";
    return;
  }
  while(!eof($INF)) {
    $line = <$INF>;
    $line=~s/\000//g;
    if(length($line)>$maxLineLength) {
       $line = substr($line,0,$maxLineLength);
    }
    if($line !~ /\n$/) {
      $line .= "\n";
    }
    print $OUTF $line;
  }

  close($OUTF);
  close($INF);
  
  unless(rename("$fName","$fName.tmp")) {
    print "*** can't rename '$fName' into '$fName.tmp': $!\n";
    return 1;
  }
  unless(rename("$tempName","$fName")) {
    print "*** can't rename '$tempName' into '$fName': $!\n";
    return 1;
  }
  unless(unlink("$fName.tmp")) {
    print "*** can't delete '$fName.tmp': $!\n";
    return 1;
  }
  
  return 1;
}


sub processMBox {
  my ($path,$fName,$account,$isSingle)=@_;
  print " mbox: $fName\n";
  my $tempSuffix="--temp--";

  my $cutName=($fName=~/(.*)\.mbox$/)[0];
  my $tempName=$cutName.$tempSuffix.".mbox";
  $uidSeq = 0;  
  my $wasBad = checkFixFile("$path/$fName","$path/$tempName");
  
  
  if($wasBad && -f "$path/$cutName.bdx") {
    unless(unlink("$path/$cutName.bdx")) {
      print "*** can't delete '$path/$cutName.bdx': $!\n";
      return;
    }
  }

}

sub processMDir {
}

sub processSliced {
  my ($path,$dirName,$account,$isSingle)=@_;
  print " mslc: $dirName\n";
  my $tempSuffix="--temp--";

  unless(opendir(DIR,"$path/$dirName")) {
    print "*** Can't opendir '$path/$dirName': $!\n";
    return;
  }  
  my @files = readdir(DIR);
  closedir(DIR);
  
  my $cutName=($dirName=~/(.*)\.mslc$/)[0];
  my $tempDirName=$cutName.$tempSuffix.".mslc";
  
  my %dataFiles;
  foreach(@files) {
    if(/^data(\d+)/) {
      $dataFiles{0+$1}=$_;
    }
  }
  
  $uidSeq = 0;
  my $wasBad = 0;
  foreach(sort {$a <=> $b} keys %dataFiles) {
    $wasBad |= checkFixFile("$path/$dirName/$dataFiles{$_}","$path/$dirName/tmp-$dataFiles{$_}");
  }
  if($wasBad && -f "$path/$dirName/index.bdx") {
    unless(unlink("$path/$dirName/index.bdx")) {
      print "*** can't delete '$path/$dirName/index.bdx': $!\n";
      return;
    }
  }
  

}

__END__

