package Initialisation;

# V4 Inserted 5 lines to die on command from NJS 

require Exporter;
@ISA = qw(Exporter);

@EXPORT_OK = qw(initialisation);

use Socket;        
use Reporting qw(initial_report report_and_die);

use strict;

sub GENTLY {
	initial_report("TSI Shepherd requested to finish (SIGTERM)");
	close(FROM_NJS);
	exit(0);
}


sub initialisation() {

	$SIG{CHLD} = 'IGNORE';
	$SIG{TERM} = \&GENTLY;

    initial_report("TSI $main::my_version for $main::my_os ");
    initial_report("Copyright (c) Fujitsu Ltd, 1999 to 2003. All Rights Reserved.\n");
    initial_report("Using Perl version $]");

    # --------------------------------------------------------------------
    # Where to contact the NJS. This information can come
    # from the command line (two arguments in order host_name, port)
    # or, failing that, from values in the initialisation section.
    #
    # The NJS is told about TSIs in the IDB TSI description section
    # with the keyword PORT.

    my $njs_machine = $main::njs_machine;
	if ($njs_machine =~ m/(.*)/s ) {
		$njs_machine = $1;
	}

    my $njs_port    = $main::njs_port;
	if ($njs_port =~ m/(.*)/s ) {
		$njs_port = $1;
	}

    my $my_port    = $main::my_port;
	if ($my_port =~ m/(.*)/s ) {
		$my_port = $1;
	}

    my $proto = getprotobyname('tcp');

    if($njs_port =~ /\D/) {$njs_port = getservbyname($njs_port, 'tcp')};
    die "No NJS port\n" unless $njs_port;

    my $iaddr = inet_aton($njs_machine);
	my $ip_address = inet_ntoa($iaddr);
    my $paddr = sockaddr_in($njs_port, $iaddr);

    my $old_fh = select(STDOUT);
    $| = 1;
    select($old_fh);

    $old_fh = select(STDERR);
    $| = 1;
    select($old_fh);

	# Open a server socket to listen for new TSI requests from the NJS
	socket(FROM_NJS, PF_INET, SOCK_STREAM, $proto);
	setsockopt(FROM_NJS, SOL_SOCKET, SO_REUSEADDR, 1);
	my $from_njs_addr = sockaddr_in($my_port, INADDR_ANY);
	bind(FROM_NJS, $from_njs_addr) or die "Could not bind to port $my_port: $!\n";
	listen(FROM_NJS, SOMAXCONN)    or die "Could not listen on port  $my_port: $!\n";

	my ($other_end, $other_iaddr, $other_port, $pid);
	while(accept(NJS_CLIENT, FROM_NJS)) {

		# Got connection, from NJS?

		if($other_end = getpeername(NJS_CLIENT)) {

			($other_port, $other_iaddr) = unpack_sockaddr_in($other_end);
			my $other_ip_address = inet_ntoa($other_iaddr);

			if($other_ip_address eq $ip_address) {

				# V4 Read message from NJS to see if we need to go
				my $message = <NJS_CLIENT>;
				$message =~ /get down shep\n/  && do {
					initial_report("NJS requested a stop");
				    GENTLY();
				 };
				# V4 END 

				# Write anything to tell NJS that this is OK
				$old_fh = select(NJS_CLIENT);
				$| = 1;
				select($old_fh);
				print NJS_CLIENT "OK\n"; 
				close(NJS_CLIENT);

				# --------------------------------------------------------------------
				# Open a pair of sockets to the NJS, one to carry commands (text)
				# and the other to carry data (files read and written).
     
				initial_report("Contacting the NJS on <$njs_machine> at port number <$njs_port>");

				# Open the commands channel, wait here for the NJS to start listening
				socket(main::CMD_SOCK, PF_INET, SOCK_STREAM, $proto) or report_and_die("command socket: $!");
				while(! connect(main::CMD_SOCK, $paddr) ) {
					initial_report("Waiting for NJS at $njs_machine:$njs_port to come up (last connect attempt said: $!)");
					sleep 3;
					socket(main::CMD_SOCK, PF_INET, SOCK_STREAM, $proto) or report_and_die("command socket: $!");
				}

				# Open the data channel
				socket(main::DATA_SOCK, PF_INET, SOCK_STREAM, $proto) or report_and_die("data socket: $!");
				connect(main::DATA_SOCK, $paddr)                      or report_and_die("data connect: $!");

				# Ensure that output is flushed
				$old_fh = select(main::CMD_SOCK);
				$| = 1;
				select($old_fh);

				$old_fh = select(main::DATA_SOCK);
				$| = 1;
				select($old_fh);

				initial_report("Connection to NJS established.");

				# --------------------------------------------------------------------
				# Now fork the child which becomes the requested TSI
				if( $pid = fork ) {
					# Parent, do not want the NJS sockets
					close(main::CMD_SOCK);
					close(main::DATA_SOCK);
					next;  # go back to accept

				}
				elsif(defined $pid) {  # $pid is actually 0 in child
					# Child, do not want the listener to NJS connections
					setpag();
					close(FROM_NJS);

					# Clear the signal handlers, CHLD screws script execution
					$SIG{CHLD} = 'DEFAULT';
					$SIG{TERM} = 'DEFAULT';

                    # Gnats ID 104
                    #
                    # Reset some variables that must be unique amongst all TSIs
                    # Do it here so that sites don't have to redo changes made to Submit.pm
                    #       
                    # the "eval" should trap errors in TSIs that do not use the 
                    # particular variable
                    #       
                    eval {  
                        $Submit::counter=$$*100 # For versions without BSS
                    };      
                    eval {  
                        $Submit::tsi_unique_file_name="TSI_temp_file_$$" # for all other TSIs
                    };      

					return;  # <---- Back to tsi and so to the main processing loop
				}
				else {
					# Fork failed, NJS will eventually notice that worker will
					# not contact and retry so as for parent
					close(main::CMD_SOCK);
					close(main::DATA_SOCK);
					next;
				}
			}
			else {
				# IP addresses differ, ignore
				close(NJS_CLIENT);
				initial_report("The other end of a start TSI request does not come from the NJS, ignoring: $other_ip_address");
			}
		}
		else {
			close(NJS_CLIENT);
			initial_report("Could not identify other end of a start TSI request, ignoring.");
		}
	}

	# Should never never get here ......
	die "Failed while listening for NJS connections: $!\n";

}
#
#                   Copyright (c) Fujitsu Ltd 2000 - 2004
#
#                Use and distribution is subject a License.
# A copy was supplied with the distribution (see documentation or the jar file).
#
# This product includes software developed by Fujitsu Limited (http://www.fujitsu.com).

sub setpag {
  my $e = '';
  my ($l);
  my ($AFSCALL_SETPAG, $AFSCALL_PIOCTL, $AFS_DEF_SYSCALL, $AFS_SETPAG, $AFS_PIOCTL, $AFS_SYSCALL);

  open(AFSH, '/usr/local/include/afs/afs_args.h') or
    open(AFSH, '/usr/local/include/afs/afs.h') or
      $e = 'unable to find afs/afs.h';

  while(!$e && defined($l = <AFSH>)) {
    chomp($l);
    if ($l =~ /^\#define\s*AFSCALL_SETPAG\s*([-+\d]+)/) { $AFSCALL_SETPAG  = eval $1 }
    if ($l =~ /^\#define\s*AFSCALL_PIOCTL\s*([-+\d]+)/) { $AFSCALL_PIOCTL  = eval $1 }
    if ($l =~ /^\#define\s*AFS_SYSCALL\s*([-+\d]+)/)    { $AFS_DEF_SYSCALL = eval $1 }
    last if ($AFSCALL_SETPAG && $AFS_DEF_SYSCALL);
  }
  close(AFSH);

  open(PARAMH, '/usr/local/include/afs/param.h') or
    open(PARAMH, '/afs/cs.cmu.edu/misc/afs/@sys/3.4a/include/afs/param.h') or
      $e = 'unable to find afs/param.h' if (!$e);

  while (!$e && defined($l = <PARAMH>)) {
    if ($l =~ /^\#define\s*AFS_SETPAG\s*([-+\d]+)/)  { $AFS_SETPAG  = eval $1 }
    if ($l =~ /^\#define\s*AFS_PIOCTL\s*([-+\d]+)/)  { $AFS_PIOCTL  = eval $1 }
    if ($l =~ /^\#define\s*AFS_SYSCALL\s*([-+\d]+)/) { $AFS_SYSCALL = eval $1 }
    last if ($AFS_SYSCALL);
  }
  close(PARAMH);

  $AFS_SYSCALL = $AFS_DEF_SYSCALL if (!$AFS_SYSCALL);
  if (!$e) {
    my $r = 0;

    if ($AFS_SETPAG) {
      $r = syscall($AFS_SETPAG+0);
    } else {
      $r = syscall($AFS_SYSCALL+0, $AFSCALL_SETPAG+0);
    }
    $e = "setpag() failed: $!" if ($r);
  }

  $e;
}