#!/usr/local/bin/perl
# 
# $Header: emdb/sysman/admin/scripts/db/ob/ob_common.pl /stpl_db_11.2.0.1.0_gen/1 2009/09/21 11:54:59 pfgavin Exp $
#
# ob_common.pl
# 
# Copyright (c) 2002, 2009, Oracle and/or its affiliates. All rights reserved. 
#
#    NAME
#      ob_common.pl - Perl script for Oracle Backup remote operations.
#
#    DESCRIPTION
#      Remote execution routines for Oracle Backup.
#
#    NOTES
#      <other useful comments, qualifications, etc.>
#
#    MODIFIED   (MM/DD/YY)
#    pfgavin      09/17/09 - XbranchMerge pfgavin_hpux-lrgfix-4050441 from
#                            st_emdbgc_10.2.0.1.0
#    pfgavin      07/27/09 - fix 4050441
#    pfgavin      02/12/09 - bug 8246626
#    pfgavin      05/05/08 - warning as part of data causing collection error
#    swbalasu     10/30/07 - Creation
# 

use FileHandle;
use utf8;
use IPC::Open2;
use Text::ParseWords;
use POSIX "sys_wait_h";
use vars qw/ $OS $NT $S $TEMP $CP $MV $PS $DF $DELIMITER /;

require "$ENV{EMDROOT}/sysman/admin/scripts/db/db_common.pl";

use strict;

use vars qw/ $sd_password $ob_command $ob_result $ob_username $ob_password
             $results $pid $poll_command $trans_command $rbug
             $fpoll $jstate $frest $tmprb $rbtmpfile $bkp_rst_command
             $INSTALL_HOME $OBTOOL $ADMIN_HOST
         /;

#
# OBset_ob_env()
#
# If the perl script is run in an ade environment then
# look for the env script in the temp dir. This script fille
# will set the nessessary environment variables to access
# the ob administrative domain running in a view.
#
sub OBset_ob_env
{
  EMD_PERL_DEBUG("ob_common.OBset_ob_env(): start");
  open rbtmpfile or die "Can't find $rbtmpfile\n";
  while (<rbtmpfile>)
  {
    my $xtra;
    my $varname;
    my $varvalue;
    ($xtra, $varname, $varvalue) = split / /;
    if ($NT)
    {
      substr($varvalue, -1)   = "";
    }
    else
    {
      substr($varvalue, 0, 1) = "";
      substr($varvalue, -2)   = "";
    }
    $ENV{$varname} = $varvalue;
    if (rindex($varname, "OBCONFIG") != -1)
    {
      my $ldpath;
      my $ldconfig;
      ($ldpath, $ldconfig) = split /oracle/, $varvalue;
      $ENV{'LD_LIBRARY_PATH'} = "$ENV{'LD_LIBRARY_PATH'}:$ldpath/oracle/reliaty/lib";
      EMD_PERL_DEBUG("ob_o.OBset_ob_env(): path: $ENV{'LD_LIBRARY_PATH'}");
    }
  }
  EMD_PERL_DEBUG("ob_common.OBset_ob_env(): end");
}

sub ltrim($)
{
  my $string = shift;
  $string =~ s/^\s+//;
  return $string;
}

#
# OBset_sh_lib_path
#
# fix for lrg 4050441. Set the shlib path for *uix OSB shiphomes.
#
sub OBset_sh_lib_path
{
  my $obconfig = "/etc/obconfig";
  open obconfigpath, $obconfig or die "Can't find $obconfig: $!";
  while (<obconfigpath>)
  {
     my $varname;
     my $varvalue;
    ($varname, $varvalue) = split /:/;
    if (rindex($varname, "ob dir") != -1)
    {
      chomp($varvalue);
      $varvalue = ltrim($varvalue);
      $ENV{'LD_LIBRARY_PATH'} = "$ENV{'LD_LIBRARY_PATH'}:$varvalue/lib";
      EMD_PERL_DEBUG("ob_o.OBset_sh_lib_path(): 4:  ($ENV{'LD_LIBRARY_PATH'})");
     }
   }
   EMD_PERL_DEBUG("ob_o.OBset_sh_lib_path(): end");
}

#
# runOb
#
# Run Oracle Backup CLI and pass output backup up to the OMS.
# 
sub OBrunOb()
{
  EMD_PERL_DEBUG("ob.runOb(): start");
  $? = 0;
  local $SIG{PIPE};
  local $SIG{CHLD};
  if (!$NT)
  {
      # Ignore PIPE signal which might be invoked by "print OB_WRITER .. "
      # If we don't catch it the signal will terminate the script
      $SIG{PIPE} = sub { 
      };
      
      my $obExit = 0;
        
      # Reaper to collect ob exit status
      $SIG{CHLD} = sub { 
        if (waitpid($pid, WNOHANG))
        {
           my $ob_result = $?;
           $obExit = 1;
        }
      };  
  }
  my $rbpath;
  my $other;
  my $ack;
  my $rblocal;

  # Check for obtool in the ob_command string.
  ($rbpath, $other) = split /obtool/, $ob_command;

  EMD_PERL_DEBUG("ob.runOb(): obpath: $rbpath");

  # Check for .local.bin.
  ($rblocal, $ack) = split /bin/, $ob_command;
  chop $rblocal;
  if (-e "$rblocal/.bin.local/obtool")
  {
    ($rbpath, $other) = split /obtool/, $ob_command;
    $ob_command = "$rblocal/.bin.local/obtool $other";
  }
  else
  {
    if (!-e "$rbpath/obtool" && !-e "$rbpath/obtool.exe")
    {
      die "ob_common.OBrunOb(): No obtool found:($ob_command): $rbpath [$rblocal/.bin.local/obtool]";
     # return -1;
    }
  }

  $tmprb = $ob_command;
  if ($NT)
  {
    $rbpath = join '\\', split /\//, $rbpath;
    my @leaves = split /\\/, $rbpath;
    $ob_command = "";
    my $f = 0;
    while (@leaves)
    {
      my $leaf = shift @leaves;
      if ($f == 0)
      {
        $ob_command = $leaf;
        $f = 1;
      }
      else
      {
        my $pos = -1;
        if (index($leaf, " ", $pos) > -1)
        {
          $ob_command = "$ob_command\\\"$leaf\"";
        }
        else
        {
          $ob_command = "$ob_command\\$leaf";
        }
      }
    }
    $ob_command = "$ob_command\\obtool.exe $other";
  }

  # Look for ADE env file.
  my $rest;
  ($rbtmpfile, $rest) = split /bin/, $tmprb;
  chop $rbtmpfile;
  $rbtmpfile = "$rbtmpfile/rbmapvars.sh";
  if (-e "$rbtmpfile")
  {
    OBset_ob_env();
  }
  else
  {
    if (!$NT)
    {
      OBset_sh_lib_path();
    }
  }

  EMD_PERL_DEBUG("ob_common.OBrunOb(): open2: command: $ob_command");
  $pid = open2(\*RDRFH, \*WRITER, "$ob_command 2>&1")
      || ((die "ob_common.OBrunOb: Unable to open the obtool process.<br>") && (return -1)); 
  # Turn on autoflush for pipe output
  my $old_fh = select(RDRFH);
  $| = 1;
  select($old_fh);

  if (!$NT)
  {  
      # set RDRFH non-blocking
      my $flags = '';
      fcntl(RDRFH, F_GETFL(), $flags)
          or die "Couldn't get flags for RDRFH : $!\n";
      $flags |= O_NONBLOCK();
      fcntl(RDRFH, F_SETFL(), $flags)
          or die "Couldn't set flags for RDRFH: $!\n";
  }  

  # Turn on autoflush for standard output
  $old_fh = select(STDOUT);
  $| = 1;
  select($old_fh);

  # Write the password to obtool
  print WRITER $ob_password;
  print WRITER "\n";

  if ($sd_password)
  {
    print WRITER $sd_password;
    if ($NT)
    {
        print WRITER "\n";
    }
  }

  close WRITER;
  
  my $MAX_OUT_SIZE = 7168; #7K
  my $cur_out_size = 0;
  my $timeout = 0;
  my $rin;
  my $rout;
  $rbug = "";
  $jstate = "";

  if (!$NT)
  {
      my $rin;
      # Construct the data structure for select call
      vec($rin, fileno(RDRFH), 1) = 1;
    
      my $bufSize = 100;
      my $fullBuf ="";
      my $buf;
      my $sysret;
      
      while (1)
      {
          # wait for reading event on RDRFH, or timeout after 5 seconds
          $a = select($rout=$rin, undef, undef, 5 );
        
          if ($a > 0 && vec($rout,fileno(RDRFH),1))
          {
              # There are something in RDRFH for read
              $sysret = sysread RDRFH, $buf, $bufSize;
            
              if (defined($sysret))
              {
                  if ($sysret == 0)
                  {
                      # RDRFH is closed by ob
                      last;
                  }
                  else
                  {
                      my $fullBuf .= $buf;
                      
                      $cur_out_size += length($buf);
                      $rbug .= $buf;
                  }
              }
          }
          else
          {
             # select() times out or detects an error
             if ($timeout > 60)
             {
                # ob has exited as detected by the reaper
              
                # we do a final non-blocking reading in case there are something 
                # in the pipe left by obtool
                while ($sysret = sysread RDRFH, $buf, $bufSize)
                {
                    $fullBuf .= $buf;

                    $cur_out_size += length($buf);
                    $rbug .= $buf;
                }    
    
                last;
             } 
             $timeout = $timeout + 5;
          } 
      }
  }
  else
  {
    # NT case
    my $fullBuf ="";
    my $buf; 
    my $sysret;

    do {
        $sysret = sysread RDRFH, $buf, 100;
        if (defined($sysret))
        {	
            $cur_out_size += length($buf);
            $rbug .= $buf;
            $fullBuf=$fullBuf.$buf;
        }    
        else
        {
            die "An error ocurred when reading from ob: $? $!\n";
            $ob_result = -1;
        }

    } while (defined($sysret) && $sysret != 0);
  
  }  
  # xun: close RDRFH after reading is done
  close RDRFH;

  if ($NT)
  {
     # On NT, there is no reaper to collect the exit status of obtool.
     # We'll do it here.
     my $wpid = waitpid $pid, 0;
     
     if ($wpid != -1)
     {
        $ob_result = $?;
     }   

     # if waitpid returns -1 (in which case it's a bug for perl), 
     # we'll have to parse the obtool output to determine whether 
     # the operation is successful or not

  }
      
  if ($ob_result != 0)
  {
    $ob_result = -1;
  }

  EMD_PERL_DEBUG("ob.runOb(): end");

 return $ob_result;
}

#
# checkErrorsAndWarnings, each OBrunOb updates the $rbug variable with the output/error
# so check the $rbug for different error strings. die/exit if errors are found
# if no errors, but warnings are found, print the warnings
#
sub checkErrorsAndWarnings
{
  my $isError = 0;
  if (rindex($rbug, "Error:") != -1  ||
      rindex($rbug, "obtool:") != -1 ||
      rindex($rbug, "Obtool:") != -1 ||
      rindex($rbug, "Obtar:") != -1  ||
      rindex($rbug, "obtar:") != -1 ||
      rindex($rbug, "Obtar.exe:") != -1 ||
      rindex($rbug, "obtar.exe:") != -1
     )

  {
    my $err;
    if (rindex($rbug, "Error:") > -1)
    {
      $err = "Error:";
    }
    elsif (rindex($rbug, "obtool:") > -1)
    {
      $err = "obtool:";
    }
    elsif (rindex($rbug, "Obtool:") > -1)
    {
      $err = "Obtool:";
    }
    elsif (rindex($rbug, "obtar:") > -1)
    {
      $err = "obtar:";
    }
   elsif (rindex($rbug, "obtar.exe:") > -1)
    {
      $err = "obtar.exe:";
    }
    elsif (rindex($rbug, "Obtar:") > -1)
    {
      $err = "Obtar:";
    }
    elsif (rindex($rbug, "Obtar.exe:") > -1)
    {
      $err = "Obtar.exe:";
    }

    my $lt;
    my $msg;
    ($lt, $msg) = split /$err/, $rbug;
    ($msg, $lt) = split /\n/, $msg;

    #die "$err:$msg";
    print "em_warning=$err:$msg";
    $isError = 1;
  }

  #now check for warnings

  #if (rindex($rbug, "Warning:") > -1)
  #{
  #  my $lt;
  #  my $msg;
  #  ($lt, $msg) = split /"Warning:"/, $rbug;
  #  ($msg, $lt) = split /\n/, $msg;
  #  print "em_warning=$msg";
  #}

  return $isError;
}

sub init()
{
  $INSTALL_HOME = "$ENV{INSTALL_HOME}";
  $OBTOOL = "$INSTALL_HOME/bin/obtool";
  $ADMIN_HOST = "$ENV{ADMIN_HOST}";
  my %stdinArgs = get_stdinvars();
  $ob_username = $stdinArgs{EM_TARGET_USERNAME} if $stdinArgs{EM_TARGET_USERNAME};
  $ob_password = $stdinArgs{EM_TARGET_PASSWORD} if $stdinArgs{EM_TARGET_PASSWORD};
}

# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
	my $string = shift;
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

#
# parseObOutput
# Input: obtool command output, which is a text stream 
# Output: A two dimensional array of rows of text, each row being a name value pair.
#
sub parseObOutput
{
  my @lines = &quotewords('\n', 0, $_[0]);
  my @varMatrix;
  my $line;
  foreach $line (@lines) {
      my @phrases = split(":",$line);
      my $name = "";
      my $value = "";;
      $name = trim($phrases[0]) if ($phrases[0]);
      $value = trim($phrases[1]) if ($phrases[1]);
      my @pair = ("$name","$value");
      push (@varMatrix,\@pair);
  }
  return @varMatrix;
}

$\="\n"; #output record separator