List external clusters

List on command line (cssh -L) and in 'add host' dialogue in GUI
This commit is contained in:
Duncan Ferguson 2014-07-05 20:25:14 +01:00
parent c6747288d5
commit 085803c328
6 changed files with 127 additions and 45 deletions

View file

@ -1,5 +1,6 @@
4.03_01 2014-??-?? Duncan Ferguson <duncan_ferguson@user.sf.net>
- Amended host parsing to include alternative IPv6 address port definitions, e.g. 1:2:3:4/5567
- List of available external tags with -L option and in 'Add Host' in UI
[NOTE: Some options have changed!]
- Rework options code
4.02_04 2014-05-17 Duncan Ferguson <duncan_ferguson@user.sf.net>

View file

@ -54,9 +54,9 @@ sub new {
my $self = $class->SUPER::new(%args);
$self->{cluster} = App::ClusterSSH::Cluster->new( parent => $self, );
$self->{config} = App::ClusterSSH::Config->new( parent => $self, );
$self->{helper} = App::ClusterSSH::Helper->new( parent => $self, );
$self->{cluster} = App::ClusterSSH::Cluster->new( parent => $self, );
$self->{options} = App::ClusterSSH::Getopt->new( parent => $self, );
# catch and reap any zombies
@ -166,7 +166,7 @@ sub exit_prog() {
# finished starting or received the kill signal, do it like this
while (%servers) {
foreach my $svr ( keys(%servers) ) {
terminate_host($svr);
$self->terminate_host($svr);
}
}
exit 0;
@ -413,8 +413,7 @@ sub resolve_names(@) {
my @new_servers;
eval {
@new_servers
= $self->cluster->get_external_clusters(
$self->config->{external_cluster_command}, @servers );
= $self->cluster->get_external_clusters( @servers );
};
if ($@) {
@ -1169,7 +1168,7 @@ sub add_host_by_name() {
$windows{host_entry}->focus();
my $answer = $windows{addhost}->Show();
if ( $answer ne "Add" ) {
if ( !$answer || $answer ne "Add" ) {
$menus{host_entry} = "";
return;
}
@ -1441,15 +1440,19 @@ sub create_windows() {
-class => 'cssh',
);
my @tags = $self->cluster->list_tags();
my @external_tags = map { "$_ *" } $self->cluster->list_external_clusters();
push (@tags, @external_tags);
if ( $self->config->{max_addhost_menu_cluster_items}
&& scalar $self->cluster->list_tags() )
&& scalar @tags )
{
if (scalar scalar $self->cluster->list_tags()
if (scalar @tags
< $self->config->{max_addhost_menu_cluster_items} )
{
$menus{listbox} = $windows{addhost}->Listbox(
-selectmode => 'extended',
-height => scalar $self->cluster->list_tags(),
-height => scalar @tags,
-class => 'cssh',
)->pack();
}
@ -1462,7 +1465,17 @@ sub create_windows() {
-class => 'cssh',
)->pack();
}
$menus{listbox}->insert( 'end', sort $self->cluster->list_tags() );
$menus{listbox}->insert( 'end', sort @tags );
if(@external_tags) {
$menus{addhost_text} = $windows{addhost}->add(
'Label',
-class => 'cssh',
-text => '* is external',
)->pack();
#$menus{addhost_text}->insert('end','lkjh lkjj sdfl jklsj dflj ');
}
}
$windows{host_entry} = $windows{addhost}->add(
@ -1858,9 +1871,6 @@ sub run {
$self->getopts;
warn "GETOPTS work in progress";
#die;
### main ###
# only get xdisplay if we got past usage and help stuff
@ -1906,6 +1916,9 @@ sub run {
print( 'Available cluster tags:', $/ );
print "\t", $_, $/ foreach ( sort( $self->cluster->list_tags ) );
print( 'Available external command tags:', $/ );
print "\t", $_, $/ foreach ( sort( $self->cluster->list_external_clusters ) );
$self->debug(
4,
"Full clusters dump: ",

View file

@ -48,14 +48,32 @@ sub get_tag_entries {
return $self;
}
sub list_external_clusters {
my ( $self, ) = @_;
my @list = $self->_run_external_clusters('-L');
return
wantarray
? sort @list
: scalar @list;
}
sub get_external_clusters {
my ( $self, $external_command, @tags ) = @_;
my ( $self, @tags ) = @_;
return $self->_run_external_clusters(@tags);
}
sub _run_external_clusters {
my ( $self, @args ) = @_;
my $external_command = $self->parent->config->{external_cluster_command};
$self->debug( 3, 'Running tags through external command' );
$self->debug( 4, 'External command: ', $external_command );
$self->debug( 3, 'Tags: ', join( ',', @tags ) );
$self->debug( 3, 'Args ', join( ',', @args ) );
my $command = "$external_command @tags";
my $command = "$external_command @args";
$self->debug( 3, 'Running ', $command );
@ -219,9 +237,13 @@ Create a new object. Object should be common across all invocations.
Read in /etc/clusters, $HOME/.clusterssh/clusters and any other given
file name and register the tags found.
=item @resolved_tags=get_external_clusters($path_to_binary, @tags)
=item @external_tags=list_external_clusters()
Define and use an external script to resolve tags into hostnames.
Call an external script suing C<-L> to list available tags
=item @resolved_tags=get_external_clusters(@tags)
Use an external script to resolve C<@tags> into hostnames.
=item $cluster->get_tag_entries($filename);

View file

@ -620,9 +620,11 @@ C<< <tag3> = <tag1> <tag2> >>}
output '=item external_cluster_command = <null>';
output $self->loc(
q{Define the full path to an external command that can be used to resolve tags to host names. This command can be written in any language. The script must accept a list of tags to resolve and output a list of hosts on a single line. Any tags that cannot be resolved should be returned unchanged.
q{Define the full path to an external command that can be used to resolve tags to host names. This command can be written in any language. The script must accept a list of tags to resolve and output a list of hosts (space separated on a single line). Any tags that cannot be resolved should be returned unchanged.
A non-0 exit code will be counted as an error, a warning will be printed and output ignored.}
A non-0 exit code will be counted as an error, a warning will be printed and output ignored.
If the external command is given a C<-L> option it should output a list of tags (space separated on a single line) it can resolve}
);
output '=item extra_cluster_file = <null>';

View file

@ -12,11 +12,47 @@ use English '-no_match_vars';
use Readonly;
package Test::ClusterSSH::Mock;
# generate purpose object used to simplfy testing
sub new {
my ( $class, %args ) = @_;
my $config = {%args};
return bless $config, $class;
}
sub parent {
my ($self) = @_;
return $self;
}
sub config {
my ($self) = @_;
return $self;
}
sub load_configs {
my ($self) = @_;
return $self;
}
sub config_file {
my ($self) = @_;
return {};
}
1;
package main;
BEGIN {
use_ok("App::ClusterSSH::Cluster") || BAIL_OUT('failed to use module');
}
my $cluster1 = App::ClusterSSH::Cluster->new();
my $mock_object = Test::ClusterSSH::Mock->new();
my $cluster1 = App::ClusterSSH::Cluster->new( parent => $mock_object );
isa_ok( $cluster1, 'App::ClusterSSH::Cluster' );
my $cluster2 = App::ClusterSSH::Cluster->new();
@ -97,12 +133,12 @@ is( $trap->stdout, '', 'no stdout for non-existant get_tag' );
is( $trap->stderr, '', 'no stderr for non-existant get_tag' );
is( $tags, undef, 'non-existant tag returns undef' );
@default_expected = sort
qw/ default people tag1 tag2 tag3 tag10 tag20 tag30 tag40 tag50 /;
@default_expected
= sort qw/ default people tag1 tag2 tag3 tag10 tag20 tag30 tag40 tag50 /;
trap {
@default = $cluster1->list_tags;
};
is($trap->leaveby, 'return', 'list_tags returned okay');
is( $trap->leaveby, 'return', 'list_tags returned okay' );
is( $trap->stdout, '', 'no stdout for non-existant get_tag' );
is( $trap->stderr, '', 'no stderr for non-existant get_tag' );
is_deeply( \@default, \@default_expected, 'tag list correct' );
@ -111,7 +147,7 @@ my $count;
trap {
$count = $cluster1->list_tags;
};
is($trap->leaveby, 'return', 'list_tags returned okay');
is( $trap->leaveby, 'return', 'list_tags returned okay' );
is( $trap->stdout, '', 'no stdout for non-existant get_tag' );
is( $trap->stderr, '', 'no stderr for non-existant get_tag' );
is_deeply( $count, 10, 'tag list count correct' );
@ -119,31 +155,35 @@ is_deeply( $count, 10, 'tag list count correct' );
# now checks against running an external command
my @external_expected;
$mock_object->{external_cluster_command} = "$Bin/external_cluster_command";
@external_expected
= $cluster1->get_external_clusters("$Bin/external_cluster_command");
@external_expected = $cluster1->list_external_clusters();
is_deeply(
\@external_expected,
[qw/ tag100 tag200 tag300 tag400 /],
'External command no args'
);
is( scalar $cluster1->list_external_clusters, 4, 'External command tag count');
@external_expected = $cluster1->get_external_clusters();
is_deeply( \@external_expected, [], 'External command no args' );
@external_expected = $cluster1->get_external_clusters(
"$Bin/external_cluster_command tag1 tag2");
@external_expected = $cluster1->get_external_clusters("tag1 tag2");
is_deeply( \@external_expected, [qw/tag1 tag2 /],
'External command: 2 args passed through' );
@external_expected = $cluster1->get_external_clusters(
"$Bin/external_cluster_command tag100");
@external_expected = $cluster1->get_external_clusters("tag100");
is_deeply( \@external_expected, [qw/host100 /],
'External command: 1 tag expanded to one host' );
@external_expected = $cluster1->get_external_clusters(
"$Bin/external_cluster_command tag200");
@external_expected = $cluster1->get_external_clusters("tag200");
is_deeply(
\@external_expected,
[qw/host200 host205 host210 /],
'External command: 1 tag expanded to 3 hosts and sorted'
);
@external_expected = $cluster1->get_external_clusters(
"$Bin/external_cluster_command tag400");
@external_expected = $cluster1->get_external_clusters("tag400");
is_deeply(
\@external_expected,
[ qw/host100 host200 host205 host210 host300 host325 host350 host400 host401 /
@ -162,8 +202,7 @@ if ( $ENV{TEST_VERBOSE} ) {
}
trap {
@external_expected = $cluster1->get_external_clusters(
"$Bin/external_cluster_command -x $redirect");
@external_expected = $cluster1->get_external_clusters("-x $redirect");
};
like(
$trap->die,
@ -174,8 +213,7 @@ is( $trap->stdout, '', 'External command: no stdout from perl code' );
is( $trap->stderr, '', 'External command: no stderr from perl code' );
trap {
@external_expected = $cluster1->get_external_clusters(
"$Bin/external_cluster_command -q $redirect");
@external_expected = $cluster1->get_external_clusters("-q $redirect");
};
like(
$trap->die,

View file

@ -7,7 +7,14 @@ use warnings;
use Getopt::Std;
my $opt = {};
getopts( 'qx', $opt );
getopts( 'Lqx', $opt );
my %tag_lookup = (
tag100 => [qw/ host100 /],
tag200 => [qw/ host200 host210 host205 /],
tag300 => [qw/ host300 host350 host325 /],
tag400 => [qw/ tag100 tag200 tag300 host400 host401 /],
);
# if we get '-q' option, force an error
if ( $opt->{q} ) {
@ -21,12 +28,11 @@ if ( $opt->{x} ) {
exit 5;
}
my %tag_lookup = (
tag100 => [qw/ host100 /],
tag200 => [qw/ host200 host210 host205 /],
tag300 => [qw/ host300 host350 host325 /],
tag400 => [qw/ tag100 tag200 tag300 host400 host401 /],
);
# '-L' means list out available tags
if ( $opt->{L} ) {
print join(' ', sort keys %tag_lookup), $/;
exit 0;
}
my @lookup = @ARGV;