#!/usr/bin/perl -w
#
# This Perl script creates an tab-delimited text file(s) based on the
# information in the Post.Office account database. The tab-delimited
# file can be used to create accounts on your new CommuniGate Pro
# server, using its Account Import feature. 
# <http://www.stalker.com/CommuniGatePro/Accounts.html#Loader>
#
# The script should be used on the same computer where the Post.Office
# software is installed (the Post.Office is not required to be running) 
# See <http://www.stalker.com/CGMigration/CGPostOffice.html>
#
# Instructions:
# 1. Save the script into the directory where Post.Office "listacct"
#    utility is located (e.g. C:\win32app\Post.Office\cmdutils\ or
#    /usr/local/post.office/cmdutils/).
# 2. Launch the script (e.g. "perl PostOfficeToCGP.pl"). For each of your
#    PostOffice domains the "accounts-domain.name" and
#    "forwarders-domain.name" files will appear in the current directory.
# 3. Use the CommuniGate Pro Account Import feature to create all accounts
#    on your new server from the "accounts-domain.name" files. 
#
# 4. Use "ImportForwarders.pl" script from <http://www.stalker.com/CGPerl/>
#    to import forwarders from the "forwarders-domain.name" files.
#     
#     
# Mail your comments and suggestions to <support@stalker.com>
#

if($^O eq 'MSWin32') {

  $execList = "listacct.exe";
  $execAccnt = "getacct.exe";

  $inputFileName = "listaccnt.tmp";

  $accountsPrefix = "accounts-";
  $forwardersPrefix = "forwarders-"

} else {

  $execList = "./listacct";
  $execAccnt = "./getacct";

  $inputFileName = "/tmp/listaccnt.tmp";

  $accountsPrefix = "accounts-";
  $forwardersPrefix = "forwarders-"
}

sub PutAddresses($$$$);
sub PutRules($$$$$);

my %accDomainList;
my %fwdDomainList;

print "Starting\n";

my $execStr="$execList -i Account-ID,Name,SMTP-Address,POP-Address,Password,Mailbox-Quota,Local-Delivery,Handler-Delivery,Forward-Delivery >$inputFileName";
print "Launching $execList, please wait...\n";

system($execStr)==0 or die "Can't execute $execStr\n" ; 

die "Can't find $inputFileName\n" unless -e $inputFileName;

print "Importing accounts and forwarders...\n";
open INFILE, "< $inputFileName" or die "Can't open $inputFileName: $!\n";

while(<INFILE>) {
  chomp;
  my ($id,$realName,$addresses,$popAddr,$password,$quota,$lDelivery,$hDelivery,$fDelivery) = split /;/;
  if($lDelivery ne 'Mailbox' && $password eq '') {
    print "Not an importable account:\n$_\n\n";
  } else {
    $addresses =~ tr/A-Z/a-z/;
    $popAddr =~ tr/A-Z/a-z/;
    
    $addresses =~ /\@([\w\.\[\]\-]+)/g;
    my $domain=$1;
    if(defined $domain && $domain ne '') {
      unless(exists($accDomainList{$domain})) {
        print qq/Creating new accounts file for "$domain"\n/;
        open $domain,"> $accountsPrefix$domain" or die "Can't open $accountsPrefix$domain: $!\n";
        print $domain "Name\tRealName\tAliases\tUnixPassword\tStorage\tRules\n";
        $accDomainList{$domain} = 0;
      }
      PutAddresses($domain,$realName,$addresses,$popAddr);
      print $domain "{NS-MTA-MD5}$password\t";
      
      if($quota) { print $domain $quota."K";}
      print $domain "\t";
      
      PutRules($domain,$id,$lDelivery,$hDelivery,$fDelivery);   
      
      print $domain "\n";
      $accDomainList{$domain}++;
    }
  }
}

close INFILE;
unlink $inputFileName;


my $total=0;
foreach(keys %accDomainList) {$total+=$accDomainList{$_};}
print "\n-------- Accounts ($total total):\n"; 
foreach(keys %accDomainList) {
  close $_ or print "Can't close for $_: $!\n";
  print "$_ : $accDomainList{$_}\n";
}

$total=0;
foreach(keys %fwdDomainList) {$total+=$fwdDomainList{$_};}
if($total>0) {
  print "-------- Forwarders ($total total):\n"; 
  foreach(keys %fwdDomainList) {
    close "$_-Forwarders" or print "Can't close for $_-Forwarders: $!\n";
    print "$_ : $fwdDomainList{$_}\n";
  }
}
print '-' x 30 ."\n"; 

exit;



sub PutAddresses($$$$) {
  my ($domain,$realName,$addresses,$popAddr) = @_;
  my %addrList;
  my @tmpList=split /,/,$addresses;

  $tmpList[0] =~/^(.+)\@/;

  my $accountName=$1;
  
  if($accountName =~ /(?![a-z0-9_.\-])+/) {
    print qq/Illegal account name: "$accountName"/;
    $accountName =~ tr/[a-z0-9_.\-]/_/c;
    print qq/, converted into "$accountName"\n/;
  }

  $addrList{$accountName}=$accountName;
  shift @tmpList;

  print $domain "$accountName\t$realName\t";

  push @tmpList,$popAddr;

  foreach(@tmpList) {
    my $xAlias=$_;
    my $xDomain=$domain;
    
    if($xAlias =~ /^(.+)\@(.+)/) {
      $xAlias =$1; $xDomain=$2;  
    }
    if($xAlias =~ /(?![a-z0-9_.\-])+/) {
      print qq/Illegal alias or forwarder name: "$xAlias\@$xDomain", ommited\n/;
      next;
    }     
    if($xDomain ne $domain) {
      my $fwdFile = $xDomain."-Forwarders";
      unless(exists($fwdDomainList{$xDomain})) {
        print qq/Creating new forwarders file for "$xDomain"\n/;
        open $fwdFile,"> $forwardersPrefix$xDomain" or die "Can't open $forwardersPrefix$xDomain: $!\n";
        $fwdDomainList{$xDomain} = 0;
      }
      print $fwdFile "$xAlias\t$accountName\@$domain\n";
      $fwdDomainList{$xDomain}++;
    }
    if(exists($addrList{$xAlias})) {
      # print "duplicate address: $_\n";
    } else { 
      $addrList{$xAlias}=$xAlias;
    }    
  }

  delete($addrList{$accountName});  
  print $domain join(",",keys %addrList)."\t"; 
}

sub PutRules($$$$$) {
  my($domain,$id,$lDelivery,$hDelivery,$fDelivery) = @_;
  print $domain "(";
  if($fDelivery) {
    my @tmpList=split /,/,$fDelivery;
    print $domain "(1,\"#Redirect\",((\"Human Generated\", \"---\")), ((\"Redirect to\",\"";
    foreach(@tmpList) {
      s/SMTP|<|>| //g;
    }
    print $domain join(",",@tmpList);
    print $domain "\")";
    print $domain ",(Discard, \"---\")" if($lDelivery ne 'Mailbox');
    print $domain "))";
  }
  if($hDelivery eq 'AutoReply-Handler') {
    if(open(INP, "$execAccnt $id - |")!=0) {
      my $replyStr="";
      readReply:while(<INP>) {
      chomp;
      if(/^AutoReply-Info: \[(.*)\]/) {
        $replyStr.=$1."\n";
        while(<INP>) {
          if(/^\s*\[(.*)\]/) {
            $replyStr.=$1."\n";
          } else {            
            last readReply;
          }
        }
      }
    }       
    close(INP);
    $replyStr =~ s/\\/\\\\/g;
    $replyStr =~ s/\"/\\\"/g;
    $replyStr =~ s/\n/\\e/g;
      print $domain "," if($fDelivery);
      print $domain "(1,\"#Vacation\",((\"Human Generated\", \"---\")),((\"Reply with\", \"$replyStr\")))";
    } else {
      print "unable to execute: $execAccnt $id\n";
    }
  } 
  print $domain ")"; 
}