App-ClusterSSH
view release on metacpan or search on metacpan
live admin1@server1 admin2@server2:2022 server3 server4
All comments (marked by a #) and blank lines are ignored. Tags may
be nested, but be aware of using recursive tags as they are not
checked for.
Servers can be defined using expansion macros:
"webservers websvr{a,b,c}"
would be expanded to
"webservers websvra websvrb websvrc"
and
"webservers websvr{6..9}"
would be expanded to
"webservers websvr6 websvr7 websvr8 websvr9"
Extra cluster files may also be specified either as an option on the
command line (see "cluster-file") or in the user's
$HOME/.clusterssh/config file (see "extra_cluster_file"
configuration option).
NOTE: the last tag read overwrites any pre-existing tag of that
name.
bin_PL/clusterssh_bash_completion.dist view on Meta::CPAN
extra_cluster_file_line="`grep '^[[:space:]]*extra_cluster_file' $HOME/.clusterssh/config 2> /dev/null`"
[ -z "$extra_cluster_file_line" ] && extra_cluster_file_line="`grep '^[[:space:]]*extra_cluster_file' /etc/csshrc 2> /dev/null`"
# find the clusters line in the .csshrc or, alternatively, /etc/csshrc
clusters_line="`grep '^[[:space:]]*clusters' $HOME/.clusterssh/config 2> /dev/null`"
[ -z "$clusters_line" ] && clusters_line="`grep '^[[:space:]]*clusters' /etc/csshrc 2> /dev/null`"
# extract the location of the extra cluster file
extra_cluster_file="`echo $extra_cluster_file_line | cut -f 2- -d '='`"
[ -n "$extra_cluster_file" ] && extra_cluster_file="`eval echo $extra_cluster_file`"
# TODO: don't use eval to expand ~ and $HOME
# get the names of all defined clusters
clusters=$(
{
[ -n "$clusters_line" ] && echo "$clusters_line" | cut -f 2- -d '=' | tr "$IFS" "\n" || /bin/true
[ -n "$extra_cluster_file" ] && sed -e 's/^\([a-z0-9.-]\+\).*$/\1/i' "$extra_cluster_file" 2> /dev/null || /bin/true
sed -e 's/^\([a-z0-9.-]\+\).*$/\1/i' /etc/clusters 2> /dev/null || /bin/true
sed -e 's/^\([a-z0-9.-]\+\).*$/\1/i' $HOME/.clusterssh/clusters 2> /dev/null || /bin/true
} | sort -u)
lib/App/ClusterSSH.pm view on Meta::CPAN
my $hostobj = gethostbyname($dirty);
if ( defined($hostobj) ) {
my @alladdrs = map { inet_ntoa($_) } @{ $hostobj->addr_list };
$self->cluster->register_tag( $dirty, @alladdrs );
if ( $#alladdrs > 0 ) {
$self->debug( 3, 'Expanded to ',
join( ' ', $self->cluster->get_tag($dirty) ) );
@tag_list = $self->cluster->get_tag($dirty);
}
else {
# don't expand if there is only one record found
$self->debug( 3, 'Only one A record' );
}
}
}
if (@tag_list) {
$self->debug( 3, '... it is a cluster' );
foreach my $node (@tag_list) {
if ($username) {
$node =~ s/^(.*)@//;
$node = $username . '@' . $node;
lib/App/ClusterSSH.pm view on Meta::CPAN
my ($self) = @_;
if ( $self->config->{show_history} ) {
$windows{history}->packForget();
$windows{history}->selectAll();
$windows{history}->deleteSelected();
$self->config->{show_history} = 0;
}
else {
$windows{history}->pack(
-fill => "x",
-expand => 1,
);
$self->config->{show_history} = 1;
}
}
sub update_display_text($) {
my ( $self, $char ) = @_;
return if ( !$self->config->{show_history} );
lib/App/ClusterSSH.pm view on Meta::CPAN
}
$menus{entrytext} = "";
$windows{text_entry} = $windows{main_window}->Entry(
-textvariable => \$menus{entrytext},
-insertborderwidth => 4,
-width => 25,
-class => 'cssh',
)->pack(
-fill => "x",
-expand => 1,
);
$windows{history} = $windows{main_window}->Scrolled(
"ROText",
-insertborderwidth => 4,
-width => $self->config->{history_width},
-height => $self->config->{history_height},
-state => 'normal',
-takefocus => 0,
-class => 'cssh',
);
$windows{history}->bindtags(undef);
if ( $self->config->{show_history} ) {
$windows{history}->pack(
-fill => "x",
-expand => 1,
);
}
$windows{main_window}->bind( '<Destroy>' => sub { $self->exit_prog } );
# remove all Paste events so we set them up cleanly
$windows{main_window}->eventDelete('<<Paste>>');
# Set up paste events from scratch
if ( $self->config->{key_paste} && $self->config->{key_paste} ne "null" )
lib/App/ClusterSSH/Cluster.pm view on Meta::CPAN
),
)
);
}
my @results = split / /, $result;
return @results;
}
sub expand_filename {
my ( $self, $filename ) = @_;
my $home;
# try to determine the home directory
if ( !defined( $home = $ENV{'HOME'} ) ) {
$home = ( getpwuid($>) )[5];
}
if ( !defined($home) ) {
$self->debug( 3, 'No home found so leaving filename ',
$filename, ' unexpanded' );
return $filename;
}
$self->debug( 4, 'Using ', $home, ' as home directory' );
# expand ~ or $HOME
my $new_name = $filename;
$new_name =~ s!^~/!$home/!g;
$new_name =~ s!^\$HOME/!$home/!g;
$self->debug( 2, 'Expanding ', $filename, ' to ', $new_name )
unless ( $filename eq $new_name );
return $new_name;
}
sub read_tag_file {
my ( $self, $filename ) = @_;
$filename = $self->expand_filename($filename);
$self->debug( 2, 'Reading tags from file ', $filename );
if ( -f $filename ) {
my %hosts
= $self->load_file( type => 'cluster', filename => $filename );
foreach my $host ( keys %hosts ) {
$self->debug( 4, "Got entry for $host on tags $hosts{$host}" );
$self->register_host( $host, split( /\s+/, $hosts{$host} ) );
}
}
else {
$self->debug( 2, 'No file found to read' );
}
return $self;
}
sub read_cluster_file {
my ( $self, $filename ) = @_;
$filename = $self->expand_filename($filename);
$self->debug( 2, 'Reading clusters from file ', $filename );
if ( -f $filename ) {
my %tags
= $self->load_file( type => 'cluster', filename => $filename );
foreach my $tag ( keys %tags ) {
$self->register_tag( $tag, split( /\s+/, $tags{$tag} ) );
}
lib/App/ClusterSSH/Cluster.pm view on Meta::CPAN
else {
$self->debug( 2, 'No file found to read' );
}
return $self;
}
sub register_host {
my ( $self, $node, @tags ) = @_;
$self->debug( 2, "Registering node $node on tags:", join( ' ', @tags ) );
@tags = $self->expand_glob( 'node', $node, @tags );
foreach my $tag (@tags) {
if ( $self->{tags}->{$tag} ) {
$self->{tags}->{$tag}
= [ sort @{ $self->{tags}->{$tag} }, $node ];
}
else {
$self->{tags}->{$tag} = [$node];
}
#push(@{ $self->{tags}->{$tag} }, $node);
}
return $self;
}
sub register_tag {
my ( $self, $tag, @nodes ) = @_;
#warn "b4 nodes=@nodes";
@nodes = $self->expand_glob( 'tag', $tag, @nodes );
#warn "af nodes=@nodes";
$self->debug( 2, "Registering tag $tag: ", join( ' ', @nodes ) );
$self->{tags}->{$tag} = \@nodes;
return $self;
}
sub expand_glob {
my ( $self, $type, $name, @items ) = @_;
my @expanded;
my $range = App::ClusterSSH::Range->new();
# skip expanding anything that appears to have nasty metachars
if ( !grep {m/[\`\!\$;]/} @items ) {
$self->debug( 4, "Non-expanded: @items" );
@items = $range->expand(@items);
# run glob over anything left incase there are numeric and textual ranges
@expanded = map { glob $_ } @items;
$self->debug( 4, "Final expansion: @expanded" );
}
else {
warn(
$self->loc(
"Bad characters picked up in [_1] '[_2]': [_3]",
$type, $name, join( ' ', @items )
),
);
}
return @expanded;
}
sub get_tag {
my ( $self, $tag ) = @_;
if ( $self->{tags}->{$tag} ) {
$self->debug(
2,
"Retrieving tag $tag: ",
join( ' ', sort @{ $self->{tags}->{$tag} } )
lib/App/ClusterSSH/Cluster.pm view on Meta::CPAN
=item $cluster->get_tag_entries($filename);
Read in /etc/tags, $HOME/.clusterssh/tags and any other given
file name and register the tags found.
=item $cluster->read_cluster_file($filename);
Read in the given cluster file and register the tags found
=item $cluster->expand_filename($filename);
Expand ~ or $HOME in a filename
=item $cluster->read_tag_file($filename);
Read in the given tag file and register the tags found
=item $cluster->register_tag($tag,@hosts);
Register the given tag name with the given host names.
lib/App/ClusterSSH/Cluster.pm view on Meta::CPAN
the number of hosts in the array depending on context.
=item @tags = $cluster->list_tags();
Return an array of all available tag names
=item %tags = $cluster->dump_tags();
Returns a hash of all tag data.
=item @tags = $cluster->expand_glob( $type, $name, @items );
Use shell expansion against each item in @items, where $type is either 'node', or 'tag' and $name is the node or tag name. These attributes are presented to the user in the event of an issue with the expanion to track down the source.
=back
=head1 AUTHOR
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
=head1 LICENSE AND COPYRIGHT
lib/App/ClusterSSH/Getopt.pm view on Meta::CPAN
'e.g.
# List of servers in live
live admin1@server1 admin2@server2:2022 server3 server4'
);
output $self->loc(
q{All comments (marked by a #) and blank lines are ignored. Tags may be nested, but be aware of using recursive tags as they are not checked for.}
);
output $self->loc(q{Servers can be defined using expansion macros:});
output 'C<< webservers websvr{a,b,c} >>';
output $self->loc(q{would be expanded to});
output 'C<< webservers websvra websvrb websvrc >>';
output $self->loc(q{and});
output 'C<< webservers websvr{6..9} >>';
output $self->loc(q{would be expanded to});
output 'C<< webservers websvr6 websvr7 websvr8 websvr9 >>';
output $self->loc(
q{Extra cluster files may also be specified either as an option on the command line (see [_1]) or in the user's [_2] file (see [_3] configuration option).},
'C<cluster-file>',
'F<$HOME/.clusterssh/config>',
'L</extra_cluster_file>'
);
output $self->loc(
'B<NOTE:> the last tag read overwrites any pre-existing tag of that name.'
lib/App/ClusterSSH/Range.pm view on Meta::CPAN
use warnings;
package App::ClusterSSH::Range;
# ABSTRACT: Expand ranges such as {0..1} as well as other bsd_glob specs
=head1 SYNOPSIS
use App::ClusterSSH::Range;
my $range=App::ClusterSSH::Range->new();
my @list = $range->expand('range{0..5}');
=head1 DESCRIPTION
Perform string expansion looking for ranges before then finishing off
using C<File::Glob::bsd_glob>.
=cut
use File::Glob;
lib/App/ClusterSSH/Range.pm view on Meta::CPAN
Create a new object to perform range processing
=cut
sub new {
my ( $class, %args ) = @_;
my $self = {%args};
return bless $self, $class;
}
=item @expanded = $range->expand(@strings);
Expand the given strings. Ranges are checked for and processed. The
resulting string is then put through File::Glob::bsd_glob before being returned.
Ranges are of the form:
base{start..stop}
a{0..3} => a0 a1 a2 a3
b{4..6,9,12..14} => b4 b5 b6 b9 b12 b13 b14
=back
=cut
sub expand {
my ( $self, @items ) = @_;
my $range_regexp = qr/[\w-]*:?\{[\w\.,]+\}/;
my @newlist;
foreach my $item (@items) {
if ( $item !~ m/$range_regexp/ ) {
push( @newlist, $item );
next;
}
t/30cluster.t view on Meta::CPAN
@external_expected = $cluster1->get_external_clusters();
is_deeply( \@external_expected, [], 'External command no args' );
@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("tag100");
is_deeply( \@external_expected, [qw/host100 /],
'External command: 1 tag expanded to one host' );
@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("tag400");
is_deeply(
\@external_expected,
[ qw/host100 host200 host205 host210 host300 host325 host350 host400 host401 /
],
'External command: 1 tag expanded with self referencing tags'
);
# NOTE
# Since this is calling a shell run command, the tests cannot capture
# the shell STDOUT and STDERR. By default redirect STDOUT and STDERR into
# /dev/null so it dones't make noise in normal test output
# However, don't hide it if running with -v flag
my $redirect = ' 1>/dev/null 2>&1';
if ( $ENV{TEST_VERBOSE} ) {
$redirect = '';
# NOTE: the following are not "as expected" in line with above tests
# due to bsd_glob functionality. See output from:
# print join(q{ }, bsd_glob("o{a,b,c")).$/
'o{a,b,c' => 'o',
'p{0..2' => 'p',
# Reported as bug in github issue #89
'q-0{0,1}' => 'q-00 q-01',
'q-0{0..1}' => 'q-00 q-01',
# expand pure ranges
'{10..12}' => '10 11 12',
# expand ports
'lh:{22001..22003}' => 'lh:22001 lh:22002 lh:22003',
# FQDN's
'lh{1..3}.dot.com' => 'lh1.dot.com lh2.dot.com lh3.dot.com',
# IP addresses
'127.0.0.{10..12}' => '127.0.0.10 127.0.0.11 127.0.0.12',
'127.0.{20..22}.1' => '127.0.20.1 127.0.21.1 127.0.22.1',
);
my $range = App::ClusterSSH::Range->new();
isa_ok( $range, 'App::ClusterSSH::Range', 'object created correctly' );
for my $key ( sort keys %tests ) {
my $expected = $tests{$key};
my @expected = split / /, $tests{$key};
my $got;
trap {
$got = $range->expand($key);
};
is( $trap->stdout, '', "No stdout for scalar $key" );
is( $trap->stderr, '', "No stderr for scalar $key" );
is( $trap->leaveby, 'return', "correct leaveby for scalar $key" );
is( $trap->die, undef, "die is undef for scalar $key" );
is( $got, "$expected", "expected return for scalar $key" );
my @got;
trap {
@got = $range->expand($key);
};
is( $trap->stdout, '', "No stdout for array $key" );
is( $trap->stderr, '', "No stderr for array $key" );
is( $trap->leaveby, 'return', "correct leaveby for array $key" );
is( $trap->die, undef, "die is undef for array $key" );
is_deeply( \@got, \@expected, "expected return for array $key" )
|| diag explain \@got;
}
( run in 1.706 second using v1.01-cache-2.11-cpan-5623c5533a1 )