#!/usr/local/bin/perl
# 
# s_jwcctl_lib.pm
# 
# Copyright (c) 2012, 2016, Oracle and/or its affiliates. All rights reserved.
#
#    NAME
#      s_jwcctl_lib.pm - JWC Control Action Script OSD Library Module
#
#    DESCRIPTION
#      s_jwcctl_lib.pm - Unix OSD library module for JWC Control
#
#    NOTES
#
#    MODIFIED   (MM/DD/YY)
#    jgrout      07/06/16 - Fix bug 23750346
#    jgrout      05/17/16 - Fix bug 23301755
#    gmaldona    05/17/16 - LRG-19350778.
#    jgrout      04/12/16 - Fix bug 22651447
#    jgrout      01/25/16 - Fix bug 22066785
#    lluis       01/20/16 - Define s_get_crskeytoolctl and lock functions
#    jgrout      08/21/15 - Change localhost to global constant
#    jgrout      02/27/15 - Adapt for JWC Control from OC4J Control
#    jgrout      03/06/13 - Forward merge fix for bug 15968944 to main
#    dsemler     09/18/12 - fix regex for finding the OC4J pid
#    jgrout      05/17/12 - Create AIX porting fix for bug 14057544
#    jgrout      02/07/12 - Created

package s_jwcctl_lib;

use strict;
use warnings;
use File::Spec::Functions;
use POSIX qw(:errno_h :signal_h);
use Fcntl qw(:DEFAULT :flock :seek);
use Errno;
use Cwd;
use jwcctl_common;

our $pidfile_temp_dir;

our $VERSION = '1';

use English;
use Exporter;

use constant {
  NULLFILE => "/dev/null"
};

our (@ISA, @EXPORT);

# Export in a BEGIN block to avoid compilation failure

BEGIN {
  require Exporter;
  @ISA = qw(Exporter);

  my @exp_const = qw(NULLFILE
                    );

  my @exp_osd  = qw(s_init_globals s_async_start s_sync_start s_send_signal
                    s_get_jwc_pid_list s_get_jwc_executable_pid_list
                    s_java_path_defs s_get_jre s_get_jstack s_get_crskeytoolctl
                    s_create_lock_file s_file_lock s_file_unlock
                    );

  my @exp = (@exp_const, @exp_osd);
  @EXPORT  = @exp;
}

sub s_init_globals
#---------------------------------------------------------------------
# Function: Initialize Unix OSD globals
#
# Args    : None
#
# Returns : SUCC_CODE (operation succeeded)
#           FAIL_CODE (operation failed)
#---------------------------------------------------------------------
{
  $pidfile_temp_dir = catfile($ENV{"CATALINA_BASE"}, "temp");

  return SUCC_CODE;
}

sub s_get_jre
#---------------------------------------------------------------------
# Function: Return JRE file path
#
# Args    : None
#
# Returns : JRE file path
#---------------------------------------------------------------------
{
  return catfile($ENV{"JAVA_HOME"}, "bin", "java");
}

sub s_get_jstack
#---------------------------------------------------------------------
# Function: Return jstack command file path
#
# Args    : None
#
# Returns : jstack command file path
#---------------------------------------------------------------------
{
  return catfile($ENV{"JAVA_HOME"}, "bin", "jstack");
}

sub s_async_start
#---------------------------------------------------------------------
# Function: Start command asynchronously in the background
#
# Args    : Initial (for tomcat, shutter or checker)
#           Files for STDIN, STDOUT and STDERR
#           List with program name and its arguments
#
# Returns : None
#---------------------------------------------------------------------
{
  my $first_child_pid = fork();
  if (!defined($first_child_pid))
  {
    die "First fork attempted by s_async_start failed.";
  }
  elsif ($first_child_pid == 0)
  {
    # Fork second child here
    my $second_child_pid = fork();
    if (!defined($second_child_pid))
    {
      die "Second fork attempted by s_async_start failed.";
    }
    elsif ($second_child_pid == 0)
    {
      # Validate the pid file and execute (no return)
      validate_pid_file_and_execute(@_);
      exit;
    }
    else
    {
      # Write the PID file
      my $initial = shift;
      my $pidfile = "$second_child_pid$initial.pid";
      write_pid_file($pidfile);
    }
    exit;
  }
  else
  {
    # Wait for the first child
    waitpid($first_child_pid, 0);
  }
}

sub s_sync_start
#---------------------------------------------------------------------
# Function: Start command synchronously
#
# Args    : Initial (for tomcat, shutter or checker)
#           Files for STDIN, STDOUT and STDERR
#           List with program name and its arguments
#
# Returns : Result of synchronous command
#---------------------------------------------------------------------
{
  my $child_pid = fork();
  if (!defined($child_pid))
  {
    die "Fork attempted by s_sync_start failed.";
  }
  elsif ($child_pid == 0)
  {
    # Validate the pid file and execute (no return)
    validate_pid_file_and_execute(@_);
    exit;
  }
  else
  {
    # Write the PID file
    my $initial = shift;
    my $pidfile = "$child_pid$initial.pid";
    write_pid_file($pidfile);

    # Wait for the child
    my $ended_pid = wait;
    my $exit_code = $?;
    if ($ended_pid == -1)
    {
      die "No child seen in s_sync_start.";
    }
    elsif ($ended_pid != $child_pid)
    {
      die "Wrong pid $ended_pid seen in s_sync_start.";
    }

    # Remove the PID file
    $pidfile = catfile($pidfile_temp_dir, $pidfile);
    unlink($pidfile);
    return $exit_code;
  }
}

sub s_send_signal
#---------------------------------------------------------------------
# Function: Send check, quit or kill signal
#
# Args    : Type of signal to send ("check", "quit" or "kill")
#           Process number
#
# Returns : SUCC_CODE (for "quit" and "kill", operation initiated;
#                      for "check", process still under control)
#           FAIL_CODE (operation not implemented)
#           ERROR_PID (process no longer under control)
#           NULL_PID  (process no longer exists)
#---------------------------------------------------------------------
{
  my $sig_rc = FAIL_CODE;
  my ($action, $jwc_pid) = @_;

  if ($action eq "check")
  {
    if (kill 0 => $jwc_pid)
    {
      $sig_rc = SUCC_CODE;
    }
    elsif ($!{EPERM})
    {
      debug_out("Process $jwc_pid no longer under our control.");
      $sig_rc = ERROR_PID;
    }
    elsif ($!{ESRCH})
    {
      debug_out("Process $jwc_pid deceased or zombie.");
      $sig_rc = NULL_PID;
    }
    else
    {
      debug_out("Process $jwc_pid status could not be checked.");
      $sig_rc = ERROR_PID;
    }
  }
  elsif ($action eq "quit")
  {
    kill SIGQUIT => $jwc_pid;
    $sig_rc = SUCC_CODE;
  }
  elsif ($action eq "kill")
  {
    kill SIGKILL => $jwc_pid;
    $sig_rc = SUCC_CODE;
  }
  return $sig_rc;
}

sub s_java_path_defs
#---------------------------------------------------------------------
# Function: Return Unix java path defs
#
# Args    : None
#
# Returns : Unix java path defs 
#---------------------------------------------------------------------
{
  return ();
}

sub s_get_crskeytoolctl
#---------------------------------------------------------------------
# Function: Return crskeytoolctl command file path
#
# Args    : None
#
# Returns : crskeytoolctl command file path
#---------------------------------------------------------------------
{
  return catfile($ENV{"ORACLE_HOME"}, "bin", "crskeytoolctl");
}

sub s_create_lock_file
#---------------------------------------------------------------------
# Function: Create the lock file in the given path. The lock file will be
#           open if it already exists
#
# Args    : path to the lock file to create
#
# Returns : Filehandle of the lock file
#---------------------------------------------------------------------
{
  my ($file) = @_;
  sysopen my $fh, $file, O_RDWR | O_CREAT or die "$0: open: $!";
  debug_out("$0: $$ file opened\n");
  return $fh;
}

sub s_file_lock
#---------------------------------------------------------------------
# Function: Lock a file (LOCK_EX)
#
# Args    : Filehandle of the file to lock
#
# Returns : None
#---------------------------------------------------------------------
{
  my ($fh) = @_;
  flock ($fh, LOCK_EX) or die "$0: flock_lock_ex: $!";
  debug_out("$0: $$ acquired lock\n");
}

sub s_file_unlock
#---------------------------------------------------------------------
# Function: Unlock a file
#
# Args    : Filehandle of the file to unlock
#
# Returns : None
#---------------------------------------------------------------------
{
  my ($fh) = @_;
  flock($fh, LOCK_UN) or die "$0: flock_lock_un: $!";
  close $fh;
  debug_out("$0: $$ released lock\n");
}

sub s_get_jwc_pid_list
#---------------------------------------------------------------------
# Function: Get a list of JWC container PID(s).
#
# Args    : Tomcat initial
#           Tomcat bootstrap class (not used)
#
# Returns : List of JWC container PID(s) (if any)
#---------------------------------------------------------------------
{
  my $tomcat_initial = shift;
  return get_pid_list($tomcat_initial, "*" . "$tomcat_initial.pid");
}

sub s_get_jwc_executable_pid_list
#---------------------------------------------------------------------
# Function: Get a list of JWC checker or shutter PID(s).
#
# Args    : Executable initial
#           Executable class (not used)
#
# Returns : List of JWC checker or shutter command PID(s) (if any)
#---------------------------------------------------------------------
{
  my $executable_initial = shift;
  return get_pid_list($executable_initial, "*" . "$executable_initial.pid");
}

# Helper routines
sub write_pid_file
#---------------------------------------------------------------------
# Function: Write pid file
#
# Args    : Relative file name of pidfile
#
# Returns : None
#---------------------------------------------------------------------
{
  my $pidfile = shift;
  $pidfile = catfile($pidfile_temp_dir, $pidfile);
  sysopen(PF, $pidfile, O_TRUNC | O_WRONLY | O_CREAT)
    or die "Could not create $pidfile in write_pid_file.";
  flock(PF, LOCK_EX)
    or die "Could not lock $pidfile in write_pid_file.";
  my $start_time = time();
  print PF "$start_time\n";
  # Bug 23750346 - Let close unlock file to prevent a race between
  # the physical write to disk and the unlock of the file
  close(PF)
    or die "Could not close $pidfile in write_pid_file.";
  return;
}

sub read_pid_file
#---------------------------------------------------------------------
# Function: Read pid file (if present)
#
# Args    : Relative file name of pidfile
#
# Returns : Start time within pidfile
#           -1 if there is no pidfile or it is still empty
#---------------------------------------------------------------------
{
  my $pidfile = shift;
  $pidfile = catfile($pidfile_temp_dir, $pidfile);
  unless (sysopen(PF,$pidfile, O_RDONLY))
  {
    if($!{ENOENT})
    {
      return -1;
    }
    die "Cannot open $pidfile in read_pid_file.";
  }
  flock(PF, LOCK_SH)
    or die "Cannot lock $pidfile in read_pid_file.";
  seek(PF, 0, SEEK_SET)
    or die "Cannot seek within $pidfile in read_pid_file.";
  my $file_time = <PF>;
  # Bug 23750346 - Let close perform file unlock
  close(PF)
    or die "Cannot close $pidfile in read_pid_file";
  if (!defined($file_time) || ($file_time eq ""))
  {
    return -1;
  }
  return $file_time;
}

sub validate_pid_file_and_execute
#---------------------------------------------------------------------
# Function: Validate pid file and execute
#           File streams MUST NOT be closed without a valid redirection. And in 
#           the case of the checker and the shutter MUST NOT be redirected in 
#           any case as STDOUT provides a communications channel for error 
#           information to the user via crsctl and srvctl.
#
# Args    : Initial (for tomcat, shutter or checker)
#           Files for STDIN, STDOUT and STDERR
#           List with program name and its arguments
#
# Returns : Does not return
#---------------------------------------------------------------------
{
  my $initial = shift;
  my $child_stdin = shift;
  my $child_stdout = shift;
  my $child_stderr = shift;

  # Read the PID file
  my $pid = $$;
  my $pidfile = "$pid$initial.pid";
  $pidfile = catfile($pidfile_temp_dir, $pidfile);

  # Look for pidfile
  my $counter = 25;
  while ($counter > 0)
  {
    unless (sysopen(PF, $pidfile, O_RDONLY))
    {
      # If the file is not there yet, wait and try again
      if($!{ENOENT})
      {
        $counter -= 1;
        sleep 1;
        next;
      }
      die "Cannot open $pidfile in validate_pid_file_and_execute.";
    }
    last;
  }
  if ($counter == 0)
  {
    die "$pidfile not found in validate_pid_file_and_execute.";
  }

  # Lock and read process start time from pidfile
  my $file_time = 0;
  while ($counter > 0)
  {
    flock(PF, LOCK_SH)
      or die "Cannot lock $pidfile in validate_pid_file_and_execute.";
    seek(PF, 0, SEEK_SET)
      or die "Cannot seek within $pidfile in validate_pid_file_and_execute.";
    $file_time = <PF>;
    flock(PF, LOCK_UN)
      or die "Cannot unlock $pidfile in validate_pid_file_and_execute.";
    # If pidfile has not yet been written into, wait and try again
    if (!defined($file_time) || ($file_time eq ""))
    {
      $counter -= 1;
      sleep 1;
      next;
    }
    # Get current time
    my $start_time = time();

    # Close pidfile
    close(PF)
      or die "Cannot close $pidfile in validate_pid_file_and_execute";

    # Check for valid starting time
    if (abs($start_time - $file_time) >= 60)
    {
      die "$pidfile has invalid contents in validate_pid_file_and_execute.";
    }
    last;
  }
  # Close STDIN, STDOUT and STDERR 
  if ($child_stdin ne NULLFILE)
  {
    close(STDIN);
    open(STDIN, "<", $child_stdin);
  }
  if ($child_stdout ne NULLFILE)
  {
    close(STDOUT);
    open my $out_fh, ">>", $child_stdout;
    *STDOUT = $out_fh;
    if ($child_stdout eq $child_stderr)
    {
      close(STDERR);
      *STDERR = $out_fh;
    }
  }
  if ($child_stderr ne NULLFILE and $child_stdout ne $child_stderr)
  {
    close(STDERR);
    open my $err_fh, ">>", $child_stderr;
    *STDERR = $err_fh;
  }

  # Execute the program and do not come back
  exec @_;
  exit;
}

sub get_pid_list
#---------------------------------------------------------------------
# Function: Get a list of matching PIDs
#
# Args    : Initial (for tomcat, shutter or checker)
#           Wildcard for glob
#
# Returns : List of matching PID(s) (if any)
#---------------------------------------------------------------------
{
  my $initial = shift;
  my $wildcard = shift;

  my $cwd = getcwd;
  chdir($pidfile_temp_dir)
    or die "Could not make $pidfile_temp_dir " .
           "the current directory in get_pid_list";
  my @pidfiles = glob($wildcard);
  my %pid_hash;
  foreach my $pidfile (@pidfiles)
  {
    if ($pidfile =~ /^\s*(\d+)($initial)\.pid/)
    {
      $pid_hash{$1} = $pidfile;
    }
  }
  if (!%pid_hash)
  {
    chdir($cwd)
      or die "Could not make $cwd the current directory in get_pid_list";
    return ();
  }
  #
  # Build "ps -p" command to ask about process elapsed time
  my @pid_list = ();
  my $command = "/bin/ps -p ";
  foreach my $pid (keys %pid_hash)
  {
    $command = "$command$pid,";
  }
  chop $command;
  my $current_time = time();
  my $output = `$command -o pid= -o etime=`;
  my @pidlines = split /\n/, $output;
  foreach my $pidline (@pidlines)
  {
    #
    # If any of the processes whose pids are listed with "-p" exist,
    # there will be an output line for the process with the format
    #
    # nnnn [[\d+\-]hh:]mm:ss
    #
    # Example:
    #
    # => ps -p 2297 -o pid= -o etime=
    # 2297 82-17:41:55
    #
    # where "2297" is the pid
    #       "82"   is 82 days
    #       "17"   is 17 hours
    #       "41"   is 41 minutes
    #       "55"   is 55 seconds
    #
    # To compute a prospective process start time for process 2297, the
    # logic will convert 82-17:41:55 into seconds and subtract it from
    # the current time.  It will then read pid file "2297d.pid" (if this
    # is supposed to be a Tomcat container) and compare the process start
    # time in that file.  If they are within a minute of one another, they
    # are considered to be equal.
    #
    my $pid;
    my $seconds;
    if($pidline =~ /^\s*(\d+)\s+(\d+)\-(\d+)\:(\d+)\:(\d+)\s*$/)
    {
      $pid = $1;
      $seconds = (86400 * $2) + (3600 * $3) + (60 * $4) + $5;
    }
    elsif ($pidline =~ /^\s*(\d+)\s+(\d+)\:(\d+)\:(\d+)\s*$/)
    {
      $pid = $1;
      $seconds = (3600 * $2) + (60 * $3) + $4;
    }
    elsif ($pidline =~ /^\s*(\d+)\s+(\d+)\:(\d+)\s*$/)
    {
      $pid = $1;
      $seconds = (60 * $2) + $3;
    }
    elsif ($pidline =~ /^\s*(\d+)\s+$/)
    {
      # Process has no elapsed time because it is dying, dead, zombie, etc.
      # Pidfile is invalid, so leave it in the hash for disposal
      next;
    }
    else
    {
      die "Cannot parse $pidline in get_pid_list";
    }
    my $calculated_start_time = $current_time - $seconds;
    my $pidfile = $pid_hash{$pid};
    my $read_start_time = read_pid_file($pidfile);
    if (($read_start_time >= 0) &&
        (abs($calculated_start_time - $read_start_time) < 60))
    {
      # Pidfile is valid
      delete $pid_hash{$pid};
      @pid_list = (@pid_list, $pid);
    }
  }
  foreach my $pidfile (values %pid_hash)
  {
    # Try to remove invalid pid files (if already gone, that is OK)
    unlink($pidfile);
  }
  chdir($cwd)
    or die "Could not make $cwd the current directory in get_pid_list";
  return @pid_list;
}