Edit D:\app\Administrator\product\11.2.0\dbhome_1\sysman\admin\scripts\db\dbclone\clone

Edit D:\app\Administrator\product\11.2.0\dbhome_1\sysman\admin\scripts\db\dbclone\clone_util.pl

# $Header: emdb/sysman/admin/scripts/db/dbclone/clone_util.pl /stpl_db_11.2.0.1.0_gen/1 2009/10/15 10:03:03 ngade Exp $
#
# clone_util.pl
# 
# Copyright (c) 2002, 2009, Oracle and/or its affiliates. All rights reserved. 
#
#    NAME
#      clone_util.pl - <one-line expansion of the name>
#
#    DESCRIPTION
#      <short description of component this file declares/defines>
#
#    NOTES
#      <other useful comments, qualifications, etc.>
#
#    MODIFIED   (MM/DD/YY)
#    ngade       06/25/09 - fix lrg 3937471
#    rimmidi     07/30/08 - Code slap from 10205 to 11.2DBControl
#    sxzhu       03/26/07 - Set auto startmode for win service
#    sxzhu       06/21/05 - Add Linux as an OS type 
#    sxzhu       02/22/05 - Fix bug 4200564: force to get port number 
#    sxzhu       11/15/04 - Fix netstat for linux 
#    sxzhu       07/29/04 - Move getFilesSize to clone_util_10_2 
#    szhu        06/04/04 - Fix bug 3624961: also look for oratab under /etc 
#    szhu        04/14/04 - Do not use oradim to get registry value 
#    szhu        02/24/04 - Pass in OH for service checking 
#    szhu        02/12/04 - Handle getVolume with three lines returned 
#    szhu        02/09/04 - Add getFilesSize 
#    szhu        01/07/04 - Add TNS_ADMINCheck on NT 
#    szhu        12/09/03 - Add authentication service to new sqlnet.ora 
#    szhu        12/01/03 - Temp location 
#    szhu        11/12/03 - Check file exist for getUniqueDirName 
#    szhu        11/06/03 - Add serviceCheck on NT 
#    szhu        11/05/03 - Fix getRootDir 
#    szhu        11/03/03 - Fix oradim 
#    szhu        10/31/03 - Debug on NT 
#    szhu        09/04/03 - Check ownership of oracle executable 
#    szhu        08/11/03 - NT support 
#    szhu        04/21/03 - Print running process found error
#    szhu        04/16/03 - Handle network configuration files
#    szhu        01/29/03 - Handle no oratab case
#    szhu        01/28/03 - Change parameter delimiter
#    szhu        01/27/03 - Add dir checking in filesChecking
#    szhu        01/24/03 - Space checking for directory groups
#    szhu        01/17/03 - Validate multiple files
#    szhu        01/12/03 - Allow reusing old entry in oratab
#    szhu        01/08/03 - Add initora and spfile check for instance name
#    szhu        12/12/02 - Allow not updating oratab
#    szhu        12/05/02 - szhu_dbclone_validation
#    szhu        11/18/02 - Run oradim for NT
#    szhu        11/15/02 - Creation
#

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

use strict;
use File::Temp qw/ tempfile tempdir /;
use File::stat;
use vars qw/$hostUserID $OS $NT $S $TEMP $CP $MV $PS $DF $DELIMITER $Registry/;

#$ENV{EMAGENT_PERL_TRACE_LEVEL} = 0;  #DEBUG level.

# Global variables
$hostUserID = "";

# --------- OS platform-specific (for "getFreePort" only) -------------

# Run command $netstat, the listening ports information shows at each row
# of $column.
# paramForGetFreePort()
sub paramForGetFreePort
{
  my $netstat = ""; 
  my $key = "";
  my $column = "";
  my $separator = "";
  
  
  if($^O =~ /solaris/i)
  {
    EMD_PERL_DEBUG("clone_util.paramForGetFreePort(): OS platform: Solaris");
    $netstat = '/bin/netstat -an ';
    $key = "LISTEN";
    $column = 0;
    $separator = ".";
  }
  elsif($^O =~ /MSWin32/i)
  {
    EMD_PERL_DEBUG("clone_util.paramForGetFreePort(): OS platform: MSWin32");
    $netstat = 'netstat -an ';
    $key = "LISTENING";
    $column = 1;
    $separator = ":";
  }
  elsif($^O =~ /linux/i)
  {
    EMD_PERL_DEBUG("clone_util.paramForGetFreePort(): OS platform: Linux");
    $netstat = '/bin/netstat -an ';
    $key = "LISTEN";
    $column = 3;
    $separator = ":";
  }
  #Add other platforms here
  else #may be Unix
  {
    EMD_PERL_DEBUG("clone_util.paramForGetFreePort(): OS platform: Unknown");
    $netstat = '/bin/netstat -an ';
    $key = "LISTEN";
    $column = 0;
    $separator = ".";
  }

return ($netstat, $key, $column, $separator);
}
# --------- OS platform-specific (END) -----------------------------------

# Set the host userId for some uses(such as oradim)
# setHostCredential(userName, password, nfs, v10g)
sub setHostCredential
{
  EMD_PERL_DEBUG("clone_util.setHostCredential(): *** START ***");
  my ($userName, $password, $nfs, $v10g) = @_;
  if(($nfs eq 'Y') && ($v10g eq 'Y'))
  {
    $hostUserID = $userName."/".$password;
    EMD_PERL_DEBUG("clone_util.setHostCredential(): NFS: $nfs v10g: $v10g");
    EMD_PERL_DEBUG("clone_util.setHostCredential(): Host UserID: $userName/host_password");
  }
  my $domain = "";
  #if the target database is a 10g view db, pickup the USERDOMAIN
  #Decide this by looking agent IN_VOB_FLAG and target DB oracle_home contains :\ade\
  my $in_vob_flag = $ENV{IN_VOB_FLAG};
  #my $ade_in_oracleHome = ($ENV{ORACLE_HOME} =~/:\\ade\\/i);
  EMD_PERL_DEBUG("clone_util.setHostCredential(): IN_VOB_FLAG: $in_vob_flag");
  #EMD_PERL_DEBUG("clone_util.setHostCredential(): ade_in_oracleHome: $ade_in_oracleHome");
  #Another condition v10g should also be checked later (not in 10.1 branch since v10g is not available)
  ## if(($in_vob_flag eq 'TRUE') && ($ade_in_oracleHome))
  if(($in_vob_flag eq 'TRUE'))
  {
    EMD_PERL_DEBUG("clone_util.setHostCredential(): In vob and ORACLE_HOME contains ':\\ade\\'");
    $domain =  $ENV{USERDOMAIN};
  }
  if($domain ne "")
  {
    my $position = index($userName, "\\");    
    if($position != -1)
    {
      $hostUserID = $userName."/".$password;
    }
    else
    {
      $hostUserID = $domain."\\". $userName."/".$password;
    }
    EMD_PERL_DEBUG("clone_util.setHostCredential(): Host UserID: $domain\\$userName/host_password");
  }
  EMD_PERL_DEBUG("clone_util.setHostCredential(): *** END ***");
}

# Check for an entry in the oratab for the specified instance.
# This check is done for Solaris only.
# Return OK if the entry does not exist, otherwise, return NOK.
# oratabCheck(inst)
sub oratabCheck
{
  EMD_PERL_DEBUG("clone_util.oratabCheck(): *** START ***");
	my($inst) = @_;
  my $instString = $inst.":";  #looking for string from beginning to : in oratab
	my($line);

if(!$NT)
  {
    EMD_PERL_DEBUG("clone_util.oratabCheck(): Unix like platform");
		my($oratab) = getOratab();
    
    #temp handle no oratab case
    if($oratab eq "")
    {
      EMD_PERL_DEBUG("clone_util.oratabCheck(): oratab does not exist");
      return "OK";
    }

if (-r "$oratab")
    {
      EMD_PERL_DEBUG("clone_util.oratabCheck(): Examining oratab file $oratab");
      open (ORATAB, "$oratab")
        or (((EMD_PERL_ERROR("clone_util.oratabCheck(): Unable to open $oratab for ORATAB")) && return "NOK") || (return "NOK"));
  
			while($line = <ORATAB>)
      {
				if($line =~ /^$instString/)
        {
          EMD_PERL_DEBUG("clone_util.oratabCheck(): found oratab entry for $inst");
					close(ORATAB);
          EMD_PERL_DEBUG("clone_util.oratabCheck(): *** END ***");
          return "NOK";
				}
			}
      EMD_PERL_DEBUG("clone_util.oratabCheck(): NOT found oratab entry for $inst");
			close(ORATAB);
		}
    else
    {
      EMD_PERL_ERROR("clone_util.oratabCheck(): NO read permission to file $oratab");
      return "NOK";
    }
	}
  else
  {
    EMD_PERL_DEBUG("clone_util.oratabCheck(): NT platform");
  }

EMD_PERL_DEBUG("clone_util.oratabCheck(): *** END ***");
  return "OK";
}
	
# Check if an Oracle process(es) is running for the specified instance.
# This check is done for Solaris only. For NT, it calls serviceCheck().
# Return OK if the process does not exist, otherwise, return NOK.
# Need to pass in OracleHome for NT, otherwise, it returns agent's TNS_ADMIN
# instanceCheck(inst, OracleHome)
sub instanceCheck
{
  EMD_PERL_DEBUG("clone_util.instanceCheck(): *** START ***");
	my($inst) = $_[0];
  my $oracleHome = $_[1];
	my($line);

if($OS ne "NT")
  {
    EMD_PERL_DEBUG("clone_util.instanceCheck(): Solaris platform");
		#Check: Look for running processes for this instance
		my(@res) = `$PS -ef 2>&1`;
		if(@res > 1)
    {
      EMD_PERL_DEBUG("clone_util.instanceCheck(): examining process listing");
			foreach $line (@res)
      {
				chop($line);
				if ($line =~ /ora_.+_$inst$/)
        {
          EMD_PERL_DEBUG("clone_util.instanceCheck(): found process for $inst: $line");
          EMD_PERL_DEBUG("clone_util.instanceCheck(): *** END ***");
					return "NOK";
				}
			}
		}
    EMD_PERL_DEBUG("clone_util.instanceCheck(): NOT found process for $inst");
	}
  else
  {
    EMD_PERL_DEBUG("clone_util.instanceCheck(): OS type is $OS");
    if($NT)
    {
      EMD_PERL_DEBUG("clone_util.instanceCheck(): NT platform");
      return serviceCheck($inst, $oracleHome);
    }
  }

EMD_PERL_DEBUG("clone_util.instanceCheck(): *** END ***");
  return "OK";
}

# Check if a service already exists for the specified instance.
# This check is done for NT only.
# Return OK if the service does not exist, otherwise, return NOK.
# serviceCheck(inst, OracleHome)
sub serviceCheck
{
  EMD_PERL_DEBUG("clone_util.serviceCheck(): *** START ***");
  my($instance) = $_[0];
  my $passedInOracleHome = $_[1];

if($NT)
  {
    #Check: Look for existing service for this instance by checking the registry.

my $oracleHome = $ENV{ORACLE_HOME};
    if(defined($passedInOracleHome))
    {
      $oracleHome = $passedInOracleHome;
    }
    EMD_PERL_DEBUG("clone_util.serviceCheck(): Oracle Home: $oracleHome, Instance: $instance");

my $service_value= $Registry->{"LMachine${S}System${S}CurrentControlSet${S}Services${S}OracleService${instance}${S}ImagePath"}
      or EMD_PERL_DEBUG("Can not find the service for LMachine${S}System${S}CurrentControlSet${S}Services${S}OracleService${instance}${S}ImagePath: $^E");
    if(!defined $service_value)
    {
      EMD_PERL_DEBUG("clone_util.serviceCheck(): NOT found service for $instance");
      EMD_PERL_DEBUG("clone_util.serviceCheck(): *** END ***");
      return "OK";
    }

EMD_PERL_ERROR("clone_util.serviceCheck(): Found service for $instance !!!");
    EMD_PERL_DEBUG("clone_util.serviceCheck(): registry value: $service_value");
    EMD_PERL_DEBUG("clone_util.serviceCheck(): *** END ***");
    return "LMachine${S}System${S}CurrentControlSet${S}Services${S}OracleService${instance}${S}ImagePath: $service_value";
  }
  else
  {
    EMD_PERL_DEBUG("clone_util.serviceCheck(): NOT NT platform");
  }

EMD_PERL_DEBUG("clone_util.serviceCheck(): *** END ***");
  return "OK";
}

# Check if the specified TNS_ADMIN location exists in registry.
# This check is done for NT only.
# Return OK if the specified TNS_ADMIN exists, otherwise, return NOK.
# TNS_ADMINCheck(tnsLocation, OracleHome)
sub TNS_ADMINCheck
{
  EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): *** START ***");
  my($tnsLoc) = $_[0];
  my $passedInOracleHome = $_[1];

if($NT)
  {
    #Check: Look for existing entry by checking the registry.

my $oracleHome = $ENV{ORACLE_HOME};
    if(defined($passedInOracleHome))
    {
      $oracleHome = $passedInOracleHome;
    }
    EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): Oracle Home: $oracleHome, TNS_ADMIN: $tnsLoc");

#get the registry key location from OH/bin/oracle.key
    my $oracle_key = "${oracleHome}${S}bin${S}oracle.key";
    open (ORACLE_KEY, "$oracle_key") || ((EMD_PERL_ERROR("clone_util.TNS_ADMINCheck(): Unable to open $oracle_key") && (return "OK")) || (return "OK"));
    my @oracle_key_content = <ORACLE_KEY>;
    my $key_loc = "@oracle_key_content";
    chomp($key_loc);
    close ORACLE_KEY;

EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): Oracle Home registry key: $key_loc");

my $tns_value = $Registry->{"LMachine${S}${key_loc}${S}TNS_ADMIN"}
     or EMD_PERL_DEBUG("Can not find the TNS_ADMIN for LMachine${S}${key_loc}${S}TNS_ADMIN: $^E");
    if(!defined $tns_value)
    {
      #if fail, means TNS_ADMIN entry does not exist, the default is OH/network/admin
      EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): NOT found TNS_ADMIN entry");

#check the specified tns is the default one.  If yes, return OK, otherwise NOK
      my $default = "${oracleHome}${S}network${S}admin";
      if((uc $tnsLoc) eq (uc $default))
      {
        EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): $tnsLoc is the default one.");
        EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): *** END ***");
        return "OK";
      }
      EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): $tnsLoc is not the default one.");
      EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): *** END ***");
      return "LMachine${S}${key_loc}${S}TNS_ADMIN = $default";
    }

#if not fail, means TNS_ADMIN entry exists.
    #check if the entry value is the same as specified tns location
    EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): NS_ADMIN: $tns_value");
    if((uc $tnsLoc) eq (uc $tns_value))
    {
      EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): $tnsLoc is the same as $tns_value.");
      EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): *** END ***");
      return "OK";
    }
    EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): $tnsLoc is different from $tns_value.");
    EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): *** END ***");
    return "TNS_ADMIN: $tns_value";
  }
  else
  {
    EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): NOT NT platform");
  }

EMD_PERL_DEBUG("clone_util.TNS_ADMINCheck(): *** END ***");
  return "OK";
}

# For solaris, add an entry to oratab for cloned instance.
# addEntryToOratab()
sub addEntryToOratab
{
  EMD_PERL_DEBUG("clone_util.addEntryToOratab(): *** START ***");

if(!$NT)
  {
    my($oratab) = getOratab();
    EMD_PERL_DEBUG("clone_util.addEntryToOratab(): Adding an entry to oratab: $oratab");

#temp handle no oratab case
    if($oratab eq "")
    {
      EMD_PERL_DEBUG("clone_util.addEntryToOratab(): oratab does not exist");
      return;
    }

if (-w "$oratab")
    {
      my $oracleHome = $ENV{ORACLE_HOME};
      my $instance = $ENV{ORACLE_SID};
      EMD_PERL_DEBUG("clone_util.addEntryToOratab(): Examining oratab file for instance $instance");

#if an instance with the same name is running, abort 
      my $chkStatus = &instanceCheck($instance);
      if($chkStatus eq "NOK")
      {
        EMD_PERL_ERROR("clone_util.addEntryToOratab(): Could not add $instance to $oratab");
        my(@res) = `$PS -ef 2>&1`;
        my $line;
        if(@res > 1)
        {
          print STDOUT "$PS -ef | grep ora_ | grep _$instance\n";
          foreach $line (@res)
          {
            chop($line);
            if ($line =~ /ora_.+_$instance$/)
            {
              print STDOUT "$line\n";
            }
          }
        }
        exit(1);
      }

#Allow reusing existing SID
      $chkStatus = &oratabCheck($instance);
      if($chkStatus eq "NOK")
      {
        #comment out the original line
        &commentOutEntryInOratab($instance);
      }

open(ORATAB, ">>$oratab") || die "Cannot open $oratab";

#Append the new entry to oratab file
      print ORATAB "${instance}:${oracleHome}:N\n";

close ORATAB || die "Cannot close $oratab";
		}
    else
    {
      EMD_PERL_ERROR("clone_util.addEntryToOratab(): NO write permission to file $oratab");
      #should we add the entry to a temp file and notify users?
    }
	}
  else
  {
    EMD_PERL_DEBUG("clone_util.addEntryToOratab(): NT platform, no need to add entry to oratab");
  }

EMD_PERL_DEBUG("clone_util.addEntryToOratab(): *** END ***");
}

# Comment out an entry in the oratab for the specified instance.
# This is done for Solaris only.
# Return OK if the entry is commented out, otherwise, return NOK.
# commentOutEntryInOratab(inst)
sub commentOutEntryInOratab
{
  EMD_PERL_DEBUG("clone_util.commentOutEntryInOratab(): *** START ***");
	my($inst) = @_;
  my $instString = $inst.":";  #looking for string from beginning to : in oratab
	my($line);

if(!$NT)
  {
    EMD_PERL_DEBUG("clone_util.commentOutEntryInOratab(): Unix like platform");
		my($oratab) = getOratab();
    if($oratab eq "")
    {
      EMD_PERL_DEBUG("clone_util.commentOutEntryInOratab(): oratab does not exist");
      return;
    }
		if (-w "$oratab")
    {
      #create a temp file to hold temp oratab info
      (my $fh, my $filename) = &create_temp_file();
      
      EMD_PERL_DEBUG("clone_util.commentOutEntryInOratab(): Examining oratab file $oratab");
      open (ORATAB, "$oratab")
        or (((EMD_PERL_ERROR("clone_util.commentOutEntryInOratab(): Unable to open $oratab for ORATAB")) && return "NOK") || (return "NOK"));

open(TEMP_ORATAB, ">$filename") || die "Cannot open $filename";
      my $commented = 0;
      
			while($line = <ORATAB>)
      {
				if($line =~ /^$instString/)
        {
          EMD_PERL_DEBUG("clone_util.commentOutEntryInOratab(): oratab entry for $inst has been found.");
          print TEMP_ORATAB "#"."$line";
          $commented = 1;
				}
        else
        {
          print TEMP_ORATAB "$line";
        }
			}
			close(ORATAB);
      close(TEMP_ORATAB);
      close($fh);

if(! $commented)
      {
        EMD_PERL_ERROR("clone_util.commentOutEntryInOratab(): oratab entry for $inst has NOT been commented out!");
        return "NOK";
      }
      
      #copy the temp oratab file over the original oratab file
      &copyFile($filename, $oratab);
		}
    else
    {
      EMD_PERL_ERROR("clone_util.commentOutEntryInOratab(): NO write permission to file $oratab");
      return "NOK";
    }
	}
  else
  {
    EMD_PERL_ERROR("clone_util.commentOutEntryInOratab(): NT platform");
    return "NOK";
  }

EMD_PERL_DEBUG("clone_util.commentOutEntryInOratab(): *** END ***");
  return "OK";
}

# For NT, run oradim to install the service for cloned instance.
# Ignore the return status; since we don't delete the service
# on a failed attempt, we will try to re-run this cmd on subsequent
# attempts, which will generate an error. So, ignore it. (The
# reason a DELETE isn't attempted is because it seems to 
# sometimes generate a DIM-00020 error, and doesn't actually delete 
# anything.)
# Start the service immediately. It's actually started by default
# the first time it's installed, but on SUBSEQUENT attempts to
# reuse an existing service (i.e., after a failed creation), the
# service may NOT be running. e.g., If the machine was rebooted
# after the failed create attempt. An attempt to connect to the
# cloned instance in this case will result in a TNS-12500 (can't
# start a dedicated server process) because the service, although
# it exists, isn't running.
# There's no error generated trying to start an already-started service.
# runOradim()
sub runOradim
{
  EMD_PERL_DEBUG("clone_util.runOradim(): *** START ***");
  
	if($NT)
  {
    my $oracleHome = $ENV{ORACLE_HOME};
    my $instance = $ENV{ORACLE_SID};

#backup the password file since oradim always generate a password file and will result in error if the same file exists
    my $passwdFile = $oracleHome."\\database\\pwd".$instance.".ora";
    my $passwdFileBk = $passwdFile.".save.$$";
    !copyFile($passwdFile, $passwdFileBk) || (EMD_PERL_DEBUG("Error copying $passwdFile to $passwdFileBk") && (die "Error copying $passwdFile to $passwdFileBk"));
    &removeFile($passwdFile);

my $runAs = "";
    if ($hostUserID ne "")
    {
      $runAs = " -RUNAS ".$hostUserID;
    }

EMD_PERL_DEBUG("clone_util.runOradim(): Running oradim to install service for $instance");
		my($cmd) = "${oracleHome}${S}bin${S}oradim.exe -NEW -SID $instance -STARTMODE auto";
    EMD_PERL_DEBUG("clone_util.runOradim(): Command: ${cmd}");
    $cmd = $cmd.$runAs;

&tempLocFallback();
    my $filename = "$TEMP\\"."dbclone.$$";
    EMD_PERL_DEBUG("clone_util.runOradim(): Output file: $filename");
      
		# Do NOT check the return value of this command
		my(@res) = `$cmd >$filename 2>&1`;
		if($?)
    {
			my($err) = "@res";
      EMD_PERL_ERROR("clone_util.runOradim(): ${oracleHome}${S}bin${S}oradim.exe -NEW -SID $instance -STARTMODE auto: $err");
      exit(1);
    }
    
		# Immediately start (no harm done if already started)
		$cmd = "${oracleHome}${S}bin${S}oradim.exe -STARTUP -SID $instance -STARTTYPE srvc";
    EMD_PERL_DEBUG("clone_util.runOradim(): Command: ${cmd}");
    
		# Do NOT check the return value of this command
		@res = `$cmd >$filename 2>&1`;
		if($?)
    {
			my($err) = "@res";
      EMD_PERL_ERROR("clone_util.runOradim(): ${oracleHome}${S}bin${S}oradim.exe -STARTUP -SID $instance -STARTTYPE srvc: $err");
      exit(1);
    }

if($NT)
    {
      $cmd = $ENV{ComSpec}." /c";
      $cmd = "$cmd sc config OracleService".${instance}." start= auto";
      EMD_PERL_DEBUG("clone_util.runOradim(): config service: $cmd");
      @res = `$cmd >$filename 2>&1`;
      EMD_PERL_DEBUG("clone_util.runOradim(): config service output: @res");
    }

#put back the original passwdFile
    !copyFile($passwdFileBk, $passwdFile) || (EMD_PERL_DEBUG("Error copying $passwdFileBk to $passwdFile") && (die "Error copying $passwdFileBk to $passwdFile"));
    &removeFile($passwdFileBk);
    &removeFile($filename);
    EMD_PERL_DEBUG("clone_util.runOradim(): service for $instance has been started");
	}
  else
  {
    EMD_PERL_DEBUG("clone_util.runOradim(): Not NT platform, no need to run oradim");
  }
		
  EMD_PERL_DEBUG("clone_util.runOradim(): *** END ***");
}

# Check if initSID.ora or spfileSID.ora exist.
# Return OK if not, NOK if any one exist.
# initoraSpfileCheck(oracleHome, sid)
sub initoraSpfileCheck
{
  my ($oracleHome, $sid) = @_;

my $initFile = $oracleHome."/dbs/init".$sid.".ora";
  my $spfile = $oracleHome."/dbs/spfile".$sid.".ora";

if($NT)
  {
    $initFile = $oracleHome."\\database\\init".$sid.".ora";
    $spfile = $oracleHome."\\database\\spfile".$sid.".ora";
  }

if(-e "$initFile")
  {
      EMD_PERL_DEBUG("clone_util.initoraSpfileCheck(): File $initFile exists");
      return "NOK";
  }
  elsif(-e "$spfile")
  {
      EMD_PERL_DEBUG("clone_util.initoraSpfileCheck(): File $spfile exists");
      return "NOK";
  }
  else
  {
    EMD_PERL_DEBUG("clone_util.initoraSpfileCheck(): File $initFile and $spfile do not exist");
    return "OK";
  }
}

# Create a zero size file.
# createZeroSizeFile(dirName)
sub createZeroSizeFile
{
  my ($dirName) = @_;

#create dir if not exist
  &mkDir($dirName);
  
  my $fh;
  my $fileName;
  
  if(!$NT)
  {
    EMD_PERL_DEBUG("clone_util.createZeroSizeFile: To create a zero size file");
    ($fh, $fileName) = tempfile(DIR => $dirName);
  }
  else
  {
    EMD_PERL_DEBUG("clone_util.createZeroSizeFile: To create a zero size file on NT");
    $fileName = "$dirName\\"."dbclone.$$";
    #Open and close this file
    open (ZERO_FILE, ">$fileName") 
      || die "Unable to open a file for ZERO_FILE\n";
    print ZERO_FILE "";
    close ZERO_FILE || die "Bad ZERO_FILE";
  }
  
  EMD_PERL_DEBUG("clone_util.createZeroSizeFile: File name: $fileName");

if(!$NT)
  {
    close $fh;
  }

return $fileName;
}

# This routine gets a unique dir name within a location based on given pattern.
# Return the found dir name.
# getUniqueDirName(dirPattern)
sub getUniqueDirName
{
  my ($dirPattern) = @_;
  EMD_PERL_DEBUG("clone_util.getUniqueDirName(): Get unique dir name based on $dirPattern");
  my $dirNotExist = &dirNotExists($dirPattern);
  if($dirNotExist eq "OK")
  {
    EMD_PERL_DEBUG("clone_util.getUniqueDirName(): Directory $dirPattern is already unique");
    return $dirPattern;
  }

my $sibling = $dirPattern;
  
  while($dirNotExist eq "NOK")
  {
    EMD_PERL_DEBUG("clone_util.getUniqueDirName(): $sibling already exist");
    $sibling .= "_1";
    $dirNotExist = &dirNotExists($sibling);
  }

return $sibling;
}

# Check if a specified directory NOT exists
# Return OK if the directory NOT exists, otherwise, return NOK.
# dirNotExists(dirName)
sub dirNotExists
{
  my ($dirName) = @_;
  if(! -e "$dirName")
  {
    EMD_PERL_DEBUG("clone_util.dirNotExists(): Directory $dirName does not exist");
    return "OK";
  }
  elsif(! -d "$dirName")
  {
    EMD_PERL_DEBUG("clone_util.dirNotExists(): $dirName is not a directory");
    return "NOK";
  }
  
  EMD_PERL_DEBUG("clone_util.dirNotExists(): Directory $dirName exists");
  
  return "NOK";
}

# Check multiple files:
#   have valid dir location (i.e., at least top level dir is valid)
#   could be created by the specified user (write permission)
#   exist or not
# Return an array containing OK and NOK:
#   first segment of the array is for valid dir
#   second segment of the array is for write permission
#   third segment of the array is for existence
# Flag OK is returned if the file: dir valid, writable, or exists;
#   otherwise, NOK is returned.
# filesChecking(fileNameArray)
sub filesChecking
{
  my ($fileNameArray) = @_;

my @fileNames = split /$DELIMITER/, $fileNameArray;
  my $status = "";
  my $fileNames;
  my $parent;

foreach $fileNames (@fileNames)
  {
    $parent = &findNearestExistingParentDir($fileNames);
    if(($parent eq "") || ($parent eq "."))
    {
      EMD_PERL_DEBUG("clone_util.filesChecking(): File $fileNames is invalid");
      $status .= "NOK:";
    }
    else
    {
      EMD_PERL_DEBUG("clone_util.filesChecking(): File $fileNames is valid");
      $status .= "OK:";
    }
  }

foreach $fileNames (@fileNames)
  {
    $status .= &dirWritePermission(&findNearestExistingParentDir($fileNames));
    $status .= ":";
  }

$status .= &filesExist($fileNameArray);

foreach $fileNames (@fileNames)
  {
    $status .= &dirExists(&getDirname($fileNames));
    $status .= ":";
  }
  
  return $status;
}

# This method is not being used, use getVolume(dirName)
# This method is platform specific
# Get the filesystem for a given directory
# getFilesystem(dirName)
sub getFilesystem
{
  my ($dirName) = @_;
  EMD_PERL_DEBUG("clone_util.getFilesystem(): Passed in dir: $dirName");
  $dirName = &findNearestExistingParentDir($dirName);
  EMD_PERL_DEBUG("clone_util.getFilesystem(): cd to the nearest existing parent dir: $dirName");
  chdir($dirName)
    or (((EMD_PERL_ERROR("clone_util.getFilesystem(): chdir $dirName failed")) && return "-1") || (return "-1"));
  my $filesystem;

(my $df, my $row, my $column, my $divide) = &paramForGetFreeSpace();
  $column = $column - 1;
  if(!$NT)
  {
    $column = $column - 1;
  }
  EMD_PERL_DEBUG("clone_util.getFilesystem(): df: $df, row: $row, column: $column, divide: $divide");
  
  my @temp = `$df`;
  $_ = $temp[$row];
  my @tokens = split; 
  $filesystem = $tokens[$column];
  
  if("$filesystem" eq "")
  {
    EMD_PERL_ERROR("clone_util.getFilesystem(): Could not get filesystem: $!");
    exit(1);
  }
  
  EMD_PERL_DEBUG("clone_util.getFilesystem(): Filesystem for $dirName: $filesystem");
  
  return $filesystem;
}

# Get the volume for a given directory.
#   Return: the volume of an existing directory.
#   If an error occured during the checking, and we decide it is fatal, 
#     then exit from the routine and the validation is considered as failed.
#   If the error is not fatal, an empty volume is return.  In this case, the 
#     client method do not check the size of this file and the validation is 
#     considered successful and client could continue.
# getVolume(dirName)
sub getVolume
{
  local($SIG{'CHLD'}) = 'DEFAULT';
  my($dir) = $_[0];
  EMD_PERL_DEBUG("clone_util.getVolume(): getVolume for: $dir");

my $volume = "";
	
  if($NT)
  {
    $volume = &getRootDir($dir);
    EMD_PERL_DEBUG("clone_util.getVolume(): volume for $dir on NT : $volume");
		return $volume;
	}

## Determine if dir argument is a symlink; if so, distill directory name
	if (-d "$dir")
  {
		my($base) = $dir;
		while($base ne "$S")
    {
      EMD_PERL_DEBUG("clone_util.getVolume(): Checking $base for link");
			if(-l "$base")
      {
        EMD_PERL_DEBUG("clone_util.getVolume(): $base is symlink");
				$dir = readlink("$base");
        EMD_PERL_DEBUG("clone_util.getVolume(): Actual directory: $dir");
				unless($dir =~ /^$S/)
        {
          EMD_PERL_DEBUG("clone_util.getVolume(): directory name $dir is relative");
          #let it go
          return $volume;
				}
				last;
			}
			$base = dirname($base);
		}
	}
	else
  {
    EMD_PERL_ERROR("clone_util.getVolume(): $dir is not a directory");
		print "ERROR: getVolume(): ${dir}\n";
    #error out
    exit(1);
	}
		
	my($cmd) = "$DF '$dir'";
	my(@res) = `$cmd 2>&1`;

if($?)
  {
		my($err) = $!;
		if($err eq "")
    {
			$err = $res[0];
		}
		chomp($err);
    EMD_PERL_DEBUG("clone_util.getVolume(): $cmd failed: $err");

## Special case for df: If we get the "Could not find mount point"
		##  error, means we're dealing with an automount mount point
		##  or some other strange deal. In this case, just let
		##  it go through so the client can continue.
		## (This probably isn't going to work for an OS configured in
		##  in non-English. An error will be returned to the client
		##  in this case.)
		if($err =~ /Could not find mount point/i)
    {
      EMD_PERL_DEBUG("clone_util.getVolume(): ignoring error");
			return $volume;
		}

EMD_PERL_ERROR("clone_util.getVolume(): could not ignore error!");
    print "${cmd}: $err\n";
    #erro out
		exit(1);
	}

## the mount point is the last element of the second line
	if(@res == 2)
  {
		my(@out) = split(/\s+/, $res[1]);
    $volume = $out[5];
    EMD_PERL_DEBUG("clone_util.getVolume(): vol = $volume");
    return $volume;
	}
  elsif(@res == 3){
      ## When split over two lines, ensure no leading wtsp ends up in split
      my($temp) = $res[2];
      $temp =~ s/^\s+//;
      my(@out) = split(/\s+/, $temp);
      $volume = $out[4];
      ## last element is the mount point
      EMD_PERL_DEBUG("\tdf output on three lines\n");
      EMD_PERL_DEBUG("\tvol = $volume\n");
      return $volume;
  }
	else
  {
    EMD_PERL_ERROR("clone_util.getVolume(): Unexpected output from ${cmd}: @res");
    print "${cmd}: @res\n";
    #error out
		exit(1);
	}
}

# This method is specific to NT
# Get the top level dir for a given directory.  
# getRootDir(dirName)
sub getRootDir
{
  my($dir) = $_[0];
  EMD_PERL_DEBUG("clone_util.getRootDir(): get root dir on NT for: $dir");
  
  if(!$NT)
  {
    EMD_PERL_ERROR("clone_util.getRootDir(): Not a NT platform!");
    exit(1);
  }

my $rootDir = "";

my $position = index($dir, ":\\");
  $rootDir = substr($dir, 0, $position + 1);
  
  EMD_PERL_DEBUG("clone_util.getRootDir(): Root dir for $dir on NT : $rootDir");

return $rootDir;
}

# Check group sizes for multiple files:
# Input
#   fileNameArray: full filenames separated by DELIMITER
#   fileSizeArray: sizes (KB) separated by DELIMITER
# Functions
#   group them according to their volumes (UNIX) or rootDir (NT)
#   for each group, check the sum of the file sizes against volume/rootDir size
#   stop checking when finding one violating group
# Return an array (separated by PPP_DELIMITER) containing:
#   the total size of the files group (first element;)
#   the available disk space (second element;)
#   the violating group of files (third###fourth###...###nth###)
# If nothing returned, means no violation
# filesSizeChecking(fileNameArray, fileSizeArray)
sub filesSizeChecking
{
  my ($fileNameArray, $fileSizeArray) = @_;

my @fileNames = split /$DELIMITER/, $fileNameArray;
  my @fileSizes = split /$DELIMITER/, $fileSizeArray;
  my $fileName;
  my $fileSize;
  my $parent;
  my $volume;
  my %sizesHash;
  my %filesHash;
  my $sizesHash;
  my $filesHash;
  my $index = 0;

#This delimiter is used due to the Java StringTokenizer behavior that messes up : and ::: (we have : in file path on NT)
  my $PPP_DELIMITER = "###";

#build two hashtables using volumes as keys and sizes/filenames as values
  foreach $fileName (@fileNames)
  {
    $parent = &findNearestExistingParentDir($fileName);
    if(($parent eq "") || ($parent eq "."))
    {
      #this should not happen since we checked the file validity before this
      EMD_PERL_ERROR("clone_util.filesSizeChecking(): File $fileName is invalid");
      exit(1);
    }
    else
    {
      $volume = &getVolume($parent);
      #if volume is empty, we do not check the corresponding files
      if($volume ne "")
      {
        #insert the volume and file size into a hashtable using volume as key,
        #also insert the volume and file name into another hashtable using volume
        #as key, so we could return the violating file names to client.
        $fileSize = $fileSizes[$index];
        if(exists $sizesHash{$volume})
        {
          $sizesHash{$volume} += $fileSize;
          $filesHash{$volume} .= ($fileName."$PPP_DELIMITER");
        }
        else
        {
          $sizesHash{$volume} = $fileSize;
          $filesHash{$volume} = ($fileName."$PPP_DELIMITER");
        }
      }
    }
    $index ++;
  }

#check the required volume sizes against available sizes
  my $fileGroupSize;
  my $volumeFreeSize;
  while(($volume, $fileGroupSize) = each %sizesHash)
  {
    $volumeFreeSize = &getFreeSpace($volume);
    if($volumeFreeSize < $fileGroupSize)
    {
      return $fileGroupSize."$PPP_DELIMITER".$volumeFreeSize."$PPP_DELIMITER".$filesHash{$volume};
    }
  }

return "";
}

# Backup two network config files:
#   check exist or not
#   check file length
#      if not exist, create an empty one with a comment at the top
#      if exist and length > 0, copy it to make a backup
#      if exist but length 0, copy it to make a backup then add a comment at the top of original one
# backupNetConfigFiles(listener, listenerBk, tnsnames, tnsnamesBk, sqlnet)
sub backupNetConfigFiles
{
  my ($listener, $listenerBk, $tnsnames, $tnsnamesBk, $sqlnet) = @_;

if(! -e "$listener") #not exist
  {
    my $tempfile = createZeroSizeFile(getDirname($listener));
    EMD_PERL_DEBUG("clone_util.backupNetConfigFiles(): tempfile: $tempfile");
    open(TEMPFILE, ">>$tempfile") || die "Cannot open $tempfile";
    print TEMPFILE "#LISTENER.ORA Network Configuration File\n";
    print TEMPFILE "#Created by Oracle Enterprise Manager Clone Database tool\n";
    close TEMPFILE || die "Cannot close $tempfile";
    copyFile($tempfile, $listener);
    removeFile($tempfile);
  }
  else #exists
  {
    copyFile($listener, $listenerBk);
    if(-z "$listener") #exists and zero size
    {
      open(CONFIGFILE, ">>$listener") || die "Cannot open $listener";
      print CONFIGFILE "#LISTENER.ORA Network Configuration File\n";
      print CONFIGFILE "#Modified by Oracle Enterprise Manager Clone Database tool\n";
      close CONFIGFILE || die "Cannot close $listener";
    }
  }
  
  if(! -e "$tnsnames") #not exist
  {
    my $tempfile = createZeroSizeFile(getDirname($tnsnames));
    open(TEMPFILE, ">>$tempfile") || die "Cannot open $tempfile";
    print TEMPFILE "#TNSNAMES.ORA Network Configuration File\n";
    print TEMPFILE "#Created by Oracle Enterprise Manager Clone Database tool\n";
    close TEMPFILE || die "Cannot close $tempfile";
    copyFile($tempfile, $tnsnames);
    removeFile($tempfile);
  }
  else #exists
  {
    copyFile($tnsnames, $tnsnamesBk);
    if(-z "$tnsnames") #exists and zero size
    {
      open(CONFIGFILE, ">>$tnsnames") || die "Cannot open $tnsnames";
      print CONFIGFILE "#TNSNAMES.ORA Network Configuration File\n";
      print CONFIGFILE "#Modified by Oracle Enterprise Manager Clone Database tool\n";
      close CONFIGFILE || die "Cannot close $tnsnames";
    }
  }

if(! -e "$sqlnet") #not exist
  {
    my $tempfile = createZeroSizeFile(getDirname($sqlnet));
    open(TEMPFILE, ">>$tempfile") || die "Cannot open $tempfile";
    print TEMPFILE "#SQLNET.ORA Network Configuration File\n";
    print TEMPFILE "#Created by Oracle Enterprise Manager Clone Database tool\n";
    if($NT)
    {
      print TEMPFILE "sqlnet.authentication_services=(NTS)\n";
    }
    close TEMPFILE || die "Cannot close $tempfile";
    copyFile($tempfile, $sqlnet);
    removeFile($tempfile);
  }
  else #exists
  {
    if(-z "$sqlnet") #exists and zero size
    {
      #only backup if zero size since we do not modify it if non-zero size
      #this is to workaround transferring zero size file.
      copyFile($sqlnet, $sqlnet.".orig"); 
      open(CONFIGFILE, ">>$sqlnet") || die "Cannot open $sqlnet";
      print CONFIGFILE "#SQLNET.ORA Network Configuration File\n";
      print CONFIGFILE "#Modified by Oracle Enterprise Manager Clone Database tool\n";
      if($NT)
      {
        print CONFIGFILE "sqlnet.authentication_services=(NTS)\n";
      }
      close CONFIGFILE || die "Cannot close $sqlnet";
    }
  }
}

# This method is platform specific, will be dealt with later.
# Get free port for a host
# getFreePort()
sub getFreePort
{
  (my $netstat, my $key, my $column, my $separator) = &paramForGetFreePort();
  EMD_PERL_DEBUG("clone_util.getFreePort(): netstat: $netstat, column: $column, key: $key");

my $freePort = 1521; #the starting port to be checked
  my $usedPortCol = "";
  my $usedPort = "";
  my $row;
  my @tokens;
  my $separatorIndex = 0;
  my $found = 1;
  
  my @temp = `$netstat`;

if(@temp > 1)
  {
    EMD_PERL_DEBUG("clone_util.getFreePort(): examining listening port");
    while($found == 1)
    {
      $found = 0;
      foreach $row (@temp)
      {
        chop($row);
        if ($row =~ /$key/)  #only ckeck rows containing key
        {
          $_ = $row;
          @tokens = split; 
          $usedPortCol = $tokens[$column];
          $separatorIndex = rindex($usedPortCol, $separator);
          $usedPort = substr($usedPortCol, $separatorIndex + 1);
          if($freePort eq $usedPort)
          {
            EMD_PERL_DEBUG("clone_util.getFreePort(): Port is being used: $freePort");
            $freePort = $freePort + 1;
            $found = 1;
            last;
          }
        }
      }
    }
	}
  
  EMD_PERL_DEBUG("clone_util.getFreePort(): Free port: $freePort");
  
  return $freePort;
}

# check if the given user is the owner of oracle executable.
# isOwnerOfOracleExecutable(userName, oracleHome)
sub isOwnerOfOracleExecutable
{
  my($userName) = $_[0];
  my $oracleHome = $_[1];
  EMD_PERL_DEBUG("clone_util.isOwnerOfOracleExecutable(): the given username: $userName");
  EMD_PERL_DEBUG("clone_util.isOwnerOfOracleExecutable(): the given Oracle Home: $oracleHome");
  
  if($NT)
  {
    EMD_PERL_DEBUG("clone_util.isOwnerOfOracleExecutable(): NT platform!");
    return "OK";
  }

my @userUidString = `id $userName 2>&1`;
  my $userUidString = "@userUidString";
  EMD_PERL_DEBUG("clone_util.isOwnerOfOracleExecutable(): userUidString: $userUidString");
  
  my $startPos = index($userUidString, "uid=");
  if( $startPos < 0)
  {
    EMD_PERL_DEBUG("clone_util.isOwnerOfOracleExecutable(): Bad username: $userName");
    return "NOK";
  }
  
  my $endPos = index($userUidString, "(");
  my $length = $endPos - $startPos - 4;
  my $userUid = trim(substr($userUidString, $startPos + 4, $length));
  EMD_PERL_DEBUG("clone_util.isOwnerOfOracleExecutable(): user UID: $userUid");
  
  my $st = stat("$oracleHome/bin") or die "Can't stat $oracleHome/bin: $!";
  my $oracleUid = trim($st->uid);
  EMD_PERL_DEBUG("clone_util.isOwnerOfOracleExecutable(): ORACLE UID: $oracleUid");

if($userUid ne $oracleUid)
  {
    EMD_PERL_DEBUG("clone_util.isOwnerOfOracleExecutable(): user $userName is not $oracleHome/bin owner.");
    return "NOK";
  }
  
  EMD_PERL_DEBUG("clone_util.isOwnerOfOracleExecutable(): user $userName is $oracleHome/bin owner.");
  return "OK";
}

# Get the oratab filename
# getOratab()
sub getOratab
{
  my $oratab = "";
  
  if(!$NT)
  {
    $oratab = "/var/opt/oracle/oratab";
    
    if(! -e $oratab)
    {
      EMD_PERL_DEBUG("clone_util.getOratab(): File $oratab does not exist");
      $oratab = "/etc/oratab";
      if(! -e $oratab)
      {
        EMD_PERL_DEBUG("clone_util.getOratab(): File $oratab does not exist");
        $oratab = "";
      }
    }
  }
  
  EMD_PERL_DEBUG("clone_util.getOratab(): oratab is: $oratab");
  
  return $oratab;
}

# Create a file with signature.
# createSignatureFile(dirName)
sub createSignatureFile
{
  my ($dirName) = @_;

#create dir if not exist
  &mkDir($dirName);
  
  my $fh;
  my $fileName;
  
  if(!$NT)
  {
    EMD_PERL_DEBUG("clone_util.createSignatureFile: To create a file with signature");
    ($fh, $fileName) = tempfile(DIR => $dirName);
  }
  else
  {
    EMD_PERL_DEBUG("clone_util.createSignatureFile: To create a file with signature on NT");
    $fileName = "$dirName\\"."dbclone.$$";
  }
  
  #Open the file, add signature, then close it
  open (SIGNATURE_FILE, ">$fileName") 
      || die "Unable to open a file for SIGNATURE_FILE\n";
  print SIGNATURE_FILE "createSignatureFile_SIGNATURE";
  close SIGNATURE_FILE || die "Bad SIGNATURE_FILE";
  
  EMD_PERL_DEBUG("clone_util.createSignatureFile: File name: $fileName");

if(!$NT)
  {
    close $fh;
  }

return $fileName;
}
1;

#Tests
# removed main_dbclone

Ms-Dos/Windows Unix Write backup

jsp File Browser version 1.2 by www.vonloesch.de