#!/usr/bin/perl -w
#
# ConvertToSliced.pl
#
# The mailbox conversion script for CommuniGate Pro.
# version 1.6 Apr 3, 2019
#
# Using this script you can convert accounts' mailboxes from TextMailbox and MailDirMailbox format to Sliced.
# The script works on filesyatem level and needs to be launched
# on the server machine.
#
# Unlike other scripts which convert files directly, this one
# doesn't require shutting down the server.
#
#
#
# Mail your comments to support@communigatepro.ru
#

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


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

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

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

my $updateIndex=1; # update mailbox index after conversion
                   # set this to 0 if the domain is suspended


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

my $tempSuffix="--temp--";
my $maxLineLength=1024*80;   # cut lines longer that this
my $slicedFileSize=50*1024*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 $imap = new IO::Socket::INET(   PeerAddr => '127.0.0.1',
                                    PeerPort => 143,
                                    Timeout  => 600
                                  ) 
   || die "*** Can't connect to CGPro via IMAP.\n";                                

$imap->autoflush(1);
my $responseLine = <$imap>;

print $imap "x LOGIN $Login $Password\015\012";
do {
  $responseLine = <$imap>;
}until($responseLine =~/^x /);
die "*** Can't login to CGPro IMAP: $responseLine.\n"
  unless($responseLine =~ /^x OK/);

print $imap "x ENABLE EXTENSIONS\015\012";
do {
  $responseLine = <$imap>;
}until($responseLine =~/^x /);



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

processAccount('user@company.com');
#processDomain('company.com');
#processAllDomains();
#processFile('accountList.txt');



print "Done\n";
$cli->Logout();
print $imap "x LOGOUT\015\012";
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=~/\.mbox$/) {
    #processMBox($BaseDir.$DomainPath,$AccLocation,"$Account\@$Domain",1); 
    print "*** won't convert a single-mailbox account\n";
    return;
  } elsif($AccLocation=~/\.mdir$/) {
    #processMDir($BaseDir.$DomainPath,$AccLocation,"$Account\@$Domain",1); 
    print "*** won't convert a single-mailbox account\n";
    return;
  }
  unless(checkIfNeedToConvert($BaseDir.$DomainPath.$AccLocation,"","$Account\@$Domain")) {
    print " no need to convert this account\n";
    return;
  }

  my $oldAccessModes;
  if($disableUser) {
    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) {
    $cli->UpdateAccountSettings("$Account\@$Domain",{ AccessModes=>$oldAccessModes });  
  }

} 

sub processAccountEx2 {
  my ($Domain,$Account,$DomainPath,$AccLocation) = @_;
  
  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 checkIfNeedToConvert {
  my ($b,$path,$account)=@_;
  #  print "Checking dir: $b/$path\n";
  unless(opendir(DIR,"$b/$path")) {
    print "*** Can't opendir '$b/$path': $!\n";
    return 0;
  }  
  my @files = readdir(DIR);
  closedir DIR;

  foreach(@files) {
    my $fullPath="$b/".(($path) ? "$path/$_" : $_);
    if(/\.mbox$/ && -f $fullPath) {
      return 1;
    }elsif(/\.mdir$/ && -d $fullPath) {
      return 1;
    }elsif(/\.folder$/ && -d $fullPath) {
      my $res=checkIfNeedToConvert($b,($path) ? "$path/$_" : $_,$account);
      return $res if($res);
    }
  }
  return 0; 
}

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(/\.folder$/ && -d $fullPath) {
      checkDir($b,($path) ? "$path/$_" : $_,$account);
    }
  } 
}

sub processMBox {
  my ($path,$fName,$account,$isSingle)=@_;
  print " mbox: $fName\n";
  unless(open(INF,"$path/$fName")) {
    print "*** can't open '$path/$fName': $!\n";
    return;
  }
  
  my $cutName=($fName=~/(.*)\.mbox$/)[0];
  my $tempDirName=$cutName.$tempSuffix.".mslc";
  
  unless(reCreateDir("$path/$tempDirName")) {
    return;
  }
  my($fileCnt,$fileSize,$nextUID)=(0,$slicedFileSize+1,0);
   
  my $isEmpty=1;
  while(<INF>) {
    chomp;
    my $line=$_;
#    if($isEmpty &&  $line=~/^>(From.*)/) { 
#      $line=$1; 
#    } else
    if($isEmpty && $line=~/^From <.*>\((.*)\) (.*)/) {
      my ($comment,$timestamp)=($1,$2);
      
      if($fileSize>$slicedFileSize) {
        close(OUTF);
        $fileCnt++;$fileSize=0;
        unless(open(OUTF,">$path/$tempDirName/data$fileCnt")) {
          print "*** can't create $path/$tempDirName/data$fileCnt: $!\n";
          return;
        }
      }
      my ($uid,$oid);
      my $flags;
      if( $comment=~/(.+)-(\d+)-(\d+)/ ) {
        $flags=$1;
        $uid=$2;$oid=$3;
      } elsif($comment=~/(.+)-(\d+)/) {
        $flags=$1;
        $uid=$oid=$2;
      } else {
        print "Unknown format: $line\n";
      }
      $nextUID=$uid+1;
      $uid='0'.$uid while(length($uid)<10);
      $uid=substr($uid,-10) if(length($uid)>10);
      $oid='0'.$oid while(length($oid)<10); 
      $oid=substr($oid,-10) if(length($oid)>10);
      
      if($flags=~/^\*/) {
        $flags='*';
      } else {  
        $flags.='_' while(length($flags)<26); 
      }
      print OUTF "\001\001\001"."0 ".$uid." ".$oid." ".ConvTime($timestamp)." ".$flags."\n";
      next;
    }
    $fileSize+=length($line)+1;
    if(length($line)>$maxLineLength) {
      print "too long line: ".length($line)."\n";
      while(length($line)>$maxLineLength) {
        print OUTF substr($line,0,$maxLineLength)."\n";
        $line=substr($line,$maxLineLength);
      }
    }
    print OUTF "$line\n";

    $isEmpty=($line eq '') ? 1 : 0;
  }
  close(OUTF);
  close(INF);
  
  if(-f "$path/$cutName.bdx") {
    unless(unlink("$path/$cutName.bdx")) {
      print "*** can't delete '$path/$cutName.bdx': $!\n";
      return;
    }
  }
  unless(rename("$path/$fName","$path/$fName.tmp")) {
    print "*** can't rename '$path/$fName' into '$path/$fName.tmp': $!\n";
    return;
  }
  unless(rename("$path/$tempDirName","$path/$cutName.mslc")) {
    print "*** can't rename '$path/$tempDirName' into '$path/$cutName.mslc': $!\n";
    return;
  }
  unlink("$path/$fName.tmp");
  UpdateIndex($cutName,$account,$isSingle) if($nextUID>0 && $updateIndex);
}


sub processMDir {
  my ($path,$dirName,$account,$isSingle)=@_;
  print " mdir: $dirName\n";
  unless(opendir(DIR,"$path/$dirName")) {
    print "*** Can't opendir '$path/$dirName': $!\n";
    return;
  }  
  my @files = readdir(DIR);
  closedir(DIR);
  
  my %messages;
  my %attrFiles;
  foreach(@files) {
    if(/^(\d+)/) {
      $messages{$1}=$_;
    }elsif(/^O(\d+)/) {
      $attrFiles{$1}=$_;
    }
  }
  
  my $cutName=($dirName=~/(.*)\.mdir$/)[0];
  my $tempDirName=$cutName.$tempSuffix.".mslc";
  
  unless(reCreateDir("$path/$tempDirName")) {
    return;
  }

  my($fileCnt,$fileSize,$nextUID)=(0,$slicedFileSize+1,0);
  
  foreach(sort {$a <=> $b} keys %messages) {
    my $uid=$_;
    $nextUID=$uid+1;
    my $fName=$messages{$_};

    $uid='0'.$uid while(length($uid)<10);
    my $oid;
    if($fName=~/O(\d+)/) {
      $oid=$1;
      $oid='0'.$oid while(length($oid)<10);
    } else {
      $oid=$uid;
    }
    $fName=~/\-(.+)\-(\d+)\-(\d+)$/;
    my $flags=$1;
    $flags.='_' while(length($flags)<26);
    my $timestamp=$2;

    if($fileSize>$slicedFileSize) {
      close(OUTF);
      $fileCnt++;$fileSize=0;
      unless(open(OUTF,">$path/$tempDirName/data$fileCnt")) {
        print "*** can't create $path/$tempDirName/data$fileCnt: $!\n";
        return;
      }
    }
    
    unless(open(INF,"$path/$dirName/$fName")) {
      print "*** can't open '$path/$dirName/$fName': $!\n";
      return;
    }
    print OUTF "\001\001\001"."0 ".$uid." ".$oid." ".$timestamp." ".$flags."\n";
    while(<INF>) {
      chomp;
      my $line=$_;
      $fileSize+=length($line)+1;
      if(length($line)>$maxLineLength) {
        print "too long line: ".length($line)."\n";
        while(length($line)>$maxLineLength) {
          print OUTF substr($line,0,$maxLineLength)."\n";
          $line=substr($line,$maxLineLength);
        }
      }
      print OUTF "$line\n";
    }   
    close(INF);
  }
  
  foreach(sort {$a <=> $b} keys %attrFiles) {
    my $uid=$nextUID++;
    $uid='0'.$uid while(length($uid)<10);

    my $fName=$attrFiles{$_};
    $fName=~/O(\d+)/;
    my $oid=$1;
    $oid='0'.$oid while(length($oid)<10);
    my $flags='*';
    my $timestamp='20180101000000';
    if($fileSize>$slicedFileSize) {
      close(OUTF);
      $fileCnt++;$fileSize=0;
      unless(open(OUTF,">$path/$tempDirName/data$fileCnt")) {
        print "*** can't create $path/$tempDirName/data$fileCnt: $!\n";
        return;
      }
    }
    
    unless(open(INF,"$path/$dirName/$fName")) {
      print "*** can't open '$path/$dirName/$fName': $!\n";
      return;
    }
    print OUTF "\001\001\001"."0 ".$uid." ".$oid." ".$timestamp." ".$flags."\n";
    my $msgSize=0;
    while(<INF>) {
      chomp;
      my $line=$_;
      $msgSize+=length($line)+1;
      $fileSize+=length($line)+1;
      if(length($line)>$maxLineLength) {
        print "too long line: ".length($line)."\n";
        while(length($line)>$maxLineLength) {
          print OUTF substr($line,0,$maxLineLength)."\n";
          $line=substr($line,$maxLineLength);
        }
      }
      print OUTF "$line\n";
    }   
    close(INF);
    while($msgSize<2048) {
      my $nChars=2048-$msgSize;
      $nChars=72 if($nChars>72);
      print OUTF ("_" x $nChars)."\n";
      $msgSize+=$nChars+1;
    }
  }
  
  close(OUTF);
  
  unless(rename("$path/$dirName","$path/$cutName-temp-.mdir")) { 
    print "*** can't rename '$path/$dirName' into 'path/$cutName-temp-.mdir': $!\n";
    return;
  }
  unless(rename("$path/$tempDirName","$path/$cutName.mslc")) {
    print "*** can't rename '$path/$tempDirName' into '$path/$cutName.mslc': $!\n";
    return;
  }
  foreach(@files) {
    if (-f "$path/$cutName-temp-.mdir/$_" && !unlink("$path/$cutName-temp-.mdir/$_")) {
      print "*** can't delete 'path/$cutName-temp-.mdir/$_': $!\n";
    }
  }

  unless(rmdir("$path/$cutName-temp-.mdir")) {
    print "*** can't delete dir '$path/$cutName-temp-.mdir': $!\n";
  }

  UpdateIndex($cutName,$account,$isSingle) if($nextUID>0 && $updateIndex);
}

sub UpdateIndex {
  my ($boxName,$account,$isSingle)=@_;
  if($isSingle) {
    $boxName='INBOX';
  } else {  
    $boxName=~s|.folder\/|\/|g;
  }  
  print $imap qq{x SELECT "~$account/$boxName"\015\012};
  my $responseLine;
  do {
   $responseLine = <$imap>;
  }until(!defined($responseLine) || $responseLine =~/^x /);
  if(!defined($responseLine)) {
    print "*** Can't select ~$account/$boxName: connection broken\n";
    exit(1);
  }elsif($responseLine !~ /^x OK/) {
    print "*** Can't select ~$account/$boxName: ". $responseLine."\n";
    return;
  }

  print $imap "s STORE 1 +FLAGS (Label3)\015\012";
  do {
    $responseLine = <$imap>;
  }while($responseLine && $responseLine !~/^s /);
  print $imap "s STORE 1 -FLAGS (Label3)\015\012";
  do {
    $responseLine = <$imap>;
  }while($responseLine && $responseLine !~/^s /);
  
  print $imap "x UNSELECT\015\012";
  do {
    $responseLine = <$imap>;
  }while($responseLine && $responseLine !~/^x /);
  if(!defined($responseLine)) {
    print "*** Can't select ~$account/$boxName: connection broken\n";
    exit(1);
  }elsif($responseLine !~ /^x OK/) {
    print "*** Can't select ~$account/$boxName: ". $responseLine."\n";
    return;
  }

}

sub reCreateDir {
  my ($dirName)=@_;
  
  if(-d $dirName) {
    my $dh;
    unless(opendir($dh,$dirName)) {
      print "*** Can't opendir '$dirName': $!\n";
      return;
    }  
    my @files = readdir($dh);
    closedir($dh);
    foreach(@files) {
      if (-f "$dirName/$_" && !unlink("$dirName/$_")) {
        print "*** can't delete '$dirName/$_': $!\n";
      }
    }
    return 1;
  } 
  unless(mkdir($dirName)) {
    print "*** can't mkdir $dirName: $!\n";
    return 0;
  }
  1;
}


sub ConvTime {
  my ($sec,$min,$hour,$mday,$month,$year)=('00','00','00','01','01','1980');
  my %mNames=qw(Jan 0 Feb 1 Mar 2 Apr 3 May 4 Jun 5
                Jul 6 Aug 7 Sep 8 Oct 9 Nov 10 Dec 11);

  if($_[0] =~ /(\w\w\w)\s(\d\d)\s(\d\d):(\d\d):(\d\d)\s(\d\d\d\d)/) { # Wed Oct 09 07:06:30 2002
    $month=$mNames{$1}+1;
    $month='0'.$month if(length("$month")==1);
    $mday=$2;
    $hour=$3;
    $min=$4;
    $sec=$5;
    $year=$6;
  } elsif($_[0] =~ /(\d\d)-(\d\d)-(\d\d\d\d).(\d\d):(\d\d):(\d\d)/) { # 08-03-2007_13:17:45_
    $mday=$1;
    $month=$2;
    $year=$3;
    $hour=$4;
    $min=$5;
    $sec=$6;
  }elsif($_[0] =~ /(\d{1,2}).(\w\w\w).(\d\d\d\d).(\d\d):(\d\d):(\d\d)/) {
    $mday=$1;
    $month=$mNames{$2};
    $year=$3-1900;
    $hour=$4;
    $min=$5;
    $sec=$6;
  } else {
    print "Unknown date format: $_[0]\n";
  }
  return "$year$month$mday$hour$min$sec";
  
}




__END__

