#!C:\perl\bin -w -I./t
# PROGRAM modul : EDIREX3.pm  
# auther : LPO , M&F Hlinsko, Palackeho 1295, f.o. 
# GNU : garante jusqu a non changee  file.
# L'Original est depose chez auther
# Date de commence de creation  : 21.11.2002
# La dernier change             : 14.07.2003
#***************************************************
#################################
#################################  
#     PRE SENT data
#################################
#*********************************************************
#          
#         Sending files using EDIREX
#
sub pre_send_edi
{
    &getdatum;  
    chdir "$param{'edirex_outbound'}";
    @bestanden =();
    $outscr =0;
    if ($param{'edirex_edi_type'} eq "B") { &NactiDleWildC; }    #Puvodne: { @bestanden =<*.*>; }
    else { @bestanden =<*.edi>; }        
    if ($#bestanden > -1) {
      $outscr=1;
      foreach (@bestanden) {
        if( -d $_ ) { next };
        if( $_ =~ / / ) {
          $Chyba="Jmeno odesilaneho souboru $_ obsahuje mezery - neodesilam! Prejmenujte soubor!";
          &Hlaska("! $Chyba");
          &sli_alert;
          next;
        }
        $vstup=$_; 
        if ($param{'edirex_edi_type'} eq "E") { &rozdel; }
        elsif ($param{'edirex_edi_type'} eq "A") { &rozdelA; }
        else {
          if (defined ($param{'UnikatniJmena'}) && ($param{'UnikatniJmena'}==1)) {
            &getdatum;
            my $PomJmeno=&VyrobUnikatniJmeno($_);
            rename ("$param{'edirex_outbound'}/$_","$param{'edirex_out_dir'}/$PomJmeno");
          } else {
            if( ! -e "$param{'edirex_out_dir'}/$_" ) { 
              &Hlaska("--- Kopiruji $param{'edirex_outbound'}/$_ do $param{'edirex_out_dir'}");
              copy ("$param{'edirex_outbound'}/$_","$param{'edirex_out_dir'}/$_");
            } else {
              &Hlaska(" --- ChcikKopirovat $param{'edirex_outbound'}/$_ do $param{'edirex_out_dir'} ale soubor uz v $param{'edirex_out_dir'} existuje!");
            }
          }
          if ($param{'edirex_biolit'} >= 1) {
            print AUDIT "$datum - File : $_ is BINARY  -> moved to OUT without control  \n"; 
          };
        };
      };# end of each
    };# end of if bestanden  
  #********************************************
  # Zpracovano OUTBOUND, jdu do OUT
  #********************************************
  $outscr=0;
  if ($param{'edirex_biolit'} >= 1) {
    &Hlaska("- PreSending - seeking for edi in: $param{'edirex_out_dir'}");
  };
  chdir "$param{'edirex_out_dir'}";
  @bestanden =();
  @bestanden =<*>;
  if ($#bestanden > -1) {
    foreach (@bestanden) {
      if( -d $_ ) { next };
      #if($recipient ne "") { &Hlaska("$AnalyzaEDI"); }
      if($param{'edirex_edi_type'} ne "B"){
        $AnalyzaEDI=&AnalEDI($_);
        if(($recipient eq "") and (! $JeToControl)) {
          $Chyba="001 - Naplatne EDI file ";
          $vyklad="pokus o odeslani no edi file ";
          &waruj_na_doline;
          rename ("$param{'edirex_out_dir'}/$_","$EDIREX_HOME/error/$_");
          &Hlaska("File: $_ neni typ EDI! -> presunuto do ERROR!");
          next;
        }
      }
      $outscr =1;
      if($param{'edirex_biolit'} >= 1) { &Hlaska("File k odeslani $_"); }
    } # foreach pro kazdy co nasel
  } else {
    if($param{'edirex_biolit'} >= 1) { &Hlaska("EDIREX found no files to send"); }
  }# else  bestanden ander leoesung 
  if($param{'edirex_biolit'} >= 1) { &Hlaska("- PreSending EDIREX process finished"); };   
}
# Konec sub pre_send_edi

#################################
sub NactiDleWildC{
my @polepripon;
my @pompole=();

  if(defined ($param{'Wildcards'})) {
    $param{'Wildcards'}=~s/ //g;  # zrus vsechny mezery
  } else {
    $param{'Wildcards'}="";
  }
  if($param{'Wildcards'} eq "") { $param{'Wildcards'}="*.*"; }
  @polepripon=split(',',$param{'Wildcards'});
  foreach $soub (<@polepripon>) {
    if( -d $soub ) { next };
    push @pompole, $soub;
  }
  undef %saw;
  @bestanden = grep(!$saw{$_}++, @pompole);
}

#*******************************************

sub AnalEDI()
{
  my($Soub01)=@_;
  my $VystupStr="";

         $recipient ="";
          $sender ="";
          $pass ="";
          $aprf ="";
          $snrf="";
        open(DATA, "<$Soub01") or die "Cannot open interchange file $Soub01 : $!,";
        local( *D ) = *DATA;
        my($c9,$c10);
        my($data) = "";

        seek(D,0,0);   # rewind file
        read(D, $data, 300);
        if( $data =~ /^TLDNDELIV/ ) {
          $JeToControl=1;
        } else {
          $JeToControl=0;
        }   
      ($colon, $plus, $query, $quote)=(":", "+", "?", "'");
      $UNA=$header=$lterm="";
      $isEDIFACT=0;

 if( $data =~ /^UNA/ ) {
   $colon  = substr($data,3,1);
   $plus   = substr($data,4,1);
   $query  = substr($data,6,1);  $query="" if $query eq " ";
   $quote  = substr($data,8,1);
   $c9     = substr($data,9,1);
   $c10    = substr($data,10,1);
   $lterm  = $quote;
   $lterm .= $c9  if $c9  lt " ";
   $lterm .= $c10 if $c10 lt " ";
   $UNA = substr($data, 0, 9 );
   $data= substr($data, 8+length($lterm) );
 } # if una


  if( $data =~ m/(^UNB.*?[^$query][$quote])/g )
   {
   $header = substr($1, 0, length($1)-1 );
    (@unbrecord) = split(/\+/,$header);
    ($sender, $fill) = split(/\:/,$unbrecord[2]);
    ($recipient, $fill) = split(/\:/,$unbrecord[3]);
    if (defined ($unbrecord[5])) { $snrf = $unbrecord[5]; }
    if (defined ($unbrecord[6])) { $pass = $unbrecord[6]; }
    if (defined ($unbrecord[7])) { $aprf = $unbrecord[7]; }
    if($recipient ne "") { $VystupStr="SENDER: $sender RECIPIENT: $recipient PASS: $pass APRF: $aprf SNRF: $snrf"; }
   }                 # if unb

  
 if( $data =~ m/(^ISA(.*)\~G)/g )             
   { $header = substr($1, 0, length($1)-1 );
     
    (@unbrecord) = split(/\*/,$header);          

    ($sender) = $unbrecord[6];
    ($recipient) = $unbrecord[8];
    $snrf = $unbrecord[13];
    $pass = $unbrecord[4];
    $aprf = $unbrecord[2];
    $VystupStr="";
    #if($recipient ne "") { $VystupStr="$sender,$recipient"; }
 } # if isa

  if( $data =~ m/(UNH.*?[^$query][$quote])/g ){
    $header = substr($1, 0, length($1)-1 );
    (@unbrecord) = split(/\+/,$header);
    ($ftypzpr) = split(/\:/,$unbrecord[2]);
  }
  if($recipient ne "") { $VystupStr="SENDER: $sender RECIPIENT: $recipient PASS: $pass APRF: $aprf SNRF: $snrf TypZpr: $ftypzpr"; }

   $data="";
   close DATA;
   return($VystupStr);
}
# Konec sub AnalEDI($Soub01)

#*******************************************
sub VyrobUnikatniJmeno() {

  my ($jmeno)=@_;
  if(-1!=(my $i=index $jmeno,'.')) {
    return(substr($jmeno,0,$i) . $cas . substr($jmeno,$i));
  } else {
    return("$jmeno$cas");
  }
}

#*******************************************
sub ZapisLastConn{
  open(PRIZN, ">$param{'EdirexLastConn'}/EdirexLastConn.txt");
  print(PRIZN "EDIREX se naposled uspesne pripojil v: $datum");
  close(PRIZN);
}

#*******************************************
sub ZapisLastDownload{
  open(PRIZN, ">$param{'EdirexLastConn'}/EdirexLastDownload.txt");
  print(PRIZN "EDIREX stahl posledni soubor v: $datum");
  close(PRIZN);
}

#*******************************************
sub open_server{
$edirex_adr='';

  if (!defined ($param{'NumRetryConn'}))   { $param{'NumRetryConn'}=0; }
  if (!defined ($param{'DelayRetryConn'})) { $param{'DelayRetryConn'}=3; }

  while(1) {
    if (defined ($param{'edirex_srv1'})) {
      $edirex_adr=$param{'edirex_srv1'};
      &open_server2;
    }
    if(!$auth){
      if (defined ($param{'edirex_srv2'})) {
        $edirex_adr=$param{'edirex_srv2'};  # Zkus na dalsi adresu
        &open_server2;
      }
    }
    if($auth or !$param{'NumRetryConn'}) { last; }
    if($param{'NumRetryConn'} > 4)     { $PomHl="Zbyva $param{'NumRetryConn'} pokusu."; }
    elsif($param{'NumRetryConn'} > 1)  { $PomHl="Zbyvaji $param{'NumRetryConn'} pokusy."; }
    elsif($param{'NumRetryConn'} == 1) { $PomHl="Zbyva $param{'NumRetryConn'} pokus."; }
    &Hlaska(" Cekam $param{'DelayRetryConn'} min na dalsi pokus. $PomHl");
    sleep($param{'DelayRetryConn'} * 60);
    $param{'NumRetryConn'}--;
  }
  if(!$auth){
    if(!$dosazeno){
      $Chyba = "Nepodarilo se pripojit na server." ;
    } else {
      $Chyba = "Neuspesna autorizace na serveru.";
    }
    &error_log;     
    $retok=0;      
  } else {
    &Hlaska("-- Spojeni je uspesne navazano.");
    syswrite (WRITE,"type b \n\n");
    &VyctiVystup("binary");
    $retok=1;
    &ZapisLastConn();
  }
}

#*******************************************

sub open_server2
{
$dosazeno=0;
$auth=0;
  &getdatum;
  my $prenos="edirexstck.dll";
  ##my $parametr1="-o IdentityFile=$EDIREX_HOME/$param{'privatni_klic'}";
  my $parametr1="-keypairFile=$EDIREX_HOME/$param{'privatni_klic'}";
  my $HostKeyPar="-hostKeyMD5=$param{'HostKey'}";
  my $userip = "$param{'edirex_user'}\@$edirex_adr";
  &Hlaska("- Oteviram spojeni pro $userip ...");
  if( defined ($param{'proxy'}) and ( $param{'proxy'} eq 'y')) {
    $proxyType=$param{'proxyType'};
    $proxyServer=$param{'proxyServer'};
    $proxyPort=$param{'proxyPort'};
    $proxyUsername=$param{'proxyUsername'};
    $proxyPassword=$param{'proxyPassword'};
    $ftp = open3( 'WRITE','READ','ERROR', $prenos, $parametr1,"-unat=y","-noRegistry","-proxy=y","-proxyType=$proxyType","-proxyServer=$proxyServer","-proxyPort=$proxyPort","-proxyUsername=$proxyUsername","-proxyPassword=$proxyPassword",$HostKeyPar,$userip);
  } else {
    $ftp = open3( 'WRITE','READ','ERROR', $prenos, $parametr1,"-unat=y","-noRegistry",$HostKeyPar,$userip);
  }
  if ( $param{'edirex_biolit'} >= 1){ &Hlaska("- Sftp proces $ftp spusten."); }
  $retok=1;
  &vycti100;
  
  if(!$auth){
      if(!$dosazeno){ &Hlaska("-- Nepodarilo se pripojit na server $edirex_adr."); } 
      else          { &Hlaska("-- Spojeni s $edirex_adr bylo navazano, ale autorizace byla neuspesna."); }
    }
} # end of sub open_server2
#*******************************************
# SUB close_server
#*******************************************
sub close_server
{
my $delka;
my $vycteno="";
my $citac=0;
my $reaped_pid=0;
   &getdatum;
   &Hlaska("-- Uzaviram spojeni.");
   print WRITE "\nquit\n";
   sleep 1;
   kill 9,$ftp;
   #$reaped_pid = waitpid $ftp, 0;
   if ( $param{'edirex_biolit'} >= 1){ 
     while(($vycteno !~ /terminated/) and ($citac<10)) { $delka=sysread ( READ,$vycteno,80); print ( AUDIT "$delka:$vycteno" ); $citac++; }
     $citac=0;
     while(($reaped_pid ne -1) and ($citac<10)) { $reaped_pid = waitpid $ftp, 0; print(AUDIT "PID:$reaped_pid\n"); $citac++; } 
   }
   close(WRITE);
   close(READ);
   close(ERROR);
   $retok=1;
}# end of sub  close server
#*****************************************
sub error_log2($text){
  ($Chyba)=@_;
  &error_log;
}
#*********************************
#sub error log
#******************************
sub error_log{

  &Hlaska("! $Chyba");
  if ($param{'SendErrorPopup'} eq 1)  { &waruj_na_doline; }
  if ($param{'SendErrorEmail'} eq 1)  { &sli_alert; }
  open(ERRORLOG,">> $param{'edirex_log_dir'}/error.log");
  print(ERRORLOG "$datum $Chyba\n");
  close(ERRORLOG);
}
# end od sub error log
#****************************
# vycti100 - LOGIN/CONNECT
#****************************
sub vycti100
{ my $delka=80;
  my $vycteno="";
  print WRITE "\n";
  while (($vycteno ne "sftp> ") and ($delka > 0)){
    $delka = sysread ( READ,$vycteno,80);
    $vycteno=~s/\n//g;
    $vycteno=~s/\r//g;
    if ( $param{'edirex_biolit'} >= 2){
      print AUDIT "1. vycti $delka = |$vycteno|\n";
    };
    if($vycteno =~ /^Warning/) { print WRITE "\n"; }
    if($vycteno eq "Authentication completed.") { $auth=1; }
    if($vycteno eq "Connection established.") { $dosazeno=1; }
  };
  &getdatum;
### Presunuto do open_server
};

#****************************
#***    VyctiVystup  ******
#****************************
sub VyctiVystup($operace)
{ my $delka=80;
  my $vycteno="";
  my $vycteno2="";
  my ($operace)=@_;
  $retok=0;
  while (( $vycteno2 !~ /$operace/ ) and ($delka)){
    $delka = sysread ( READ,$vycteno,80);
    if ( $param{'edirex_biolit'} >= 2){
      print AUDIT "$operace.1 delka: $delka text: |$vycteno|\n";
    }
    $vycteno=~s/\n//g;
    $vycteno=~s/\r//g;    
    $vycteno2=$vycteno2.$vycteno;
  }
  $vycteno="";
  $vycteno2="";
  $delka=80;
  while (($vycteno2 !~ /sftp>/) and ($delka)){
    $delka = sysread ( READ,$vycteno,80);
    if ( $param{'edirex_biolit'} >= 2){
      print AUDIT "$operace.2 delka : $delka text : |$vycteno|\n";
    };
    $vycteno=~s/\n//g;
    $vycteno=~s/\r//g;    
    $vycteno2=$vycteno2.$vycteno;
    if($vycteno2 =~ /\<OK\>/) { $retok=1; }
  };
};# end of VyctiVystup
#***********************************

#***********************************
# SUB envoye edi mess ne lire packo ce ca 
#*********************************** 
sub exec_send
{ 
my $retok2=1;
  &getdatum;
  chdir "$param{'edirex_out_dir'}";
  @bestanden =();
  @bestanden =<*>;
  if ($#bestanden > -1){
    $retok=1;
    foreach $vstup (@bestanden){
      if( -d $vstup ) { next };
      &put_file("in/temp/$vstup");
      if ($retok != 1) {
        if ($param{'StopOnOutError'} == 1 ) { return; }
        $retok2=0;
        next;
      }
      &move_file;
      if ($retok != 1) {
        if ($param{'StopOnOutError'} == 1 ) { return; }
        $retok2=0;
        next;
      }
      &LogujSoubor("out",$vstup);
      if(copy ("$param{'edirex_out_dir'}/$vstup","$param{'edirex_outarchiv'}/$vstup")){
        if(!unlink("$param{'edirex_out_dir'}/$vstup")) {
            $Chyba="! Nemohu smazat $param{'edirex_out_dir'}/$vstup !!";
            &error_log;
            $retok2=0;
        }
        if( -e "$param{'edirex_outbound'}/$vstup" ) {
          if(!unlink("$param{'edirex_outbound'}/$vstup")) {
            $Chyba="! Nemohu smazat $param{'edirex_outbound'}/$vstup !!";
            &error_log;
            $retok2=0;
          }
        }
      } else {
        $Chyba="! Nemohl jsem presunout $vstup do $param{'edirex_outarchiv'} !!";
        if( !-d "$param{'edirex_out_dir'}/sent" )  { mkdir("$param{'edirex_out_dir'}/sent"); }
        rename("$param{'edirex_out_dir'}/$vstup","$param{'edirex_out_dir'}/sent/$vstup"); # Zkus odlozit soubor z tmp out, aby se znovu neodesilal
        &error_log;
        $retok2=0;
      }
    }; # for each
  };# if bestanden
  if( $retok2==1 ) {
    &Hlaska("-- ODESLANI VSECH DAT PROBEHLO USPESNE.");
  } else {
    &Hlaska("!!! PRI ODESILANI DAT SE VYSKYTLY CHYBY!!");
  }
  &PresunSentToArchive();
}
#
#*********************************

sub PresunSentToArchive(){
my $file;

  if( !-d "$param{'edirex_out_dir'}/sent" ) { return; }
  chdir("$param{'edirex_out_dir'}/sent");
  foreach $file (<*>) {
    if( -d $file ) { next };
    &Hlaska("Presunuti souboru $file ze /sent do Outarchiv - OK.");
    if(copy ($file,"$param{'edirex_outarchiv'}/$file")) {
      &Hlaska("Presunuti souboru $file ze /sent do $param{'edirex_outarchiv'} - OK.");
      unlink($file);
    } else {
      &Hlaska("Presunuti souboru $file ze /sent do $param{'edirex_outarchiv'} - Nejde!.");
    }
  } 
}

#*******************************************
# SUB put_file to  VANCCF
#################################  
sub put_file()
{
  my $ret;
  my ($rem_cesta_jm)=@_;
  my $pomcesta=$param{'edirex_out_dir'};
  $pomcesta=~s/\\/\//g;
  &getdatum;
  print AUDIT "* $datum <<<< ODESILAM $vstup ... ";		# Zde nepouzivat &Hlaska!!!
  print       "* $datum <<<< ODESILAM $vstup ... ";
  $ret= syswrite (WRITE,"put \"$pomcesta/$vstup\" $rem_cesta_jm \n\n");
  ##$ret= syswrite (WRITE,"200\n");;
  &VyctiVystup("put");
  if($retok ne 1) {
    if(!((defined ($param{'Zakaz_mazani_in_temp'})) and ($param{'Zakaz_mazani_in_temp'} eq 1 ))){
      print AUDIT "mazu tmp ... ";
      print       "mazu tmp ... ";
      $ret= syswrite (WRITE,"rm $rem_cesta_jm \n\n");   # Zkus vymazat soubor v temp pri mozne kolizi
      &VyctiVystup("removing");
      $ret= syswrite (WRITE,"put \"$pomcesta/$vstup\" $rem_cesta_jm \n\n");
      &VyctiVystup("put");
    }
    if($retok ne 1) {
      print AUDIT "ERROR\n";		# Zde nepouzivat &Hlaska!!!
      print       "ERROR\n";
      $Chyba = "ERROR 200 -- Chyba pri SSH presunu souboru $vstup do schranky, mozna kolize se souborem v in/temp." ;
      &error_log;
    }
  }
}# fine de  put_file
#
#################################  
sub move_file
{   
  &getdatum;
  if ( $param{'edirex_biolit'} >= 1){
    print AUDIT "OK\n* $datum - REMOTE MOVE $vstup on CCF...";		# Zde nepouzivat &Hlaska!!!
    print       "OK\n* $datum - REMOTE MOVE $vstup on CCF...";
  }    
  $ret= syswrite (WRITE,"chmod 0777 in/temp/$vstup\n");
  $ret= syswrite (WRITE,"rename in/temp/$vstup in/$vstup \n\n");
  ##$ret= syswrite (WRITE,"300 \n");;
  &VyctiVystup("rename");
  if ($retok eq 1){
    print AUDIT "OK\n";		# Zde nepouzivat &Hlaska!!!
    print       "OK\n";
  } else {
    print AUDIT "ERROR\n";		# Zde nepouzivat &Hlaska!!!
    print       "ERROR\n";
    $Chyba = "ERROR 300 - Chyba pri SSH remote move odeslaneho souboru.";
    &error_log;    
  }
}# fine de  move_file
#*******************************************

#**************  end of subroutines ***************** 
1;

