mirror of
https://github.com/duncs/clusterssh.git
synced 2025-07-03 18:03:23 +00:00

Previously cssh -a "hostname ; hostname" <server> would return the remote hostname and the local hostname. Fix to allow for both commands to run on the remote server.
186 lines
4.5 KiB
Perl
186 lines
4.5 KiB
Perl
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 $autoclose = $config->{auto_close};
|
|
|
|
my $postcommand = $autoclose ? "echo Press RETURN to continue; read IGNORE" : "sleep $autoclose";
|
|
|
|
# # 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);
|
|
# };
|
|
|
|
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\\\" ; $postcommand";
|
|
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;
|