#!/opt/casp/tools/bin/linux2/perl5/bin/perl  -I/opt/casp/tools/bin/linux2/perl5/lib -I/opt/casp

use INSTALL::common;

use INSTALL::global;
use INSTALL::parameter;
use INSTALL::os;
use INSTALL::process_info;

my $pParameters = \%INSTALL::parameter::variables;

#==============================================================================
#------------------------ Default global values
#==============================================================================

$pParameters->{asphome} = "/opt/casp";
$pParameters->{com_layer} = "chilicom";

INSTALL::common::set_standard_globals;

my $pGlobals = \%INSTALL::global::variables;
my $pOS = \%INSTALL::os::Details;

# This is responsible for storing the ServerRoot Variable
# and the Pid file. This keys are 
my %apacheServerStats = ( 
                          "serverRoot" => undef , 
                          "pidFile" => undef 
                        );

sub usage
{
  report("Usage:", "$0 binary=... conf=... [args=...] start|stop|restart|status");
  exit(1);
}

#==============================================================================
#------------------------ Validate all the required parameters.
#==============================================================================
my %PARAM_REQUIREMENTS =
  (
   REQUIRED     => [ 'binary', 'conf', 'start|stop|restart|status'],
   OPTIONAL     => [ 'args' ]
  );

$pParameters->{non_interactive} = 'true';
# This tool will _NOT_ run interactively.

if ((not @ARGV) || boolean_value($pParameters->{'--help'})) {
  usage();
}

unless(INSTALL::parameter::verify(%PARAM_REQUIREMENTS)) {
  usage();
  exit (1);
}

if (not (-x $pParameters->{binary})) {
  error("The specified binary '$pParameters->{binary}' does not exist or is not executable.");
}
elsif (not (-f $pParameters->{conf})) {
  error("The specified configuration file '$pParameters->{conf}' does not exist.");
}

sub retrieve_pidfilepid
{
  ($#_ == 1) || die "Invalid number of arguments.";

  my ($binary,$conf) = @_;
  my ($pidFile, $serverRoot);

  if (open(CONF,"<$conf")) {
    for(<CONF>) {
      if (/[^\#]*PidFile\s+\"([^\"]|\\.)\"/i) {
        $pidFile = $1;
      }
      elsif (/[^\#]*PidFile\s+(\S+)/i) {
        $pidFile = $1;
      }
      elsif (/[^\#]*ServerRoot\s+\"([^\"]|\\.)\"/i) {
        $serverRoot = $1;
      }
      elsif (/[^\#]*ServerRoot\s+(\S+)/i) {
        $serverRoot = $1;
      }

      if ($pidFile && $serverRoot) {
        last;
      }
    }
  }
  close(CONF);

  my ($binPidFile, $binServerRoot);

  if ((not $pidFile) || (not $serverRoot)) {
    if (-x $binary) {
      my @binary_values = split(/\n/,`$binary -V`);

      foreach(@binary_values) {
        if (/HTTPD_ROOT=\"((\\.|[^\"])*)\"/) {
          $binServerRoot = $1;
        }
        elsif (/DEFAULT_PIDLOG=\"((\\.|[^\"])*)\"/) {
          $binPidFile = $1;
        }

        if ($binPidFile && $binServerRoot) {
          last;
        }
      }
    }
  }

  if (not $pidFile) {
    $pidFile = $binPidFile;
  }

  if (not $serverRoot) {
    $serverRoot = $binServerRoot;
  }

  if ($pidFile) {
    $apacheServerStats{'pidFile'} = $pidFile ;
  }
  if ($serverRoot) {
    $apacheServerStats{'serverRoot'} = $serverRoot;
  }

  if ($pidFile =~ m@^[^/]@) {
    # Path is relative to server root.
    $pidFile = "$serverRoot/$pidFile";
  }

  if ($pidFile && (-f $pidFile) && open(PIDFILE,"<$pidFile")) {
    my $pid = <PIDFILE>;
    chomp $pid;
    close(PIDFILE);

    if (($pid =~ /^[0-9]+$/) && kill(0,$pid)) {
      return($pid)
    }
  }

  return(undef);
}

#------------------------------------------------------------------------------
# Read the apache pid database we maintain, storing each pid to
#------------------------------------------------------------------------------
sub read_database
{
  my @pid_lines;
  my $pid_file = "$pGlobals->{log_dir}/apache-pid.database";
  my %pid_map;

  if (open(PIDFILE,"<$pid_file")) {
    @pid_lines = <PIDFILE>;
    close(PIDFILE);


    chomp @pid_lines;
    foreach(@pid_lines) {
      if (m@^([^|]+\|[^|]+)\|([^|]+)$@) {
        $pid_map{$1} = $2;
      }
    }
  }

  return(%pid_map);
}

#------------------------------------------------------------------------------
# Save the pid information for the specified process in the apache pid database
#------------------------------------------------------------------------------
sub save_database
{
  my (%pid_map) = @_;
  my $pid_file = "$pGlobals->{log_dir}/apache-pid.database";

  unlink($pid_file);
  if (open(PIDFILE,">$pid_file")) {
    chmod(0644,$pid_file);

    foreach(keys %pid_map) {
      print PIDFILE
        ("$_|$pid_map{$_}\n");
    }

    close(PIDFILE);
  }
  return(1);
}

#------------------------------------------------------------------------------
# Confirm that the specified <pid> is associated with a binary / conf pair of
# <binary> and <conf>.
# Returns 1 if the process id is found otherwise undef.
# Presently the confirmation is done by reverse looking up at the process
# infomation of the binary name.
#------------------------------------------------------------------------------
sub validate_ProcessPid 
{
  my ($pid,$binary,$conf) = @_;

  # We will get this variable filled by retrievePidFile routine.
  my $serverRoot ;
  if ($apacheServerStats{'serverRoot'}) {
    $serverRoot =  $apacheServerStats{'serverRoot'} ;
    if ($serverRoot =~ /\"([^\"]\S+)\"/) {
      $serverRoot = $1;
    }
  }
      
  my %process_info = INSTALL::process_info::process_info($pid);
  if (scalar(keys %process_info)) 
  {
    my $process_binary = $process_info{binary} ;
    if ($process_binary =~ m@/([^/]*)$@) {
      $process_binary = $1;
    }

    my $binary_path = INSTALL::common::realpath($binary);
    my $conf_path = INSTALL::common::realpath($conf);
    my ($binary_match,$conf_match) ;

    if (not defined $binary_path) {
      $binary_path = $binary;
    }

    if ($binary_path =~ m@/([^/]*)$@) {
      $binary_match = $1;
    }
    else {
      $binary_match = $binary;
    }

    if (not defined $conf_path) {
      $conf_path = $conf;
    }

    if ($conf_path =~ m@/([^/]*)$@) {
      $conf_match = $conf_path ;
      $conf_match =~ s@(.*)/\S+$@$1@ ;
    }
    else {
      $conf_match = $conf_path ;
    }

    unless (($binary_match eq $process_binary) && ($process_info{ppid} == 1)) {
      # We must kill only the apache which is not owned by any parenting
      # process (except init, of course).
      return(undef);
    }

    # At this point, we have matched the binary name.
    # Now as as last straw try to match as much as possible of 
    # the configuration information before we puke out.
    foreach (@{$process_info{pArgv}}) {
      if (m@$binary_path@ || (grep { m@$binary_path@ } $_) ) {
        return 1;
      }
      elsif (m@$serverRoot@  || (grep { m@$serverRoot@ } $_) ) {
        return 1;
      }
      elsif (m@$conf_path@ || (grep { m@$conf_path@ } $_) ) {
        return 1;
      }
      elsif (m@$conf_match@ || (grep { m@$conf_match@ } $_) ) {
        return 1;
      }
    }

    my $execute = 0;

    # If we are Not able to match binary or conf,  use the -f as key
    if ($execute && (not grep { m@^\-f$@ } @{$process_info{pArgv}})) 
    {
      # Called webserver without -f option, defaults to whatever the default
      # SERVER_CONFIG_FILE is set to.

      my $module_info = `$binary_path -V`;
      my @module_info_lines = split(/\n/,$module_info);
      my $server_root;
      my $server_conf;

      foreach(@module_info_lines) {
        if (m@HTTPD_ROOT=\"([^\"]+)\"@) {
          $server_root=$1;
        }
        elsif (m@SERVER_CONFIG_FILE=\"([^\"]+)\"@) {
          $server_conf=$1;
        }
      }

      if ($server_conf =~ m@^[^/]@) {
        # If not an absolute directory, attach to $server_root.
        $server_conf = "$server_root/$server_conf";
      }

      # Remove any possible symlinks in the server's conf file.
      $server_conf = INSTALL::common::realpath($server_conf);
      if (($conf_path eq $server_conf) || ($conf eq $server_conf)) {
        return(1);
      }
    }
    else {
      return(undef);
    }
  }

  return(undef);
}

#------------------------------------------------------------------------------
# Confirm that the specified <pid> is associated with a binary / conf pair of
# <binary> and <conf>.
#------------------------------------------------------------------------------
sub confirm_process
{
  my ($pid,$binary,$conf) = @_;

  my %process_info = INSTALL::process_info::process_info($pid);

  if (scalar(keys %process_info)) {
    my $binary_path = INSTALL::common::realpath($binary);
    my $conf_path = INSTALL::common::realpath($conf);

    if (not defined $binary_path) {
      $binary_path = $binary;
    }

    if (not defined $conf_path) {
      $conf_path = $conf;
    }

    if ($binary_path ne $process_info{binary}) {
      return(undef);
    }
    elsif ($process_info{ppid} != 1) {
      # We must kill only the apache which is not owned by any parenting
      # process (except init, of course).
      return(undef);
    }
    else {
      if (grep { (m@^$conf_path$@ || m@^$conf$@) } @{$process_info{pArgv}}) {
        # Called webserver with <binary> -f <conf>
        return(1);
      }
      elsif (not grep { m@^-f$@ } @{$process_info{pArgv}}) {
        # Called webserver without -f option, defaults to whatever the default
        # SERVER_CONFIG_FILE is set to.

        my $module_info = `$binary_path -V`;
        my @module_info_lines = split(/\n/,$module_info);
        my $server_root;
        my $server_conf;

        foreach(@module_info_lines) {
          if (m@HTTPD_ROOT=\"([^\"]+)\"@) {
            $server_root=$1;
          }
          elsif (m@SERVER_CONFIG_FILE=\"([^\"]+)\"@) {
            $server_conf=$1;
          }
        }

        if ($server_conf =~ m@^[^/]@) {
          # If not an absolute directory, attach to $server_root.
          $server_conf = "$server_root/$server_conf";
        }

        # Remove any possible symlinks in the server's conf file.
        $server_conf = INSTALL::common::realpath($server_conf);

        if (($conf_path eq $server_conf) || ($conf eq $server_conf)) {
          return(1);
        }
      }
      else {
        return(undef);
      }
    }
  }

  return(undef);
}

#------------------------------------------------------------------------------
# Searches the entire process space, attempting to find an apache running with
# the specified binary / conf pair.  If such a process is found, its pid is
# returned.  Otherwise, undef is returned.
#
# Note: The returned process is guaranteed to have an owning (parent) pid of
#       1 (which denotes the parent of all Apache processes).
#------------------------------------------------------------------------------
sub find_process
{
  ($#_ == 1) || die "Invalid number of arguments.";

  my ($binary,$conf) = @_;
  my ($binary_path,$binary_match) ;

  if (-x $binary) {
    $binary_path = INSTALL::common::realpath($binary);
    if (not defined $binary_path) {
      $binary_path = $binary ;
    }
  }
  else {
    return(undef);
  }

  my %prochash = INSTALL::process_info::retrieve_prochash;
  my @guess_pids;

  if ($binary_path =~ m@/([^/]*)$@) {
    $binary_match = $1;
  }
  else {
    $binary_match = $binary;
  }

  foreach(keys %prochash) {
    my $test_binary;

    if ($prochash{$_} =~ m@/([^/]*)$@) {
      $test_binary = $1;
    }
    else {
      $test_binary = $prochash{$_};
    }

    if ($test_binary =~ m@$binary_match@) {
      push @guess_pids,$_;
    }
  }

  foreach(@guess_pids) {
    my $pid = $_ ;
    if ($pOS->{os} =~ /HP-UX/i) {
      if (validate_ProcessPid($pid,$binary,$conf)) {
        return($pid);
      }
    }
    else {
      if (confirm_process($pid,$binary,$conf)) {
        return($pid);
      }
    }
  }

  return(undef);
}

#------------------------------------------------------------------------------
# Attempts to retrieve the pid from the apache database and if that fails,
# tries to retrieve the information from Apache's conf PidFile.  If both fail,
# then undef is returned.
#
# Note: The value returned is guaranteed to be valid, given the specified conf
#       and binary files.
#------------------------------------------------------------------------------
sub retrieve_process
{
  return(undef); #--> It may be quicker to actually ignore cache checking?

  ($#_ == 1) || die "Invalid number of arguments.";

  my ($binary,$conf) = @_;

  my %database = read_database;
  my $key = INSTALL::common::realpath($binary)."|".INSTALL::common::realpath($conf);
  my $result = undef;
  my $pid = undef;

  if (exists $database{$key}) {
    if ($pid = $database{$key}) {
      $result = confirm_process($pid,$binary,$conf);
    }
  }

  if ((not $result) &&
      ($pid = retrieve_pidfilepid($binary,$conf)))
  {
    $result = confirm_process($pid,$binary,$conf);
  }

  if ($result) {
    return($pid);
  }
  else {
    return(undef);
  }
}

#------------------------------------------------------------------------------
# Returns 1 if the webserver is running, undef otherwise.
#------------------------------------------------------------------------------
sub status
{
  my %database = read_database;
  my $key = INSTALL::common::realpath($pParameters->{binary})."|".INSTALL::common::realpath($pParameters->{conf});

  # On HP-UX systems, the ps command does not return the full command line.
  # So I am presently going ahead with a version, which purely depends only
  # on the pid file to stop the web server.

  my $running = undef ;
  if ($pOS->{os} =~ /HP-UX/i) 
  {
    my $pid = retrieve_pidfilepid($pParameters->{binary},$pParameters->{conf});
    if ($pid) {
      $running = validate_ProcessPid($pid,$pParameters->{binary},$pParameters->{conf}) ;
    } else {
      $running = find_process($pParameters->{binary},$pParameters->{conf}) ;
    }
    if ($running) {
      report("status: The webserver is running.");
      return(1);
    }
    else {
      report("status: The webserver is not running.");
      return(undef);
    }
  }
  else {
    if (retrieve_process($pParameters->{binary},$pParameters->{conf}) ||
        find_process($pParameters->{binary},$pParameters->{conf}))
    {
      report("status: The webserver is running.");
      return(1);
    }
    else {
      report("status: The webserver is not running.");
      return(0);
    }
  }
}

#------------------------------------------------------------------------------
# Returns 1 if the start succeeds.
#------------------------------------------------------------------------------
sub start
{
  my %database = read_database;
  my $key = INSTALL::common::realpath($pParameters->{binary})."|".INSTALL::common::realpath($pParameters->{conf});

  my $LIBPATH_VAR = $pOS->{libpath_variable};
  my $running = undef;
  my $pid = undef ;

  if ($pOS->{os} =~ /HP-UX/i) {
    $pid = retrieve_pidfilepid($pParameters->{binary},$pParameters->{conf});
    if ($pid) {
      $running = validate_ProcessPid($pid,$pParameters->{binary},$pParameters->{conf}) ;
    } else {
      $running = find_process($pParameters->{binary},$pParameters->{conf}) ;
    }
    if ($running) {
      $running = 1;
      report("start: The webserver was already running.");
      return(1);
    }
  }
  else {
    if (retrieve_process($pParameters->{binary},$pParameters->{conf}) ||
        find_process($pParameters->{binary},$pParameters->{conf}))
    {
      $running = 1;
      report("start: The webserver was already running.");
      return(undef);
    }
  }
  if (! $running) 
  {
    $pid = fork;

    if (not $pid) {
      my @library_additions =
        (
         $pGlobals->{com_lib_dir},
         $pGlobals->{lib_dir}
        );

      if (exists $ENV{$LIBPATH_VAR}) {
        my @library_order = split(/:/,$ENV{$LIBPATH_VAR});
        my @library_paths;

        foreach my $libpath (@library_order) {
          if (not grep { $_ eq $libpath} @library_additions) {
            push @library_paths, $libpath;
          }
        }
        $ENV{$LIBPATH_VAR}=join(":",@library_paths);
      }

      $ENV{$LIBPATH_VAR}=join(":",@library_additions) . ":$ENV{$LIBPATH_VAR}";

      my @additional_args;
      if (exists $pParameters->{args}) {
        @additional_args = @{$pParameters->{args}};
      }

      exec($pParameters->{binary},"-f",$pParameters->{conf},@additional_args);
      exit(1);
    }
    else {
      waitpid($pid,0);

      if ($?) {
        report("start: The webserver failed to start.");
        return(undef);
      }
      else {
        my $new_pid = retrieve_pidfilepid($pParameters->{binary},$pParameters->{conf});
        $database{$key} = $pid;
        save_database(%database);

        report("start: The webserver was successfully started.");
        return(1);
      }
    }
  }
}

#------------------------------------------------------------------------------
# Returns 1 if the stop succeeds.
#------------------------------------------------------------------------------
sub stop
{
  my %database = read_database;
  my $key = INSTALL::common::realpath($pParameters->{binary})."|".INSTALL::common::realpath($pParameters->{conf});

  my $running = undef;
  my $pid = undef;

  if ($pOS->{os} =~ /HP-UX/i) 
  {
    $pid = retrieve_pidfilepid($pParameters->{binary},$pParameters->{conf});
    if ($pid) {
      $running = validate_ProcessPid($pid,$pParameters->{binary},$pParameters->{conf});
    } else {
      $running = find_process($pParameters->{binary},$pParameters->{conf});
    }
  }
  else {
    $pid = retrieve_process($pParameters->{binary},$pParameters->{conf});
    if (not $pid) {
      $pid = find_process($pParameters->{binary},$pParameters->{conf});
    }
    $running = 1 if ($pid) ;
  }

  if ($pid && $running) {
    kill("TERM",$pid);

    my $time = time;
    while(kill(0,$pid) && (($time + 10) > time)) {
      INSTALL::common::usleep(250000);
    }

    delete $database{$key};
    save_database(%database);
    report("stop: The webserver was successfully stopped.");
    return(1);
  }
  else {
    report("stop: No webserver found to stop.");
    return(undef);
  }
}

#------------------------------------------------------------------------------
# Returns 1 if the start succeeds.
#------------------------------------------------------------------------------
sub restart
{
  my $result;
  stop;
  $result = start;

  return($result);
}

my $result = 1;

if (exists $pParameters->{args}) {
  $pParameters->{args} = [ split_command($pParameters->{args}) ];
}

my @directives = grep { /^(?:start|stop|restart|status)$/ } @ARGV;

foreach (@directives) {
  /^start$/ &&
    do {
      $result &= start;
    };

  /^restart$/ &&
    do {
      $result &= restart;
    };

  /^stop$/ &&
    do {
      $result &= stop;
    };

  /^status$/ &&
    do {
      $result &= status;
    };
}

exit(not $result);