# $Id: cchp,v 1.11 2004/11/29 16:18:13 duncan_ferguson Exp $
#
# Script:
#   $RCSfile: cchp,v $
#
# Usage:
#   cluster console helper program - only to be called by cssh/crsh
#
# Options:
#   None of any interest
#
# Parameters:
#   None of any interest
#
# Purpose:
#   Smaller, quicker, program fo starting up sub-xterm childern
#
# Processing:
#
# Dependencies:
#   Only to be called by cssh/crsh (did I mention that already?)
#   See cssh/crsh for others
#
# Limitations:
#
# Enhancements:
#
# Note:
#   This script does not have the perl interpreter defined at line 1 as
#   it called using it from cssh, i.e. "perl /path/to/cchp"
#
# License:
#   This code is distributed under the terms of the GPL (GNU General Pulic
#   License).
#
#   Copyright (C)
#
#   This program is free software; you can redistribute it and/or modify it
#   under the terms of the GNU General Public License as published by the
#   Free Software Foundation; either version 2 of the License, or any later
#   version.
#
#   This program is distributed in the hope that it will be useful, but
#   WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
#   Public License for more details.
#
#   You should have received a copy of the GNU General Public License along
#   with this program; if not, write to the Free Software Foundation, Inc.,
#   59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
#   Please see the full text of the licenses is in the file LICENSE and also at
#     http://www.opensource.org/licenses/gpl-license.php
#
############################################################################
# Change log located at file end
############################################################################
my $VERSION='$Revision: 1.11 $ ($Date: 2004/11/29 16:18:13 $)';
# Now tidy it up, but in such as way cvs doesn't kill the tidy up stuff
$VERSION=~s/\$Revision: //;
$VERSION=~s/\$Date: //;
$VERSION=~s/ \$//g;

use strict;
use warnings;

use Fcntl;

use Getopt::Std;
my %options;

sub exit_prog();

getopts('vx:y:z:k:ds:', \%options);

if($options{v})
{
	my $name=$0;
	$name =~ s!.*/!!;
	print("$name: $VERSION\n");
	exit;
}

unless ($ENV{TERM}) {
	$ENV{TERM} = 'xterm';
}

$SIG{CHLD}='IGNORE';

# die gracefully if we get any signals we cannot otehrwise handle
use sigtrap qw(handler \&exit_prog untrapped normal-signals old-interface-signals);

# autoflush output
$|=1;

my $pid;

if($options{x})
{
	if( ! -p $options{x} || !  $options{y} || ! $options{z})
	{
		die ("cchp should only be called via cssh/crsh\n");
	}

	my $TIOCSTI=$options{y};
	my $KILLOFF=$options{z};

	if($options{d})
	{
		print "TIOCSTI=$TIOCSTI\n";
		print "KILLOFF=$KILLOFF\n";
		print "pipe=$options{x}\n";
	}

	my $sleepinterval=0.1;
	if ($options{s}) {
		$sleepinterval=$options{s};
	}

	$pid=fork();

	if(!defined($pid))
	{
		die("Could not fork: $!");
	}

	if($pid==0)
	{
		# this is the child
		print "ARGV=:",join(" ",@ARGV),":\n" if ($options{d});
		exec(@ARGV) || die("Could not exec within x: $!");
	} else {
		print "Forked to:$pid from $$\n" if($options{d});
		# this is the parent

		my $PIPELINE;

		# open pipe for reading from, non blocking, read only
		if(!sysopen($PIPELINE, $options{x}, O_NONBLOCK|O_RDONLY))
		{
			unlink($options{x});
			die ("Cannot open pipe for reading: $!");
		}

		OUTTER:
		{
			while()
			{
				if(sysread($PIPELINE,my $chars,10000))
				{
					print "Received:$chars:\n" if ($options{d});

					foreach my $char (split(//, $chars))
					{
						print "Caught KILLOFF\n" if(ord($char) == $KILLOFF && $options{d});
						last OUTTER if(ord($char) == $KILLOFF);
						#print STDIN "This is an echo line\n";
						unless(ioctl(STDIN,$TIOCSTI,$char))
						{
							print "failed to write to client ($!)\n";
							last OUTTER;
						}
					}
				}
				print "Pipe removed\n" if ($options{d} && ! -p $options{x});
				last OUTTER if(! -p $options{x});

				# if we can no longer write to client, it is gone
				print "Whoops - $pid no longer there\n" if($options{d} && ! kill(0,$pid));
				#print "KILL RETURNED:",kill(0,$pid),$/ if($options{d});
				last unless(kill(0,$pid));

				# sleep for a bit so we are nicer to the machine
				select(undef,undef,undef,$sleepinterval);
			}
		}
		exit_prog();
	}
	warn("Weird error - should never get here: $!") if($options{d});
	die("Weird error - should never get here: $!");
} else {
	warn ("cchp should only be called via cssh/crsh\n") if($options{d});
	die ("cchp should only be called via cssh/crsh\n");
}

sub exit_prog()
{
	print "Killing $pid\n" if($options{d} && kill(0,$pid));
	kill(9,$pid) if (kill(0,$pid));

	print "Removing pipe\n" if($options{d} && -p $options{x});
	unlink($options{x}) if(-p $options{x});

	if($options{k})
	{
		print "-k option set; sleeping for $options{k} seconds\n";
		sleep $options{k};
	}

	exit;
}
############################################################################
# $Log: cchp,v $
# Revision 1.11  2004/11/29 16:18:13  duncan_ferguson
# Change debug output slightly to be more meaningful
#
# Revision 1.10  2004/09/07 12:18:08  duncan_ferguson
# Add -k functionality to keep child windows open for x seconds
#
# Revision 1.9  2004/08/26 07:47:49  duncan_ferguson
# Code added to allow user definition of of the cchp sleep interval, default=0.1 (Tony Mancill)
#
# Revision 1.8  2004/08/13 15:13:29  duncan_ferguson
# Fix bug introduced with syswrite fix in 2.24 that stopped arrow keys working
#
# Revision 1.7  2004/05/10 12:32:15  duncan_ferguson
# Remove perl interpreter from line 1
# Correct -v output to use program name, not "Version:"
#
# Revision 1.6  2004/05/04 15:04:33  duncan_ferguson
# Swap around code order when detecting a removed pipe
# Add in sleep for .25 of a second during read to be nicer to the system
#
# Revision 1.5  2004/05/04 09:33:57  duncan_ferguson
# Add more debug info and also -v
#
# Revision 1.4  2004/04/30 14:22:14  duncan_ferguson
# Remove unnecesary IO::Select and IO::Handle code with some rewrite to fix
#   bug on redhat that locked code into a loop
#
# Revision 1.3  2004/04/29 14:59:05  duncan_ferguson
# Remove redhat bug whereby while(read(,my ,1)) {..} stuck in a loop
#
# Revision 1.2  2004/04/28 08:28:14  duncan_ferguson
# added -d debug option for some small debug output
#
# Revision 1.1  2004/04/20 12:44:29  duncan_ferguson
# Code split off from cssh version 2.7 in attempt to speed up cx's
#
############################################################################
