#!/usr/local/bin/perl

#----------------
# standard header

require 5.6.1; # minimum perl version
use strict;
use warnings;

#-------------------------
# dictums for this program

# Errors
# - catch and report errors at the lowest level possible
#
# Functions and Variables
# - list each function used when importing a module
# - declare a function prototype for each of our functions
# - call all non-Class functions with no parens: func arg1, arg2 ...
# - note: perl requires calling a Class function as: XX::YY->f(arg1, arg2, ...)
# - use scoped static variables instead of global variables
#
# Options and Arguments
# - support gnu-style options processing and a -help option

#------------------------------------------------------------------------------
#                  PROGRAM PREFACE
#------------------------------------------------------------------------------

#---------------
# import modules

use English; # allow readable special variables
use Getopt::Long qw( GetOptions );

use File::Basename qw( basename );
use File::Copy qw( copy );
use File::Find qw( find );
use File::Path qw( mkpath
                   rmtree );
use File::Spec # Class
               qw( catdir
                   catfile
                   rel2abs);

#----------------------
# function declarations

sub copy_file ($$);
sub copy_tree ($$);
sub copy_tree_callback ($);
sub create_dir ($);
sub get_deployed_mp_names ($);
sub get_errors ();
sub get_help ();
sub get_option ($);
sub get_subdirs ($$);
sub is_readable_dir ($);
sub my_exit (@);
sub read_options ();
sub report_error (@);

#----------
# constants

# error strings
my $ERROR_SEVERITY_STR = 'ERROR: ';
my $WARNING_SEVERITY_STR = 'WARNING: ';
my $INFO_SEVERITY_STR = 'INFO: ';

# deployed MP marker file name has the form: ".deployed_$MpVersionStr"
# (eg. .../scripts/emx/potatoserver_http/.deployed_2.4)
#
my $DEPLOYED_MARKER_PAT = '^\\.deployed_.*';

# these paths are relative to ORACLE_HOME (on an agent)
my $METADATA_SUBDIR = File::Spec->catdir(
  'sysman', 'admin', 'metadata');
my $COLLECTION_SUBDIR = File::Spec->catdir(
  'sysman', 'admin', 'default_collection');
my $MP_SUBDIR = File::Spec->catdir(
  'sysman', 'admin', 'scripts', 'emx');

#------------------------------------------------------------------------------
#                  FUNCTION: get_help
#------------------------------------------------------------------------------
# Get help text for this command.
#
# Input: none
# Returns:
#   $help_text -- multiline help text string for this command (ie. man page)
#
# ----
# Note that the option names for this command are required
# by the upgrade framework code to be -src_home and -tgt_home.
#
sub get_help () {
  my $help_text = <<'HELP_TEXT';  # do not expand vars

------
Usage:
  upgrade_mp.pl
    -src_home=old_agent_home
    -tgt_home=new_agent_home
    [-help]

--------
Arguments: (abbreviations allowed)
  -src_home=old_agent_home
    Path to the old agent home directory (ORACLE_HOME environment variable).

  -tgt_home=new_agent_home
    Path to the new agent home directory.

  [-help]
    Outputs help for this command.

------------
Description:
  This command upgrades all the Management Plug-Ins (MP_NAMEs) on an agent,
  by copying them from the old agent home to a new agent home.
  This command should be run on the agent being upgraded or on a host
  where both the old_agent_home and new_agent_home directories are accessible.
  
  Each MP_NAME which was successfully deployed on the agent is copied.
  The files copied to corresponding places on the new agent home are:
    OLD_AGENT_HOME/sysman/admin/metadata/MP_NAME.xml
    OLD_AGENT_HOME/sysman/admin/default_collection/MP_NAME.xml
    OLD_AGENT_HOME/sysman/admin/scripts/emx/MP_NAME/*  (recursive copy)
  
  An informational message ("INFO: ...") is reported for each MP_NAME
  that is successfully copied to the new agent home.

  The exit code from this command is zero unless some errors occur.
  An error ("ERROR: ...") is reported when:
    o the old agent home directory does not exist
    o the new agent home directory does not exist
    o the metadata file does not exist
    o the default collection file does not exist
    o a file copy fails

---------
Examples:
  #
  # upgrade Management Plug-Ins on this agent from version 10.1 to version 10.2
  #
  upgrade_mp.pl -src_home=/usr/lib/oracle/emagent_10.1 \
                -tgt_home=/usr/lib/oracle/emagent_10.2

HELP_TEXT
  return $help_text;
}

#------------------------------------------------------------------------------
{ # begin private static variables for main

#------------------------------------------------------------------------------
#                  MAIN PROGRAM
#------------------------------------------------------------------------------

#---------------------------------------
# Get and check command arguments.
# Set {old|new}_home variables.

# read option values, print help text if requested, and exit on syntax errors
read_options;

my $old_home = get_option 'src_home';
is_readable_dir $old_home
  or my_exit $ERROR_SEVERITY_STR
    . "src_home '$old_home' is not a readable directory\n";

my $new_home = get_option 'tgt_home';
is_readable_dir $new_home
  or my_exit $ERROR_SEVERITY_STR
    . "tgt_home '$new_home' is not a readable directory\n";

#---------------------------------------
# Set {old|new}_*_dir variables.

# use absolute paths (for better error messages)
my $old_metadata_dir = File::Spec->rel2abs($METADATA_SUBDIR, $old_home);
my $old_collection_dir = File::Spec->rel2abs($COLLECTION_SUBDIR, $old_home);
my $old_mp_scripts_dir = File::Spec->rel2abs($MP_SUBDIR, $old_home);

my $new_metadata_dir = File::Spec->rel2abs($METADATA_SUBDIR, $new_home);
my $new_collection_dir = File::Spec->rel2abs($COLLECTION_SUBDIR, $new_home);
my $new_mp_scripts_dir = File::Spec->rel2abs($MP_SUBDIR, $new_home);

is_readable_dir $old_metadata_dir
  or my_exit $ERROR_SEVERITY_STR
    . "'$old_metadata_dir' is not a readable directory\n";

is_readable_dir $old_collection_dir
  or my_exit $ERROR_SEVERITY_STR
    . "'$old_collection_dir' is not a readable directory\n";

#---------------------------------------
# Get list of deployed MPs.
# Create new_*_dir top level directories.

# get the list of deployed MPs
my @mp_names = get_deployed_mp_names $old_mp_scripts_dir;

# report info message and exit if there are no deployed MPs
@mp_names
  or my_exit $INFO_SEVERITY_STR
    . "There are no Management Plug-Ins to upgrade\n";

# assert: there are some deployed MPs
# assert: $old_mp_scripts_dir is a readable directory

# create new top level dirs if they do not exist
create_dir $new_metadata_dir
  or my_exit;
create_dir $new_collection_dir
  or my_exit;
create_dir $new_mp_scripts_dir
  or my_exit;

#---------------------------------------
# Copy each deployed MP to the new agent home.

foreach my $mp (@mp_names) {

  my $mp_goodness = 1;

  # copy metadata file for MP
  my $old_metadata_file = File::Spec->catfile($old_metadata_dir, $mp . '.xml');
  my $new_metadata_file = File::Spec->catfile($new_metadata_dir, $mp . '.xml');
  copy_file $old_metadata_file, $new_metadata_file
    or $mp_goodness = 0;

  # copy default collection file for MP
  my $old_collection_file = File::Spec->catfile($old_collection_dir, $mp . '.xml');
  my $new_collection_file = File::Spec->catfile($new_collection_dir, $mp . '.xml');
  copy_file $old_collection_file, $new_collection_file
    or $mp_goodness = 0;

  # copy MP script files
  my $old_mp_dir = File::Spec->catdir($old_mp_scripts_dir, $mp);
  my $new_mp_dir = File::Spec->catdir($new_mp_scripts_dir, $mp);
  copy_tree $old_mp_dir, $new_mp_dir
    or $mp_goodness = 0;

  # info message if copy of MP was successful
  if ($mp_goodness) {
    report_error $INFO_SEVERITY_STR
      . "Management Plug-in '$mp' upgraded successfully\n";
  }

} # foreach $mp

#---------------------------------------
# Report errors and exit.

my_exit;

} # end private static variables for main
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
#                  FUNCTION: get_deployed_mp_names
#------------------------------------------------------------------------------
# Get the names of all deployed MPs.
#
# An MP is deployed if a deployment marker file exists for it
# in the scripts directory for the MP.
#
# Input:
#   $mp_scripts_dir -- parent directory of all MP scripts directories
# Returns:
#   @deployed_mps -- list of deployed MP names
#
sub get_deployed_mp_names ($) {
  my ($mp_scripts_dir) = @_;
  my @deployed_mps = ();

  # not an error if no MPs were deployed
  -d $mp_scripts_dir
    or return @deployed_mps;

  # set @all_mp_paths to the list of subdirs under the source scripts dir
  my @all_mp_paths = ();
  get_subdirs $mp_scripts_dir, \@all_mp_paths
    or return @deployed_mps;

  # build the list of deployed MPs
  foreach my $mp_dir (@all_mp_paths) {
    if (not opendir MP_DIR, $mp_dir) {
      report_error $ERROR_SEVERITY_STR
        . "cannot open directory '$mp_dir'\n";
      next; # NEXT $mp_dir
    }
    # an MP is deployed iff a deployment marker file exists
    my @deployed_marker_files = grep {/$DEPLOYED_MARKER_PAT/o} readdir MP_DIR;

    closedir MP_DIR;

    my $mp = basename $mp_dir;
    if (@deployed_marker_files == 1) { # one deployment marker file
      push @deployed_mps, $mp;
    }
    elsif (@deployed_marker_files > 1) { # more than one deployment marker file
      report_error $ERROR_SEVERITY_STR
        . "MP Internal Error: more than one deployment marker file exists for MP '$mp'\n";
    }
    # else no deployment marker file

  } # foreach $mp

  return @deployed_mps;
}

#------------------------------------------------------------------------------
#                  FUNCTION: get_subdirs
#------------------------------------------------------------------------------
# Get all subdirectories (not "." or "..") of a parent directory
# in sorted order.
#
# Input:
#   $dir -- parent directory of subdirectories
# Input-Output:
#   \@out_subdirs_ref -- ref to the list of subdirectories
# Returns:
#   $rc -- 1 if success, 0 if any errors are reported
#
sub get_subdirs ($$) {
  my ($dir, $out_subdirs_ref) = @_;

  if (not opendir DIRH, $dir) {
    report_error $ERROR_SEVERITY_STR
      . "cannot open directory '$dir'\n";
    return 0;
  }

  # get all subdirectories (not "." or "..") in sorted order
  @$out_subdirs_ref =
    sort
    grep {-d}
    map {File::Spec->catfile($dir, $_)}
    grep {not /^(\.|\.\.)$/}
    readdir DIRH; # just filenames not full pathnames

  closedir DIRH;

  return 1;
}

#------------------------------------------------------------------------------
#                  FUNCTION: is_readable_dir
#------------------------------------------------------------------------------
# Return 1 if the current user has read and search permissions
# on directory $dir.
#
# Input:
#   $dir -- directory
# Returns:
#   $rc -- 1 if $dir is a readable directory, otherwise 0
#
sub is_readable_dir ($) {
  my ($dir) = @_;

  return -d $dir and -r $dir and -x $dir;
}

#------------------------------------------------------------------------------
#                  FUNCTION: copy_file
#------------------------------------------------------------------------------
# Copy a file preserving the chmod value.
# The target file is removed before the source file is copied.
#
# Input:
#   $from -- source file
#   $to -- target file
# Returns:
#   $rc -- 1 if success, 0 if any errors are reported
#
sub copy_file ($$) {
  my ($from, $to) = @_;

  # delete the target file if it exists
  # (otherwise there may be permission problems which prevent a file copy)
  #
  if (-e $to) {
    if (not unlink $to) {
      # do not report an error -- let copy report a problem if it fails
    }
  }

  # copy the file
  if (not copy $from, $to) {
    report_error $ERROR_SEVERITY_STR
      . "failed to copy file '$from' to file '$to': $OS_ERROR\n";
    return 0;
  }

  # chmod the target file to match the source file
  # (the mask 0777 removes any suid/sgid bits)
  #
  my $chmod_value = (stat $from)[2] & 0777;
  if (not chmod $chmod_value, $to) {
    report_error $ERROR_SEVERITY_STR
      . "failed to chmod file '$to': $OS_ERROR\n";
    return 0;
  }

  return 1;
}

#------------------------------------------------------------------------------
#                  FUNCTION: create_dir
#------------------------------------------------------------------------------
# Create a new directory (and all intermediate directories along its path)
# and chmod each new directory to 0755. If the directory already exists,
# its permission bits will be set to 07xx (where xx is unchanged).
#
# Input:
#   $new_dir -- pathname of directory to create if necessary
# Returns:
#   $rc -- 1 if success, 0 if any errors are reported
#
sub create_dir ($) {
  my ($new_dir) = @_;

  # report error if new_dir exists but is not a directory
  if (-e $new_dir) {
    if (not -d $new_dir) {
      report_error $ERROR_SEVERITY_STR
        . "'$new_dir' exists but is not directory\n";
      return 0;
    }
    # new_dir is an existing directory
    else {
      # chmod directory to be 0755
      if (not chmod 0755, $new_dir) {
        report_error $ERROR_SEVERITY_STR
          . "failed to chmod directory '$new_dir': $OS_ERROR\n";
        return 0;
      }
    }
  }
  # new_dir does not exist
  else {
    # create the new directory
    eval { # try
      # create new directory and any needed intermediate directories
      mkpath $new_dir, 0, 0755;
    };
    if ($EVAL_ERROR) { # catch
      report_error $ERROR_SEVERITY_STR
        . "failed to create directory '$new_dir': $EVAL_ERROR\n";
      return 0;
    }
  }

  return 1;
}

#------------------------------------------------------------------------------
{ # begin private static variables for copy_tree functions

# variables used to communicate with copy_tree_callback
my $g_callback_errcount = 0;
my $g_from_top_dir = '';
my $g_to_top_dir = '';

#------------------------------------------------------------------------------
#                  FUNCTION: copy_tree
#------------------------------------------------------------------------------
# Copy a directory tree recursively, following symbolic links in the
# source directory tree; the target directory will have no symbolic links.
#
# Algorithm:
# - If the target directory exists, the directory and all files under it
#   are removed.
# - Then the source directory is copied recursively to the target directory.
# - All target directories will have chmod value 0755.
# - The chmod value of each target file will match the chmod value of the
#   corresponding source file.
# - All target files and directories will be owned
#   by the user who runs this command.
#
# Input:
#   $from_dir -- source directory pathname
#   $to_dir -- target directory pathname
# Returns:
#   $rc -- 1 if success, 0 if any errors are reported
#
sub copy_tree ($$) {
  my ($from_dir, $to_dir) = @_;

  # check source directory
  if (not is_readable_dir $from_dir) {
    report_error $ERROR_SEVERITY_STR
      . "'$from_dir' is not a readable directory\n";
    return 0;
  }

  # delete target directory and any files under it
  if (-e $to_dir) {
    if (not -d $to_dir) {
      report_error $ERROR_SEVERITY_STR
        . "'$to_dir' exists but is not directory\n";
      return 0;
    }

    # save rmtree messages prefixed with warning severity string
    $SIG{__WARN__} = sub {report_error map {$WARNING_SEVERITY_STR . $_} @_};
    rmtree $to_dir;
    $SIG{__WARN__} = 'DEFAULT';

    if (-e $to_dir) {
      report_error $ERROR_SEVERITY_STR
        . "failed to delete directory '$to_dir'\n";
      return 0;
    }
  }

  # recursively walk top down (breadth-first) the directory tree $from_dir,
  # executing function copy_tree_callback for each file or directory

  # variables used to communicate with copy_tree_callback
  $g_from_top_dir = $from_dir;
  $g_to_top_dir = $to_dir;
  $g_callback_errcount = 0;

  my %find_options = (
    wanted=>\&copy_tree_callback,  # callback function for files and dirs
    follow_skip=>2,  # ignore duplicate files and dirs
    no_chdir=>1,  # no chdir to each dir
    );

  # recursive tree walk
  find \%find_options, $from_dir;

  if ($g_callback_errcount) { # find reported some errors
    return 0;
  }

  return 1; # success
}

#------------------------------------------------------------------------------
#                  FUNCTION: copy_tree_callback
#------------------------------------------------------------------------------
# Callback function for each file and directory in a top down tree walk,
# called from function copy_tree via function find.
#
# If $File::Find::name (the full source path) is a directory,
# then create_dir is called to create the corresponding target directory.
# If $File::Find::name is a file,
# then copy_file is called to create the corresponding target file.
#
# All target directories will have chmod value 0755.
# The chmod value of each target file will match the chmod value of the
# corresponding source file.
# All target files and directories will be owned
# by the user who runs this command.
#
# Input:
#   $File::Find::name -- full source path for current "find" file or dir
# Returns: none
#
sub copy_tree_callback ($) {
  # do not need to use input arg
  my $from_path = $File::Find::name;

  # form corresponding target path
  # by replacing source top dir prefix with target top dir prefix
  #
  my $to_path = substr $from_path, length $g_from_top_dir;
  $to_path = $g_to_top_dir . $to_path;

  if (-d $from_path) { # directory
    create_dir $to_path
      or $g_callback_errcount++;
  }
  else { # file
    copy_file $from_path, $to_path
      or $g_callback_errcount++;
  }
}

} # end private static variables for copy_tree functions
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
{ # begin private static variables for error functions

# list of errors to report
my @g_errs = ();

#------------------------------------------------------------------------------
#                  FUNCTION: report_error
#------------------------------------------------------------------------------
# Add a list of error messages (each ending in newline) to the list
# of errors to report.
#
# Input:
#   @more_errors -- list of error messages (each ending in newline) to be added
# Returns: none
#
sub report_error (@) {
  push @g_errs, @_;
}

#------------------------------------------------------------------------------
#                  FUNCTION: get_errors
#------------------------------------------------------------------------------
# Get the list of all errors to report.
#
# Input: none
# Returns:
#   @all_errors -- list of all errors to report
#
sub get_errors () {
  return @g_errs;
}

} # end private static variables for error functions
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
{ # begin private static variables for options functions

# command line options hash: $option_value=$g_opt{$option_name}
my %g_opt = ();

#------------------------------------------------------------------------------
#                  FUNCTION: get_option
#------------------------------------------------------------------------------
# Get option value.
#
# Preconditions:
#   -- read_options must have already been called
# Input:
#   $option_name -- name of option
# Returns:
#   $option_value -- value of option, or undef if it is not set
#
sub get_option ($) {
  my ($option_name) = @_;
  return $g_opt{$option_name};
}

#------------------------------------------------------------------------------
#                  FUNCTION: read_options
#------------------------------------------------------------------------------
# Note: this function needs to be customized for each program's options.
#
# Parse the command line to set command option values.
# After this function is called, @ARGV contains all the positional arguments.
#
# If the -help option is specified on the command line, the help text
# is printed to stdout and this program exits with a code of zero.
# If any syntax errors occur, they are printed to stderr, the help text
# is printed to stderr, and this program exits with a non-zero code.
#
# The option specification as well as the default options are set
# by this function before parsing the command line options.
#
# Command line option syntax: -[-]option_name[=option_value]
# Note that option_name may be an unambiguous abbreviation
# of the full option name.
#
# Preconditions:
#   -- read_options must not have already been called
# Input: none
# Returns: EXIT if -help option specified
#   -- @ARGV has been modified to contain just the positional arguments
#   -- EXIT program with value 0 if -help option specified
#   -- EXIT program with value 2 if any syntax errors occur
#
sub read_options () {

  # customize: set options specification
  my @options_spec = (
    'help!',
    'src_home=s',
    'tgt_home=s',
    );

  # customize: set default options
  %g_opt = (
    help => 0,
    );

  # store options in hash %g_opt
  # and save GetOptions error messages prefixed with error severity string
  #
  $SIG{__WARN__} = sub {report_error map {$ERROR_SEVERITY_STR . $_} @_};
  GetOptions \%g_opt, @options_spec
    or my_exit get_help;
  $SIG{__WARN__} = 'DEFAULT';
  # @ARGV now contains only positional arguments

  # print help if requested
  if (get_option 'help') {
    print STDOUT get_help;
    my_exit;
  }

  # customize: check for required arguments
  if (not defined get_option 'src_home') {
    report_error $ERROR_SEVERITY_STR
      . "missing required argument -src_home\n";
    my_exit get_help;
  }
  if (not defined get_option 'tgt_home') {
    report_error $ERROR_SEVERITY_STR
      . "missing required argument -tgt_home\n";
    my_exit get_help;
  }

  # customize: check for correct number of positional arguments
  if (@ARGV) {
    report_error $ERROR_SEVERITY_STR
      . "no positional arguments are allowed\n";
    my_exit get_help;
  }
}

} # end private static variables for options functions
#------------------------------------------------------------------------------

#------------------------------------------------------------------------------
#                  FUNCTION: my_exit
#------------------------------------------------------------------------------
# Exit the program after printing to stderr the accumulated error messages
# and then the new list of errors specified.
#
# Note that the report_error function should be called to report errors when
# an immediate exit is not desired.
# 
# Input:
#   @more_errors -- list of error messages (each ending in newline)
#                   to be reported
# Returns: EXIT always
#   -- EXIT value from this command is the highest error severity reported:
#     0 -- success severity (no error message)
#     0 -- info severity ("INFO: ...")
#     1 -- warning severity ("WARNING: ...")
#     2 -- error severity ("ERROR: ...")
#
sub my_exit (@) {
  # output to stderr all error messages then the function args
  my (@all_errs) = (get_errors, @_);

  print STDERR @all_errs;

  # set the severity level
  my $severity_level = 0; # default is success severity

  if (@all_errs) { # some messages were reported
   # error severity
    if (grep { /^$ERROR_SEVERITY_STR/ } @all_errs) {
      $severity_level = 2;
    }
   # warning severity
    elsif (grep { /^$WARNING_SEVERITY_STR/ } @all_errs) {
      $severity_level = 1;
    }
  }

  exit $severity_level; # EXIT
}