#!/usr/local/bin/perl
# 
# $Header: javavm/install/update_javavm_binaries.pl /main/20 2015/09/04 11:52:57 nneeluru Exp $
#
# update_javavm_binaries.pl
# 
# Copyright (c) 2008, 2015, Oracle and/or its affiliates. All rights reserved.
#
#    NAME
#      update_javavm_binaries.pl - Update JAVAVM JDK binaries 
#
#    DESCRIPTION
#
#      This script updates the binaries of JAVAVM to those of the given
#      JDK version. It is used in the development environment as well as
#      the customer environment. However, in the development environment, 
#      certain other things are to be done before this script is invoked, 
#      which are expected to be done by the script that invokes this script.
#
#    NOTES
#
#      Usage: perl update_javavm_binaries.pl {-install | -refresh | <version>}
#                                  [-dev] [-force] [-force_copy]
#              -install  - to be used in the invocation by the Installer
#                          to set up the default JDK specific files.
#              -refresh  - force switch to the current version.
#              <version> - the target version to which the user wants to move.
#
#      Example: perl update_javavm_binaries.pl 6
#      This updates the software (binaries) on OS file system, to version 6, 
#      if the current version is not 6.
#
#      There are two purposes for which this script can be called:
#      a) During install time, to setup the default version's binaries in place.
#
#      b) During JDK version switch by the user via EM DBControl (or Opatch) or
#         manually.
#
#      In a), this script is called with special argument '-install'.
#      In b), this script is called with a 'version' argument.
#
#    MODIFIED   (MM/DD/YY)
#    nneeluru    09/03/15 - Avoid doing certain steps when only one JDK exists
#                           as in 12.2.0.1
#    nneeluru    02/04/13 - Don't save oracle.exe during switch,
#                           but save once during install
#    nneeluru    07/16/12 - fix bug 14302259;
#                           force copy on Win.x64;
#                           exit, if oracle couldn't be saved;
#    nneeluru    06/29/12 - relativize symlinks to take care of cloning (bugfix
#                           14259589)
#    nneeluru    05/15/12 - Set up default JDK files during install
#    nneeluru    05/15/12 - Win64-specific changes
#    nneeluru    04/25/12 - Take only the first character as version
#    nneeluru    11/07/11 - Some miscellaneous changes  
#    nneeluru    10/02/11 - Handle -install to do nothing, temporarily.
#    nneeluru    10/12/10 - cp2local only if in dev env
#    nneeluru    10/06/10 - Fix verion.log update
#    nneeluru    11/06/08 - Simplify, since no need to take care of cloning.
#                           Also, take care of system and user ncomp.
#    nneeluru    04/08/08 - Creation
#

use File::Copy;
use File::Basename;
use File::Path;

process_args();

if (($install ne "true") and ($refresh ne "true"))
{
  die "No multi-JDK in this release.\n";
}

$pathsep = "/";  
# $pathsep = "\\" if $ENV{'OS'} eq "Windows_NT";
if ($dev eq "true")
{
  $oh = $ENV{ORACLE_HOME};
}
else
{
  $oh = '/app/oracle/19.3.0/db_1';  # Installer will put correct value here.
                          # Single quotes are used to let '\'s (that appear in
                          # Windows paths) not be used as escaping characters.
}
$javavmbasedir = $oh.$pathsep."javavm";
$javavmadmin = $javavmbasedir.$pathsep."admin";
$jdkversionsfile = $javavmadmin.$pathsep."jdk.versions";
$logfile = $javavmadmin.$pathsep."version.log";

get_supported_jdk_versions();

$currentversion = get_current_version();

if ($install eq "true")
{
  $targetversion = $defaultversion;
  $force = "true";  # During install, $currentversion will be $defaultversion,
                    # but yet the default version is not set up and needs to 
                    # be set up now. 
}

if ($refresh eq "true")
{
  $targetversion = $currentversion;
  $force = "true";
}

if ($targetversion eq "")
{
  $targetversion = $defaultversion;
}

if (($ENV{OS} eq "Windows_NT") and
    (($ENV{PROCESSOR_ARCHITECTURE} eq "AMD64") or
     ($ENV{PROCESSOR_ARCHITEW6432} eq "AMD64")))
{
  $force_copy = "true";   # On Windows X64, symlinks, even if supported by some
                          # Perl implementation, may not work reliably.  So, 
                          # force copy.  This also makes dev and customer worlds
                          # have same behavior (of copying), since in dev's Perl
                          # symlinks are not supported and so copy happens.
}

check_version($targetversion);
$target_jdkdir = $javavmbasedir.$pathsep."jdk".$pathsep."jdk".$targetversion;
$current_jdkdir = $javavmbasedir.$pathsep."jdk".$pathsep."jdk".$currentversion;

if (($currentversion ne $targetversion) or ($force eq "true"))
{
  if (symlink_is_supported() eq "1")
  {
    $do_link_or_copy = 'dolink';
  }
  else
  {
    $do_link_or_copy = 'docopy';
  }

  if ($force_copy eq "true")  # Over-ride the default behavior
                              # by the command-line option.
  {
    $do_link_or_copy = 'docopy';
  }

  if ($dev eq "true")
  {
    $do_unlink = 'do_unlink_dev';
  }
  else
  {
    $do_unlink = 'do_unlink';
  }

#  save_current();   # Save any required state of the current version.
#  remove_current(); # remove unwanted/affecting state of the current version.
  update_default(); # put the $targetversion's binaries in place.
  ensure_update_was_ok();
  create_or_update_log();
}
else
{
  print "Nothing needs to be done... already in version $targetversion \n";
}

sub save_current
{
# On Windows.X64: 
#   save OH\bin\oracle.exe and OH\rdbms\admin\oracle.sym to 
#   jdk\jdk<defaulversion>\admin\ during install 

  if (($ENV{OS} eq "Windows_NT") and 
      (($ENV{PROCESSOR_ARCHITECTURE} eq "AMD64") or 
       ($ENV{PROCESSOR_ARCHITEW6432} eq "AMD64")) and 
      ($install eq "true") and 
      ($dev ne "true"))
  {
    #  During install, targetjdkver is defaultjdkver
    docopy($oh.$pathsep."bin".$pathsep."oracle.exe", 
           $target_jdkdir.$pathsep."admin".$pathsep."oracle.exe");
    docopy($oh.$pathsep."rdbms".$pathsep."admin".$pathsep."oracle.sym", 
           $target_jdkdir.$pathsep."admin".$pathsep."oracle.sym");
  }
}

sub remove_current
{
# Here, we remove those files in the 'base javavm', that may not be overwritten
# by the targetversion's files (because there may not be such files in the 
# targetversion), and whose presence in the base javavm might affect the 
# targetversion.

# Probable candidates:
# - NCOMP DLLs
# - classes.bin patch files

  my(@list);
  my($file);

  opendir(DIR1, $javavmadmin) || print "Could not open $javavmadmin \n";

  @list = readdir(DIR1);
  foreach $file(@list)
  {
    if ((($file =~ /^cbp/) and ($file =~ /\.bin$/)) # classes.bin patch
        or ($file =~ /^(lib|ora)jtc_/) # user NCOMP DLL
        or ($file =~ /^(lib|ora)jtc[0-9a-zA-Z]/) # system NCOMP DLL
       )
    {
      &$do_unlink($javavmadmin.$pathsep.$file);
    }
  }

  close(DIR1);
}

sub update_default
{
  my($generic_layout_file, $platform_layout_file);

  if ($dev eq "true") # Running in Dev. world.
  {
    $generic_layout_file = $target_jdkdir.$pathsep."layout_dev.txt";
    $platform_layout_file = $target_jdkdir.$pathsep."s_layout_dev.txt";
  }
  else # Running in Cust. world.
  {
    $generic_layout_file = $target_jdkdir.$pathsep."layout.txt";
    $platform_layout_file = $target_jdkdir.$pathsep."s_layout.txt";
  }

  put_files_in_place($generic_layout_file);
  put_files_in_place($platform_layout_file);

  update_cbp_and_ncomp(); # These are handled outside of the layout file 
                          # mechanism.

  update_oracle_if_required(); # Handled outside of the layout files.
}

sub put_files_in_place
{
  my($layout_file) = @_;
  my($line, @pieces, $from, $to);

  open(F, $layout_file) || print "Could not open $layout_file \n";

  while (($line = readline(*F)) ne undef)
  {
    if ($line =~ /^#/) # Comments line, skip it. 
    {
      next;
    }
    chop($line);
    @pieces = split(/\s/, $line);
    $from = $pieces[0];
    $to = $pieces[1];
    make_sure_path_exists_for($oh.$pathsep.$to);
    if ($do_link_or_copy eq "dolink")            # relativize symlinks
    {
      $final_from = compute_symlink_text($from, $to);
    }
    else
    {
      $final_from = $target_jdkdir.$pathsep.$from;
    }
    &$do_link_or_copy($final_from, $oh.$pathsep.$to);
  }

  close(F);
}

# Bring the classes.bin patch files (cbpNNNNNNNN.bin) into the 'base javavm'.
# Also, bring in the system NCOMP DLLs.

sub update_cbp_and_ncomp
{
  my(@list);
  my($file);
  my($target_jdk_admin) = $target_jdkdir.$pathsep."admin";

  opendir(DIR, $target_jdk_admin) 
  || print "Could not open $target_jdk_admin \n";

  @list = readdir(DIR);
  foreach $file(@list)
  {
    if ((($file =~ /^cbp/) and ($file =~ /\.bin$/)) # classes.bin patch
        or ($file =~ /^(lib|ora)jtc[0-9a-zA-Z]/) # system NCOMP DLL
       )
    {
      if ($do_link_or_copy eq "dolink")  # relativize symlinks
      {
        $final_from = "../../javavm/jdk/jdk".$targetversion."/admin";
      }
      else
      {
        $final_from = $target_jdk_admin;
      }
      &$do_link_or_copy($final_from.$pathsep.$file, $javavmadmin.$pathsep.$file);
    }
  }

  close(DIR);
}

sub update_oracle_if_required
{
  if (($ENV{OS} eq "Windows_NT") and 
      (($ENV{PROCESSOR_ARCHITECTURE} eq "AMD64") or 
       ($ENV{PROCESSOR_ARCHITEW6432} eq "AMD64")) and 
      ($install ne "true") and 
      ($dev ne "true"))
  {
    docopy($target_jdkdir.$pathsep."admin".$pathsep."oracle.exe",
           $oh.$pathsep."bin".$pathsep."oracle.exe");
    docopy($target_jdkdir.$pathsep."admin".$pathsep."oracle.sym",
           $oh.$pathsep."rdbms".$pathsep."admin".$pathsep."oracle.sym");
  }
}

# To make symlink $to whose text points to $from, in relative terms.
# $to is relative to ORACLE_HOME.

sub compute_symlink_text
{
  my ($from, $to) = @_;
  $to = compute_effective_path($to);
  my @path_items = split('/', $to);     # assuming '/' to be the separator.
  my $up_path = "";
  for (my $i = 0; $i < $#path_items; $i++)  # ignore the last part (filename)
  {
    $up_path = $up_path."../";
  }
  my $final_from = $up_path."javavm/jdk/jdk".$targetversion."/".$from;
  return $final_from;
}

# Parse the given file path a/b/c.txt (that is relative to OH) and replace 
# any component that is a symlink by its text. Do this recursively, until 
# no symlinks exist in the path. (This is for the current file system where
# the script is run.) Also, remove the '.' and '..' in the path, without 
# affecting the effective path. All this may not be required on customer's
# site, but required in dev world (e.g., OH/lib is a symlink to OH/.dispatch/lib# (at least on Linux.X64) so if we just create ../javavm/jdk/.../libjavavm12.a 
# as the symlink text, it doesn't work; it has to be 
# ../../javavm/jdk/.../libjavavm12.a). 

sub compute_effective_path
{
  my ($new_path) = @_;
  my $input_path;

  do
  {
    $input_path = $new_path;
    my @path_items = split('/', $input_path); # assuming '/' to be separator
    my $so_far = $oh;
    $new_path = "blah";  # just some initial value 
    for (my $i = 0 ; $i < $#path_items; $i++) #ignore the last part (filename)
    {
      my $path_item = $path_items[$i];
      my $current_path = $so_far.$pathsep.$path_item;
      if (-l $current_path)
      {
        $path_item = readlink($current_path);  # This could raise an exception
                                          # if symlinks are not implemented,
                                          # but it's OK, since this sub-routine
                                          # is called only for symlink case.
      }
      $new_path = $new_path.$pathsep.$path_item;
      $so_far = $so_far.$pathsep.$path_item;
    }
    $new_path = remove_dot_and_dotdots($new_path);
    $new_path =~ s/^blah\///;  # now, remove the leading buffer pattern.
    $new_path = $new_path.$pathsep.$path_items[$#path_items];
  } while($input_path ne $new_path);  # This is true, implies the path has 
                                      # changed in the current iteration, so
                                      # try another round. Stop when it doesn't
                                      # change.

  return $new_path;
}

sub remove_dot_and_dotdots
{
  my ($path) = @_;
  my @path_items = split('/', $path);  # assuming '/' to be the separator!

  if ($path_items[0] eq "..")
  {
    die "path going beyond ORACLE_HOME, exiting... (given path = $path)\n";
  }
  my @final_items = ();
  foreach my $current_item(@path_items)
  {
    if ($current_item eq ".")
    {
      next;
    }
    elsif ($current_item eq "..")
    {
      pop(@final_items);
    }
    else
    {
      push(@final_items, $current_item);
    }
  }
  my $return_path = join('/', @final_items);
  return $return_path;
}

sub ensure_update_was_ok
{
  if (are_binaries_ok() ne "1")
  {
    die "Something went wrong... exiting. \n";
  }
}

# symlinks/copies file $from to $to....  
# If $to already exists, it will be removed and then link/copy is done.

sub dolink
{
  my($from, $to) = @_;

  if (-e $to || -l $to)
  {
    &$do_unlink($to);
  }
  symlink($from, $to) || print "Could not link $from to $to \n";
}

sub docopy
{
  my($from, $to) = @_;

  if (-e $to || -l $to)
  {
    &$do_unlink($to);
  }
  copy($from, $to) || print "Could not copy $from to $to \n";
}

sub docopy_or_exit
{
  my($from, $to) = @_;

  if (-e $to || -l $to)
  {
    &$do_unlink($to);
  }
  copy($from, $to) || die "Could not copy $from to $to, exiting. \n";
}

sub symlink_is_supported
{
  my($val) = eval {symlink("", "");};

  if ($@ eq "")
  {
    return "1";
  }
  else
  {
    return "0";
  }
}

sub create_or_update_log
{
  if ((-e $logfile) && (!-w $logfile))
  {
    if (chmod(0777, $logfile) == 0)
    {
      print "Could not chmod $logfile \n";
      if ($dev eq "true")
      {
        print "Trying after cp2local ... \n";
        system("cp2local $logfile");
      }
    }
  }
  open(FILE, ">", $logfile) || print "Could not open the log file $logfile \n";
  print(FILE $targetversion);
  close(FILE);
}

sub get_current_version
{
  my($version);

  if (-f $logfile)
  {
    open(FILE, "<", $logfile) || print "Could not open the file $logfile \n";
    $version = readline(FILE) || print "Could not read from $logfile \n";
    $version = substr($version, 0, 1); #There could be \n at the end; ignore it
    close(FILE);
    return $version;
  }

  return $defaultversion;
}

sub are_binaries_ok
{
  my($classesbin);
  my($libjavavm);

#  if (symlink_is_supported() eq "1")
#  { 
#    $classesbin = readlink($javavmadmin.$pathsep."classes.bin");
#    if ($classesbin ne $target_jdkdir.$pathsep."admin".$pathsep."classes.bin")
#    {
#      return "0";
#    }
#    $libjavavm = readlink($javavmbasedir.$pathsep."lib".$pathsep."libjavavm11.a");
#    if ($libjavavm ne $target_jdkdir.$pathsep."lib".$pathsep."libjavavm11.a")
#    {
#      return "0";
#    }
#  }

  return "1";
}

sub check_version
{
  my($version) = @_;
  my($item);

  if (!is_version_supported($version))
  {
    print "Invalid version $version ... Valid options are: "; 
    foreach $item (@supportedversions)
    {
      print "$item ";
    }
    print "\n";
    exit(0);
  }
}

sub is_version_supported
{
  my($inputver) = @_;

  foreach $ver(@supportedversions)
  {
    if ($ver eq $inputver)
    {
      return 1;
    }
  }
  return 0;
}

sub get_supported_jdk_versions
{
  my($version, $line);

  @supportedversions = ();
  open(F, "<", $jdkversionsfile) || print "Could not open $jdkversionsfile \n";
  while (($line = readline(*F)) =~ /^#/)
  {
#    print " This line belongs to the header. So, skip it. \n";
  }
  $defaultversion = $line;
  chop($defaultversion); # remove the '\n' at the end
  push(@supportedversions, $defaultversion);
  while (($version = readline(*F)) ne undef)
  {
    chop($version);  # remove the '\n' at the end.
    push(@supportedversions, $version);
  }
  close(F);
}

sub process_args
{
  my($i) = 1;

  if ($ARGV[0] eq "-install") # No version; called by the Installer; 
                              # setup default JDK.
  {
    $install = "true";
  }
  elsif ($ARGV[0] eq "-refresh")
  {
    $refresh = "true";
  }
  else
  {
    $targetversion = $ARGV[0];
  }

  while ($ARGV[$i] ne "")
  {
    if ($ARGV[$i] eq "-force")
    {
      $force = "true";
    }
    elsif ($ARGV[$i] eq "-dev")
    {
      $dev = "true";
    }
    elsif ($ARGV[$i] eq "-force_copy")
    {
      $force_copy = "true";
    }
    else
    {
#      die "Invalid option. Valid options are: -force \n";
    }
    $i = $i + 1;
  }
}

sub make_sure_path_exists_for
{
  my($file_path) = @_;

  my($filename, $pardir, $suffix) = fileparse($file_path);

  if (!-d $pardir)
  {
    eval { mkpath($pardir) };
    if ($@)
    {
      print "Could not mkdir $pardir \n";
    }
  }
}

# Try to remove the existing file. On NT, it is not always simple. So, we need
# to try out certain things.
#
sub do_unlink
{
  my($file) = @_;

  if (-e $file || -l $file || -f $file)
  {
    if (unlink($file) == 0)
    {
      print "Could not remove $file, trying after chmod... \n";
      if (chmod(0777, $file) == 0)
      {
        print "Could not chmod $file .. so, not removed\n";
      }
      else
      {
	unlink($file) || print "Still could not remove\n";
      }
    }
  }
}

sub do_unlink_dev
{
  my($file) = @_;

  if (-e $file || -l $file || -f $file)
  {
    if (unlink($file) == 0)
    {
      print "Could not remove $file, trying after chmod... \n";
      if (chmod(0777, $file) == 0)
      {
        print "Could not chmod $file, trying after cp2local... \n";
        system("cp2local $file");
      }
      unlink($file) || print "Still could not remove\n";
    }
  }
}