#!<<perl_header>>

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} = "<<asphome>>";
$pParameters->{com_layer} = "<<com_layer>>";

INSTALL::common::set_standard_globals;

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

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

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

$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 (-f $pParameters->{conf})) {
  report("Error: The specified configuration file '$pParameters->{conf}' does not exist.");
}

my %serverInfo = () ;
$serverInfo{conf} = $pParameters->{conf} ;
$serverInfo{binary} = $pParameters->{binary} ;

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

  open(PIDFILE,"<$pid_file");

  @pid_lines = <PIDFILE>;
  close(PIDFILE);

  my %pid_map;

  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 netscape pid database
#------------------------------------------------------------------------------
sub save_database
{
  my (%pid_map) = @_;
  my $pid_file = "$pGlobals->{log_dir}/netscape-pid.database";

  unlink($pid_file);
  open(PIDFILE,">$pid_file");

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

  close(PIDFILE);
  return(1);
}

#------------------------------------------------------------------------------
# retrieve the pid file from the given configuration file. 
#------------------------------------------------------------------------------
sub retrieve_pidfilepid
{
  ($#_ == 1) || die "Invalid number of arguments.";

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

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

      if ($pidFile && $serverRoot) {
        last;
      }
    }
  }
  close(CONF);
  
  if ((not $pidFile) && ($serverRoot)) {
    $pidFile = "$serverRoot/logs/pid";
  }

  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)
    }
  }

  $serverInfo{pidFile} = $pidFile if ($pidFile) ;
  $serverInfo{serverRoot} = $serverRoot if ($serverRoot) ;
  
  return(undef);
}

#------------------------------------------------------------------------------
# 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) = @_;

  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);
    my ($binary_match,$conf_match) ;
    my $default_binary = "uxwdog" ;

    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 (exists $serverInfo{serverRoot}) {
      $conf_match = $serverInfo{serverRoot} ;
    } 
    else {
      $conf_match = $conf_path ;
      $conf_match =~ s@(.*)/\S+@$1@;
    }

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

    # For HP-UX, we will validate with uxwdog process.
    if (($process_info{binary} =~ "uxwdog") || ($process_info{binary} =~ "$binary_match"))
    {
      foreach (@{$process_info{pArgv}}) {
        if (m@$conf_path@ || m@$conf_match@) {
          return (1);
        }
        elsif (m@$binary_path@ || m@$binary_match@) {
          return (1);
        }
        elsif (m@^\-f$@ || m@^\-d$@) {
          return (1);
        }
        elsif (m@$default_binary@) {
          return (1);
        }
      }
      return (undef);
    }
    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);
    my ($binary_name,$conf_dir) ;

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

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

    $binary_name = "$binary_path";
    $binary_name =~ s@(.*)/(\S+)$@$2@;
    if (not defined $binary_name) {
      $binary_name = "ns-httpd" ;
    }

    # the process list will have the config_directory instead of the config
    # file.
    $conf_dir = $conf_path;
    $conf_dir =~ s@(.*)/\S+@$1@;

    if (($process_info{binary} =~ "ns-httpd") || ($process_info{binary} =~ "$binary_name"))
    {
      if (grep { (m@^$conf_path$@ || m@$^conf$@ || m@^$conf_dir$@) } @{$process_info{pArgv}}) {
        # Called webserver with  -d <conf>
        return(1);
      }
      else {
        return(undef);
      }
    }
    else {
      return(undef);
    }
  }

  return(undef);
}

#------------------------------------------------------------------------------
# Searches the entire process space, attempting to find an netscape 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) = @_;

  foreach(INSTALL::process_info::retrieve_pids) {
    if (confirm_process($_,$binary,$conf)) {
      return($_);
    }
  }

  return(undef);
}

#------------------------------------------------------------------------------
# this routine, will parse the config/magnus.dir and fill the hash object with
# with all required informations.
#
# Following are some of the values we are interested as of now.
#
# $pServerInfo->{webserver_server_root} -
#   which will point to the location of the netscape webserver which is attached
#   to Sun Chili!Soft ASP server.
#
# $pServerInfo->{webserver_start_script} -
#   this should point to the start script of the netscape server.
#
# $pServerInfo->{webserver_stop_script} -
#   this should point to the stop script of the netscape server.
#
# Returns 1 if success otherwise undef is returned.
#------------------------------------------------------------------------------
sub process_nsconfig
{

  my ($pServerInfo) = @_;

  unless(open(CONFIG, "<$pServerInfo->{webserver_conf}")) {
    return(undef);
  }
  while(<CONFIG>) {
    if (/^\s*\#ServerRoot\s+(\S+)/) {
      $pServerInfo->{webserver_server_root} = $1;
      $pServerInfo->{webserver_install_root} = $1;
      $pServerInfo->{webserver_install_root} =~ s/(\S.*)\/(\S+)$/$1/ ;
      last ;
    }
  }
  close(CONFIG);

  if (not exists $pServerInfo->{webserver_start_script}) {
    $pServerInfo->{webserver_start_script}= ("$pServerInfo->{webserver_server_root}/start");
  }
  if (not exists $pServerInfo->{webserver_stop_script}) {
    $pServerInfo->{webserver_stop_script}= ("$pServerInfo->{webserver_server_root}/stop");
  }
  unless (-f "$pServerInfo->{webserver_start_script}") {
    error ("Unable to find the netscape 'start' script at location '$pServerInfo->{webserver_server_root}'.");
    return undef;
  }
  unless (-f "$pServerInfo->{webserver_stop_script}") {
    error ("Unable to find the netscape 'stop' script at location '$pServerInfo->{webserver_server_root}'.");
    return undef;
  }
  return (1);
}

#------------------------------------------------------------------------------
# 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.
  if ($pOS->{os} =~ /HP-UX/i) 
  {
    if (exists $database{$key}) {
      if (validate_ProcessPid($database{$key},$pParameters->{binary},$pParameters->{conf})) {
        report("status: The webserver is running.");
        return(1);
      }
    }

    # This is in another simple check up, to ensure that the path is in the
    # the correct location, which we are operating about.
    my $pid = retrieve_pidfilepid($pParameters->{binary},$pParameters->{conf});
    if ($pid && validate_ProcessPid($pid,$pParameters->{binary},$pParameters->{conf})) {
      report("status: The webserver is running.");
      return(1);
    }
    else {
      report("status: The webserver is not running.");
      return(undef);
    }
  }
  else 
  {
    if (exists $database{$key}) {
      if (confirm_process($database{$key},$pParameters->{binary},$pParameters->{conf}))
      {
        report("status: The webserver is running.");
        return(1);
      }
    }

    if (find_process($pParameters->{binary},$pParameters->{conf}))
    {
      report("status: The webserver is running.");
      return(1);
    }
    else {
      report("status: The webserver is not running.");
      return(undef);
    }
  }
  return 1;
}

#------------------------------------------------------------------------------
# Returns 1 if the start succeeds.
#------------------------------------------------------------------------------
sub start
{

  my $LIBPATH_VAR = $pOS->{libpath_variable};
  my %database = read_database;
  my $key = INSTALL::common::realpath($pParameters->{binary})."|".INSTALL::common::realpath($pParameters->{conf});

  if ($pOS->{os} =~ /HP-UX/i) {
    if (exists $database{$key}) {
      if (validate_ProcessPid($database{$key},$pParameters->{binary},$pParameters->{conf})) {
        report("start: The webserver was already running.");
        return(1);
      }
    }
    my $pid = retrieve_pidfilepid($pParameters->{binary},$pParameters->{conf});
    if ($pid && validate_ProcessPid($pid,$pParameters->{binary},$pParameters->{conf}))
    {
      report("start: The webserver was already running.");
      return(1);
    }
  }
  else {
    if (exists $database{$key}) {
      if (confirm_process($database{$key},$pParameters->{binary},$pParameters->{conf}))
      {
        report("start: The webserver was already running.");
        return(undef);
      }
    }

    if (find_process($pParameters->{binary},$pParameters->{conf}))
    {
      report("start: The webserver was already running.");
      return(undef);
    }
  }

  # Now look for various combinations of inputs possible for calling this webserver

  my %server_info;
  if (-f $pParameters->{conf}) {
    $server_info{webserver_conf} = "$pParameters->{conf}";
  }
  elsif ((-d "$pParameters->{conf}") &&
        (-f "$pParameters->{conf}/config/magnus.conf")) {
    $server_info{webserver_conf} = "$pParameters->{conf}/config/magnus.conf";
  }
  else {
    report("start: Invalid NSAPI configuration file specified as input.");
    return undef;
  }

  if (not process_nsconfig(\%server_info)) {
    report("stop: The specified configuration file does not seems to be a valid NSAPI configuration file.");
    return undef;
  }

  my $pid = fork;

  if (not $pid) {
    # To start the Netscape web server, we will presently support only the
    # conventional way - i.e, we support this , only if the start script
    # is present at the location.

    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}";

    if (exists $server_info{webserver_start_script}) {
      exec("$server_info{webserver_start_script}");
    }
    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 = 0;
  if ($pOS->{os} =~ /HP-UX/i) 
  {
    my $pid = retrieve_pidfilepid($pParameters->{binary},$pParameters->{conf});
    $running = validate_ProcessPid($pid,$pParameters->{binary},$pParameters->{conf});
  }
  else 
  {
    if (exists $database{$key}) {
      $running = 1 if (confirm_process($database{$key},$pParameters->{binary},$pParameters->{conf})) ;
    }
    else {
      $running = 1 if (find_process(pParameters->{binary},$pParameters->{conf}));
    }
  }
  if ($running)
  {
    # Now look for various combinations of inputs possible for calling this webserver
    my %server_info;
    if (-f $pParameters->{conf}) {
      $server_info{webserver_conf} = "$pParameters->{conf}"; 
    }
    elsif ((-d "$pParameters->{conf}") && 
	  (-f "$pParameters->{conf}/config/magnus.conf")) {
      $server_info{webserver_conf} = "$pParameters->{conf}/config/magnus.conf"; 
    }
    else {
      report("stop: Invalid NSAPI configuration file specified as input.");
      return (undef);
    }

    if (not process_nsconfig(\%server_info)) {
      report("stop: The specified configuration file does not seems to be a valid NSAPI configuration file.");
      return (undef);
    }

    my $pid = fork;

    if (not $pid) {
      # To stop the Netscape web server, we will presently support only the 
      # conventional way - i.e, we support this , only if the start script
      # is present at the location.
      if (exists $server_info{webserver_stop_script}) {
        exec("$server_info{webserver_stop_script}");
      }
      exit(1);
    }
    else {
      waitpid($pid,0);
      
      if ($?) {
        report("start: The webserver failed to stop.");
        return(undef);
      }
      else {
        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;

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);