#!/usr/local/bin/perl
# 
# $Header: has/install/crsconfig/s_crsconfig_lib.pm /stpl_db_11.2.0.1.0_win.x64/2 2010/03/26 22:57:57 dpham Exp $
#
# s_crsconfig_lib.pm
# 
# Copyright (c) 2007, 2010, Oracle and/or its affiliates. All rights reserved. 
#
#    NAME
#      s_crsconfig_lib.pm - <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)
#    dpham       03/15/10 - Fix deinstallfence (9478187)
#    dpham       03/15/10 - Add s_deltOldServ()
#    dpham       03/02/10 - Remove s_getDomainName() 
#    dpham       03/03/10 - Add s_get_olr_file() function
#    dpham       02/23/10 - Fix bug 9391523
#    dpham       02/22/10 - Revert bug 9267774
#    dpham       02/21/10 - Add s_getDomainName() function
#    dpham       02/12/10 - Fix cacls.exe to work on other languages (9340331)
#    dpham       02/05/10 - Add s_stopDeltOldASM() and
#    			    s_isServiceExists() (9326638)
#    dpham       01/28/10 - Add /r and /p options to ocfsformat
#    dpham       01/21/10 - Fix s_deltService() function
#    dpham       01/13/10 - Add s_getGroupName() and add 'use strict'
#			  - Add s_getAuthorizedOwner()
#    dpham       01/15/10 - Add s_copyRegKey()
#    dpham       12/22/09 - Add s_deltRegKey() s_deltService()
#    dpham       12/18/09 - Add '-upgrade' option when calling remote nodes
#    dpham       12/02/09 - Add s_copyOCRLoc
#    krikrish    11/16/09 - lrg# 4246646
#    dpham       11/11/09 - Get old crshome from crsconfig_param file
#    dpham       11/05/09 - Add check for local user privileges
#    dpham       10/27/09 - Not to prefix domain-name if user is SYSTEM
#    dpham       10/22/09 - Add domainName when check for superuser
#    dpham       10/15/09 - Format disk drive only on the first node
#			  - Add "-remoteParams" option
#    dpham       09/25/09 - Fix configAllRemoteNodes() to return the
#			    correct status (8769081)
#    dpham       10/05/09 - Fix bugs: 8932218,8580937,8892375,8553637,8913585
#    dpham       05/25/09 - s_removeGPnPprofile and s_copyOCRLoc
#    dpham       04/15/09 - Add createLocalOnlyOCR
#    dpham       01/29/09 - Increase sleep to 60 in s_startService
#    dpham       12/31/08 - Add s_createClusterNameKey function
#    dpham       12/14/08 - XbranchMerge dpham_bug-7558309 from main
#    dpham       12/10/08 - Add s_createConfigEnvFile
#    dpham       12/11/08 - Fix ocfs, permissions, start services issues
#    dpham       10/22/08 - Add Win32::Service 
#                         - Change addDriveLetter to assigndriveletter
#                         - Add s_start_ocfs_driver
#    khsingh     08/06/08 - fix s_reset_crshome
#    khsingh     08/06/08 - fix s_reset_crshome
#    hkanchar    03/18/08 - Add a function to return old crs home
#    srisanka    03/18/08 - handle stdout/stderr
#    srisanka    02/12/08 - do OSD actions
#    srisanka    01/29/08 - Creation
# 

use strict;
use Win32;
use Win32::NetAdmin qw(DOMAIN_ALIAS_RID_ADMINS GetAliasFromRID
                       LocalGroupIsMember GroupIsMember);
use Win32::TieRegistry (Delimiter => '/');
use Win32::Service;
use Win32API::File  qw(DeleteFile);
use Cwd;
use crsconfig_lib;

use constant FAILED                    =>  "0";
use constant SUCCESS                   =>  "1";
use constant TRUE                      =>  "1";
use constant FALSE                     =>  "0";

####---------------------------------------------------------
#### Function for checking and returning Super User name
# ARGS : 1
# ARG1 : Program name
sub s_check_SuperUser
{
    trace ("Checking for super user privileges");

    my $superUser = $ENV{'USERNAME'};
    my $groupName = s_getGroupName();
    trace ("superUser=$superUser groupName=$groupName");

    # get group name for Administrators
    if (! $groupName) {
        return "";
    }

    # get user-name
    my $domainName = Win32::DomainName();
    my $userName   = Win32::LoginName();
    $userName      =~ tr/a-z/A-Z/;
    my $errorMsg   = "User must be \"SYSTEM\", or $userName must be " .
                     "or a member of $groupName group to run root script";
    trace ("domain=$domainName user=$userName");


    if ($userName eq "SYSTEM") {
       trace ("User has $superUser privileges");
       return $superUser;
    }

    # check if local user has privileges
    if (!(LocalGroupIsMember("", $groupName, $userName) ||
          GroupIsMember("", $groupName, $userName))) 
    {
       # local user does not have privileges
       # now check if domain\user has privileges
       
       if ($domainName) {
          $userName = $domainName . '\\' . $userName;

          if (!(LocalGroupIsMember("", $groupName, $userName) ||
             GroupIsMember("", $groupName, $userName))) 
          { 
             error ("$errorMsg");
             return "";
          }
       }
       else {
          error ("$errorMsg");
          return "";
       }
    }

    trace ("User has $superUser privileges");

    return $superUser;
}

sub s_getGroupName
{
   # get group name for Administrators
   my $groupName;

   if (! GetAliasFromRID("", DOMAIN_ALIAS_RID_ADMINS, $groupName)) {
      error ("GetAliasFromRID failed");
   }

   return $groupName;
}

####---------------------------------------------------------
#### Function for setting user and group on a specified path
# ARGS : 3
# ARG1 : Oracle owner
# ARG2 : Oracle group 
# ARG3 : file
sub s_set_ownergroup
{
    # Note: this function is a no-op on NT

    return SUCCESS;
}

sub s_set_ownergroup_win
#----------------------------------------------------------------
# Function: Use cacls to change file permissions
# Args    : owner, group, file
#----------------------------------------------------------------
{
   my ($owner, $group, $file) = @_;

   if (! $owner) {
      error ("Null value passed for Oracle owner");
      return FAILED;
   }

   if (! $group) {
      error ("Null value passed for group name");
      return FAILED;
   }

   if (! $file) {
      error ("Null value passed for file or directory path");
      return FAILED;
   }

   if (! (-e $file)) {
      error ("The path \"" . $file . "\" does not exist");
      return FAILED;
   }

   # set permission
   my $cmd = "cmd /c cacls $file /E /G \"$group\":F \"$owner\":F > NUL";
   if ($DEBUG) { trace ("Invoking: $cmd"); }
   system ("$cmd");
   
   return SUCCESS;
}

####---------------------------------------------------------
#### Function for setting permissions on a specified path
# ARGS : 2
# ARG1 : permissions
# ARG3 : file/dir
sub s_set_perms
{
    # Note: this function is a no-op on NT

    return SUCCESS;
}

sub s_first_node_tasks
#-------------------------------------------------------------------------------
# Function: Perform one-time clusterwide setup
# Args    : none
#
# OS                    Major   Minor
# --			-----	-----
# Windows 95              4        0
# Windows 98              4       10
# Windows Me              4       90
# Windows NT 3.51         3       51
# Windows NT 4            4        0
# Windows 2000            5        0
# Windows XP              5        1
# Windows Server 2003     5        2
# Windows Vista           6        0
#-------------------------------------------------------------------------------
{
   my $OCFS_CONFIG = $CFG->params('OCFS_CONFIG');
   
   trace ("Perform first node tasks OCFS_CONFIG=$OCFS_CONFIG");
   
   if (! $OCFS_CONFIG) {
      return SUCCESS;
   }
  
   # create ClusterName key in the registry
   s_createClusterNameKey ();

   # get Windows version
   # if Win2k8, format using /r and /p options and then assign drive 
   # letter to avoid Win2k8 drive formatting popup msg. 
   # Otherwise, assign drive letter and then format
   my ($str, $winMajor, $winMinor, $build, $id) = Win32::GetOSVersion();


   my $OCFSFMTBIN  = catfile ($ORACLE_HOME, "cfs", "ocfsformat.exe");
   my @drvinfoarr  = split (/\s*,\s*/, $OCFS_CONFIG);
   my ($dsk, $dsknum, $partnum, $type, $drvletter, $clustersz);
   my (@cmd, $status);

   foreach my $drvcfg (@drvinfoarr) {
      ($dsk, $dsknum, $partnum, $type) = split (/ /, $drvcfg);
      ($drvletter,) = split (/:/, $dsk);
      trace ("disk=$dsk disknum=$dsknum partnum=$partnum type=$type");

      # check if drive letter has been assigned. If so, check next disk
      # this check is necessary so that the disk drive won't be formatted 
      # during configure remote nodes
      # NOTE: we should also check if disk has been formatted (enhancement
      # for beta2)
      next if (-d $dsk);

      # Assign drive letter to OCFS disk
      if ($winMajor <= 5) {
         if (! s_assignDriveLetter($drvletter, $dsknum, $partnum)) {
            return FAILED;
         }
      }

      # Format disk using OCFS. Hence, only on first node
      if ((! $REMOTENODE) && (! $CFG->addnode)) {
	 trace("formatting disk:$dsknum partition:$partnum");
	 $type =~ tr/A-Z/a-z/;

	 if ($type eq "data") {
	    $clustersz = 4;
	 } 
	 elsif ($type eq "software") {
	    $clustersz = 32;
	 } 
	 else {
            error ("Invalid type specified for (disk:partition) " .
                   "($dsknum:$partnum)");
            return FAILED;
         }

         if ($winMajor <= 5) {
            @cmd = ("$OCFSFMTBIN", "/m", "$drvletter:", "/c", $clustersz);
	 }
	 else {
            @cmd = ("$OCFSFMTBIN", "/m", "$drvletter:", "/c", $clustersz,
		    "/r", $dsknum, "/p", $partnum);

	 }

         trace("@cmd"); 
         $status = system("@cmd");

         if (0 != $status) {
            error ("Error formatting (disk:partition) ($dsknum:$partnum)");
            return FAILED;
         }
      }

      # Assign drive letter to OCFS disk
      if ($winMajor > 5) {
         if (! s_assignDriveLetter($drvletter, $dsknum, $partnum)) {
            return FAILED;
         }
      }

   }
    
   return SUCCESS;
}

sub s_assignDriveLetter
{
   my $drvletter = $_[0];
   my $dsknum    = $_[1];
   my $partnum   = $_[2];

   # Assign drive letter to OCFS disk
   my $crssetup = catfile ($ORACLE_HOME, 'bin', 'crssetup.exe');
   my @cmd = ($crssetup, "assigndriveletter", "-l", $drvletter,
			 "-d", $dsknum, "-p", $partnum);
   my $rc  = system(@cmd);
   trace("@cmd");

   if (0 != $rc) {
      error ("Assigning drive letter to (disk:partition) " .
             "($dsknum:$partnum) failed with rc=", $rc >> 8);
      return FAILED;
   }

   return SUCCESS;
}

####-----------------------------------------------------------------------
#### Function for performing NT-specific setup
# ARGS: 0
sub s_osd_setup
{
   # if in ADE env, skip these steps and return success
   if (is_dev_env ()) {
      return SUCCESS;
   }

   # start ocfs driver
   if (! s_start_ocfs_driver ()) {
      return FAILED;
   }

   # create services 
   if (! s_create_services ()) {
      return FAILED;
   }

   # start services 
   if (! s_start_services ()) {
      return FAILED;
   }

   return SUCCESS;
}

####-----------------------------------------------------------------------
#### Function for creating NT services
# ARGS: 0
sub s_create_services
{
   my ($cmd, $status);

   if ($CRS_STORAGE_OPTION == 2) {
      if (! s_isServiceRunning ("OracleClusterVolumeService")) { 
         # create Oracle Cluster Volume Service
         trace ("Creating Oracle Cluster Volume Service...");
         my $ocfsfindvol = catfile ($ORACLE_HOME, "cfs", "OcfsFindVol.exe");
         $cmd = "$ocfsfindvol /i:$ocfsfindvol";
         if ($DEBUG) { trace ("Invoking: $cmd"); }

         $status = system ("$cmd");
         if ($status == 0) {
            trace ("Create Oracle Cluster Volume Service successfully");
         }
         else {
            error ("Create Oracle Cluster Volume Service failed");
            return FAILED;
         }
      }
   }

   # create Oracle Object Service
   if (! s_isServiceRunning ("Oracle Object Service")) { 
      trace ("Creating Oracle Object Service...");
      my $obj = catfile ($ORACLE_HOME, "bin", "OracleOBJService.exe");
      $cmd = "$obj /install";
      if ($DEBUG) { trace ("Invoking: $cmd"); }
      
      $status = system ("$cmd");
      if ($status == 0) {
         trace ("Create Oracle Object Service successfully");
      }
      else {
         error ("Create Oracle Object Service failed");
         return FAILED;
      }
   }

   # create Oracle Fence Service
   if (! s_isServiceRunning ("OraFenceService")) { 
      trace ("Creating Oracle Fence Service...");
      my $crssetup = catfile ($ORACLE_HOME, "bin", "crssetup.exe");
      $cmd = "$crssetup installFence";
      if ($DEBUG) { trace ("Invoking: $cmd"); }

      $status = system ("$cmd");
      if ($status == 0) {
         trace ("Create Oracle Fence Service successfully");
      }
      else {
         error ("Create Oracle Fence Service failed");
         return FAILED;
      }
    }

    return SUCCESS;

}

####-----------------------------------------------------------------------
#### Function for starting NT services
# ARGS: 0
sub s_start_services
{
   my ($svcName, $cmd, $status);

   # If $CRS_STORAGE_OPTION is 2 (CFS), then start OCFS service
   if ($CRS_STORAGE_OPTION == 2) {
      # start "OracleClusterVolumeService"
      if (SUCCESS != s_startService ("OracleClusterVolumeService")) { 
         return FAILED;
      }
   }

   # start "Oracle Object Service"
   if (SUCCESS != s_startService ("Oracle Object Service")) { 
      return FAILED;
   }

   # start "OraFenceService"
   if (SUCCESS != s_startService ("OraFenceService")) { 
      return FAILED;
   }

   return SUCCESS;
}

sub s_isServiceExists
#-------------------------------------------------------------------------------
# Function: Check if Windows service exists
# Args    : service name
#-------------------------------------------------------------------------------
{
   my $svcName = $_[0];
   my %srvc_status;
   
   Win32::Service::GetStatus("", $svcName, \%srvc_status);
  
   if ($srvc_status{"CurrentState"} =~ /[1-7]/) {
      return TRUE;
   }
   else {   
      return FALSE;
   }

}

sub s_isServiceRunning
#-------------------------------------------------------------------------------
# Function: Check Windows service is running or start_pending
# Args    : service name
#-------------------------------------------------------------------------------
{
   my $svcName = $_[0];
   my %srvc_status;
   
   # check if service is running
   Win32::Service::GetStatus("", $svcName, \%srvc_status);
  
   # 4 means service is running
   if ($srvc_status{"CurrentState"} == 4) {
      if ($DEBUG) { trace ("$svcName is running..."); }
      return TRUE;
   }
   else {   
      return FALSE;
   }
}

sub s_startService
#----------------------------------------------------------------
# Function: Start Windows service
# Args    : service name
#----------------------------------------------------------------
{
   my $svcName = $_[0];
   
   if (s_isServiceRunning ($svcName)) { 
      return SUCCESS;
   }  

   trace ("Starting $svcName...");
   if (! Win32::Service::StartService ("", $svcName)) {
      error ("Start of $svcName failed");
      return FAILED;
   }

   # wait for service to start
   my $retries = 5;
   my $srv_running = FALSE;
   
   while ($retries && (! $srv_running)) {
      if (s_isServiceRunning ($svcName)) { 
         $srv_running = TRUE;
      }
      else {
         trace ("Waiting for $svcName to start");
         sleep (60);
         $retries--;
      }
   }   
       
   if (! $srv_running) {
      error ("Error $svcName failed to start");
      return FAILED;
   }

   return SUCCESS;
}

sub s_deltService
#-------------------------------------------------------------------------------
# Function: Delete Windows service
# Args    : 1 - service name
#-------------------------------------------------------------------------------
{
   my $svcName = $_[0];

   if (s_isServiceExists($svcName)) {
      if (s_stopService($svcName)) {
         my $oradim = catfile ($ORACLE_HOME, 'bin', 'oradim.exe');
         my @cmd    = ($oradim, "-ex", "s", "delete", "\"$svcName\"");
         my $rc     = system(@cmd);

         if ($rc == 0) {
            trace ("@cmd ... success");
            return SUCCESS;
         }
         else {
            trace ("@cmd ... failed with rc=", $rc >> 8);
            return FAILED;
         }
      }
   }

   return SUCCESS;
}

####-----------------------------------------------------------------------
#### Function for checking if CRS is already configured
# ARGS: 2
# ARG1: hostname
# ARG2: crs user
sub s_check_CRSConfig
{

    # ignore all args on NT

    # Check if OCR registry entry exists.
    # XXX: do we need any additional checks?
    if ($Registry->{"LMachine/$OCRLOC/"}) {
        trace ("HKLM/$OCRLOC/ is already configured\n");
        return TRUE;
    } else {
        trace ("HKLM/$OCRLOC/ is NOT configured\n");
        return FALSE;
    }
}

####-----------------------------------------------------------------------
#### Function for validating OLR keys and creating them if they do not exist
# ARGS: 2
# ARG1 : Complete path of OLR location
# ARG2 : CRS Home
sub s_validate_olrconfig
{
    my $olrlocation = $_[0];
    my $crshome     = $_[1];

    trace ("Validating OLR registry keys for OLR location " . $olrlocation);

    ## @todo Check existing OLR_LOC. If it exists, then check value of
    #olrconfig_loc property. If it's same as the one passed on the call then go
    #ahead. Else, throw an error msg and quit the installation.
    my $idx = rindex ($OLRLOC, '/') + 1;
    my $parentkey = substr ($OLRLOC, 0, $idx);
    my $key = substr ($OLRLOC, $idx);
    trace ("OLRLOC=$OLRLOC parentkey=$parentkey key=$key");
    $Registry->{"LMachine/$parentkey"} = {
        "$key/" => {
        "/olrconfig_loc" => "$olrlocation",
        "/crs_home" => "$crshome",
        },
    };

    return SUCCESS;
}

####---------------------------------------------------------
#### Function for validating ocr.loc file
# ARGS: 2
# ARG1 : ocrlocations
# ARG2 : isHas
sub s_validate_ocrconfig
{
    my $ocrlocations = $_[0];
    my $isHas        = $_[1];

    trace ("Validating OCR locations in OCR registry key");

    my ($ocrlocation,
        $ocrmirrorlocation,
        $ocrlocation3,
        $ocrlocation4,
        $ocrlocation5) = split (/\s*,\s*/, $ocrlocations);

    trace ("Setting ocr location " . $ocrlocation);
    $Registry->{"LMachine/$OCRLOC/"} = {
        "/ocrconfig_loc" => "$ocrlocation",
    };

    if ($ocrmirrorlocation) {
        trace ("Setting ocr mirror location " . $ocrmirrorlocation);
        $Registry->{"LMachine/$OCRLOC/"} = {
            "/ocrmirrorconfig_loc" => "$ocrmirrorlocation",
        };
    }

    if ($ocrlocation3) {
        trace ("Setting ocr location3 " . $ocrlocation3);
        $Registry->{"LMachine/$OCRLOC/"} = {
            "/ocrconfig_loc3" => "$ocrlocation3",
        };
    }

    if ($ocrlocation4) {
        trace ("Setting ocr location4 " . $ocrlocation4);
        $Registry->{"LMachine/$OCRLOC/"} = {
            "/ocrconfig_loc4" => "$ocrlocation4",
        };
    }

    if ($ocrlocation5) {
        trace ("Setting ocr location5 " . $ocrlocation5);
        $Registry->{"LMachine/$OCRLOC/"} = {
            "/ocrconfig_loc5" => "$ocrlocation5",
        };
    }

    if ($isHas) {
        $Registry->{"LMachine/$OCRLOC/"} = {
            "/local_only" => "TRUE",
        };
    } else {
        $Registry->{"LMachine/$OCRLOC/"} = {
            "/local_only" => "FALSE",
        };
    }

    return SUCCESS;
}

####---------------------------------------------------------
#### Validating OCR locations based on existing ocr settings
# ARGS: 3
# ARG1 : Path for Oracle CRS home
# ARG2 : Cluster name
# ARG3 : Comma separated OCR locations
sub s_validateOCR
{
    my $crshome = $_[0];
    my $clustername = $_[1];
    my $ocrlocations = $_[2];

    my $status = SUCCESS;

    trace ("Setting OCR locations in registry");
    s_validate_ocrconfig ($ocrlocations, 0) or {$status = FAILED};

    # XXX: do we need to do anything more here?
    return $status;
}

####---------------------------------------------------------
#### Function for invalidating srvconfig_loc in srvconfig.loc file
sub s_reset_srvconfig
{

    # XXX: currently a no-op on NT; do we need to do anything here?  Like, say,
    # remove some registry (sub)keys??
    return SUCCESS;
}

####---------------------------------------------------------
#### Function for resetting crshome user and permissions
sub s_reset_crshome
{

    # currently a no-op on NT;
    return SUCCESS;
}

####---------------------------------------------------------
#### Function for registering daemon/service with init
# ARGS: 1
# ARG1: daemon to be registered
sub s_register_service
{
    my $srv = $_[0];

    my $SRVBIN = catfile ($ORACLE_HOME, "bin", $srv);
    my $status = system ("$SRVBIN install");
    # XXX: ignore error in Windows dev env as mktwork would have already
    # registered this service
    if ((0 != $status) && !is_dev_env ()) {
        return FAILED;
    }

    return SUCCESS;
}

####---------------------------------------------------------
#### Function for unregistering daemon/service
# ARGS: 1
# ARG1: daemon to be unregistered
sub s_unregister_service
{
    my $srv = $_[0];

    my $SRVBIN = catfile ($ORACLE_HOME, "bin", $srv);
    my $status = system ("$SRVBIN remove");
    if (0 != $status) {
        return FAILED;
    }

    return SUCCESS;
}

####---------------------------------------------------------
#### Function for starting daemon/service
# ARGS: 3
# ARG1: daemon to be started
# ARG2: user under whom daemon/service needs to be started
sub s_start_service
{
    my $srv  = $_[0];
    my $user = $_[1]; # this arg is ignored on NT

    my $SRVBIN = catfile ($ORACLE_HOME, "bin", $srv);
    my $status = system ("$SRVBIN start");

    if (0 == $status) {
        trace ("$srv is starting");
        print  "$srv is starting\n";
    } else {
        trace("failed path = $SRVBIN");
        error ("$srv failed to start: $!");
        return FAILED;
    }

    return SUCCESS;
}

####---------------------------------------------------------
#### Function for stopping daemon/service
# ARGS: 2
# ARG1: daemon to be stopped
# ARG2: user under whom daemon/service needs to be stopped
sub s_stop_service
{
    my $srv = $_[0];
    my $user = $_[1]; # this arg is ignored on NT

    my $SRVBIN = catfile ($ORACLE_HOME, "bin", $srv);
    my $status = system ("$SRVBIN stop");
    if (0 != $status) {
        return FAILED;
    }

    return SUCCESS;
}
#
####---------------------------------------------------------
#### Function for checking daemon (OSD actions)
# ARGS: 2
# ARG1: daemon to be checked
# ARG2: is daemon running?
sub s_check_service
{
    # no-op on NT; generic actions in check_service() are sufficient
}

####---------------------------------------------------------
#### Function for initializing SCR settings
# ARGS: 0
sub s_init_scr
{
    # this function is a no-op on NT
}

####---------------------------------------------------------
#### Function for running a command as given user
# ARGS: 2
# ARG1: cmd to be executed
# ARG2: user name
sub s_run_as_user
{
    my $cmd  = $_[0];
    # ARG2 is ignored on NT; command is always run as current user

    trace ("s_run_as_user: Running $cmd");
    return system ($cmd);
}

####---------------------------------------------------------
#### Function for running a command as given user, returning back 
#### stdout/stderra output
# ARGS: 3
# ARG1: ref to cmdlist argv list to be executed
# ARG2: user name, can be undef
# ARG3: ref to resulting array of stderr/out, can be undef
sub s_run_as_user2
{
    my $cmdlistref = $_[0];
    my @cmdlist = @{$cmdlistref};
    my $usr = $_[1]; # ARG2 is ignored on NT; 
                     # command is always run as current user
    my $capoutref = $_[2];
    my $rc = -1;
    my $cmd = join( ' ', @cmdlist );

    # capture stdout/stderr, if requested
    if (defined($capoutref))
    {
      @{$capoutref} = ();

      trace ("s_run_as_user2: Running $cmd");

      # system() with stdout/stderr capture. 
      # Note that this is a portable notation in perl
      # see http://perldoc.perl.org/perlfaq8.html
      open (CMDOUT, "$cmd 2>&1 |" );
      @{$capoutref} = <CMDOUT>;
      close (CMDOUT); # to get $?
      $rc = $?;
    }
    else  # regular system() call
    {
      $rc = s_run_as_user( $cmd, $usr );
    }
    if ($rc == 0) {
        trace ("$cmdlist[0] successfully executed\n");
    }
    elsif ($rc == -1) {
        trace ("$cmdlist[0] failed to execute: $!\n");
    }
    elsif ($rc & 127) {
        trace ("$cmdlist[0]  died with signal %d, %s coredump\n",
            ($rc & 127),  ($rc & 128) ? 'with' : 'without');
    }
    else {
        trace ("$cmdlist[0] exited with rc=%d\n", $rc >> 8);
    }
    return $rc;
}

####---------------------------------------------------------
#### Function for getting value corresponding to a key in ocr.loc or olr.loc
# ARGS: 2
# ARG1: ocr/olr
# ARG2: key
sub s_get_config_key
{
   my $src   = $_[0];
   my $key   = $_[1];
   my $value = "";
   $src      =~ tr/a-z/A-Z/;
   my $reg;

   if ($src eq 'OCR') {
      $reg = $OCRLOC;
   }
   elsif ($src eq 'OLR') {
      $reg = $OLRLOC;
   }
   elsif ($src eq 'SRV') {
      $reg = $SRVLOC;
   }

   my $regkey = $Registry->{"LMachine/$reg/"};
   if (keys (%{$regkey})) {
      $value = $regkey->{"/$key"};
   }
   else {
      error ("$regkey registry key does not exist");
   }

   return $value;
}

####---------------------------------------------------------
#### Function for getting platform family
# ARGS: 0
sub s_get_platform_family
{
    return "windows";
}

####---------------------------------------------------------
#### Function for checking if a path is a link, and if so, return the target
#### path
#### Note: this function is applicable only to Oracle dev env, where a symlink
#### driver is used.  This will not be applicable in production env, and
#### s_isLink() will always return "" (FALSE)
# ARGS: 1
# ARG1: file/dir path
sub s_isLink
{
    my $path = $_[0];
    my $target = "";

    if (!is_dev_env ()) {
        return $target;
    }

    # run qln and get its output into a string
    open (LNKDRV, "qln $path |") or return "";
    my $op = join ("", <LNKDRV>);
    close (LNKDRV);

    # if qln returns a target path for $path, populate $target
    if ($op && ($op =~ m/->/)) {
        my $key;
        my $ptr;
        ($key, $ptr, $target,) = split (/ /, $op);
    }

    return $target;
}

####--------------------------------
#### Function for redirecting output
# ARGS: 1
# ARG1: file to redirect to
sub s_redirect_souterr
{
    # redirect STDOUT/STDERR to a file
    open(SAVEOUT, ">&STDOUT");
    open(SAVEERR, ">&STDERR");

    open(STDOUT, ">$_[0]") or die "Can't redirect stdout";
    open(STDERR, ">&STDOUT") or die "Can't dup stdout";

    select(STDOUT); $| = 1;  # unbuffer
    select(STDERR); $| = 1;  # unbuffer
}


####---------------------------------------------------------
#### Function for restoring output
# ARGS: 0
sub s_restore_souterr
{
    # restore STDOUT/STDERR
    close(STDOUT);
    close(STDERR);

    open(STDOUT, ">&SAVEOUT");
    open(STDERR, ">&SAVEERR");
}

sub s_getOldCrsHome
#-------------------------------------------------------------------------------
# Function: Get old crshome 
# Args    : none
# Return  : old crshome
#-------------------------------------------------------------------------------
{
   my $oldCRSHome = $CFG->params('OLD_CRS_HOME');

   return $oldCRSHome;
}

####---------------------------------------------------------
#### Function for stopping the services from OldCrsHome
# ARGS:  1

sub s_stop_OldCrsStack
{
  my $oldCrsHome = $_[0];
  my $crsctl     = catfile($oldCrsHome, "bin", "crsctl");
  my @cmd	 = ($crsctl, 'stop', 'crs');
  
  my $rc = system(@cmd);

  return $rc;
}


sub s_checkOracleCM 
#----------------------------------------------------------------
# Function: Check for OracleCMService 
# Args    : none
# Return  : TRUE - if found
#----------------------------------------------------------------
{
   my $svcName = "OracleCMService";
   my %status;

   Win32::Service::GetStatus("",$svcName,\%status);
   my $service_status = $status{CurrentState};

   if ($service_status == 4) {
      # 4 means service is running
      return TRUE;
   }
   else {
      return FALSE;
   }
}

sub s_start_ocfs_driver
#----------------------------------------------------------------
# Function: Start OCFS driver
# Args    : none
#----------------------------------------------------------------
{
   # if in ADE env or CRS_STORAGE_OPTION not = 2, 
   # skip these steps and return success
   if (is_dev_env () ||
      ($CRS_STORAGE_OPTION != 2)) {
      return SUCCESS;
   }

   # Check if ocfs service is running
   if (s_isServiceRunning ("ocfs")) { 
      return SUCCESS;
   }

   # create ClusterName key in the registry
   s_createClusterNameKey ();

   # OCFS is not running, need to start ocfs
   trace ("Creating OCFS driver...");
   my ($cmd, $status);

   # Need to be in $OH\cfs directory in order to run Ocfsinstall.exe
   my $save_current_dir = getcwd;

   my $cfs_dir = (catfile ($ORACLE_HOME, "cfs"));
   chdir $cfs_dir || die "Can't chdir to $cfs_dir";
   my $current_dir = getcwd;

   my $ocfsinstall = catfile ($cfs_dir, "OcfsInstall.exe");
   $cmd = "$ocfsinstall /y";
   if ($DEBUG) { trace ("Invoking: $cmd"); }
   $status = system ("$cmd");
  
   if ($status != 0) {
      error ("Create OCFS driver failed");
      return FAILED;
   }

   # return to prev current dir
   chdir $save_current_dir;

   # start ocfs
   if (SUCCESS != s_startService ("ocfs")) { 
      return FAILED;
   }

   return SUCCESS;
}

sub s_configureAllRemoteNodes
#---------------------------------------------------------------------
# Function: Automatically execute rootcrs.pl on all remote nodes
#           by calling 'crssetup install'
# Args    : 0 
#---------------------------------------------------------------------
{
   trace ("call 'crssetup install' to configure all remote nodes");
   my $crssetup = catfile ($ORACLE_HOME, "bin", "crssetup.exe");
   my @remote_param = ('-remotenode'); 
   if ($CFG->UPGRADE) {
      push @remote_param, '-upgrade';
   }

   my @cmd = ("$crssetup", "install", "-remoteParams", "\"@remote_param\""); 
   trace ("cmd=@cmd");
   system(@cmd);
   my $rc = $? >> 8;
   trace("rc from crssetup=$rc ");

   if ($rc == 0) {
      return SUCCESS;
   } 
   else {
      return FAILED;
   }
}

sub s_createClusterNameKey
#---------------------------------------------------------------------
# Function: Add ClusterName key to Windows registry
# Args    : 0 
#---------------------------------------------------------------------
{
   my $cluster_name = $CFG->params('CLUSTER_NAME');

   trace ("Creating ClusterName key: $cluster_name");
 
   my $ocfs_key = $Registry->{"LMachine/System/CurrentControlSet/Services"}->
                               CreateKey("ocfs");
   my $ocfs_parameters_key = $ocfs_key->CreateKey("Parameters");
   $ocfs_parameters_key->{'ClusterName'} = $cluster_name;
}

sub s_createLocalOnlyOCR
#---------------------------------------------------------------------
# Function: Create local_only OCR
# Args    : none 
#---------------------------------------------------------------------
{
   trace ("Create local_only OCR on Windows...");
   
   # create local_only OCR
   $Registry->{"LMachine/$OCRLOC/"} = {
               "/local_only" => "TRUE",
       	       };

}

sub s_ResetOLR
#---------------------------------------------------------------------
# Function: Reset OLR
# Args    : 0
#--------------------------------------------------------------------
{
   my $olrdisk = s_get_config_key("olr", "olrconfig_loc");
   trace("Removing OLR disk: $olrdisk");

   s_remove_file($olrdisk);

   # remove olr registry key
   my $value = delete $Registry->{"LMachine/$OLRLOC/"};
}

sub s_ResetOCR
{
   trace ("Reset OCR");
   my ($ocr_loc, $ocr_mirror_loc, $ocr_loc3, $ocr_loc4, $ocr_loc5);

   if ($g_downgrade) {
      if ($g_version eq "9.2") {
	 DowngradeTo9i ();
      } 
      else {
	 DowngradeTo10or11i ();
      }

      return SUCCESS;
   }

   s_ResetOLR();

   if (! $g_lastnode) {
      # remove ocr registry key
      my $value = delete $Registry->{"LMachine/$OCRLOC/"};
      return SUCCESS;
   }

   $ocr_loc = get_ocrdisk();
   $ocr_mirror_loc = get_ocrmirrordisk();
   $ocr_loc3 = get_ocrloc3disk();
   $ocr_loc4 = get_ocrloc4disk();
   $ocr_loc5 = get_ocrloc5disk();

   if (! -f $ocr_loc) {
      # ocr.loc file does not exist. Take ocr location of srvconfig.loc. 
      if (-f $SRVCONFIG) {
         $ocr_loc = get_srvdisk();
      }
   }

   if ($ocr_mirror_loc) {
      trace("Removing OCR mirror device: $ocr_mirror_loc");
      s_remove_file($ocr_mirror_loc);
   }

   if ($ocr_loc3) {
      trace("Removing OCR mirror device 3: $ocr_loc3");
      s_remove_file($ocr_loc3);
   }

   if ($ocr_loc4) {
      trace("Removing OCR mirror device 4: $ocr_loc4");
      s_remove_file($ocr_loc4);
   }

   if ($ocr_loc5) {
      trace("Removing OCR mirror device 5: $ocr_loc5");
      s_remove_file($ocr_loc5);
   }

   # reset OCR device if it's not on ASM
   if (($g_lastnode)    &&
       (! $g_downgrade) &&
       (! $CFG->ASM_STORAGE_USED)) 
   {
      trace("Removing OCR device: $ocr_loc");
      s_remove_file($ocr_loc);
   }

   # remove ocr.loc 
   my $value = delete $Registry->{"LMachine/$OCRLOC/"};
}

sub s_remove_file
#-------------------------------------------------------------------------------
# Function: Remove file on Windows
# Args    : File
#-------------------------------------------------------------------------------
{
   my $file = $_[0];

   if (-e $file) {
      trace("Removing file: $file");
      DeleteFile($file);
   }
}

sub s_ResetVotedisks
#-------------------------------------------------------------------------------
# Function: Reset voting disks
# Args    : [0] list of voting disks
#-------------------------------------------------------------------------------
{
   my @votedisk_list = @_;
   my $vdisk;

   trace ("Reset voting disks:@votedisk_list");
   trace ("CRS_STORAGE_OPTION:$CRS_STORAGE_OPTION");

   if ($CRS_STORAGE_OPTION != 1) {
      foreach $vdisk (@votedisk_list) {
         trace("Removing voting disk: $vdisk");
         s_remove_file($vdisk);
      }
   }
}

sub s_CleanTempFiles
{
   # this function is a no-op on NT
   return SUCCESS
}

sub s_createConfigEnvFile
{
   # this function is a no-op on NT
   return SUCCESS
}

sub s_isRAC_appropriate
{
   # this function is a no-op on NT
   return SUCCESS
}

sub s_removeCvuRpm
{
   # this function is a no-op on NT
   return SUCCESS
}

sub s_is92ConfigExists
{
   # this function is a no-op on NT
   return SUCCESS
}

sub s_RemoveInitResources
{
   # this function is a no-op on NT
   return SUCCESS
}

sub s_copyOCRLoc
#-------------------------------------------------------------------------------
# Function: copy OCR location from other node
# Args    : 0 
#-------------------------------------------------------------------------------
{
   trace ("Creating ocr key using ocr key from other node");

   my @node_list = getCurrentNodenameList();
   my $rc	 = FAILED;
   my $node;

   foreach $node (@node_list) {
      if ($node !~ /\b$HOST\b/i) {
	 trace("get OCR key from node=$node");
	 my $remKey = $Registry->Connect("\\\\$node", 
	   			  	 "LMachine/$OCRLOC");
	 my @vnames = $remKey->ValueNames;
         my ($vname, $vdata);

	 foreach $vname (@vnames) {
            $vdata = $remKey->GetValue("$vname");

            print ("creating $vname=$vdata from node=$node\n");
            trace ("creating $vname=$vdata from node=$node");
            $Registry->{"LMachine/$OCRLOC/"} = {
         	        "$vname" => "$vdata",
            };
         }

	 $rc = SUCCESS;
 	 last;

      }
      else {
         trace("Avoiding self copy of ocr on node: $node");
      }
   }

   return $rc;
}

sub s_houseCleaning
{
   s_deltService("OracleClusterVolumeService");

   s_deltService("Oracle Object Service");

   s_deltService("OracleOHService");

   my $LMachine = "LMachine/System/CurrentControlSet/Services/";
   my ($key, $key_param);

   # remove ocfs key 
   $key       = $LMachine . "ocfs";
   $key_param = $key . "/Parameters";
   trace ("removing $key ...");

   s_deltRegKey($key_param);
   s_deltRegKey($key);
}

sub s_deltRegKey
#-------------------------------------------------------------------------------
# Function: Delete registry key and its subkeys
# Args    : 1 (key) 
#-------------------------------------------------------------------------------
{
   my $key      = $_[0];
   my $checkkey = $Registry->Open("$key") || return SUCCESS;

   my @subkeys = $Registry->{"$key"}->SubKeyNames;
   my ($delt, $subkey);

   # delete all subkeys 
   # Fixme: this function should be recursively delete
   foreach $subkey (@subkeys) {
      print("delete subkey=$subkey\n");
      trace("delete subkey=$subkey");
      $delt = delete $Registry->{"$key/$subkey/"};
   }

   # delete key 
   $delt = delete $Registry->{"$key/"};
}

sub s_getAbsLink
{
   # this function is a no-op on NT
   return SUCCESS;
}

sub s_removeSCR
{
   my $key   = "SCR";
   my $value = delete $Registry->{"LMachine/Software/oracle/$key/"};
}


sub s_removeFenceServ
#-------------------------------------------------------------------------------
# Function: remove oracle fence service
# Args    : 0 
#-------------------------------------------------------------------------------
{

   my $crssetup = catfile($ORACLE_HOME, 'bin', 'crssetup.exe');
   my $cmd	= "$crssetup deinstallfence";
   trace ("Remove Oracle Fence Service... $cmd");
   print ("Remove Oracle Fence Service... $cmd\n");

   my $status = system($cmd);
   if ($status == 0) {
      trace ("Remove Oracle Fence Service successfully");
   }
   else {
      error ("Remove Oracle Fence Service failed");
      return FAILED;
   }

    return SUCCESS;
}

sub s_getAuthorizedOwner
#-------------------------------------------------------------------------------
# Function: Get authorized owner ("NT AUTHORITY\SYSTEM")
# Args    : none
#-------------------------------------------------------------------------------
{
   # ohasd.exe should be owned by 'NT AUTHORITY\SYSTEM'
   # therefore get its file permission

   my ($owner, $dummy);

   if (is_dev_env ()) {
      $owner = "NT AUTHORITY\\SYSTEM";
      return $owner;
   }

   my $ohasd_file = catfile($CFG->params('ORACLE_HOME'), 'bin', 'ohasd.exe');
   my ($owner, $dummy);

   my @out = system_cmd_capture('cacls.exe', "$ohasd_file");
   my $rc  = shift @out;
   trace ("output from cacls=@out");

   if ($rc == 0) {
      my @grep_out = grep(/\SYSTEM:/, @out); # grep for SYSTEM
      if (scalar(@grep_out) > 0) {
         ($owner, $dummy) = split(/:/, trim($grep_out[0]));
      }
   }

   trace ("owner from cacls=$owner");

   if (! $owner) {
      die ("Unable to get authorized owner");
   }

   return $owner;
}

sub s_copyRegKey
{
   my $from_key = $_[0];
   my $to_key   = $_[1];


   trace ("copy registry key from=$from_key to=$to_key");
   $Registry->{"LMachine/$to_key/"} = $Registry->{"LMachine/$from_key/"};
}

sub s_stopService
#-------------------------------------------------------------------------------
# Function: Stop Windows service
# Args    : 1 - service name
#-------------------------------------------------------------------------------
{
   my $svcName     = $_[0];
   my $svc_stopped = FALSE;
   my $retries     = 5;
   my %svc_status;
   
   if (s_isServiceRunning($svcName)) { 
      # stop service
      Win32::Service::StopService("", $svcName);
 
      while ($retries && (! $svc_stopped)) {
   	 # get service status
         Win32::Service::GetStatus("", $svcName, \%svc_status);
  
         # 1 means service stopped
         if ($svc_status{"CurrentState"} == 1) {
            $svc_stopped = TRUE;
         }
         else {
            trace ("Waiting for $svcName to stop");
            sleep (60);
            $retries--;
         }
      }
   }
   else {
      $svc_stopped = TRUE;
   }
   
   if ($svc_stopped) {
      trace ("stop of $svcName ... success");
   }
   else {
      trace ("stop of $svcName ... failed");
   }

   return $svc_stopped;
}

sub s_stopDeltOldASM
{
   my $asm_service = "OracleASMService\+ASM";
   my $success     = TRUE;

   if (s_isServiceExists($asm_service)) {
      $success = s_stopService($asm_service);

      if ($success) {
	 # delete ASM dependencies
	 my @cmd = ('sc', 'config', $asm_service, 'depend=', "\"\"");
         my @out = system_cmd_capture(@cmd);
         trace("out=@out");
         my $rc  = shift @out;

	 if ($rc == 0) {
	    trace ("@cmd ... success");
	 }
	 else {
	    trace ("@cmd ... failed with rc=", $rc >> 8);
            $success = FALSE;
	 }
      }
   }

   if (! $success) {
      die ("Unable to stop $asm_service and its dependencies");
   }


   return $success;
}

sub s_get_olr_file
{
   my $key = $_[0];

   return s_get_config_key("OLR", $key);
}

sub s_getDomainName
{

   return Win32::DomainName();
}

sub s_deltOldServ
{
   my $rc = s_deltService("OracleCRService");

   if ($rc) {
      s_deltService("OracleCSService");
   }

   if ($rc) {
      s_deltService("OracleEVMService");
   }

   return $rc;
}

1;