#!/pkg/bin/perl -w

# $Id: ohs,v 1.31 1998/02/17 19:36:43 rowe Exp $

# This is the main source file for the Organizational Hierarchy Server within
# GrIDS. 

# To do:

# Socket/GCPF I/O is not implemented.

# Hierarchy view update is not implemented.

#============================================================================#
#============================================================================#

#				PREAMBLE

# Inclusions, global variables, etc.

#============================================================================#
#============================================================================#

# Other code to utilize

use English;			# Mnemonic names for Perl special variables.
#use Storable;			# Store data structures.  Part of CPAN.
use Hierarchy;			# Class for hierarchy of depts and hosts.
use Static_message_syntax;	# Checking GCPF message syntax
use Clog;			# For managing our log file.
use Comm;

#============================================================================#

$SIG{ALRM} = 'catch_alarm';
sub catch_alarm {
}

# Constants which affect the operation of the server.

%global::allowed_headers = ('hvr',1,	# Models the set of headers we know.
		    'htr',1, 	
		    'hte',1, 	
		    'htc',1);		
%global::allowed_htr_type = ('new_root',1,	# Models set htr messages we.
		    'change_user',1, 		# know 
		    'add_host',1,		 
		    'add_dept',1,
		    'move_dept',1,
		    'move_host',1,
		    'move_manager',1,
		    'move_aggregator',1,
		    'remove_host',1,
		    'remove_dept',1,
		    'change_variable',1);		
$global::state_directory = "ohs_state";
$global::hierarchy_file = "hierarchy";
#$global::transaction_file = "transactions";
$global::log_file = "ohs_log";
$global::parameter_file = "parameters";
$global::max_requests = -1;
$global::output_mode  = 'stdio';	# Real output/various debugging modes
$global::original_dir = `pwd`; chomp $global::original_dir;
$global::init_user = "user";      # This should be set at startup
$global::init_pass = "password";  # This should be set at startup
$global::use_ACL = 1; # Acess control should be used.


# Constants which are used for logging operations

$global::module_name = "ohs";
$global::dept_name = "N/A";
$global::ohs_port = 2000; # port we will receive messages on

#============================================================================#

# Global variables and data structures.

$global::locked 		 = 0;	# Global lock.  True when locked.

$global::request_id 		 = 0;	# index of which request this is.

$global::transactions_in_process = {};	# transactions currently under way.  
# This is a reference to a hash.
# The hash is keyed by the transaction-id initially supplied to us by
# the interface.  The value is a reference to an array which contains
# all the original contents of the htr message as documented in the
# design report.
				
$global::hierarchy 		 = {};	# nodes and hosts in hierarchy.  This
# is our main data structure.  It is just a Hierarchy object.  Hosts
# and Departments are keyed by their name.  The corresponding value is
# a reference, either to a Department object or a Host object.

$global::current_view		 = 0;   # the next view serial number to use.

$global::log			 = {};   # reference to our log object.

$global::return_address		 = '';   # person to reply to with ..r mesg.

#============================================================================#
#============================================================================#

#				MAIN PROGRAM

#	Loads the state information, then loops over getting messages, doing 
#	a limited amount of sanity checking, and then handing off the 
#	processing to a function specific to the message in question.  The
#	state information is saved upon exit.
			
#============================================================================#
#============================================================================#

foreach (@ARGV) {eval '$'.$_;} # process possible changes to variables

# Note: Received initial user and password from command line.

# Create log.
$global::log = new Clog($global::module_name,$global::dept_name,
				$global::log_file);
$global::log->{'central_log'} = 0; # No central logging - presently broken.
$global::log->warn("Debugging $PROGRAM_NAME \[$PROCESS_ID\] at ".localtime());
$global::log->warn("Output mode is $global::output_mode");

&load_state();

# Initialize Comm.pm if necessary.
if($global::output_mode eq 'comm')
 {
  my($status,$tcp,$udp) = Comm::init($global::ohs_port,$global::ohs_port);
  unless($status eq 'ok')
   {
    die "OHS could not initialize Comm.pm correctly\n";
   }
}

# Create child process to handle polling.
use IPC::Open2;

#
# Running on non-UCDseclab environments ( perl binaries not in /pkg/bin ) may
# require a PERLLOC environment variable to point explicitly to the perl
# binary.  If so the following comment line must be manipulated. JRowe 2/9/98
#
$child_pid = open2(\*sonReader, \*sonWriter,"$ENV{'PERLLOC'}/perl -w $ENV{'GRIDSPATH'}".'/ohs/son '.
   "$global::init_user $global::init_pass");
#$child_pid = open2(\*sonReader, \*sonWriter,"$ENV{'GRIDSPATH'}".'/ohs/son '.
#   "$global::init_user $global::init_pass");

unless (defined($child_pid))
 {
  die "Unable to start SON.  OHS is exiting.  Please try again\n";
 }

select sonWriter; $| = 1; # Turn on buffering.
select sonReader;  $| = 1;

select STDOUT;

print STDERR "OHS is now receiving transactions.\n";


LOOP_OVER_REQUESTS:

while(1)
{
  $global::request_id++;  
  last if $global::max_requests >= 0 && $global::request_id > $global::max_requests;
  $global::log->separator(); $global::log->{'prefix'} = "$global::request_id: "; 
  
  my($header,$messageref) = &get_incoming_message();

  # Basic sanity checking of message
  unless($global::allowed_headers{$header} && &message_syntax_ok($header,$messageref))
   {
    $global::log->warn("Bad syntax in OHS request:$header @$messageref");
    &reply_hte($messageref,"Bad syntax in OHS request:$header @$messageref");
    next;
   } # end unless

  # Now call the particular subroutine for this kind of message.
  # These all have names of the form process_transaction_name;
  # We pass in the message array minus the header.
  my $function_call = "\&process_$header";
  unless(eval "$function_call".'($messageref)')
   {
    $global::log->warn("Unexpected problem with $function_call: $@");
   }# end unless
} # end while

$global::log->separator();
&save_state();
$global::log->warn("OHS exiting normally.  Thank you and good night.");

# End of MAIN PROGRAM

#============================================================================#
#============================================================================#

#			MAJOR OPERATIONAL FUNCTIONS
			
#============================================================================#
#============================================================================#

# Function Name: load_state

# This function is called by the main program.  Its purpose is to determine
# if appropriate state information was saved by a previous incarnation of
# the program, and load it into this incarnation if it was.

# Convention on the state directory is as follows.  If it exists, it is 
# assumed to have a complete correct account of the current state of the
# hierarchy.  If it does not have such a complete, correct account, then
# it should not exist.

# Inputs:
#  Actual Arguments:
#   None
#  Global:
#   $global::state_directory - Directory containing state information
#   $global::transaction_file - File containing transactions in progress
#   $global::hierarchy_file - File containing hierarchy information
#   $global::current_view, - The next view serial number to use
#   $global::log - Reference for log object
#   $global::parameter_file - File containing parameters

# Return Value(s):
#   None
 
# Global variable modifications:
#  $global::hierarchy - The main data structure

# Example of usage:
#  &load_state();

sub load_state 
{
  # Check to see if a previous state is on file.
  if(0) # SS 8/22/96 modified temporarily was if(-d $global::state_directory)
   {
    # we have state - load it in.
    chdir $global::state_directory;
#    $global::transactions_in_process = retrieve($global::transaction_file);
    do $global::parameter_file;
    $global::hierarchy = new Hierarchy($global::log,$global::hierarchy_file,$global::current_view);


   }# end if
  else
   {
    # no state.  Create an empty directory to use later.
    system("mkdir $global::state_directory");
    chdir $global::state_directory;
    $global::hierarchy = new Hierarchy($global::log);
    $global::hierarchy->set_initial_user($global::init_user,$global::init_pass);
   } # end else
} # end load_state

#============================================================================#

# This function is called by the main program.  Its purpose is to save our 
# state information for future use.

# Inputs:
#  Actual Arguments:
#   None
#  Global:
#   $global::state_directory - Directory containing state information
#   $global::transaction_file - File containing transactions in progress
#   $global::hierarchy_file - File containing hierarchy information
#   $global::current_view, - The next view serial number to use
#   $global::log - Reference for log object
#   $global::parameter_file - File containing parameters
 
# Return Value(s):
#   None
 
# Global variable modifications:
#  None
 
# Example of usage:
#  &save_state();

sub save_state
{
#  store($global::transactions_in_process, $global::transaction_file);
  $global::log->warn("Saving hierarchy");
  $global::hierarchy->save($global::hierarchy_file);
  open(PARAMETERS,">$global::parameter_file"); 
  select(PARAMETERS);
  print '$global::current_view = '."$global::current_view;";
  select(STDOUT);
  close(PARAMETERS);
} # end save_state

#============================================================================#

# Function name:  process_hvr

# This function is called by the main program.  Its task is to handle
# hvr (hierarchy view request) messages.  It does some sanity checking on
# the message.  Then, if the hierarchy is locked it returns an error message.
# Next it checks if the user making the request is authorized to see this
# view.  Finally, it calls the reply_hv function to fulfill the request
# if everything else is ok.

# Inputs:
#  Actual Arguments:
#   an array containing transaction information
#  Transaction Arguments (contained in array):
#   User, Password, Dept
#  Global:
#   $global::locked - Hierarchy lock variable
#   $global::log - Reference for log object
 
# Return Value(s):
#  True (1) for all paths
# Reply messages:
#  hve if request is not acceptable
#  hv otherwise
 
# Global variable modifications:
#  None
 
# Examples of usage:
#  my $function_call = "\&process_hvr";
#  unless (eval "$function_call".'($messageref)')
# or
#  unless (process_hvr($messageref))

# Example of actual transaction call:
#  hvr my_name pass_wd some_dept

sub process_hvr 
{
  # Pull transaction parameters from array in argument.
  my($user,$password,$dept) = @{$_[0]};
  #Check for proper message format.
  unless(defined $user && defined $password && defined $dept)
   {
    $global::log->warn("Bad args to process_hvr: ".join(' ',@{$_[0]}));
    &reply_hve($user,$dept,"Security error.");
    return 1;
   } # end unless
  # Note the transaction in the log.
  $global::log->warn(
      "process_hvr: User: $user, Password: $password, Department: $dept");
  if($global::locked)
   {
    $global::log->warn("Hierarchy locked: sent hve reply.");
    &reply_hve($user,$dept,"Hierarchy locked.");
    return 1;
   } # end if 
  # Perform sanity checking.
  unless($dept eq 'null' && 
        (($user eq $global::init_user) && 
         ($password eq $global::init_pass))) # Startup case
   {    
    # Make sure requested department exists.
    unless(ref $global::hierarchy->{$dept} eq 'Department')
     {
      $global::log->
	warn("Request on non existent node $dept: sent hve reply.");
      &reply_hve($user,$dept,"Security Error.");
      return 1;
     } # end unless 
    # Make sure user is authorized.
    unless(&view_authorization_ok($user,$password,$dept))
     {
      $global::log->warn("Authorization failure.");
      &reply_hve($user,$dept,"Security error.");
      return 1;  
    }# end unless
   }# end unless
 reply_hv($dept);
 return 1;
} # end process_hvr

#============================================================================#

# Function: process_htr

# This function is called by the main program.  Its task is to handle
# htr (hierarchy transaction request) messages.  It does some sanity checking 
# on the message.  Then, if the hierarchy is locked it returns an error 
# message.  Next it checks if the user making the request is authorized to 
# make this change.  Assuming they are, it sanity checks that the change is
# actually feasible.  Finally, it locks the hierarchy and sends an htp message 
# to the caller with permission to go ahead.

# Inputs:
#  Actual Arguments:
#   an array containing transaction information
#  Transaction Arguments (contained in array):
#   Type, Trans-id, transaction specific information
#  Global:
#   $global::locked - Hierarchy lock variable
#   $global::log - Reference for log object
#   $global::transactions_in_process - Transactions currently in progress 

# Return Value(s):
#  True (1) for all paths
# Reply messages:
#  hte if transaction is not acceptable
#  htp otherwise
 
# Global variable modifications:
#  $global::locked - the overall hierarchy lock variable which might get set
#  @global_temp_array - used as a kludge.
# $global::transactions_in_process - add in the transaction if it is good.

# Examples of usage:
#  my $function_call = "\&process_htr";
#  unless (eval "$function_call".'($messageref)')
# or
#  unless (process_htr($messageref))
 
# Examples of actual transaction calls:
#  htr new_root trans_id_19 ROOT manager 54 aggregator 72
#  htr add_dept trans_id_421 user pass 3 ROOT child_dept first_host first_host

sub process_htr
{
  # Retrieve transaction information for local use.
  my $messageref = $_[0];
  my($type,$trans_id) = @$messageref;

  # Make sure this is a recognized type of transaction
  unless($global::allowed_htr_type{$type})
   {
    $global::log->warn("Unknown htr type: $type");
    &reply_hte($messageref,"Security error.");   
   } # end unless
  $global::log->warn("process_htr: ".join(' ',@$messageref));

  # Check on the global hierarchy locking
  if($global::locked)
   {
    &reply_hte($messageref,"Hierarchy locked.");
    $global::log->warn("Hierarchy locked: sent hte reply.");
    return 1;
   } # end if

  # Have we already seen this request?
  if(exists $global::transactions_in_process->{$trans_id})
   {
    &reply_hte($messageref,"Security error.");
    $global::log->warn("Repeated transaction request: $trans_id");
    return 1;
   } # end if

  # Is the transaction a reasonable thing to try and do?
  # Call a per-transaction-type sanity checking function.
  # This also authenticates the user.
  my $function_call = '$global::hierarchy->'.$type.'_is_sane';
  unless(eval "$function_call".'($messageref)')
   {
    &reply_hte($messageref,"Security error.");
    $global::log->warn("Transaction Denied.");
    return 1;
   } # end unless

  # Send message to SON to verify liveness.
  print sonWriter ("htr,".join(' ',@$messageref)."#");

  my $cnt = 0;
  my $exit = 0; 
  my @response;
  while($cnt < 15 && $exit == 0){ # Wait at most 15 seconds for response.
    $cnt ++;
    alarm 1;
    if($buf = <sonReader>)
     {
      @response = split(/,/,$buf);
      if($response[0] eq $trans_id && $response[1] == 1){
        $exit = 1;
       }
      else
       {
        $exit = -1;
       }
     }
  }

  unless($exit == 1)
   {
    my $hte_resp;
    if ($exit == 0){ $hte_resp = "No response from SON."; }
    else { $hte_resp = "Negative response from SON.  $response[2]"; }

    #&reply_hte($trans_id,"Necessary componant is not alive.");
    &reply_hte($trans_id,$hte_resp);
    $global::log->warn("Transaction Denied - $hte_resp.");
    return 1;
   }
  
  $global::locked = 1; # We now have a lock on the hierarchy.

  @global::temp_array = @$messageref; # Note global - so we can keep it around.
  $global::transactions_in_process->{$trans_id} = \@global::temp_array;
  
  #Issue the go-ahead back to the interface;
  &reply_htp($trans_id);
  return 1;
} # end process_htr

#============================================================================#

# Function:  process_htc

# This function processes htc (hierarchy transaction complete) messages.
# It first identifies that we know about the supposed transaction.  Assuming
# that we do, we call the function which is actually going to update our
# data structures in the way called for by this kind of transaction.

# Inputs:
#  Actual Arguments:
#   an array containing transaction information
#  Transaction Arguments (contained in array):
#   Type, Trans-id, special case transaction information
#  Global:
#   $global::locked - Hierarchy lock variable.
#   $global::log - Reference for log object.
#   $global::current_view - the next view serial number to use.
#   $global::transactions_in_process - Transactions currently in progress.

# Return Value(s):
#  True (1) for all paths
# Reply messages:
#  hte if transaction is not acceptable
#  htp otherwise
 
# Global variable modifications:
#  $global::current_view - incremented by one.
#  $global::locked - gets unset
#  $global::transactions_in_process - remove the completed transaction
 
# Examples of usage:
#  my $function_call = "\&process_htc";
#  unless (eval "$function_call".'($messageref)')
# or
#  unless (process_htc($messageref))
 
# Examples of actual transaction calls:
#  htc new_root trans_id_70923
#  htc add_host trans_id_5234
#  htc add_dept trans_id_823 149 150   (a special case)

sub process_htc
{ 
  # Retrieve transaction information.
  my $messageref = $_[0];
  my $trans_id = $messageref->[1];
  $global::log->warn("process_htc: $trans_id");
  # Make sure that the transaction exists.
  unless(exists $global::transactions_in_process->{$trans_id})
   {
    $global::log->warn("No such transaction!");
    return 1;
   } # end unless
  my $type = ${$global::transactions_in_process->{$trans_id}}[0];
  # Make sure that transaction types match.
  unless($type eq $messageref->[0])
   {
    $global::log->warn("Type in htc does not match type in corresponding htr!");
    return 1;
   } # end unless

  # Now call the function which actually updates our data structures.
  $global::current_view++;
  my $function_call = '$global::hierarchy->'.$type;
  unless(eval "$function_call".'($global::transactions_in_process->{$trans_id}'.
  	',$messageref,$global::current_view)')
   {
    $global::log->warn("Unexpected problem with $function_call: $@");
    return 1;
   } # end unless
 
  # Send message to SON so it can update its hierarchy. 
  my $trans = $global::transactions_in_process->{$trans_id};
  print sonWriter ("htc,$type,".
                   join(' ',@$trans).",".
                   join(' ',@$messageref).
                   ",$global::current_view"."#");
 
 
  delete $global::transactions_in_process->{$trans_id};
  $global::locked = 0; # The transaction is over and we may unlock.
#
#  Added by J.Rowe for debugging

  my($key,$g_serial);
  my $g_serial = $global::current_view;
  foreach $key (keys %{$global::hierarchy}){
      if (ref $global::hierarchy->{$key} eq 'Department'){
        my $d_serial = $global::hierarchy->{$key}{'view_serial'};
        if ($d_serial != $g_serial) {
	  $global::log->warn("Warn-process_htc: $key view_serial is $d_serial but");
	  $global::log->warn("Warn-process_htc: global::current_view is $g_serial");
        }
      }
  }     
#
#
  return 1;
} # end process_htc

#============================================================================#
#
# Function:  process_hte
#
# This function processes hte (hierarchy transaction error) messages.
# It first identifies that we know about the supposed transaction.  Assuming
# that we do, we cancel the transaction and unlock the hierarchy.
#
# Inputs:
#  Actual Arguments:
#   an array containing transaction information
#  Global:
#   $global::locked - Hierarchy lock variable.
#   $global::log - Reference for log object.
#   $global::current_view - the next view serial number to use.
#   $global::transactions_in_process - Transactions currently in progress.
#
# Return Value(s):
#  True (1) for all paths
# 
# Global variable modifications:
#  $global::current_view - incremented by one.
#  $global::locked - gets unset
#  $global::transactions_in_process - remove the completed transaction
# 
# Examples of usage:
#  my $function_call = "\&process_hte";
#  unless (eval "$function_call".'($messageref)')
# or
#  unless (process_hte($messageref))
# 
# Examples of actual transaction calls:
#  hte new_root trans_id_70923
#  hte add_host trans_id_5234
#
#----------------------------------------------------------------------------#

sub process_hte
{ 
  # Retrieve transaction information.
  my $messageref = $_[0];
  my $trans_id = $messageref->[0];
  $global::log->warn("process_hte: $trans_id");
  # Make sure that the transaction exists.
  unless(exists $global::transactions_in_process->{$trans_id})
   {
    $global::log->warn("No such transaction!");
    return 1;
   } # end unless
  my $type = ${$global::transactions_in_process->{$trans_id}}[0];
  # Make sure that transaction types match.

  $global::log->warn("Transaction $trans_id cancelled due to hte.");
  $global::log->warn("Error message was $messageref->[1]");
   
  delete $global::transactions_in_process->{$trans_id};
  $global::locked = 0; # The transaction is over and we may unlock.
  return 1;
} # end process_hte

#============================================================================#
#============================================================================#

#			AUTHORIZATION CHECKING FUNCTIONS
		
#============================================================================#
#============================================================================#

#============================================================================#
#
# Function: view_authorization_ok
#
# This function determines if the user is authorized to view this section
# of the hierarchy and notes the outcome in the log.
#
# Inputs:
#  Actual Arguments:
#   an array containing transaction information
#  Transaction Arguments (contained in array):
#   User, Password, Dept.
#  Global:
#   $global::log - Reference for log object.
#
#
# Return Value(s):
#  True (1) for all paths
#
# Global variable modifications:
#  None 
# 
# Example of usage:
#  unless(&view_authorization_ok($user,$password,$dept))
#
#----------------------------------------------------------------------------#

sub view_authorization_ok
{
 $global::log->warn("view_authorization_ok");
 my($user,$password,$dept) = @_;

  unless($global::hierarchy->view_authorization($user,$password,$dept))
   {
    $global::log->warn("User is not autorized to view hierarchy from $dept.");
    return 0;
   } # end unless

 return 1;
} # end view_authorization_ok


#============================================================================#
#============================================================================#

#			COMMUNICATION INTERFACE

#============================================================================#
#============================================================================#

# Function: get_incoming_message

# Gets one incoming message in GrIDS Common Packet Format and the hierarchy 
# packet format.

# Inputs:
#  Actual Arguments:
#   None
#  Global:
#   None
 
# Return Value(s):
#  Transaction header, 
#  reference to array containing transaction information
 
# Global variable modifications:
#  None
 
# Example of usage:
#  my($header,$messageref) = &get_incoming_message();
 

sub get_incoming_message
{
  my($host,$port,$header,@array);

  if($global::output_mode eq 'comm')
   {
    # Real I/O
    $global::log->warn("OHS about to receive\n");
    until(defined $host)
     { 
      ($host,$port,$header,@array) = Comm::tcp_recv('blocking');
      unless($host && $port && $header)
       {
        $global::log->warn("Error in tcp_recv call in get_incoming_message");
       }
     }     

    $global::log->warn("OHS received $header from $host:$port\n");
    $global::return_address = "$host:$port";
   }
  else
   {
    # one or other form of testing I/O
    RESTART:
    @array = split(' ',<STDIN>);
    if($global::output_mode eq 'file' && !defined $array[0])
     {
      seek(STDIN,0,1);
      sleep 1;
      goto RESTART;
     }
    $global::return_address = shift @array 
			if($global::output_mode eq 'file');
    $header = shift @array;

   }

  return ($header,\@array);
} # end get_incoming_message

#============================================================================#

# Function: reply_hve

# This function produces the hve error message. 
 
# Inputs:
#  Actual Arguments:
#   an array containing transaction information
#  Transaction Arguments (contained in array):
#   User, Dept, Error message
#  Global:
#   $global::log
 
# Return Value(s):
#  None

# Global variable modifications:
#  None
 
# Example of usage:
#  &reply_hve($user,$dept,"Security error.");
#  &reply_hve($user,$dept,"Hierarchy locked.");
 
sub reply_hve
{
  my($user,$dept,$error) = @_;
  $global::log->warn("reply_hve: $user $dept $error");

  &reply('hve', [$user,$dept,$error]);

} # end reply_hve

#============================================================================#

# Function: reply_hv

# This function returns the requested view of the hierarchy.

# Inputs:
#  Actual Arguments:
#   Department to be viewed
#  Global:
#   $global::log
 
# Return Value(s):
#  None
# Reply messages:
#  hv message with the appropriate information
 
# Global variable modifications:
#  None
 
# Example of usage:
#  &reply_hv($dept);
 
sub reply_hv
{
 my($dept) = @_;
 my($serial,$h_output);
 
 if($dept eq 'null')
  {
   # Special startup case.
   $serial = 0;
   $h_output = '';
  } # end if
 else
  {
#
# Modified by J.Rowe to fix inconsistent view errors when moving depts
#   $serial = $global::hierarchy->{$dept}{'view_serial'};
   $serial = $global::current_view;
#
#   
   $h_output = $global::hierarchy->sub_hierarchy_output($dept);
  } # end else
   $global::log->warn("reply_hv: $serial $dept");

  &reply('hv',[$dept,$serial,$h_output]);

} # end reply_hv

#============================================================================#

# Function: reply_hte

# This function sends an error message for a failed transaction request.
 
# Inputs:
#  Actual Arguments:
#   a reference to an array containing transaction information,
#   an error message
#  Global:
#   $global::log
 
# Return Value(s):
#  None
# Reply messages:
#  hte message with the appropriate information
 
# Global variable modifications:
#  None
 
# Example of usage:
#  &reply_hte($messageref,"Security error.");
 
sub reply_hte
{
 my($messageref,$error) = @_;
 my $type = $messageref->[0];
 my $trans_id;
 if($type eq 'new_root') 
  { $trans_id = $type;}
 else
  { $trans_id = $messageref->[1];} 
 &reply('hte', [$trans_id,$error]);
 $global::log->warn("reply_hte on $trans_id: $error");
} # end reply_hte

#============================================================================#

# Function: reply_htp

# This function sends the htp message for permissable transactions.
 
# Inputs:
#  Actual Arguments:
#   Transaction Identification
#  Global:
#   $global::log
 
# Return Value(s):
#  None
# Reply messages:
#  htp message with transaction identification
 
# Global variable modifications:
#  None
 
# Example of usage:
#  &reply_htp($trans_id);
 
sub reply_htp
{
 my($trans_id) = @_;
 &reply('htp', [$trans_id]);
 $global::log->warn("reply_htp: $trans_id");
} # end reply_htp

#============================================================================#

sub reply
{
  my($header,$body_ref) = @_;
  if($global::output_mode eq 'stdio')
   {
    # Output on stdio
    print "$header ".join(' ',@$body_ref)."\n";
   }
  elsif($global::output_mode eq 'file')
   {
    # Output to the appropriately named file
    open(OUTPUT,">>$global::original_dir/pipes/$global::return_address") ||
     $global::log->die("Couldn't open $global::original_dir/pipes/$global::return_address:$!");
    print OUTPUT "$header ".join(' ',@$body_ref)."\n";
    close OUTPUT;
   }
  elsif($global::output_mode eq 'comm')
   {
    # Output via Comm.pm
    my($host,$port) = split(/:/,$global::return_address);
    $global::log->warn("OHS version is now $global::current_view\n");
    $global::log->warn("OHS about to send $header to $host:$port\n");
    my $comm_return = Comm::tcp_send($host,$port,$header,@$body_ref);
    unless ($comm_return eq 'true')
     {
      $global::log->warn("tcp_send failed:$comm_return");
      return;
     }
    Comm::tcp_close($host,$port)
   }
}

#============================================================================#
