#!/usr/bin/perl -w
#
# Importing calendar and contacts files (*.ics *.vcf)
#
# The input files structure shouod be as follows:
# ./inp/
# ./inp/user@domain.dom/
# ./inp/user@domain.dom/file1.vcf
# ./inp/user@domain.dom/file2.vcf
# ./inp/user@domain.dom/file1.ics
# ./inp/user2@domain.dom/
# ...
#
# Revision: 27-Mar-2019
# Contact: <support@communigatepro.ru>

use strict;
use IO::Socket;
use LWP::UserAgent;
use Data::Dumper;

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

my $CGServerAddress='127.0.0.1';  # IP or domain name;
my $CGServerURL="http://$CGServerAddress:8100";  # WebMail URL
my $adminLogin='postmaster';
my $adminPassword='pass';


my $inputDir="exch-export";
my $completedDir="$inputDir-done";

my $debug=0;

#### end of the customizeable variables list

print "Starting\n";
  
opendir(DIR,"$inputDir") || die "can't opendir '$inputDir': $!";
my @userDirs = readdir(DIR);
closedir DIR;

unless(-d $completedDir) {
  mkdir($completedDir) || die "can't create '$completedDir': $!";
}

my $sessionID;
my $ximss=XIMSS_Connect($CGServerAddress,11024);
XIMSS_command($ximss, qq{<login id="A01" authData="$adminLogin" password="$adminPassword"/>} );
my @data=XIMSS_read($ximss);
  foreach(@data) {
    if(/urlID=\"(.*?)\"/) {#"
      $sessionID=$1;
      last;
    }
    if(/errorText=\"(.*?)\"/) {#"
      print "Error logging in for $adminLogin: $1\n";
      XIMSS_Disconnect($ximss);
      exit(1);
    }
  }
#print "sessionID=$sessionID\n";

my $userCnt=0;
foreach(sort @userDirs) {
  next if(/^\./);
  my $fname=$_;
  unless($fname=~/\@/) {
    print "strange name: '$fname'\n";
    next;
  }
  if(processAccount($fname)==0) {
    rename("$inputDir/$fname/","$completedDir/$fname/") || print "error renaming '$inputDir/$fname/': $!\n";
    $userCnt++;
  }  
}


XIMSS_command($ximss, qq{<bye id="A06"/>});
XIMSS_read($ximss);
XIMSS_Disconnect($ximss);

print "Done, $userCnt user(s) imported.\n";
exit(0);

sub processAccount {
  my($account)=@_;

  XIMSS_command($ximss, qq{<folderOpen id="A04" folder="cont" mailbox="~$account/\$Contacts\$" mailboxClass="IPF.Contact" sortField="INTERNALDATE"/>} );
  @data=XIMSS_read($ximss);
  foreach(@data) {
    if(/errorText=\"(.*?)\"/) {#"
      print "Error opening contacts for $account: $1\n";
      XIMSS_command($ximss, qq{<calendarClose id="A05" calendar="ccc"/>});
      XIMSS_read($ximss);
      return -1;
    }
  }

  XIMSS_command($ximss, qq{<mailboxCreate id="A02" mailbox="~$account/\$Calendar\$" mailboxClass="IPF.Appointment"/>} );
  @data=XIMSS_read($ximss);

  XIMSS_command($ximss, qq{<calendarOpen id="A03" calendar="ccc" mailbox="~$account/\$Calendar\$"/>});
  @data=XIMSS_read($ximss);
  foreach(@data) {
    if(/errorText=\"(.*?)\"/) {#"
      print "Error opening calendar for $account: $1\n";
      return -1;
    }
  }


  opendir(DIR,"$inputDir/$account") || die "can't opendir '$inputDir/$account': $!";
  my @files = readdir(DIR);
  closedir DIR;
  
  my $retCode=0;
  
  foreach(@files) {
    next if(/^\./);
    my $fname=$_;
    if($fname=~/.vcf$/i) {
      $retCode=importContact($account,$fname);
    } elsif($fname=~/.ics$/i) {
      $retCode=importCalendar($account,$fname);
    } else {
      print "strange name: '$inputDir/$account/$fname'\n";
      next;
    }
    last if($retCode);
  }

  XIMSS_command($ximss, qq{<calendarClose id="A05" calendar="ccc"/>});
  XIMSS_read($ximss);
  
  XIMSS_command($ximss, qq{<folderClose id="A05" folder="cont"/>});
  XIMSS_read($ximss);
  
  print "$account imported\n" unless($retCode);
  return $retCode;
}

sub importCalendar {
  my ($account,$fname)=@_;
  unless(open(FILE,"$inputDir/$account/$fname")) {
    print "can't open $inputDir/$account/$fname: $!\n";
    return -1;
  } 
  my $inpData;
  while(<FILE>) {
    #chomp;
    #$calData.="$_\015\012";
    $inpData.=$_;
  }  
  close(FILE); 
  
  my $ua = LWP::UserAgent->new;
  my $url="$CGServerURL/Session/$sessionID/UPLOAD/calData";
  my $response = $ua->put( $url, Content => $inpData );
  unless($response->is_success) {
    print "Can't upload $account/$fname:".$response->status_line."\n";
    return -1;
  }
  XIMSS_command($ximss, qq{<calendarImport id="CalInp" calendar="ccc" uploadID="calData"/>});
  @data=XIMSS_read($ximss);
  foreach(@data) {
    if(/errorText=\"(.*?)\"/) {#"
      print "Error importing $account/$fname: $1\n";
      return -1;
    }
  }
  0;
}

sub importContact {
  my ($account,$fname)=@_;
  unless(open(FILE,"$inputDir/$account/$fname")) {
    print "can't open $inputDir/$account/$fname: $!\n";
    return -1;
  } 
  my $inpData;
  while(<FILE>) {
    #chomp;
    #$calData.="$_\015\012";
    $inpData.=$_;
  }  
  close(FILE); 
  
  my $ua = LWP::UserAgent->new;
  my $url="$CGServerURL/Session/$sessionID/UPLOAD/contData";
  my $response = $ua->put( $url, Content => $inpData );
  unless($response->is_success) {
    print "Can't upload $account/$fname:".$response->status_line."\n";
    return -1;
  }
  XIMSS_command($ximss, qq{<contactsImport id="ContInp" folder="cont" uploadID="contData"/>});
  @data=XIMSS_read($ximss);
  foreach(@data) {
    if(/errorText=\"(.*?)\"/) {#"
      print "Error importing $account/$fname: $1\n";
      return -1;
    }
  }
  0;
}

#### subroutines ####################################

sub XIMSS_Connect {
  my ($address,$port)=@_;
  $port=11024 unless($port);
  
  my $sock;
  unless($sock = IO::Socket::INET->new(PeerAddr => $address,
                                         PeerPort => $port,
                                         Proto => 'tcp')) {
    die "unable to create socket: ". $IO::Socket::INET::errstr . "\n";
  }
  #binmode $sock;
  $sock->autoflush(1);

  $sock;
}

sub XIMSS_Disconnect {
  my ($ximss)=@_;
  $ximss->close();
}

sub XIMSS_command {
  my ($ximss,$command)=@_;
  print "s: $command\n" if($debug);
  $ximss->print($command ."\0");
}

sub XIMSS_read {
  my ($ximss)=@_;
  my @resp;
  while(my $line = XIMSS_readLine($ximss)) {
    print "r: $line\n" if($debug);
    push(@resp,$line);
    if($line =~ /^<response id=/ ) { 
      last;
    }
  }
  @resp;
}

sub XIMSS_readLine {
  my ($ximss)=@_;
  my $ln='';
  for(;;) {
    my $ch;
    $ximss->recv($ch,1,0);
    last if($ch eq "\0");
    $ln.=$ch;
  }
  return $ln;
}

__END__

