#!/usr/bin/perl -w 
#
# $Id: cssh,v 2.9 2004/04/20 15:51:50 duncan_ferguson Exp $
#
# Script:
#   $RCSfile: cssh,v $
#
# Usage:
#   cluster administrator console
#
# Options:
#  See help text below
#
# Parameters:
#   servers names to open cx's to
#
# Purpose:
#   To allow for administration of a cluster of xterms onto machines
#   via a sigle console window
#
# Processing:
#
#   Note: we "xterm->start ssh host" rather than "ssh host->start xterm"
#   because this allows us to easily use ssh to a number of different unices.
#   Otherwise, we have to work out target host type and work out where xterm is
#
# Dependencies:
#   perl
#   Tk
#   Config::Simple
#
# Limitations:
#
# Enhancements:
#
# 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
#
############################################################################
# History moved to bottom of file
############################################################################
my $VERSION='$Revision: 2.9 $ ($Date: 2004/04/20 15:51:50 $)';
# 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 5.006_000;
use Tk 800.022;
use Tk ':variables';
use Config::Simple 4.55;
##use English; # so we can use $UID and $EUID instead of $< and $>
require Tk::Dialog; # for the about box
require Tk::LabEntry; # for the add host widget
##use IO::Handle; # for untaint on the ps listing
use File::Basename; # for cmdline version and help output
use Sys::Hostname;
use File::Temp qw/:POSIX/;
use POSIX qw/ mkfifo /;
use Fcntl;
use FindBin;
use Term::Cap;

# set autoflush so we print to client correctly
$|=1;

# autoreap our zombies
$SIG{CHLD}='IGNORE';

# This section "up top" so unnecessary code isn't run if starting xterms
use Getopt::Std; # command line parsing, incase someone uses -v or -h
my %options;

# NOTE - option x is hidden and should never be called directly
getopts('x:l:hvncgst:T:', \%options);

my $TIOCSTI = "";

# Now set up all of those vars
sub setup_OS(); # make sure func is defined so we can use it straight away
setup_OS(); # and now call it

sub KILLOFF { return 0xEE }; # quit signal to send to xterm clients 

# Load Term::Cap entries (Assuming children are same type as parent)
my $termios = new POSIX::Termios;
$termios->getattr;
# 20040413 <tmancill@debian.org> - if TERM isn't set assume xterm
unless ($ENV{TERM}) {
	$ENV{TERM} = 'xterm';
}

my $ospeed = $termios->getospeed;
my $terminal = Tgetent Term::Cap { TERM => undef, OSPEED => $ospeed };

# This is the process by which we get around requiring setuid while also
# only running from one script
if($options{x})
{
	if( ! -p $options{x})
	{
		die ("cssh called incorrectly\n");
	}

	my $pid=fork();

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

	if($pid==0)
	{
		# this is the child
		exec(@ARGV) || die("Could not exec within x: $!");
	} else {
		# this is the parent

		use IO::Select;
		use IO::Handle;

		my $READER;

		# open pipe for reading from
		if(!sysopen($READER, $options{x}, O_RDONLY))
		{
			unlink($options{x});
			die ("Cannot open pipe for reading: $!");
		}

		# Don't allow the read to stop the prog
		$READER->blocking(0);

		my $reader=new IO::Select($READER) or die("$!");;

		my @ready;

		OUTTER:
		{
			while()
			{
				@ready = $reader->can_read(0.25);
			
				foreach my $fh (@ready)
				{
					if($fh == $READER)
					{
						while(read($READER,my $char,1))
						{
							last OUTTER if(ord($char) == KILLOFF);

							last if(! -p $options{x});
							
							unless(ioctl(STDIN,$TIOCSTI,$char))
							{
								print "failed to write to client\n";
								last OUTTER;
							}
						}
					}
				}
				# if we can no longer write to client, it is gone
				last unless(kill(0,$pid));
			}
		}
		kill(9,$pid) if (kill(0,$pid));
		unlink($options{x}) if(-p $options{x});
		exit;
	}
	die("Weird error - should never get here: $!");
}

# Set up some defaults
my %user_config;
$user_config{'default.terminal'}="x-terminal-emulator";
$user_config{'default.user'}=$ENV{LOGNAME};
$user_config{'default.terminal_options'}="-ls -sb -sl 1024";
$user_config{'default.cx_path'}="/usr/bin";
$user_config{'default.key_quit'}="Control-q";
$user_config{'default.key_addhost'}="Control-plus";
$user_config{'default.key_clientname'}="Alt-n";
$user_config{'default.variables'}="no";
$user_config{'default.title_number'}="no";
$user_config{'default.term_size'}="80x24";
$user_config{'default.always_tile'}="never";

# Now read in the system config file
Config::Simple->import_from('/etc/csshrc', \%user_config);

# Now overwrite that with any user defined ones
Config::Simple->import_from($ENV{HOME}."/.csshrc", \%user_config);

# predfine funcs as necessary
sub send_character_to_server;

# We can do something funky here - if we are called using a name other than
# 'cssh', drop the first letter and then use that instead, i.e. crsh uses
# rsh not ssh...
my $my_name=$FindBin::Script;

# now, untaint it 
if($my_name =~ /^([-\@\w.]+)$/) {
	$my_name=$1;
} else {
	die "FATAL: program name used is insecure ($my_name)\n";
}

my $method=$my_name;
$method =~ s/^.//;

if($method !~ /^[rs]sh$/) 
{
	die "FATAL: Only ssh and rsh protocols are currently supported (method=$method)\n";
}

my $path_method=$user_config{'default.cx_path'}."/".$method;

if($options{v})
{
	print("$my_name: $VERSION\n");
	exit;
}

if($options{h})
{
	print(<<EOL);
usage: $my_name [-hve] [-T "title"] [-t "term opts"] [[user@]<server>|<tag>] ...

where:
  -h             - this text
  -v             - version and date information
	-s             - set client-side environment variables (sh style)
	-c             - set client-side environment variables (csh style)
  -T "title"     - Additional test for control window title
	-n             - Show number of connection in control window title
	-l             - default login ID for ssh connections
  -t "termopts"  - start terminals with options in addition to 
                   "-ls -sb -sl 1024"
	-g "termsize"  - starts terminal windows in the set size, i.e. 60x10
  <server name>  - list of servers to connect to
  <tag name>     - list of servers from /etc/clusters using name as a tag 

See the man pages for more information ("perldoc cssh" or "man cssh").
EOL
	exit;
}

if($user_config{'default.variables'} eq "sh")
{
	$options{s}="yes";
} elsif($user_config{'default.variables'} eq "csh") {
	$options{c}="yes";
}

if($options{l})
{
	$user_config{'default.user'}=$options{l};
}

if($user_config{'default.title_number'} ne "no")
{
	$options{n}="yes";
}

if($user_config{'default.always_tile'} ne "never")
{
	$options{g}="yes";
}

if($options{t})
{
	$user_config{'default.terminal_options'}.=" $options{t} ";
	# untaint parameters
	if($user_config{'default.terminal_options'} =~/^([-\@\w. :]+)$/)
	{
		$user_config{'default.terminal_options'}=$1;
	} else {
		die "FATAL: options given with -t are insecure (no ; / or | allowed)\n";
	}
	print "Starting terminals with: $user_config{'default.terminal_options'}\n";
}

my $control_title="$my_name";
if($options{T})
{
	$control_title="$options{T} - $my_name";
}

# now, untaint it 
if($control_title =~ /^([-\@\w. ]+)$/) {
	$control_title=$1;
} else {
	die "FATAL: title used is insecure ($options{T})\n";
}

# remove 'bareword' errors for menu creation items
use subs qw/mw_mb_items mw_mb_file_items mw_mb_hosts_items mw_mb_options_items mw_mb_help_items wm_mb_help_about/;

# because we are running setuid (i.e. in taint mode), clean up the 
# environment we are running in
$ENV{PATH}='/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/bin:/usr/openwin/bin:/usr/X11R6/bin';
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

# Read in all cluster aliases if /etc/clusters exists for nice & quick
# alias translations
my %clusters;

if ( -r "/etc/clusters" )
{
	open(CLUSTERS,"<", "/etc/clusters");

	while(<CLUSTERS>)
	{
		next if(/^#/); # ignore all comment lines
		next if(/^\s*$/); # ignore all blank lines

		chomp;

		s/^([\w-]+)\s*//; # remote first work and stick into $1
		$clusters{$1} = $_ ; # Now bung in rest of line
	}

	close(CLUSTERS);
}

{ 
	my $clstr = $user_config{'default.clusters'};
	if(defined($clstr))
	{
		my(@clarray)=split(/\s+/,$clstr);
		foreach (@clarray)
		{
			my $c=$user_config{'default.'.$_};
			$clusters{$_} = $c if $c;
		}
	}
}

# loop over ARGV and expand any cluster aliases
my @cmdargs=@ARGV;

# function to take a name, check /etc/clusters for it, and return a correct
# list as appropriate
sub resolve_name($)
{
	my $alias = shift;

	# no point in doing anything if the alias file doesn't exist...
	return $clusters{$alias} if defined($clusters{$alias});

	return $alias;
}

# check all command line hosts for aliases and resolve
# - reverse it so we don't cover what we add onto the end and get into
# an infinite loop
foreach (reverse(@cmdargs))
{
	push (@cmdargs, split(/ /, resolve_name($_)));

	# now remove the alias from @cmdargs
	$_="";
}

# Now, tidy the array up and remove any blank entries
{
	my @cleanarray;

	foreach (@cmdargs)
	{
		push(@cleanarray, $_) if($_ && $_ !~ /^$/);
	}

	@cmdargs=@cleanarray;
}

# hash to contain all required info about windows used
# format of %servers is:
# [0] active
# [1] process id
# [2] pipe file name
# [3] pipe file handle
# [4] window geometry if tiling
my %servers;

# handle for main window
my $mw=MainWindow->new(-title=>$control_title);

# work out how many windows we are opening if setting geometry
# vars we need when we open windows
my ($term_height, $term_width, $rows, $cols) = (0,0,0,0);

if($options{g})
{
	# Now get the screen height for tiling windows later
	my $screen_height=$mw->screenheight;
	my $screen_width=$mw->screenwidth;

	#warn "screen_height=$screen_height\n";
	#warn "screen_width=$screen_width\n";

	RECALC:

	# Get the term width and height
	$term_height=$user_config{'default.term_size'};
	$term_height=~ s/.*x//;
	$term_height= ( $term_height * 13 ) + 5 ; # convert loosly to pixels
	$term_width=$user_config{'default.term_size'};
	$term_width=~ s/x.*//;
	$term_width= ( $term_width * 6 ) + 20 ; # convert loosly to pixels

	# Convert character size to pixels
	$rows=int(( $screen_height - ($screen_height % $term_height )) / $term_height);
	$cols=int(( $screen_width - ( $screen_width % $term_width )) / $term_width);

	my $total=@cmdargs;

	#warn "total=$total\n";
	#warn "term_height=$term_height\n";
	#warn "term_width=$term_width\n";
	#warn "cols=$cols\n";
	#warn "rows=$rows\n";
	#warn "default.term_size=$user_config{'default.term_size'}\n";

	# If we cannot fit them all in, decrease size of windows and rework out
	if($total > ($rows * $cols ))
	{
		my $term_height=$user_config{'default.term_size'};
		$term_height=~ s/.*x//;
		my $term_width=$user_config{'default.term_size'};
		$term_width=~ s/x.*//;

		if($term_height>10 && $term_width > 40) 
		{
			$term_height-=2;
			$term_width-=5;
			$user_config{'default.term_size'}="${term_width}x${term_height}";

			warn "WARNING: too many too big terminals to fit; reducing in size to ",
				$user_config{'default.term_size'}, "\n";

	#warn "total=$total\n";
	#warn "term_height=$term_height\n";
	#warn "term_width=$term_width\n";
	#warn "cols=$cols\n";
	#warn "rows=$rows\n";
	#warn "default.term_size=$user_config{'default.term_size'}\n";

			goto RECALC;
		} else {
			warn "WARNING: cannot tile windows - not attempting to tile\n";
			delete($options{g});
		}
	} 
}


open_windows(@cmdargs);

sub change_title_number {
	return unless $options{n};

	my $number=keys(%servers);

	$mw->title($control_title." [$number]");
}

change_title_number;

sub open_windows
{
	# Only need carry on if we have been passed some args
	return if($#_ == -1);

	my $total=@cmdargs;
	#warn "cols:$cols, rows:$rows\n";

	my $cur_col = 0;
	my $cur_row = 0;

	if($options{g})
	{
		$cur_col = $total % $cols;
		$cur_row = ($total - ($total % $cols)) / $cols;

		#warn "cur_col=$cur_col\n";
		#warn "cur_row=$cur_row\n";

		# we want the first ones to be from 0 not 1, so take 1 off 
		$cols-=1 if($cols > 0);
		$rows-=1 if($rows > 0);
		
		$cur_col-=1;
		if($cur_col<0)
		{
			$cur_row-=1 ;
			$cur_col=$cols;
		}

		# If we are tiling, reverse the array we work on, else we get the windows
		# out backwards
		@_ = reverse(@_);

		#warn "start cols:$cols, rows:$rows\n";
		#warn "start cur_col=$cur_col\n";
		#warn "start cur_row=$cur_row\n";
	}

	foreach (@_)
	{
		my $serv;
		my $serv_name;

		# untaint parameter
		if(/^([-:\@\w.]+)$/)
		{
			# use a random number to uniquely id host in hash so we can then
			# open a cx to the same host more than once.  use the __ as a marker
			# to remove all text after that point when we want to use the var
			$serv_name="$1__".rand();
			$serv_name=$user_config{'default.user'}."@".$serv_name if($serv_name !~ /@/);
			$serv=$serv_name;
			$serv=~ s/__.*//;
		} else {
			warn "FATAL: server name given is insecure ($serv)\n";
			exit_prog();
		}

		$serv=~s/.*@// if($serv =~ /$ENV{LOGNAME}@/);

		$servers{$serv_name}[0]=1; # mark terminal child process as active

		# Sort out a unique temp name for our pipe - do before fork so both
		# client and parent have access to it
		$servers{$serv_name}[2]=tmpnam();

		# Now we create the fifo pipe file
		mkfifo($servers{$serv_name}[2], 0600) or die("Cannot create pipe: $!");

		my $size= $options{g} ? "-geometry $user_config{'default.term_size'}" : "";
		my $place=$size;

		# If tiling, start at the bottom right and work backwards to ensure the 
		# correct overlaps
		if($options{g})
		{

			#warn "in cur_col=$cur_col\n";
			#warn "in cur_row=$cur_row\n";

			# Include extra space (+30) required on first line for title bar here
			$place=$size."+".$cur_col*$term_width."+".(($cur_row*$term_height)+30);
			#print "place=$place\n";

			$cur_col -= 1;

			if($cur_col<0)
			{
				#warn "cur_col reset, cur_row -1\n";
				$cur_col = $cols;
				$cur_row-=1;
			}

			#warn "out cur_col=$cur_col\n";
			#warn "out cur_row=$cur_row\n";
		}

		$servers{$serv_name}[1]=fork();

		if(!defined($servers{$serv_name}[1]))
		{
			# unset => fork failed for whatever reason
			warn "Cannot fork: $!";
			exit_prog();
		} elsif($servers{$serv_name}[1] == 0) {
			# child => fork returned 0

			my $KILLOFF=KILLOFF();

			# Start up the terminal via ourselves so the pipes are in place
			exec("$user_config{'default.terminal'} $user_config{'default.terminal_options'} $place -title '$method:$serv' -e /usr/lib/cchp -x $servers{$serv_name}[2] -y $TIOCSTI -z $KILLOFF $path_method $serv") or warn("Could not exec session to $serv: $! ");
		} else {
			# parent => fork return process id of child

			if(!sysopen($servers{$serv_name}[3], $servers{$serv_name}[2], O_WRONLY))
			{
				unlink($servers{$serv_name}[2]);
				die ("Cannot open pipe for writing: $!");
			}

			# strip off any username@ if included in the connection string
			$serv=~ s/.*@// if ($serv =~ /@/);
			if($options{s})
			{
				syswrite($servers{$serv_name}[3], "CSSH_CLIENT=".$serv.chr(13));
				syswrite($servers{$serv_name}[3], "CSSH_SERVER=".hostname.chr(13));
				syswrite($servers{$serv_name}[3], "export CSSH_CLIENT CSSH_SERVER".chr(13));
			} elsif($options{c}) {
				syswrite($servers{$serv_name}[3], "setenv CSSH_CLIENT=".$serv.chr(13));
				syswrite($servers{$serv_name}[3], "setenv CSSH_SERVER=".hostname.chr(13));
			}
		}
	}
}

change_title_number();

$mw->configure(-menu=>my $mw_mb=$mw->Menu);
my $file_menu = $mw_mb->cascade(
	-label     => 'File', 
	-menuitems => mw_mb_file_items,
	-tearoff   => 0,
);
my $hosts_menu = $mw_mb->cascade(
	-label     => 'Hosts', 
	-tearoff   => 1,
);
my $help_menu = $mw_mb->cascade(
	-label     => 'Help', 
	-menuitems => mw_mb_help_items,
	-tearoff   => 0,
);

my $entrytext="";

my $mw_entry=$mw->Entry(
	-textvariable           => \$entrytext,
	-insertborderwidth            => 4,
	-width => 25, # width of cluster control window
)->pack( -fill => "x",
	-expand => 1,
);

my $add_host_win=$mw->DialogBox(
	-popover => $mw,
	-popanchor => 'n',
	-title 				=> "Add Host",
	-buttons => [ 'Add', 'Cancel' ],
	-default_button => 'Add',
);

my $newhosts="";

my $add_host_entry = $add_host_win->add('LabEntry', 
	-textvariable => \$newhosts,
	-width        => 20,
	-label        => "Host",
	-labelPack    => [-side => 'left'],
)->pack(-side=>'left');

# Set up key shortcuts

# exit program key shortcut
$mw->bind($mw, "<$user_config{'default.key_quit'}>" => \&exit_prog);
$mw_entry->bind("Tk::Text", "<$user_config{'default.key_quit'}>" => \&exit_prog);

# add host key shortcut
$mw->bind($mw, "<$user_config{'default.key_addhost'}>" => \&add_host_win_entry);
$mw_entry->bind("Tk::Text", "<$user_config{'default.key_addhost'}>" => \&add_host_win_entry);

sub add_host_win_entry {
#	$add_host_win->Subwidget('entry')->focus;
	$add_host_entry->focus();
	my $answer=$add_host_win->Show();

	return if($answer eq "Cancel");
	return if(!$newhosts);

	my @new_hosts=split(/ /, $newhosts);
	open_windows(@new_hosts);

	# Only way it seems we can to the hosts menu is to delete all and recreate
	# name and ensure it has an entry on "Add Hosts" menu.  Start at 2 so
	# we don't delete the "Add Host" item
	my $menu=$mw_mb->entrycget('Hosts', -menu);
	$menu->delete(2,'end');

	# add back in the seperator
	$hosts_menu->separator;

	for my $serv_name (sort(keys(%servers)))
	{
		my $serv=$serv_name;
		$serv=~s/__.*//;

		$serv=~s/.*@// if($serv =~ /$ENV{LOGNAME}@/);

		$hosts_menu->checkbutton(
			-label=>$serv,
			-variable=>\$servers{$serv_name}[0],
		);
	}

	$newhosts="";

	$mw->withdraw;
	$mw->deiconify;
	$mw->raise;
	$mw->focus;
	$mw_entry->focus;
}

sub send_clientname {
	foreach my $serv_name (keys(%servers))
	{
		my $serv=$serv_name;
		$serv=~ s/__.*//;
		$serv=~ s/.*@// if ($serv =~ /@/);
		for (split(//, $serv))
		{
			send_character_to_server($serv_name,$_);
		}
	}
}

# key binding to send client name 
$mw->bind($mw, "<$user_config{'default.key_clientname'}>" => \&send_clientname);
$mw_entry->bind("Tk::Text", "<$user_config{'default.key_quit'}>" => \&send_clientname);

$mw_entry->eventAdd('<<Paste>>' => '<Control-v>');
$mw_entry->eventAdd('<<Paste>>' => '<Button-2>');

$mw_entry->bind('<<Paste>>' => sub {
	my $paste_text = '';
	Tk::catch { $paste_text=$mw_entry->SelectionGet }; # SelectionGet is fatal if no sel

	# grab everything within the text entry variable and output it to children
	for (split(//, $paste_text))
	{
		send_character($_);
	}
});

# we currently can only deal with ASCII codes, so any unusual
# keys must be converted, i.e. arrow keys.  
$mw->bind('<Key>' => sub { 
	my $char=$Tk::event->A;
	my $ascii=ord($Tk::event->A);

	if(!$ascii)
	{
		my $keysym=$Tk::event->K;
		if (my $termsym = {
			'Up'    => 'ku',
			'Right' => 'kr',
			'Down'  => 'kd',
			'Left'  => 'kl',
		}->{$keysym}) {
			for (split(//, $terminal->Tputs($termsym)))
			{
				send_character($_);
			}
		} else {
			return; # catch all for unhandled control keys
		}
	}

	if (!(keys(%servers)))
	{
		#no servers within hash array
		exit if $Tk::event->k == 39; # <CTRL>-D pressed, so exit
	}

	send_character($char);
	$entrytext="";
});

sub delete_host
{
	my $serv_name=shift;
	my $serv=$serv_name;
	$serv=~ s/__.*//;

	# grab a link to the hosts menu so we can work on it
	my $menu=$mw_mb->entrycget('Hosts', -menu);

	$serv=~ s/.*@// if ($serv =~ /$ENV{LOGNAME}@/);

	# now remove the menu entry
	
	Tk::catch { $menu->delete($serv) }; # Sometimes the menu is not yet created

	if($servers{$serv_name})
	{
		unlink($servers{$serv_name}[2]);
		delete($servers{$serv_name});
	}
	change_title_number();
}


sub send_character_to_server
{
	#[0]=server name
	#[1]=character
	my $serv_name=$_[0];
	my $char=$_[1];

	if($servers{$serv_name}[0])
	{
		if(-p $servers{$serv_name}[2])
		{
			# send the characters unbuffered via pipe
			syswrite($servers{$serv_name}[3], $char);
		} else {
			delete_host($serv_name);
		}
	}
}

sub send_character {
	my $char=$_[0];

	foreach (keys(%servers))
	{
		send_character_to_server($_,$char);
	}
	$entrytext="";
}

# every so many milliseconds, check to see if all our children are around.
# If not, remove them from the hash and the hosts menu
$mw->repeat(500, sub{
	foreach (keys(%servers))
	{
		unless (checkProcID($servers{$_}[1]))
		{
			delete_host($_);
		}
	}

	# pasting into the control window sometimes leaves the text behind.
	# Take advantage of the repeat to keep the entry text widget clean
	$entrytext="";
});

# Do this neatly...
sub exit_prog()
{
	foreach (keys(%servers))
	{
		if($servers{$_}[0])
		{
			if(-p $servers{$_}[2])
			{
				# send the children die signal - unused ASCII char
				syswrite($servers{$_}[3], chr(KILLOFF));
			}
		}
	}

	# and formally exit the program
	exit 0;
}


##################
# Top level menu items
##################
sub mw_mb_items
{
	[
		[ 'cascade', "File", -tearoff, 0, -menuitems, mw_mb_file_items ],
		[ 'cascade', "Hosts", -tearoff, 1 ],
		[ 'cascade', "Help", -tearoff, 0, -menuitems, mw_mb_help_items ],
	]
}
###

###
# File menu items
###
sub mw_mb_file_items
{
	[
			[ 'command', "Exit", -command => \&exit_prog, -accelerator => "$user_config{'default.key_quit'}" ],
		#	[ 'command', "printhash", -command => \&printhash ],
	]
}
###

###
# Hosts menu item - list of hosts fomr command line in hash 
###
# Grab the menu and add in all the hosts by hand
# First, button to allow more hosts to be added in later on
$hosts_menu->command(
	-label => "Add Host",
	-accelerator => "$user_config{'default.key_addhost'}",
	-command => \&add_host_win_entry,
);
$hosts_menu->separator;

# Now add in all the hosts we know about from command line
for (sort(keys(%servers)))
{
	my $serv=$_;
	$serv=~s/__.*//;

	# Remove any user@ if it is the current user
	$serv=~s/.*@// if($serv =~ /$ENV{LOGNAME}@/);

	if(checkProcID($servers{$_}[1]))
	{
		$hosts_menu->checkbutton(
			-label=>"$serv",
			-variable=>\$servers{$_}[0],
		);
	}
}
###

###
# Options menu item
###
sub mw_mb_options_items
{
	[
		[ 'command', "Option" ]
	]
}
###

###
# Help=>About dialogue box
###
my $wm_mb_help_about=$mw->Dialog(
	-popover      => $mw,
	-overanchor   => "c",
	-popanchor    => "c",
	-font         => 
		[ -family => "interface system",
			-size   => 10 ],
	-text => "Cluster Administrator Console using SSH\n\nVersion: $VERSION.\n\n" .
	"Bug/Suggestions to duncan_ferguson\@users.sourceforge.net",
);
###

###
# Help menu items
###
sub mw_mb_help_items
{
	[
		[ 'command', "About", -command=> sub { $wm_mb_help_about->Show } ],
	]
}
###

sub printhash
{
	# format of %servers is:
	# [0] active
	# [1] process id
	# [2] device
	# [3] file descriptor

	foreach (keys(%servers))
	{
		print "$_ [0] is $servers{$_}[0]\n" if (defined($servers{$_}[0]));
		print "$_ [1] is $servers{$_}[1]\n" if (defined($servers{$_}[1]));
		print "$_ [2] is $servers{$_}[2]\n" if (defined($servers{$_}[2]));
		print "$_ [3] is $servers{$_}[3]\n" if (defined($servers{$_}[3]));
	}
	print "----\n";
}

$mw_entry->focus;
MainLoop();

# Make sure our exit routine gets called
# NOTE: this func calls an explicit exit
exit_prog();

sub setup_OS()
{
	# to attempt to find out plateform value for setting TIOCSTI
	# and other such dependencies
	use Config;

	# predefined for linux
	if($Config{archname}=~/-linux/)
	{
		$TIOCSTI=0x5412;
		return;
	}

	# predefined for Sun Solaris
	if($Config{archname}=~/solaris/)
	{
		$TIOCSTI=0x007417;
		return;
	}

	# predefined for OpenBSD
	if($Config{archname}=~/^OpenBSD.i\d86-openbsd$/)
	{
		$TIOCSTI=0x80017472;
		return;
	}

	# predefined for HP-UX 11i rp7410
	if($Config{archname}=~/^PA-RISC2.0-LP64$/)
	{
		$TIOCSTI=0x80017472;
		return;
	}

	# not predefined, so attempt to work it out from the "normal" source
	if(! eval { require "sys/ioctl.ph" } )
	{
		print "Archname: -$Config{archname}-\n";
		die "FATAL ERROR: Please run \"cd /usr/include ; h2ph sys/ioctl.h\" as root\n";
	}

	my $tiocsti=eval{&TIOCSTI};

	if(defined($tiocsti))
	{
		print "Please email duncan_ferguson\@users.sourceforge.net with the following:\n";
		print "Archname: -$Config{archname}-\n";
		print "TIOCSTI:  -$tiocsti-\n";
		$TIOCSTI=$tiocsti;
		return;
	}

	print "An error has occured; your architecture is unknown.  ".
		"Please email\n\tduncan_ferguson\@users.sourceforge.net\nfor further ".
		"support with the following information:\n";
	print "\tArchname: -$Config{archname}-\n";
	print "Please also look in the BUGS section of the man page and run the ".
		"C code provided\n";

	exit 1;
}

# func to check if a process is still around and functioning
sub checkProcID
{
	return kill(0,$_[0]);
}


__END__

=head1 NAME

cssh - Cluster administration tool

=head1 SYNOPSIS

S<< cssh [-hvngcs] [-T"title"] [-t"opts"] [-l usr] [[usr@]<svr>|<tag>] [...] >>
S<< crsh [-hvngcs] [-T"title"] [-t"opts"] [-l usr] [[usr@]<svr>|<tag>] [...] >>

=head1 DESCRIPTION

The above command opens multiple connections to the specified hosts and an
administration console.  Any text typed into the administration console
is replicated to all other connected and active windows.

This tool is intended for cluster administration where the same configuration
or commands must be run on each node within the cluster.  Performing these
commands all at once via this tool ensures all nodes are kept in sync.

Connections are opened via ssh so a correctly installed and configured 
ssh installation is required.  If, however, the program is called by "crsh"
then the rsh protocol is used (and the communcations channel is insecure).

Extra caution should be taken when editing system files such as 
/etc/inet/hosts as lines may not necessarily be in the same order.  Assuming
line 5 is the same across all servers and modifying that is dangerous.  
Better to search for the specific line to be changed and double-check before
changes are committed.

=head2 Further Notes

=over

=item *

The dotted line on the Hosts sub-menu is a tear-off, i.e. click on it 
and the sub-menu is turned into its own window.

=item *

Unchecking a hostname on the Hosts sub-menu will disassociate the host 
window control from cluster control so no commands are sent.  Selecting 
it will reassociate it.

=item *

If the code is called as crsh instead of cssh (i.e. a symlink called 
crsh points to the cssh file or the file is renamed) rsh is used as the 
communcations protocol instead of ssh.

=back

=head1 OPTIONS

The following options are supported:

=over

=item -h

Basic help text

=item -v

Show version information

=item -g

Attempt to tile all the client windows in the available screen space

=item -T "title"

Changes the title from "cssh" to "title - cssh" to help 
distinguish between different invocations of the program.

=item -l userid

Changes the default user for the ssh connection from the current user for
all connection where not otherwise specified, i.e. 

  cssh -l user1 server1 server2 server3 user2@server4

will connect as user1 on server1, server2 and server3, and user2 on server4

=item -t "terminal options"

Pass all the text between the quotes directly to the xterms that are started.
Quotes must be used and all options must be accepted by xterm else the 
program stops.  

NOTE: options that include any of the following ; / | are excluded by
default as this could otherwise be a backdoor into the system.  If you want
to define colours you have to use names, i.e. -bg LightGrey1.  Names on Solaris
can be found in /usr/openwin/lib/rgb.txt

=back

=head1 KEY SHORTCUTS

The following key shortcuts are available within the console window, and all 
of them may be changed via the configuration files.

=over

=item Control-q

Quit the program and close all connections and windows

=item Control-+

Open the Add Host dialogue box

=item Alt-n

Paste in the correct client name to all clients, i.e. 

  scp /etc/hosts server:files/<Alt-n>.hosts 

would replace the <Alt-n> with the correct client name

=back

=head1 CONFIGURATION FILES

=over

=item /etc/clusters

This file contains a list of tags to server names mappings.  When any name
is used on the command line it is checked to see if it is a tag in 
/etc/clusters.  If it is a tag, then the tag is replaced with the list 
of servers from the file.  The file is formated as follows:

  <tag> [user@]<server> [user@]<server> [...]

i.e. 

  # List of servers in live
  live admin1@server1 admin2@server2 server3 server4

All standard comments and blank lines are ignored.

=item /etc/csshrc $HOME/.csshrc

This file contains configuration overrides - the defaults are as marked.  
Options are overwritten first by the global file, and then by the user file.

=over 

=item terminal = xterm

Terminal to use for the connection

=item terminal_options = -ls -sb -sl 1024

Options to pass to the terminal used

=item cx_path = /usr/bin/

Path to binary used for the connection if it hasn't been found by default
(i.e. the path to ssh when using cssh, or the path to rsh when using crsh)

=item variables = none

Can be "sh" or "csh".  Sets up environment variables on the client using
bourne shell or c shell syntax

=item title_number = no

Show the number of open connections in control window title

=item always_tile = never

If set to anything than "never" always sets -g switch (to tile windows)

=item clusters

List of defined clusters held within the file (see section on /etc/clusters 
above), i.e.

  clusters = list1 list2
  list1 = server1 user@server2
  list2 = server4 user@server5

=item key_quit = Control-q

Default key sequence to quit the program (will terminate all open windows).
See below note.

=item key_addhost = Control-+

Default key sequence to open AddHost menu.  See below note.

=item key_clientname = Alt-n

Default key sequence to send cssh client names to client

NOTE: The key shortcut modifiers must be in the form "Control", "Alt", or 
"Shift", i.e. with the first letter capitalised and the rest lower case.

=back

=back

=head1 AUTHOR

Duncan Ferguson

=head1 CREDITS

clusterssh is distributed under the GNU public license.  See the file 
LICENSE for details.

A web site is available at http://www.sourceforge.net/projects/clusterssh/.

=head1 BUGS

=over 2

=item *

Only ASCII codes can be sent to child terminals, so arrow keys and such 
have to be converted.  The arrow keys should work - please post to the
web site for any others that are required and do not work.

=back

=head1 REPORTING BUGS

=over 2

=item *

If you require support, please run the following commands
and post it on the web site in the support/problems forum:

  $ perl -V

  $ perl -MTk -e 'print $Tk::VERSION,$/'

  $ perl -MConfig::Simple -e 'print $Config::Simple::VERSION,$/'

=item *

I have tried to include values of TIOCSTI for those OS's I can, but not
all will currently work.  If cssh does not work for you due to a TIOCSTI 
error, please do the following (as well as the above) and send the output 
to the author, or report it on the web site (note: change the gcc as 
necessary):

  $ cat > tio.c <<EOF && gcc tio.c && ./a.out && rm ./a.out
  #include <sys/termio.h>
  #include <sys/ioctl.h>
  main() {
  printf("TIOCSTI:%#08x\n", TIOCSTI);
  }
  EOF

=back

=head1 SEE ALSO

L<http://www.sourceforge.net/projects/clusterssh/>,
L<ssh>,
L<Tk::overview>,
L<Config::Simple>
F</usr/share/doc/clusterssh/README.Debian>

=cut

############################################################################
#
#               M A I N T E N A N C E     H I S T O R Y
#
# Rf/Vs  Date      Author         Purpose
# -----  --------  -------------  -------------------------------------------
# 1.00   ??/12/02  D Ferguson     Initial Version
# 1.01   12/02/03  D Ferguson     Add in /etc/cluster aliasing
# ...
# 1.2    25/02/03  D Ferguson     Added: key-shortcuts, addition hosts,
#                                 removal of dead hosts, error control,
#                                 paste into text box
# 1.21   25/02/03  D Ferguson     cater for duff hosts that do not exist
#                                 properly by checking menu entries
# 1.22   26/02/03  D Ferguson     minor bug array fix
# 1.23   08/04/03  D Ferguson     Further bug fixes
# 1.3    30/05/03  D Ferguson     FOUND IT - bug that stopped console window
#                                 opening when more than 10 or so windows 
#                                 being opened stamped on - the repeat
#                                 was grabing too much process time due to 
#                                 slow sub function. Fix was a bit of profiling
# 1.31   02/06/03  D Ferguson     Remove introduced paste bug and added -v, -h
# 1.32   01/09/03  D Ferguson     Update to docs only (pod file)
# 1.33   03/09/03  D Ferguson     Include pod in this file, not seperatly
# 1.34   04/09/03  D Ferguson     Allow for xterm opts and docs update
# 1.35   05/09/03  D Ferguson     Tidied up taint error throughout for security
#                                 Also, if called as crsh uses rsh instead
# 1.36   08/09/03  D Ferguson     Found potentially serious bug with UID stuff
#                                 Also added a cancel button to Add Host box
# 1.37   12/09/03  D Ferguson     Amend how VERSION is defined so works with
#                                 make_package better.  Also finally installed
#                                 into my own SCCS
# 1.38   12/09/03  D Ferguson     Correct man page version and date and tidy up
# 1.39   22/09/03  D Ferguson     Change of email address
#                                 First bash at arch-independant TIOCSTI
#                                 Removed focus error msg from rocky_codehead
#                                 Fix to allow multiple cx's to same host
#                                 Mods to bugs section of man page
#                                 Speeded up startup when no hosts given
# 1.40   03/09/03  D Ferguson     Non-connecting client does not force
#                                 cssh to die
# 1.41   06/09/03  D Ferguson     Starting to fix linux issues
#                                   account for arch dependant stuff better
#                                     i.e. binary locations
#                                   in-script ptree  - ptree is solaris only
# 1.42   07/10/03  D Ferguson     Remove arbitary sleep and instead wait for
#                                   connections
#                                 Fix bugs in the new "ptree" in-house code
#                                 Include a number of linux bug fixes by clink
# 1.43   09/10/03  D Ferguson     Fix bug with unknown hosts not erroring
# 1.44   15/12/03  D Ferguson     Make sure the GPL license was included
# 1.45   06/01/04  D Ferguson     Modified to work on Solaris x86
# 1.46   12/01/04  D Ferguson     Use Config::Simple for config files
#                                 Allow -T "..." to set control window title
# 1.47   28/01/04  D Ferguson     Untaint -T correctly.  
#                                 Remove specific default path to xterm
#                                 Moved to sf.net cvs
#
# $Log: cssh,v $
# Revision 2.9  2004/04/20 15:51:50  duncan_ferguson
# Fix bug better for when not using -g
#
# Revision 2.8  2004/04/20 12:43:52  duncan_ferguson
# When tiling, correct order of windows so they are alphabetically forwards,
#   not backwards
# Move some code into a sub-app (cchp) and amend cssh as required to called
#   in attempt to speed up connections
# Add in HP-UX TIOCSTI value
# Modify man page BUG section in tio.c to remove a.out when completed
#
# Revision 2.7  2004/04/20 08:08:11  duncan_ferguson
# Add option "always_tile" to .csshrc
# Remove error message if not tiling windows
# Update docs to include new options
#
# Revision 2.6  2004/04/19 13:51:20  duncan_ferguson
# First cut at "-g" - window tiling
# Reapply Bren Viren's lost code for clusters in .csshrc (no idea where that went)
#
# Revision 2.5  2004/04/15 09:35:28  duncan_ferguson
# Applied patch for missing env vars when run from window manager not cmd line
#   - Tony Mancill
# Apply patch for the "Add Host" window not accepting <RETURN> correctly and
#   not grabbing the focus correctly.  Also remove some taint checks
#   - Gavin Brock
#
# Revision 2.4  2004/04/13 12:19:50  duncan_ferguson
# Apply patch from Tony Mancill for "-l <user>" errors when closing terminals.
# Apply patch from Gavin Brock fix the arrow keys bug
# Amend docs accordingly
#
# Revision 2.3  2004/04/06 15:33:45  duncan_ferguson
# fix use of user@server in /etc/clusters
#
# Revision 2.2  2004/04/06 14:10:21  duncan_ferguson
# Reinsert lost "cssh -l user" code - no idea where that went...
#
# Revision 2.1  2004/04/06 11:41:08  duncan_ferguson
# Strip off user@ in "Alt-N" and -s/-c options
# Remove some unnecessary setuid stuff now no longer setuid
#
# Revision 2.0  2004/04/02 13:27:03  duncan_ferguson
# MAJOR CHANGE - removal of setuid requirement and references
# Reset key shortcuts to CTRL-q, CTRL-+ and ALT-n
# Reorg of reused code into funcs
# Change of main hash format
# Removal all ps listing stuff as no longer required
# Update man page
#
# Revision 1.56  2004/03/26 11:38:23  duncan_ferguson
# Removed debug menu option "printhash"
# Corrected menu accelorator keys (Tony Mancill)
# Updated man/pod page with usage and key shortcuts info
# Added key shortcut to send client name to client (Hans-Joachim Hoetger)
#
# Revision 1.55  2004/03/25 12:27:46  duncan_ferguson
# Added in configurable shortcut to send client names to client
#
# Revision 1.54  2004/03/25 10:49:19  duncan_ferguson
# Remove debug message for number of cx's in title window
# Finally fixed bug for sorting the Add Hosts menu
#
# Revision 1.53  2004/03/25 10:23:57  duncan_ferguson
# Include option for displaying total number of connections in console title 
#    bar (David Gardner)
# Work on bug for failed connection messages not always showing (David Gardner)
#
# Revision 1.52  2004/03/24 12:29:14  duncan_ferguson
# Added in client side variables (i.e. CSSH_CLIENT and CSSH_SERVER) with -s|c
# Changed key shortcuts to be user configurable
# Changed key shortcut quit from Control-X to Alt-X (for EMACS users)
# Changed key shortcut Add Host from Control-A to Alt-A (for consistency)
#
# Revision 1.51  2004/02/20 09:36:35  duncan_ferguson
# Include Jason Hollands patches:
# - includes :'s in hostnames
# - include TIOCSTI for linux ia64 systems.
# Modified patch slight to assume all linux systems have same TIOCSTI value
# Also modified section of docs on the /etc/cluster file
#
# Revision 1.50  2004/02/02 10:26:45  duncan_ferguson
# allow spaces in -T "" string for window title
# increase size of window from 20 chars to 25 chars
# change default title from "Cluster Control by SSH" to program name
#
# Revision 1.49  2004/01/28 13:41:28  duncan_ferguson
# man page corrections
#
# Revision 1.48  2004/01/28 12:34:03  duncan_ferguson
# fix bugs introduced by cvs move
#
# Revision 1.47  2004/01/28 10:38:03  duncan_ferguson
# Moved to sf.net cvs
#
#
############################################################################
