amassivus/clusterssh
1
0
Fork 0
mirror of https://github.com/duncs/clusterssh.git synced 2025-04-21 09:09:06 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Move the helper script as is into a module and get working again

Browse source
This commit is contained in:
Duncan Ferguson 2011-08-31 21:01:12 +01:00
parent 4976b953bd
commit ce4f610905
5 changed files with 493 additions and 252 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

247
lib/App/ClusterSSH.pm
View file

@ -10,6 +10,9 @@ use Carp;
use base qw/ App::ClusterSSH::Base /;
use App::ClusterSSH::Host;
use App::ClusterSSH::Config;
use App::ClusterSSH::Helper;
use FindBin qw($Script);
use POSIX ":sys_wait_h";
use Pod::Usage;
@ -52,6 +55,7 @@ sub new {
my $self = $class->SUPER::new(%args);
$self->{config} = App::ClusterSSH::Config->new();
$self->{helper} = App::ClusterSSH::Helper->new();
# catch and reap any zombies
$SIG{CHLD} = \&REAPER;
@ -64,6 +68,11 @@ sub config {
return $self->{config};
}
sub helper {
my ($self) = @_;
return $self->{helper};
}
sub REAPER {
my $kid;
do {
@ -106,7 +115,6 @@ my %windows; # hash for all window definitions
my %menus; # hash for all menu definitions
my @servers; # array of servers provided on cmdline
my %servers; # hash of server cx info
my $helper_script = "";
my $xdisplay;
my %keyboardmap;
my $sysconfigdir = "/etc";
@ -732,113 +740,113 @@ sub send_resizemove($$$$$) {
#$xdisplay->flush(); # dont flush here, but after all tiling worked out
}
sub setup_helper_script() {
my($self) = @_;
logmsg( 2, "Setting up helper script" );
my $comms=$self->config->{comms};
my $comms_args=$self->config->{$self->config->{comms}.'_args'} || '';
my $command=$self->config->{command};
# P = pipe file
# s = server
# u = username
# p = port
# m = ccon master
# c = comms command
# a = command args
# C = command to run
$helper_script = q{
use strict;
use warnings;
use Getopt::Std;
my %opts;
getopts('PsupmcaC', \%opts);
my $command="$opts{c} $opts{a}";
open(PIPE, ">", $opts{P}) or die("Failed to open pipe: $!\n");
print PIPE "$$:$ENV{WINDOWID}"
or die("Failed to write to pipe: $!\\n");
close(PIPE) or die("Failed to close pipe: $!\\n");
if($opts{s} =~ m/==$/)
{
$opts{s} =~ s/==$//;
warn("\nWARNING: failed to resolve IP address for $opts{s}.\n\n");
sleep 5;
}
if($opts{m}) {
unless("$comms" ne "console") {
$opts{m} = $opts{m} ? "-M $opts{m} " : "";
$opts{c} .= $opts{m};
}
}
if($opts{u}) {
unless("$comms" eq "telnet") {
$opts{u} = $opts{u} ? "-l $opts{u} " : "";
$opts{c} .= $opts{u};
}
}
if("$comms" eq "telnet") {
$command .= "$opts{s} $opts{p}";
} else {
if ($opts{p}) {
$opts{c} .= "-p $opts{p} $opts{s}";
} else {
$opts{c} .= "$opts{s}";
}
}
#$command .= " $command || sleep 5";
warn("Running:$command\n"); # for debug purposes
exec($command);
};
# $helper_script = <<" HERE";
# my \$pipe=shift;
# my \$svr=shift;
# my \$user=shift;
# my \$port=shift;
# my \$mstr=shift;
# my \$command="$config{$config{comms}} $config{$config{comms}."_args"} ";
# open(PIPE, ">", \$pipe) or die("Failed to open pipe: \$!\\n");
# print PIPE "\$\$:\$ENV{WINDOWID}"
# or die("Failed to write to pipe: $!\\n");
# close(PIPE) or die("Failed to close pipe: $!\\n");
# if(\$svr =~ m/==\$/)
# {
# \$svr =~ s/==\$//;
# warn("\\nWARNING: failed to resolve IP address for \$svr.\\n\\n"
# );
# sleep 5;
# }
# if(\$mstr) {
# unless("$config{comms}" ne "console") {
# \$mstr = \$mstr ? "-M \$mstr " : "";
# \$command .= \$mstr;
# }
# }
# if(\$user) {
# unless("$config{comms}" eq "telnet") {
# \$user = \$user ? "-l \$user " : "";
# \$command .= \$user;
# }
# }
# if("$config{comms}" eq "telnet") {
# \$command .= "\$svr \$port";
# } else {
# if (\$port) {
# \$command .= "-p \$port \$svr";
# } else {
# \$command .= "\$svr";
# }
# }
# \$command .= " $config{command} || sleep 5";
## warn("Running:\$command\\n"); # for debug purposes
# exec(\$command);
# HERE
# eval $helper_script || die ($@); # for debug purposes
logmsg( 2, $helper_script );
logmsg( 2, "Helper script done" );
return $self;
}
#sub setup_helper_script() {
# my($self) = @_;
# logmsg( 2, "Setting up helper script" );
# my $comms=$self->config->{comms};
# my $comms_args=$self->config->{$self->config->{comms}.'_args'} || '';
# my $command=$self->config->{command};
#
# # P = pipe file
# # s = server
# # u = username
# # p = port
# # m = ccon master
# # c = comms command
# # a = command args
# # C = command to run
# my $lelehelper_script = q{
# use strict;
# use warnings;
# use Getopt::Std;
# my %opts;
# getopts('PsupmcaC', \%opts);
# my $command="$opts{c} $opts{a}";
# open(PIPE, ">", $opts{P}) or die("Failed to open pipe: $!\n");
# print PIPE "$$:$ENV{WINDOWID}"
# or die("Failed to write to pipe: $!\\n");
# close(PIPE) or die("Failed to close pipe: $!\\n");
# if($opts{s} =~ m/==$/)
# {
# $opts{s} =~ s/==$//;
# warn("\nWARNING: failed to resolve IP address for $opts{s}.\n\n");
# sleep 5;
# }
# if($opts{m}) {
# unless("$comms" ne "console") {
# $opts{m} = $opts{m} ? "-M $opts{m} " : "";
# $opts{c} .= $opts{m};
# }
# }
# if($opts{u}) {
# unless("$comms" eq "telnet") {
# $opts{u} = $opts{u} ? "-l $opts{u} " : "";
# $opts{c} .= $opts{u};
# }
# }
# if("$comms" eq "telnet") {
# $command .= "$opts{s} $opts{p}";
# } else {
# if ($opts{p}) {
# $opts{c} .= "-p $opts{p} $opts{s}";
# } else {
# $opts{c} .= "$opts{s}";
# }
# }
# #$command .= " $command || sleep 5";
# warn("Running:$command\n"); # for debug purposes
# exec($command);
# };
## $helper_script = <<" HERE";
## my \$pipe=shift;
## my \$svr=shift;
## my \$user=shift;
## my \$port=shift;
## my \$mstr=shift;
## my \$command="$config{$config{comms}} $config{$config{comms}."_args"} ";
## open(PIPE, ">", \$pipe) or die("Failed to open pipe: \$!\\n");
## print PIPE "\$\$:\$ENV{WINDOWID}"
## or die("Failed to write to pipe: $!\\n");
## close(PIPE) or die("Failed to close pipe: $!\\n");
## if(\$svr =~ m/==\$/)
## {
## \$svr =~ s/==\$//;
## warn("\\nWARNING: failed to resolve IP address for \$svr.\\n\\n"
## );
## sleep 5;
## }
## if(\$mstr) {
## unless("$config{comms}" ne "console") {
## \$mstr = \$mstr ? "-M \$mstr " : "";
## \$command .= \$mstr;
## }
## }
## if(\$user) {
## unless("$config{comms}" eq "telnet") {
## \$user = \$user ? "-l \$user " : "";
## \$command .= \$user;
## }
## }
## if("$config{comms}" eq "telnet") {
## \$command .= "\$svr \$port";
## } else {
## if (\$port) {
## \$command .= "-p \$port \$svr";
## } else {
## \$command .= "\$svr";
## }
## }
## \$command .= " $config{command} || sleep 5";
### warn("Running:\$command\\n"); # for debug purposes
## exec(\$command);
## HERE
#
# # eval $helper_script || die ($@); # for debug purposes
# #logmsg( 2, $helper_script );
# #logmsg( 2, "Helper script done" );
#
# return $self;
#}
sub open_client_windows(@) {
my $self = shift;
@ -930,12 +938,12 @@ sub open_client_windows(@) {
"'".$self->config->{title}.': '.$servers{$server}{connect_string}."'",
'-font '.$self->config->{terminal_font},
"-e ".$^X.' -e ',
"'".$helper_script."'",
"-P ".$servers{$server}{pipenm},
"-s ".$servers{$server}{givenname},
"-u '".$servers{$server}{username}."'",
"-p '".$servers{$server}{port}."'",
"-m '".$servers{$server}{master}."'",
"'".$self->helper->script($self->config)."'",
" ".$servers{$server}{pipenm},
" ".$servers{$server}{givenname},
" '".$servers{$server}{username}."'",
" '".$servers{$server}{port}."'",
" '".$servers{$server}{master}."'",
);
logmsg( 2, "Terminal exec line:\n$exec\n" );
exec($exec) == 0 or warn("Failed: $!");
@ -1073,7 +1081,7 @@ sub retile_hosts {
my %config;
warn 'Todo: retile hosts';
if ( $self->config->{window_tiling} ne "yes" && !$force ) {
#if ( $self->config->{window_tiling} ne "yes" && !$force ) {
logmsg( 3,
"Not meant to be tiling; just reshow windows as they were" );
@ -1081,9 +1089,9 @@ sub retile_hosts {
$xdisplay->req( 'MapWindow', $servers{$server}{wid} );
}
$xdisplay->flush();
show_console();
$self->show_console();
return;
}
#}
# ALL SIZES SHOULD BE IN PIXELS for consistency
@ -2054,7 +2062,6 @@ sub run {
logmsg( 2, "Capture map events" );
$self->capture_map_events();
$self->setup_helper_script();
logmsg( 0, 'Opening to: ', join(' ', @servers) );
$self->open_client_windows(@servers);
@ -2136,6 +2143,8 @@ the code until this time.
=item config
=item helper
=item create_menubar
=item create_windows
@ -2190,8 +2199,6 @@ the code until this time.
=item send_text_to_all_servers
=item setup_helper_script
=item setup_repeat
=item show_console

91
lib/App/ClusterSSH/Config.pm
View file

@ -9,10 +9,12 @@ our $VERSION = version->new('0.01');
use Carp;
use Try::Tiny;
use FindBin qw($Script);
use base qw/ App::ClusterSSH::Base /;
my %clusters;
my @app_specific = (qw/ title comms method ssh rsh telnet ccon /);
my @app_specific = (qw/ command title comms method ssh rsh telnet ccon /);
my %default_config = (
terminal => "xterm",
terminal_args => "",
@ -76,6 +78,16 @@ sub new {
my $self = $class->SUPER::new(%default_config);
( my $comms = $Script ) =~ s/^c//;
$self->{comms} = $comms;
# list of allowed comms methods
if ( 'ssh rsh telnet console' !~ m/\B$comms\B/ ) {
$self->{comms} = 'ssh';
}
$self->{title} = uc($Script);
return $self->validate_args(%args);
}
@ -85,8 +97,9 @@ sub validate_args {
my @unknown_config = ();
foreach my $config ( sort( keys(%args) ) ) {
if (grep /$config/, @app_specific) {
$self->{$config} ||= 'unknown';
if ( grep /$config/, @app_specific ) {
# $self->{$config} ||= 'unknown';
next;
}
@ -172,31 +185,43 @@ sub parse_config_file {
}
sub load_configs {
my ($self, @configs) = @_;
my ( $self, @configs ) = @_;
if ( -e $ENV{HOME} . '/.csshrc' ) {
warn( $self->loc('NOTICE: [_1] is no longer used - please see documentation and remove', $ENV{HOME} . '/.csshrc'), $/);
warn(
$self->loc(
'NOTICE: [_1] is no longer used - please see documentation and remove',
$ENV{HOME} . '/.csshrc'
),
$/
);
}
for my $config ( '/etc/csshrc', $ENV{HOME} . '/.csshrc', $ENV{HOME} . '/.clusterssh/config', ) {
$self->parse_config_file($config) if( -e $config );
for my $config (
'/etc/csshrc',
$ENV{HOME} . '/.csshrc',
$ENV{HOME} . '/.clusterssh/config',
)
{
$self->parse_config_file($config) if ( -e $config );
}
# write out default config file if necesasry
try {
$self->write_user_config_file();
} catch {
warn $_,$/;
}
catch {
warn $_, $/;
};
# Attempt to load in provided config files. Also look for anything
# Attempt to load in provided config files. Also look for anything
# relative to config directory
for my $config ( @configs ) {
next unless($config); # can be null when passed from Getopt::Long
$self->parse_config_file($config) if( -e $config );
for my $config (@configs) {
next unless ($config); # can be null when passed from Getopt::Long
$self->parse_config_file($config) if ( -e $config );
my $file = $ENV{HOME} . '/.clusterssh/config_'.$config;
$self->parse_config_file($file) if( -e $file );
my $file = $ENV{HOME} . '/.clusterssh/config_' . $config;
$self->parse_config_file($file) if ( -e $file );
}
return $self;
@ -207,14 +232,17 @@ sub write_user_config_file {
return if ( -f "$ENV{HOME}/.clusterssh/config" );
if(! -d "$ENV{HOME}/.clusterssh" ) {
if(!mkdir("$ENV{HOME}/.clusterssh")) {
croak(
App::ClusterSSH::Exception::Config->throw(
error => $self->loc('Unable to create directory [_1]: [_2]', '$HOME/.clusterssh', $!),
),
);
if ( !-d "$ENV{HOME}/.clusterssh" ) {
if ( !mkdir("$ENV{HOME}/.clusterssh") ) {
croak(
App::ClusterSSH::Exception::Config->throw(
error => $self->loc(
'Unable to create directory [_1]: [_2]',
'$HOME/.clusterssh', $!
),
),
);
}
}
@ -227,7 +255,11 @@ sub write_user_config_file {
else {
croak(
App::ClusterSSH::Exception::Config->throw(
error => $self->loc('Unable to write default [_1]: [_2]', '$HOME/.clusterssh/config', $!),
error => $self->loc(
'Unable to write default [_1]: [_2]',
'$HOME/.clusterssh/config',
$!
),
),
);
}
@ -295,14 +327,17 @@ sub find_binary {
sub dump {
my ( $self, $no_exit, ) = @_;
$self->debug(3, 'Dumping config to STDOUT');
print('# Configuration dump produced by "cssh -u"',$/);
$self->debug( 3, 'Dumping config to STDOUT' );
print( '# Configuration dump produced by "cssh -u"', $/ );
foreach my $key (keys %$self) {
foreach my $key ( sort keys %$self ) {
if ( grep /$key/, @app_specific ) {
next;
}
print $key, '=', $self->{$key}, $/;
}
$self->exit if(!$no_exit);
$self->exit if ( !$no_exit );
}
#use overload (

132
lib/App/ClusterSSH/Helper.pm Normal file
View file

@ -0,0 +1,132 @@
package App::ClusterSSH::Helper;
use strict;
use warnings;
use version;
our $VERSION = version->new('0.01');
use Carp;
use Try::Tiny;
use base qw/ App::ClusterSSH::Base /;
sub new {
my ( $class, %args ) = @_;
my $self = $class->SUPER::new(%args);
return $self;
}
sub script {
my ($self, $config ) = @_;
my $comms = $config->{comms};
my $comms_args = $config->{$comms.'_args'};
my $command = $config->{command};
my $script = <<" HERE";
my \$pipe=shift;
my \$svr=shift;
my \$user=shift;
my \$port=shift;
my \$mstr=shift;
my \$command="$comms $comms_args ";
open(PIPE, ">", \$pipe) or die("Failed to open pipe: \$!\\n");
print PIPE "\$\$:\$ENV{WINDOWID}"
or die("Failed to write to pipe: $!\\n");
close(PIPE) or die("Failed to close pipe: $!\\n");
if(\$svr =~ m/==\$/)
{
\$svr =~ s/==\$//;
warn("\\nWARNING: failed to resolve IP address for \$svr.\\n\\n"
);
sleep 5;
}
if(\$mstr) {
unless("$comms" ne "console") {
\$mstr = \$mstr ? "-M \$mstr " : "";
\$command .= \$mstr;
}
}
if(\$user) {
unless("$comms" eq "telnet") {
\$user = \$user ? "-l \$user " : "";
\$command .= \$user;
}
}
if("$comms" eq "telnet") {
\$command .= "\$svr \$port";
} else {
if (\$port) {
\$command .= "-p \$port \$svr";
} else {
\$command .= "\$svr";
}
}
\$command .= " $command || sleep 5";
warn("Running:\$command\\n"); # for debug purposes
exec(\$command);
HERE
$self->debug(4, $script);
$self->debug(2, 'Helper script done');
return $script;
}
#use overload (
# q{""} => sub {
# my ($self) = @_;
# return $self->{hostname};
# },
# fallback => 1,
#);
1;
=pod
=head1 NAME
ClusterSSH::Helper
=head1 SYNOPSIS
=head1 DESCRIPTION
Object representing application configuration
=head1 METHODS
=over 4
=item $host=ClusterSSH::Helper->new ({ })
Create a new helper object.
=item $host=ClusterSSH::Helper->script ({ })
Return the helper script
=back
=head1 AUTHOR
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
=head1 LICENSE AND COPYRIGHT
Copyright 1999-2010 Duncan Ferguson.
This program is free software; you can redistribute it and/or modify it
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.
See http://dev.perl.org/licenses/ for more information.
=cut
1;

240
t/15config.t
View file

@ -11,7 +11,9 @@ use File::Temp qw(tempdir);
use Readonly;
BEGIN { use_ok("App::ClusterSSH::Config") || BAIL_OUT('failed to use module')}
BEGIN {
use_ok("App::ClusterSSH::Config") || BAIL_OUT('failed to use module');
}
my $config;
@ -67,6 +69,8 @@ Readonly::Hash my %default_config => {
history_height => 10,
command => q{},
title => q{15CONFIG.T},
comms => q{ssh},
max_host_menu_items => 30,
max_addhost_menu_cluster_items => 6,
@ -203,7 +207,10 @@ trap {
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception::Config' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, '"missing" binary not found - please amend $PATH or the cssh config file', 'die message correct' );
is( $trap->die,
'"missing" binary not found - please amend $PATH or the cssh config file',
'die message correct'
);
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
@ -213,12 +220,12 @@ trap {
$path = $config->find_binary('ls');
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is_deeply( $config, \%expected, 'amended config is correct' );
is($path, which('ls'), 'Found correct path to "ls"');
is( $path, which('ls'), 'Found correct path to "ls"' );
note('Checks on loading configs');
note('empty dir');
@ -228,114 +235,127 @@ trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
#note(qx/ls -laR $ENV{HOME}/);
ok( -d $ENV{HOME}.'/.clusterssh', '.clusterssh dir exists');
ok( -f $ENV{HOME}.'/.clusterssh/config', '.clusterssh config file exists');
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
$ENV{HOME} = undef;
note('.csshrc warning');
$ENV{HOME} = tempdir( CLEANUP => 1 );
open(my $csshrc, '>', $ENV{HOME}.'/.csshrc');
open( my $csshrc, '>', $ENV{HOME} . '/.csshrc' );
print $csshrc 'auto_quit = no', $/;
close($csshrc);
$expected{auto_quit}='no';
$expected{auto_quit} = 'no';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, 'NOTICE: '.$ENV{HOME}.'/.csshrc is no longer used - please see documentation and remove'.$/, 'Got correct STDERR output for .csshrc' );
ok( -d $ENV{HOME}.'/.clusterssh', '.clusterssh dir exists');
ok( -f $ENV{HOME}.'/.clusterssh/config', '.clusterssh config file exists');
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr,
'NOTICE: '
. $ENV{HOME}
. '/.csshrc is no longer used - please see documentation and remove'
. $/,
'Got correct STDERR output for .csshrc'
);
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
note('.csshrc warning and .clusterssh dir plus config');
open($csshrc, '>', $ENV{HOME}.'/.clusterssh/config');
open( $csshrc, '>', $ENV{HOME} . '/.clusterssh/config' );
print $csshrc 'window_tiling = no', $/;
close($csshrc);
$expected{window_tiling}='no';
$expected{window_tiling} = 'no';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, 'NOTICE: '.$ENV{HOME}.'/.csshrc is no longer used - please see documentation and remove'.$/, 'Got correct STDERR output for .csshrc' );
ok( -d $ENV{HOME}.'/.clusterssh', '.clusterssh dir exists');
ok( -f $ENV{HOME}.'/.clusterssh/config', '.clusterssh config file exists');
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr,
'NOTICE: '
. $ENV{HOME}
. '/.csshrc is no longer used - please see documentation and remove'
. $/,
'Got correct STDERR output for .csshrc'
);
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
note('no .csshrc warning and .clusterssh dir');
unlink($ENV{HOME}.'/.csshrc');
$expected{auto_quit}='yes';
unlink( $ENV{HOME} . '/.csshrc' );
$expected{auto_quit} = 'yes';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
ok( -d $ENV{HOME}.'/.clusterssh', '.clusterssh dir exists');
ok( -f $ENV{HOME}.'/.clusterssh/config', '.clusterssh config file exists');
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
note('no .csshrc warning, .clusterssh dir plus config + extra config');
open($csshrc, '>', $ENV{HOME}.'/clusterssh.config');
open( $csshrc, '>', $ENV{HOME} . '/clusterssh.config' );
print $csshrc 'terminal = something', $/;
close($csshrc);
$expected{terminal}='something';
$expected{terminal} = 'something';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs($ENV{HOME}.'/clusterssh.config');
$config->load_configs( $ENV{HOME} . '/clusterssh.config' );
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
ok( -d $ENV{HOME}.'/.clusterssh', '.clusterssh dir exists');
ok( -f $ENV{HOME}.'/.clusterssh/config', '.clusterssh config file exists');
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
note('no .csshrc warning, .clusterssh dir plus config + more extra configs');
open($csshrc, '>', $ENV{HOME}.'/.clusterssh/config_ABC');
open( $csshrc, '>', $ENV{HOME} . '/.clusterssh/config_ABC' );
print $csshrc 'ssh_args = something', $/;
close($csshrc);
$expected{ssh_args}='something';
$expected{ssh_args} = 'something';
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs($ENV{HOME}.'/clusterssh.config', 'ABC');
$config->load_configs( $ENV{HOME} . '/clusterssh.config', 'ABC' );
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
ok( -d $ENV{HOME}.'/.clusterssh', '.clusterssh dir exists');
ok( -f $ENV{HOME}.'/.clusterssh/config', '.clusterssh config file exists');
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, '', 'Expecting no STDERR' );
ok( -d $ENV{HOME} . '/.clusterssh', '.clusterssh dir exists' );
ok( -f $ENV{HOME} . '/.clusterssh/config', '.clusterssh config file exists' );
is_deeply( $config, \%expected, 'amended config is correct' );
note('check .clusterssh file is an error');
$ENV{HOME} = tempdir( CLEANUP => 1 );
open($csshrc, '>', $ENV{HOME}.'/.clusterssh');
open( $csshrc, '>', $ENV{HOME} . '/.clusterssh' );
print $csshrc 'should_be_dir_not_file = PROBLEM', $/;
close($csshrc);
$config = App::ClusterSSH::Config->new();
@ -345,15 +365,18 @@ trap {
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception::Config' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, 'Unable to create directory $HOME/.clusterssh: File exists', 'die message correct' );
is( $trap->die,
'Unable to create directory $HOME/.clusterssh: File exists',
'die message correct'
);
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
note('check failure to write default config is caught');
$ENV{HOME} = tempdir( CLEANUP => 1 );
mkdir($ENV{HOME}.'/.clusterssh');
mkdir($ENV{HOME}.'/.clusterssh/config');
mkdir( $ENV{HOME} . '/.clusterssh' );
mkdir( $ENV{HOME} . '/.clusterssh/config' );
$config = App::ClusterSSH::Config->new();
trap {
$config->write_user_config_file();
@ -361,14 +384,17 @@ trap {
is( $trap->leaveby, 'die', 'died ok' );
isa_ok( $trap->die, 'App::ClusterSSH::Exception::Config' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, 'Unable to write default $HOME/.clusterssh/config: Is a directory', 'die message correct' );
is( $trap->die,
'Unable to write default $HOME/.clusterssh/config: Is a directory',
'die message correct'
);
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
note('check .clusterssh errors via load_configs are not fatal');
$ENV{HOME} = tempdir( CLEANUP => 1 );
open($csshrc, '>', $ENV{HOME}.'/.clusterssh');
open( $csshrc, '>', $ENV{HOME} . '/.clusterssh' );
print $csshrc 'should_be_dir_not_file = PROBLEM', $/;
close($csshrc);
$config = App::ClusterSSH::Config->new();
@ -378,78 +404,84 @@ trap {
is( $trap->leaveby, 'return', 'died ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{Unable to create directory $HOME/.clusterssh: File exists}.$/, 'Expecting no STDERR' );
is( $trap->stderr,
q{Unable to create directory $HOME/.clusterssh: File exists} . $/,
'Expecting no STDERR'
);
note('check failure to write default config is caught');
$ENV{HOME} = tempdir( CLEANUP => 1 );
mkdir($ENV{HOME}.'/.clusterssh');
mkdir($ENV{HOME}.'/.clusterssh/config');
mkdir( $ENV{HOME} . '/.clusterssh' );
mkdir( $ENV{HOME} . '/.clusterssh/config' );
$config = App::ClusterSSH::Config->new();
trap {
$config->load_configs();
};
is( $trap->leaveby, 'return', 'returned ok' );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
is( $trap->stderr, q{Unable to write default $HOME/.clusterssh/config: Is a directory}.$/, 'Expecting no STDERR' );
is( $trap->stderr,
q{Unable to write default $HOME/.clusterssh/config: Is a directory} . $/,
'Expecting no STDERR'
);
note('Checking dump');
$config = App::ClusterSSH::Config->new();trap {
$config = App::ClusterSSH::Config->new();
trap {
$config->dump();
};
my $expected=<<'EOF';
my $expected = <<'EOF';
# Configuration dump produced by "cssh -u"
terminal_reserve_top=5
terminal_bg_style=dark
window_tiling_direction=right
screen_reserve_left=0
window_tiling=yes
key_addhost=Control-Shift-plus
max_addhost_menu_cluster_items=6
key_clientname=Alt-n
terminal_allow_send_events=-xrm '*.VT100.allowSendEvents:true'
debug=0
menu_host_autotearoff=0
auto_quit=yes
console_position=
lang=en
terminal_colorize=1
unmap_on_redraw=no
terminal_reserve_left=5
screen_reserve_right=0
key_retilehosts=Alt-r
rsh_args=
debug=0
extra_cluster_file=
history_height=10
history_width=40
key_addhost=Control-Shift-plus
key_clientname=Alt-n
key_history=Alt-h
key_paste=Control-v
key_quit=Control-q
key_retilehosts=Alt-r
lang=en
max_addhost_menu_cluster_items=6
max_host_menu_items=30
menu_host_autotearoff=0
menu_send_autotearoff=0
mouse_paste=Button-2
rsh_args=
screen_reserve_bottom=60
screen_reserve_left=0
screen_reserve_right=0
screen_reserve_top=0
send_menu_xml_file=/home/dferguson/.csshrc_send_menu
use_hotkeys=yes
terminal_decoration_height=10
menu_send_autotearoff=0
terminal_args=
terminal_decoration_width=8
auto_quit=yes
terminal=xterm
command=
telnet_args=
mouse_paste=Button-2
key_history=Alt-h
terminal_reserve_right=0
show_history=0
ssh_args=
telnet_args=
terminal=xterm
terminal_allow_send_events=-xrm '*.VT100.allowSendEvents:true'
terminal_args=
terminal_bg_style=dark
terminal_colorize=1
terminal_decoration_height=10
terminal_decoration_width=8
terminal_font=6x13
terminal_reserve_bottom=0
history_width=40
extra_cluster_file=
ssh_args=
terminal_title_opt=-T
screen_reserve_bottom=60
max_host_menu_items=30
key_paste=Control-v
terminal_reserve_left=5
terminal_reserve_right=0
terminal_reserve_top=5
terminal_size=80x24
terminal_title_opt=-T
unmap_on_redraw=no
use_hotkeys=yes
window_tiling=yes
window_tiling_direction=right
EOF
isa_ok( $config, "App::ClusterSSH::Config" );
is( $trap->die, undef, 'die message correct' );
is( $trap->die, undef, 'die message correct' );
is( $trap->stdout, $expected, 'Expecting no STDOUT' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
is( $trap->stderr, q{}, 'Expecting no STDERR' );
done_testing();

35
t/20helper.t Normal file
View file

@ -0,0 +1,35 @@
use strict;
use warnings;
use FindBin qw($Bin $Script);
use lib "$Bin/../lib";
use Test::More;
use Test::Trap;
use File::Which qw(which);
use File::Temp qw(tempdir);
use Readonly;
BEGIN { use_ok("App::ClusterSSH::Helper") || BAIL_OUT('failed to use module')}
my $helper;
$helper = App::ClusterSSH::Helper->new();
isa_ok( $helper, 'App::ClusterSSH::Helper' );
#note('check failure to write default config is caught');
#$ENV{HOME} = tempdir( CLEANUP => 1 );
#mkdir($ENV{HOME}.'/.clusterssh');
#mkdir($ENV{HOME}.'/.clusterssh/config');
#$config = App::ClusterSSH::Config->new();
#trap {
# $config->load_configs();
#};
#is( $trap->leaveby, 'return', 'returned ok' );
#isa_ok( $config, "App::ClusterSSH::Config" );
#isa_ok( $config, "App::ClusterSSH::Config" );
#is( $trap->stdout, q{}, 'Expecting no STDOUT' );
#is( $trap->stderr, q{Unable to write default $HOME/.clusterssh/config: Is a directory}.$/, 'Expecting no STDERR' );
done_testing();