Add in bash expansions on hostnames

Allow hostnames to be expanded using bash where a { is in the host name definition

Github issue #53

Changes

@@ -1,6 +1,7 @@
 4.05_01 0000-00-00 Duncan Ferguson <duncan_ferguson@user.sf.net>
 - Failure to find the terminal binary should not be fatal
 - Fix processing of '--extra_tag_file' and its configuration item (Github issue #51)
+- Add bash shell expansion on host names containing a '{' character (Github issue #53)
 
 4.05 2015-11-28 Duncan Ferguson <duncan_ferguson@user.sf.net>
 - Change default key_quit from 'Control-q' to 'Alt-q' (Github issue #50)

lib/App/ClusterSSH/Cluster.pm

@@ -153,6 +153,8 @@ 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}
@@ -170,6 +172,11 @@ sub register_host {
 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;
@@ -177,6 +184,37 @@ sub register_tag {
     return $self;
 }
 
+sub expand_glob {
+    my ( $self, $type, $name, @items ) = @_;
+
+    my @expanded;
+
+    # skip expanding anything that appears to have nasty metachars
+    if ( !grep {m/[\`\!\$;]/} @items ) {
+        if ( grep {m/[{]/} @items ) {
+
+      #@expanded = split / /, `/bin/bash -c 'shopt -s extglob\n echo @items'`;
+            my $cmd = $self->parent->config->{shell_expansion};
+            $cmd =~ s/%items%/@items/;
+            @expanded = split / /, `$cmd`;
+            chomp(@expanded);
+        }
+        else {
+            @expanded = map { glob $_ } @items;
+        }
+    }
+    else {
+        warn(
+            $self->loc(
+                "Bad characters picked up in [_1] '[_2]': [_3]",
+                $type, $name, join( ' ', @items )
+            ),
+        );
+    }
+
+    return @expanded;
+}
+
 sub get_tag {
     my ( $self, $tag ) = @_;
 
@@ -287,6 +325,10 @@ Return an array of all available tag names
 
 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

lib/App/ClusterSSH/Config.pm

@@ -102,6 +102,8 @@ my %default_config = (
 
     send_menu_xml_file => $ENV{HOME} . '/.clusterssh/send_menu',
 
+    shell_expansion => "/bin/bash -c 'shopt -s extglob\n echo %items%'",
+
     # don't set username here as takes precendence over ssh config
     user => '',
 );

lib/App/ClusterSSH/Getopt.pm

@@ -563,11 +563,23 @@ would replace the <Alt-n> with the client's name in each window.}
     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 bash shell expansion:});
+    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{B<NOTE:> this requires [_1] to be installed on your system (see [_2] configuration option },
+        '/bin/bash', 'C<shell_expansion>'
+    );
     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>',
-        'C<extra_cluster_file>'
+        'L</extra_cluster_file>'
     );
     output $self->loc(
         'B<NOTE:> the last tag read overwrites any pre-existing tag of that name.'
@@ -760,6 +772,13 @@ B<NOTE:> Any "generic" change to the method (e.g., specifying the ssh port to us
         q{Number of pixels from the screen's side to reserve when calculating screen geometry for tiling.  Setting this to something like 50 will help keep cssh from positioning windows over your window manager's menu bar if it draws one at that side of the screen.}
     );
 
+    output
+        q{=item shell_expansion = /bin/bash -c 'shopt -s extglob\n echo %items%'"};
+    output $self->loc(
+        q{Command used to expand a given string (provided by the macro [_1]) - used for expanding host names when a [_2] is in the name.  See [_3]},
+        'C<%items%>', 'C<{>', 'L<bash/EXPANSION>'
+    );
+
     output '=item terminal = /path/to/xterm';
     output $self->loc(q{Path to the X-Windows terminal used for the client.});
 

t/15config.t

@@ -110,6 +110,8 @@ Readonly::Hash my %default_config => {
 
     send_menu_xml_file => $ENV{HOME} . '/.clusterssh/send_menu',
 
+    shell_expansion => "/bin/bash -c 'shopt -s extglob\n echo %items%'",
+
     # other bits inheritted from App::ClusterSSH::Base
     debug => 0,
     lang  => 'en',
@@ -567,6 +569,7 @@ screen_reserve_top=0
 send_menu_xml_file=} . $ENV{HOME} . qq{/.clusterssh/send_menu
 sftp=sftp
 sftp_args=
+shell_expansion=/bin/bash -c \'shopt -s extglob\n echo %items%\'
 show_history=0
 ssh=ssh
 ssh_args=

t/30cluster.t

@@ -55,7 +55,8 @@ BEGIN {
     use_ok("App::ClusterSSH::Cluster") || BAIL_OUT('failed to use module');
 }
 
-my $mock_object = Test::ClusterSSH::Mock->new();
+my $mock_object = Test::ClusterSSH::Mock->new(
+    shell_expansion => "/bin/bash -c 'shopt -s extglob\n echo %items%'", );
 
 my $cluster1 = App::ClusterSSH::Cluster->new( parent => $mock_object );
 isa_ok( $cluster1, 'App::ClusterSSH::Cluster' );
@@ -260,6 +261,86 @@ is( $trap->leaveby, 'return', 'exit okay on get_tag_entries' );
 is( $trap->stdout,  '',       'no stdout for get_tag_entries' );
 is( $trap->stderr,  '',       'no stderr for get_tag_entries' );
 
+# test bash expansion
+my @expected = ( 'aa', 'ab', 'ac' );
+$cluster1->register_tag( 'glob1', 'a{a,b,c}' );
+@got = $cluster2->get_tag('glob1');
+is_deeply( \@got, \@expected, 'glob1 expansion, words' )
+    or diag explain @got;
+
+@expected = ( 'ax', 'ay', 'az' );
+$cluster1->register_tag( 'glob2', 'a{x..z}' );
+@got = $cluster2->get_tag('glob2');
+is_deeply( \@got, \@expected, 'glob2 expansion, words' )
+    or diag explain @got;
+
+@expected = ( 'b1', 'b2', 'b3' );
+$cluster1->register_tag( 'glob3', 'b{1..3}' );
+@got = $cluster2->get_tag('glob3');
+is_deeply( \@got, \@expected, 'glob3 expansion, number range' )
+    or diag explain @got;
+
+@expected = ( 'ca', 'cb', 'cc', 'd7', 'd8', 'd9' );
+$cluster1->register_tag( 'glob4', 'c{a..c}', 'd{7..9}' );
+@got = $cluster2->get_tag('glob4');
+is_deeply( \@got, \@expected, 'glob4 expansion, mixed' )
+    or diag explain @got;
+
+# make sure reasonable expansions get through with no nasty metachars
+@expected = ( 'cd..f}', 'c{a..c' );
+$cluster1->register_tag( 'glob5', 'c{a..c', 'cd..f}' );
+@got = $cluster2->get_tag('glob5');
+is_deeply( \@got, \@expected, 'glob5 expansion, mixed' )
+    or diag explain @got;
+
+@expected = ();
+trap {
+    $cluster1->register_tag( 'glob6', 'c{a..c} ; echo NASTY' );
+};
+is( $trap->leaveby, 'return', 'didnt die on nasty chars' );
+is( $trap->die,     undef,    'didnt die on nasty chars' );
+is( $trap->stdout,  q{},      'Expecting no STDOUT' );
+like(
+    $trap->stderr,
+    qr/Bad characters picked up in tag 'glob6':.*/,
+    'warned on nasty chars'
+);
+@got = $cluster2->get_tag('glob6');
+is_deeply( \@got, \@expected, 'glob6 expansion, nasty chars' )
+    or diag explain @got;
+
+@expected = ();
+trap {
+    $cluster1->register_tag( 'glob7', 'c{a..b} `echo NASTY`' );
+};
+is( $trap->leaveby, 'return', 'didnt die on nasty chars' );
+is( $trap->die,     undef,    'didnt die on nasty chars' );
+is( $trap->stdout,  q{},      'Expecting no STDOUT' );
+like(
+    $trap->stderr,
+    qr/Bad characters picked up in tag 'glob7':.*/,
+    'warned on nasty chars'
+);
+@got = $cluster2->get_tag('glob7');
+is_deeply( \@got, \@expected, 'glob7 expansion, nasty chars' )
+    or diag explain @got;
+
+@expected = ();
+trap {
+    $cluster1->register_tag( 'glob8', 'c{a..b} $!', );
+};
+is( $trap->leaveby, 'return', 'didnt die on nasty chars' );
+is( $trap->die,     undef,    'didnt die on nasty chars' );
+is( $trap->stdout,  q{},      'Expecting no STDOUT' );
+like(
+    $trap->stderr,
+    qr/Bad characters picked up in tag 'glob8':.*/,
+    'warned on nasty chars'
+);
+@got = $cluster2->get_tag('glob8');
+is_deeply( \@got, \@expected, 'glob8 expansion, nasty chars' )
+    or diag explain @got;
+
 done_testing();
 
 sub test_expected {