mirror of
https://github.com/duncs/clusterssh.git
synced 2025-04-21 09:09:06 +00:00
Compare commits
No commits in common. "master" and "release-4.13" have entirely different histories.
master
...
release-4.
47 changed files with 2950 additions and 3066 deletions
68
.github/workflows/dzil_tester.yml
vendored
68
.github/workflows/dzil_tester.yml
vendored
|
|
@ -1,68 +0,0 @@
|
|||
name: CI test builds
|
||||
|
||||
on:
|
||||
push:
|
||||
branches: '*'
|
||||
pull_request:
|
||||
branches: '*'
|
||||
|
||||
jobs:
|
||||
perl-job:
|
||||
runs-on: ubuntu-latest
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
perl-version:
|
||||
- 'devel'
|
||||
- 'latest'
|
||||
- '5.40'
|
||||
- '5.38'
|
||||
- '5.36'
|
||||
- '5.34'
|
||||
- '5.32'
|
||||
- '5.30'
|
||||
- '5.28'
|
||||
- '5.26'
|
||||
- '5.24'
|
||||
- '5.22'
|
||||
- '5.20'
|
||||
- '5.18'
|
||||
- '5.16'
|
||||
include:
|
||||
- perl-version: '5.38'
|
||||
os: ubuntu-latest
|
||||
coverage: true
|
||||
container:
|
||||
image: perldocker/perl-tester:${{ matrix.perl-version }}
|
||||
|
||||
name: Perl ${{ matrix.perl-version }}
|
||||
|
||||
steps:
|
||||
- uses: actions/checkout@main
|
||||
- name: Amend PATH
|
||||
run: echo "${GITHUB_WORKSPACE}/t/bin" >> $GITHUB_PATH
|
||||
- name: Current env
|
||||
run: env
|
||||
- name: Perl info
|
||||
run: perl -V
|
||||
- name: CPAN test modules
|
||||
run: cpanm -n Pod::Coverage::TrustPod Test::Perl::Critic Test::Pod::Coverage Test::Pod Test::Trap
|
||||
- name: CPAN build modules
|
||||
run: cpanm -n Tk X11::Protocol X11::Protocol::Other
|
||||
- name: Initial Build
|
||||
run: perl Build.PL
|
||||
- name: Build the MANIFEST
|
||||
run: perl Build manifest
|
||||
- name: Test suite
|
||||
if: ${{ !matrix.coverage }}
|
||||
run: perl Build test
|
||||
env:
|
||||
RELEASE_TESTING: 1
|
||||
AUTHOR_TESTING: 1
|
||||
- name: Coverage tests
|
||||
if: ${{ matrix.coverage }}
|
||||
run: perl Build test
|
||||
env:
|
||||
COVERAGE: 1
|
||||
RELEASE_TESTING: 1
|
||||
AUTHOR_TESTING: 1
|
||||
6
.gitignore
vendored
6
.gitignore
vendored
|
|
@ -1,12 +1,7 @@
|
|||
/App-*
|
||||
*.bak
|
||||
/bin
|
||||
/blib/
|
||||
/_build/
|
||||
/.build/
|
||||
/Build
|
||||
Build.PL.orig
|
||||
Build.PL.x
|
||||
/cover_db/
|
||||
/Makefile
|
||||
/MANIFEST.bak
|
||||
|
|
@ -14,4 +9,5 @@ Build.PL.x
|
|||
/MYMETA.yml
|
||||
/pm_to_blib
|
||||
*.swp
|
||||
*.bak
|
||||
*.tar.gz
|
||||
|
|
|
|||
30
.travis.yml
Normal file
30
.travis.yml
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
language: perl
|
||||
perl:
|
||||
- blead
|
||||
- dev
|
||||
# No clean build due to removal of '.' from lib path
|
||||
# - 5.26
|
||||
- 5.24
|
||||
- 5.22
|
||||
- 5.20
|
||||
- 5.18
|
||||
- 5.16
|
||||
- 5.14
|
||||
- 5.12
|
||||
- 5.10
|
||||
# stopping builds; is anyone really still using this version?
|
||||
# - 5.8
|
||||
matrix:
|
||||
include:
|
||||
- perl: 5.24
|
||||
env: COVERAGE=1
|
||||
allow_failures:
|
||||
- perl: blead
|
||||
- perl: blead-thr
|
||||
sudo: false
|
||||
env:
|
||||
global:
|
||||
- RELEASE_TESTING=1
|
||||
- AUTHOR_TESTING=1
|
||||
before_install:
|
||||
- eval $(curl https://travis-perl.github.io/init) --auto
|
||||
158
Build.PL
158
Build.PL
|
|
@ -1,18 +1,142 @@
|
|||
use lib 'inc';
|
||||
use strict;
|
||||
use warnings;
|
||||
use Cwd;
|
||||
|
||||
require Module::Build;
|
||||
use Module::Build;
|
||||
|
||||
my %module_build_args = (
|
||||
module_name => 'App::ClusterSSH',
|
||||
dist_abstract => "Cluster administration tool",
|
||||
##{ $plugin->get_prereqs(1) ##}
|
||||
##{ $plugin->get_default('share_dir') ##}
|
||||
script_files => [
|
||||
# touch README
|
||||
open( my $fh, '>>', 'README' );
|
||||
close($fh);
|
||||
|
||||
my %project_info = (
|
||||
tracker => 'https://github.com/duncs/clusterssh/issues',
|
||||
repository => 'http://github.com/duncs/clusterssh',
|
||||
homepage => 'http://github.com/duncs/clusterssh/wiki',
|
||||
ci => 'https://travis-ci.org/duncs/clusterssh',
|
||||
coverage => 'https://coveralls.io/github/duncs/clusterssh',
|
||||
);
|
||||
|
||||
my $class = Module::Build->subclass(
|
||||
class => "Module::Build::Custom",
|
||||
code => qq{
|
||||
my \%project_info = (
|
||||
tracker => '$project_info{tracker}',
|
||||
homepage => '$project_info{homepage}',
|
||||
repository => '$project_info{repository}',
|
||||
ci => '$project_info{ci}',
|
||||
coverage => '$project_info{coverage}',
|
||||
);
|
||||
} . q{
|
||||
# don't check for errors; 'build_requires' should get this sorted
|
||||
eval {
|
||||
require File::Slurp;
|
||||
require CPAN::Changes;
|
||||
};
|
||||
|
||||
sub ACTION_email {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
# Make sure all tests pass first
|
||||
$self->depends_on("test");
|
||||
|
||||
print "Use '--changes <N>' to define how many to output. Default: 1", $/;
|
||||
my $change_count = $self->args('changes') || 1;
|
||||
|
||||
my @changes = CPAN::Changes->load( 'Changes' )->releases;
|
||||
|
||||
if($changes[-1]->date =~ m/^0000/) {
|
||||
die '#' x 40, $/, ' ' x 3, "FATAL: 'Changes' date not updated",$/,'#' x 40, $/;
|
||||
}
|
||||
|
||||
print $/;
|
||||
print 'Subject: ClusterSSH ', $self->dist_version, ' release', $/;
|
||||
print $/;
|
||||
|
||||
foreach my $change ( 1 .. $change_count ) {
|
||||
print $changes[ 0 - $change]->serialize;
|
||||
}
|
||||
|
||||
my $v=$self->dist_version;
|
||||
|
||||
print <<"EOF";
|
||||
==========
|
||||
Home page: $project_info{homepage},
|
||||
Bug Reports and Issues: $project_info{tracker}
|
||||
Project Repository: $project_info{repository}
|
||||
Automated Testing: $project_info{ci}
|
||||
Automated test coverage: $project_info{coverage}
|
||||
CPAN release: http://search.cpan.org/~duncs/App-ClusterSSH-$v
|
||||
SF release: http://sourceforge.net/projects/clusterssh/files/2.%20ClusterSSH%20Series%204/App-ClusterSSH-${v}.tar.gz/download
|
||||
==========
|
||||
EOF
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub ACTION_dist {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
print "Creating README", $/;
|
||||
|
||||
qx{ $^X bin_PL/cssh --generate-pod | pod2text > README };
|
||||
|
||||
$self->SUPER::ACTION_dist;
|
||||
}
|
||||
},
|
||||
);
|
||||
|
||||
my $build = $class->new(
|
||||
meta_merge => {
|
||||
resources => {
|
||||
Repository => [
|
||||
'http://clusterssh.git.sourceforge.net/',
|
||||
$project_info{repository},
|
||||
],
|
||||
bugtracker => $project_info{tracker},
|
||||
homepage => $project_info{homepage},
|
||||
coverage => $project_info{coverage},
|
||||
},
|
||||
},
|
||||
module_name => 'App::ClusterSSH',
|
||||
license => 'perl',
|
||||
dist_author => q{Duncan Ferguson <duncan_j_ferguson@yahoo.co.uk>},
|
||||
dist_version_from => 'lib/App/ClusterSSH.pm',
|
||||
requires => {
|
||||
'version' => '0.77',
|
||||
'Tk' => '800.022',
|
||||
'X11::Protocol' => '0.56',
|
||||
'X11::Protocol::WM' => '0',
|
||||
'Locale::Maketext' => 0,
|
||||
'Exception::Class' => '1.31',
|
||||
'Try::Tiny' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'File::Path' => 0,
|
||||
'File::Glob' => 0,
|
||||
},
|
||||
build_requires => {
|
||||
'Test::Pod::Coverage' => 0,
|
||||
'Test::Pod' => 0,
|
||||
'Test::Trap' => 0,
|
||||
'Readonly' => 0,
|
||||
'File::Which' => 0,
|
||||
'File::Temp' => 0,
|
||||
'Test::DistManifest' => 0,
|
||||
'Test::Differences' => 0,
|
||||
'CPAN::Changes' => 0.27,
|
||||
'File::Slurp' => 0,
|
||||
'Test::PerlTidy' => 0,
|
||||
'Perl::Tidy' => 20171214,
|
||||
},
|
||||
recommends => { 'Sort::Naturally' => 0, },
|
||||
configure_requires => { 'Module::Build' => 0, },
|
||||
add_to_cleanup => ['App-ClusterSSH-*'],
|
||||
create_makefile_pl => 'traditional',
|
||||
script_files => [
|
||||
'bin/cssh', 'bin/csftp',
|
||||
'bin/ccon', 'bin/crsh',
|
||||
'bin/ctel', 'bin/clusterssh_bash_completion.dist'
|
||||
],
|
||||
PL_files => {
|
||||
get_options => { changes => { type => '=s' }, },
|
||||
PL_files => {
|
||||
'bin_PL/_build_docs' => [
|
||||
'bin/cssh', 'bin/csftp',
|
||||
'bin/ccon', 'bin/crsh',
|
||||
|
|
@ -21,18 +145,4 @@ my %module_build_args = (
|
|||
},
|
||||
);
|
||||
|
||||
unless ( eval { Module::Build->VERSION(0.4004) } ) {
|
||||
my $tr = delete $module_build_args{test_requires};
|
||||
my $br = $module_build_args{build_requires};
|
||||
for my $mod ( keys %$tr ) {
|
||||
if ( exists $br->{$mod} ) {
|
||||
$br->{$mod} = $tr->{$mod} if $tr->{$mod} > $br->{$mod};
|
||||
}
|
||||
else {
|
||||
$br->{$mod} = $tr->{$mod};
|
||||
}
|
||||
}
|
||||
} # end unless Module::Build is 0.4004 or newer
|
||||
|
||||
my $builder = Module::Build->new(%module_build_args);
|
||||
$builder->create_build_script;
|
||||
$build->create_build_script;
|
||||
|
|
|
|||
44
Changes
44
Changes
|
|
@ -1,47 +1,3 @@
|
|||
Revision history for {{$dist->name}}
|
||||
|
||||
4.18 2024-10-19 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Re-release due to poor release upload to CPAN
|
||||
|
||||
4.17 2024-10-16 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Swap the hostname lookup macro from DNS to using the system hostname (Github issue #158)
|
||||
- Swap from using Travis-CI to Github Actions
|
||||
- Fix tests on perl 5.38 and 5.40 (Github Issue #153)
|
||||
|
||||
4.16 2020-06-20 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Further fix for 'resolve_names' error when adding hosts via the UI
|
||||
- Fix missing space separator for ssh_args (thanks to Petr Vorel)
|
||||
|
||||
4.15 2020-05-18 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Include all utilies within each man page
|
||||
- Add in 'command_pre' and 'command_post' configuration options
|
||||
- Fix 'Add Host' menu error finding 'resolved_names'
|
||||
- Ensure lib path is added to range tests to find the libraries
|
||||
- Mark permission test as TODO as it appears to be inconsistent
|
||||
|
||||
4.14 2019-08-21 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Include README within the repository, not just created tar.gz files
|
||||
- Add 'autoquit' setting to 'File' menu (Github issue #114)
|
||||
- Correct macro_hostname to be the FQDN of the server where cssh is being run (Github issue #116)
|
||||
- Add in user defined macros
|
||||
|
||||
4.13.2_02 2019-01-14 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Fix Getopt-Long minimum version
|
||||
- Fix excess test output when Sort::Naturally isn't installed
|
||||
|
||||
4.13.2_01 2018-11-24 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Move all Tk code into its own module as-is
|
||||
- Fix for 'bad pad value "3m"' error when using Tk 804.034
|
||||
- Update to Perl::Tidy 20181117
|
||||
- Convert to using Dist::Zilla
|
||||
|
||||
4.13.2 2018-03-14 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Fix for running builds in parallel
|
||||
- Improvements to SUPPORT and REPORTING BUGS sections in documentation
|
||||
|
||||
4.13.1 2018-03-05 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Minor update to fix failing tests due to 3rd party perltidy changes
|
||||
|
||||
4.13 2017-12-27 Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Ensure ssh_args is keep unset if it is emptied in the configuration file
|
||||
- Obey configured console position (Debian bug 758215) (Github issue #100)
|
||||
|
|
|
|||
63
INSTALL
Normal file
63
INSTALL
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
App-ClusterSSH
|
||||
|
||||
The is the Perl application bundle for ClusterSSH (a.k.a cssh), formally
|
||||
a GNU tools based project.
|
||||
|
||||
ClusterSSH is a tool for making the same change on multiple servers at
|
||||
the same time. The 'cssh' command opens an administration console and
|
||||
an xterm to all specified hosts. Any text typed into the administration
|
||||
console is replicated to all windows. All windows may also be typed into
|
||||
directly.
|
||||
|
||||
This tool is intended for (but not limited to) cluster administration
|
||||
where the same configuration or commands must be run on each node
|
||||
within the cluster. Performing these commands all at once via this
|
||||
tool ensures all nodes are kept in sync.
|
||||
|
||||
For more information, go to https://github.com/duncs/clusterssh
|
||||
|
||||
INSTALLATION
|
||||
|
||||
To install this module, run the following commands:
|
||||
|
||||
perl Build.PL
|
||||
./Build
|
||||
./Build test
|
||||
./Build install
|
||||
|
||||
SUPPORT AND DOCUMENTATION
|
||||
|
||||
After installing, you can find documentation for this module with the
|
||||
perldoc command.
|
||||
|
||||
perldoc cssh
|
||||
|
||||
or (if your MANPATH is set up appropriately)
|
||||
|
||||
man cssh
|
||||
|
||||
You can also look for information at:
|
||||
|
||||
Web site and GitHub project page
|
||||
https://github.com/duncs/clusterssh
|
||||
|
||||
Project support area
|
||||
https://github.com/duncs/clusterssh/issues
|
||||
|
||||
AnnoCPAN, Annotated CPAN documentation
|
||||
http://annocpan.org/dist/App-ClusterSSH
|
||||
|
||||
CPAN Ratings
|
||||
http://cpanratings.perl.org/d/App-ClusterSSH
|
||||
|
||||
Search CPAN
|
||||
http://search.cpan.org/dist/App-ClusterSSH/
|
||||
|
||||
|
||||
COPYRIGHT AND LICENCE
|
||||
|
||||
Copyright (C) 1999-2016 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.
|
||||
60
MANIFEST
Normal file
60
MANIFEST
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
AUTHORS
|
||||
bin_PL/_build_docs
|
||||
bin_PL/ccon
|
||||
bin_PL/clusterssh_bash_completion.dist
|
||||
bin_PL/crsh
|
||||
bin_PL/cscp.x
|
||||
bin_PL/csftp
|
||||
bin_PL/cssh
|
||||
bin_PL/ctel
|
||||
Build.PL
|
||||
Changes
|
||||
INSTALL
|
||||
lib/App/ClusterSSH/Base.pm
|
||||
lib/App/ClusterSSH/Cluster.pm
|
||||
lib/App/ClusterSSH/Config.pm
|
||||
lib/App/ClusterSSH/Getopt.pm
|
||||
lib/App/ClusterSSH/Helper.pm
|
||||
lib/App/ClusterSSH/Host.pm
|
||||
lib/App/ClusterSSH/L10N/en.pm
|
||||
lib/App/ClusterSSH/L10N.pm
|
||||
lib/App/ClusterSSH.pm
|
||||
lib/App/ClusterSSH/Range.pm
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
MANIFEST.SKIP
|
||||
META.json
|
||||
META.yml
|
||||
README
|
||||
t/00-load.t
|
||||
t/01l10n.t
|
||||
t/02base.t
|
||||
t/05getopts.t
|
||||
t/10host_ssh_config
|
||||
t/10host_ssh_include
|
||||
t/10host.t
|
||||
t/15config.t
|
||||
t/15config.t.file1
|
||||
t/15config.t.file2
|
||||
t/15config.t.file3
|
||||
t/20helper.t
|
||||
t/30cluster.cannot_read
|
||||
t/30cluster.file1
|
||||
t/30cluster.file2
|
||||
t/30cluster.file3
|
||||
t/30cluster.t
|
||||
t/30cluster.tag1
|
||||
t/80clusterssh.t
|
||||
t/bin/xterm
|
||||
t/boilerplate.t
|
||||
t/changes.t
|
||||
t/external_cluster_command
|
||||
THANKS
|
||||
t/manifest.t
|
||||
TODO
|
||||
t/perltidyrc
|
||||
t/perltidy.t
|
||||
t/pod-coverage.t
|
||||
t/pod.t
|
||||
t/range.t
|
||||
.travis.yml
|
||||
19
MANIFEST.SKIP
Normal file
19
MANIFEST.SKIP
Normal file
|
|
@ -0,0 +1,19 @@
|
|||
^App-ClusterSSH-.*
|
||||
.*\.bak$
|
||||
^bin/
|
||||
^blib/
|
||||
^_build/
|
||||
^Build$
|
||||
^Build.run$
|
||||
^cover_db/
|
||||
^.git/
|
||||
^.gitignore
|
||||
^Makefile$
|
||||
^Makefile.old$
|
||||
^MANIFEST\.bak$
|
||||
MYMETA.json
|
||||
MYMETA.yml
|
||||
pm_to_blib
|
||||
.*\.swp$
|
||||
^TOAD$
|
||||
^WIP_TASKS$
|
||||
112
META.json
Normal file
112
META.json
Normal file
|
|
@ -0,0 +1,112 @@
|
|||
{
|
||||
"abstract" : "A container for functions of the ClusterSSH programs",
|
||||
"author" : [
|
||||
"Duncan Ferguson <duncan_j_ferguson@yahoo.co.uk>"
|
||||
],
|
||||
"dynamic_config" : 1,
|
||||
"generated_by" : "Module::Build version 0.4224",
|
||||
"license" : [
|
||||
"perl_5"
|
||||
],
|
||||
"meta-spec" : {
|
||||
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
|
||||
"version" : 2
|
||||
},
|
||||
"name" : "App-ClusterSSH",
|
||||
"prereqs" : {
|
||||
"build" : {
|
||||
"requires" : {
|
||||
"CPAN::Changes" : "0.27",
|
||||
"File::Slurp" : "0",
|
||||
"File::Temp" : "0",
|
||||
"File::Which" : "0",
|
||||
"Perl::Tidy" : "20171214",
|
||||
"Readonly" : "0",
|
||||
"Test::Differences" : "0",
|
||||
"Test::DistManifest" : "0",
|
||||
"Test::PerlTidy" : "0",
|
||||
"Test::Pod" : "0",
|
||||
"Test::Pod::Coverage" : "0",
|
||||
"Test::Trap" : "0"
|
||||
}
|
||||
},
|
||||
"configure" : {
|
||||
"requires" : {
|
||||
"Module::Build" : "0"
|
||||
}
|
||||
},
|
||||
"runtime" : {
|
||||
"recommends" : {
|
||||
"Sort::Naturally" : "0"
|
||||
},
|
||||
"requires" : {
|
||||
"Exception::Class" : "1.31",
|
||||
"File::Glob" : "0",
|
||||
"File::Path" : "0",
|
||||
"Getopt::Long" : "0",
|
||||
"Locale::Maketext" : "0",
|
||||
"Tk" : "800.022",
|
||||
"Try::Tiny" : "0",
|
||||
"X11::Protocol" : "0.56",
|
||||
"X11::Protocol::WM" : "0",
|
||||
"version" : "0.77"
|
||||
}
|
||||
}
|
||||
},
|
||||
"provides" : {
|
||||
"App::ClusterSSH" : {
|
||||
"file" : "lib/App/ClusterSSH.pm",
|
||||
"version" : "4.13"
|
||||
},
|
||||
"App::ClusterSSH::Base" : {
|
||||
"file" : "lib/App/ClusterSSH/Base.pm",
|
||||
"version" : "0.02"
|
||||
},
|
||||
"App::ClusterSSH::Cluster" : {
|
||||
"file" : "lib/App/ClusterSSH/Cluster.pm",
|
||||
"version" : "0.01"
|
||||
},
|
||||
"App::ClusterSSH::Config" : {
|
||||
"file" : "lib/App/ClusterSSH/Config.pm",
|
||||
"version" : "0.02"
|
||||
},
|
||||
"App::ClusterSSH::Getopt" : {
|
||||
"file" : "lib/App/ClusterSSH/Getopt.pm",
|
||||
"version" : "0.01"
|
||||
},
|
||||
"App::ClusterSSH::Helper" : {
|
||||
"file" : "lib/App/ClusterSSH/Helper.pm",
|
||||
"version" : "0.02"
|
||||
},
|
||||
"App::ClusterSSH::Host" : {
|
||||
"file" : "lib/App/ClusterSSH/Host.pm",
|
||||
"version" : "0.03"
|
||||
},
|
||||
"App::ClusterSSH::L10N" : {
|
||||
"file" : "lib/App/ClusterSSH/L10N.pm"
|
||||
},
|
||||
"App::ClusterSSH::L10N::en" : {
|
||||
"file" : "lib/App/ClusterSSH/L10N/en.pm"
|
||||
},
|
||||
"App::ClusterSSH::Range" : {
|
||||
"file" : "lib/App/ClusterSSH/Range.pm"
|
||||
}
|
||||
},
|
||||
"release_status" : "stable",
|
||||
"resources" : {
|
||||
"bugtracker" : {
|
||||
"web" : "https://github.com/duncs/clusterssh/issues"
|
||||
},
|
||||
"homepage" : "http://github.com/duncs/clusterssh/wiki",
|
||||
"license" : [
|
||||
"http://dev.perl.org/licenses/"
|
||||
],
|
||||
"x_Repository" : [
|
||||
"http://clusterssh.git.sourceforge.net/",
|
||||
"http://github.com/duncs/clusterssh"
|
||||
],
|
||||
"x_coverage" : "https://coveralls.io/github/duncs/clusterssh"
|
||||
},
|
||||
"version" : "4.13",
|
||||
"x_serialization_backend" : "JSON::PP version 2.94"
|
||||
}
|
||||
77
META.yml
Normal file
77
META.yml
Normal file
|
|
@ -0,0 +1,77 @@
|
|||
---
|
||||
abstract: 'A container for functions of the ClusterSSH programs'
|
||||
author:
|
||||
- 'Duncan Ferguson <duncan_j_ferguson@yahoo.co.uk>'
|
||||
build_requires:
|
||||
CPAN::Changes: '0.27'
|
||||
File::Slurp: '0'
|
||||
File::Temp: '0'
|
||||
File::Which: '0'
|
||||
Perl::Tidy: '20171214'
|
||||
Readonly: '0'
|
||||
Test::Differences: '0'
|
||||
Test::DistManifest: '0'
|
||||
Test::PerlTidy: '0'
|
||||
Test::Pod: '0'
|
||||
Test::Pod::Coverage: '0'
|
||||
Test::Trap: '0'
|
||||
configure_requires:
|
||||
Module::Build: '0'
|
||||
dynamic_config: 1
|
||||
generated_by: 'Module::Build version 0.4224, CPAN::Meta::Converter version 2.150010'
|
||||
license: perl
|
||||
meta-spec:
|
||||
url: http://module-build.sourceforge.net/META-spec-v1.4.html
|
||||
version: '1.4'
|
||||
name: App-ClusterSSH
|
||||
provides:
|
||||
App::ClusterSSH:
|
||||
file: lib/App/ClusterSSH.pm
|
||||
version: '4.13'
|
||||
App::ClusterSSH::Base:
|
||||
file: lib/App/ClusterSSH/Base.pm
|
||||
version: '0.02'
|
||||
App::ClusterSSH::Cluster:
|
||||
file: lib/App/ClusterSSH/Cluster.pm
|
||||
version: '0.01'
|
||||
App::ClusterSSH::Config:
|
||||
file: lib/App/ClusterSSH/Config.pm
|
||||
version: '0.02'
|
||||
App::ClusterSSH::Getopt:
|
||||
file: lib/App/ClusterSSH/Getopt.pm
|
||||
version: '0.01'
|
||||
App::ClusterSSH::Helper:
|
||||
file: lib/App/ClusterSSH/Helper.pm
|
||||
version: '0.02'
|
||||
App::ClusterSSH::Host:
|
||||
file: lib/App/ClusterSSH/Host.pm
|
||||
version: '0.03'
|
||||
App::ClusterSSH::L10N:
|
||||
file: lib/App/ClusterSSH/L10N.pm
|
||||
App::ClusterSSH::L10N::en:
|
||||
file: lib/App/ClusterSSH/L10N/en.pm
|
||||
App::ClusterSSH::Range:
|
||||
file: lib/App/ClusterSSH/Range.pm
|
||||
recommends:
|
||||
Sort::Naturally: '0'
|
||||
requires:
|
||||
Exception::Class: '1.31'
|
||||
File::Glob: '0'
|
||||
File::Path: '0'
|
||||
Getopt::Long: '0'
|
||||
Locale::Maketext: '0'
|
||||
Tk: '800.022'
|
||||
Try::Tiny: '0'
|
||||
X11::Protocol: '0.56'
|
||||
X11::Protocol::WM: '0'
|
||||
version: '0.77'
|
||||
resources:
|
||||
Coverage: https://coveralls.io/github/duncs/clusterssh
|
||||
Repository:
|
||||
- http://clusterssh.git.sourceforge.net/
|
||||
- http://github.com/duncs/clusterssh
|
||||
bugtracker: https://github.com/duncs/clusterssh/issues
|
||||
homepage: http://github.com/duncs/clusterssh/wiki
|
||||
license: http://dev.perl.org/licenses/
|
||||
version: '4.13'
|
||||
x_serialization_backend: 'CPAN::Meta::YAML version 0.016'
|
||||
51
Makefile.PL
Normal file
51
Makefile.PL
Normal file
|
|
@ -0,0 +1,51 @@
|
|||
# Note: this file was auto-generated by Module::Build::Compat version 0.4224
|
||||
use ExtUtils::MakeMaker;
|
||||
WriteMakefile
|
||||
(
|
||||
'NAME' => 'App::ClusterSSH',
|
||||
'VERSION_FROM' => 'lib/App/ClusterSSH.pm',
|
||||
'PREREQ_PM' => {
|
||||
'CPAN::Changes' => '0.27',
|
||||
'Exception::Class' => '1.31',
|
||||
'File::Glob' => 0,
|
||||
'File::Path' => 0,
|
||||
'File::Slurp' => 0,
|
||||
'File::Temp' => 0,
|
||||
'File::Which' => 0,
|
||||
'Getopt::Long' => 0,
|
||||
'Locale::Maketext' => 0,
|
||||
'Perl::Tidy' => 20171214,
|
||||
'Readonly' => 0,
|
||||
'Test::Differences' => 0,
|
||||
'Test::DistManifest' => 0,
|
||||
'Test::PerlTidy' => 0,
|
||||
'Test::Pod' => 0,
|
||||
'Test::Pod::Coverage' => 0,
|
||||
'Test::Trap' => 0,
|
||||
'Tk' => '800.022',
|
||||
'Try::Tiny' => 0,
|
||||
'X11::Protocol' => '0.56',
|
||||
'X11::Protocol::WM' => '0',
|
||||
'version' => '0.77'
|
||||
},
|
||||
'INSTALLDIRS' => 'site',
|
||||
'EXE_FILES' => [
|
||||
'bin/ccon',
|
||||
'bin/clusterssh_bash_completion.dist',
|
||||
'bin/crsh',
|
||||
'bin/csftp',
|
||||
'bin/cssh',
|
||||
'bin/ctel'
|
||||
],
|
||||
'PL_FILES' => {
|
||||
'bin_PL/_build_docs' => [
|
||||
'bin/cssh',
|
||||
'bin/csftp',
|
||||
'bin/ccon',
|
||||
'bin/crsh',
|
||||
'bin/ctel',
|
||||
'bin/clusterssh_bash_completion.dist'
|
||||
]
|
||||
}
|
||||
)
|
||||
;
|
||||
130
README
130
README
|
|
@ -2,7 +2,7 @@ NAME
|
|||
cssh - Cluster administration tool
|
||||
|
||||
VERSION
|
||||
This documentation is for version: 4.18
|
||||
This documentation is for version: 4.13
|
||||
|
||||
SYNOPSIS
|
||||
cssh [-a '<command>'] [-K <seconds>] [-q] [-c '<filename>'] [-x <cols>]
|
||||
|
|
@ -12,14 +12,6 @@ SYNOPSIS
|
|||
[-t '<STRING>'] [-g] [-T '<title>'] [-u] [-?] [-A] [-l '<username>']
|
||||
[-v]
|
||||
|
||||
RELATED
|
||||
Also see the individual man pages for each of these utilities
|
||||
|
||||
ccon - Use 'console' as the communication method
|
||||
crsh - Use 'rsh' as the communication method
|
||||
csftp - Use 'sftp' as the communication method
|
||||
ctel - Use 'telnet' as the communication method
|
||||
|
||||
DESCRIPTION
|
||||
The command opens an administration console and an xterm to all
|
||||
specified hosts. Any text typed into the administration console is
|
||||
|
|
@ -91,8 +83,8 @@ OPTIONS
|
|||
Number of seconds to wait before closing finished terminal windows.
|
||||
|
||||
--autoquit, -q
|
||||
Toggle automatically quitting after the last client window has
|
||||
closed (overriding the config file).
|
||||
Toggle automatically quiting after the last client window has closed
|
||||
(overriding the config file).
|
||||
|
||||
--cluster-file '<filename>', -c '<filename>'
|
||||
Use supplied file as additional cluster file (see also "FILES").
|
||||
|
|
@ -231,13 +223,6 @@ KEY SHORTCUTS
|
|||
Alt-u
|
||||
Paste in the username for the connection
|
||||
|
||||
Alt-1
|
||||
Alt-2
|
||||
Alt-3
|
||||
Alt-4
|
||||
Run the matching user defined macro on the server and send the
|
||||
output to the client
|
||||
|
||||
EXAMPLES
|
||||
Open up a session to 3 servers
|
||||
$ cssh server1 server2 server3
|
||||
|
|
@ -346,21 +331,6 @@ FILES
|
|||
Enable or disable alternative algorithm for calculating terminal
|
||||
positioning.
|
||||
|
||||
command_pre =
|
||||
command_post =
|
||||
Add extra commands around the communication method. For example:
|
||||
|
||||
command_pre= . $HOME/virtualenvs/default/bin/active ;
|
||||
command_post= | ct
|
||||
|
||||
would allow for using Python virtual envronments and then piping
|
||||
all shell output through "chromaterm" for syntax highlighting.
|
||||
Note: you must use appropriate command separators/terminators to
|
||||
keep the meaning of the command pipline (such as ";" and "|"
|
||||
between commands).
|
||||
|
||||
These are not put through macro parsing.
|
||||
|
||||
comms = ssh
|
||||
Sets the default communication method (initially taken from the
|
||||
name of the program, but can be overridden here).
|
||||
|
|
@ -448,52 +418,14 @@ FILES
|
|||
Default key sequence to send username to client. See "KEY
|
||||
SHORTCUTS" for more information.
|
||||
|
||||
key_user_1 = Alt-1
|
||||
key_user_2 = Alt-2
|
||||
key_user_3 = Alt-3
|
||||
key_user_4 = Alt-4
|
||||
Default key sequence to send user defined macros to client. If
|
||||
the matching macro_user_1 macro is undefined, the sequence is
|
||||
passed straight to the terminal. See "KEY SHORTCUTS" for more
|
||||
information.
|
||||
|
||||
macro_servername = %s
|
||||
macro_hostname = %h
|
||||
macro_username = %u
|
||||
macro_newline = %n
|
||||
macro_version = %v
|
||||
macro_user_1 = %1
|
||||
macro_user_2 = %2
|
||||
macro_user_3 = %3
|
||||
macro_user_4 = %4
|
||||
Change the replacement macro used when either using a 'Send'
|
||||
menu item, or when pasting text into the main console.
|
||||
|
||||
macro_user_1_command =
|
||||
macro_user_2_command =
|
||||
macro_user_3_command =
|
||||
macro_user_4_command =
|
||||
User defined macros - the macro is run through the shell on the
|
||||
server and the output is sent to the client. For example,
|
||||
|
||||
"macro_user_1_command=echo echo macro_user_1"
|
||||
|
||||
would send the text C<echo macro_user_1> into the terminal session.
|
||||
|
||||
"macro_user_1_command=env | grep CSSH"
|
||||
|
||||
would send the CSSH environment variables to the client.
|
||||
|
||||
The following environment variables are set in the shell of the
|
||||
macro process
|
||||
|
||||
"CSSH_SERVERNAME"
|
||||
"CSSH_HOSTNAME"
|
||||
"CSSH_USERNAME"
|
||||
"CSSH_CONNECTION_STRING"
|
||||
"CSSH_CONNECTION_PORT"
|
||||
"CSSH_VERSION"
|
||||
|
||||
macros_enabled = yes
|
||||
Enable or disable macro replacement. Note: this affects all the
|
||||
"macro_*" variables above.
|
||||
|
|
@ -708,57 +640,57 @@ KNOWN BUGS
|
|||
tell the difference between the two events, there is no fix (apart
|
||||
from rewriting everything directly in X).
|
||||
|
||||
TROUBLESHOOTING
|
||||
If you have issues running cssh, first try:
|
||||
REPORTING BUGS
|
||||
* If you have issues running cssh, first try:
|
||||
|
||||
"cssh -e [user@]<hostname>[:port]"
|
||||
"cssh -e [user@]<hostname>[:port]"
|
||||
|
||||
This performs two tests to confirm cssh is able to work properly with
|
||||
the settings provided within the $HOME/.clusterssh/config file (or
|
||||
internal defaults).
|
||||
This performs two tests to confirm cssh is able to work properly
|
||||
with the settings provided within the $HOME/.clusterssh/config file
|
||||
(or internal defaults).
|
||||
|
||||
1 Test the terminal window works with the options provided
|
||||
1 Test the terminal window works with the options provided
|
||||
|
||||
2 Test ssh works to a host with the configured arguments
|
||||
2 Test ssh works to a host with the configured arguments
|
||||
|
||||
Configuration options to watch for in ssh are:
|
||||
Configuration options to watch for in ssh are
|
||||
|
||||
* SSH doesn't understand "-o ConnectTimeout=10" - remove the option
|
||||
SSH doesn't understand "-o ConnectTimeout=10" - remove the option
|
||||
from the $HOME/.clusterssh/config file
|
||||
|
||||
* OpenSSH-3.8 using untrusted ssh tunnels - use "-Y" instead of "-X"
|
||||
OpenSSH-3.8 using untrusted ssh tunnels - use "-Y" instead of "-X"
|
||||
or use "ForwardX11Trusted yes" in $HOME/.ssh/ssh_config (if you
|
||||
change the default ssh options from "-x" to "-X")
|
||||
|
||||
SUPPORT AND REPORTING BUGS
|
||||
A web site for comments, requests, bug reports and bug fixes/patches is
|
||||
available at: <https://github.com/duncs/clusterssh>
|
||||
* If you require support, please run the following commands and post
|
||||
it on the web site in the support/problems forum:
|
||||
|
||||
If you require support, please run the following commands and create an
|
||||
issue via: <https://github.com/duncs/clusterssh/issues>
|
||||
"perl -V"
|
||||
|
||||
"perl -V"
|
||||
"perl -MTk -e 'print $Tk::VERSION,$/'"
|
||||
|
||||
"perl -MTk -e 'print $Tk::VERSION,$/'"
|
||||
"perl -MX11::Protocol -e 'print $X11::Protocol::VERSION,$/'"
|
||||
|
||||
"perl -MX11::Protocol -e 'print $X11::Protocol::VERSION,$/'"
|
||||
"cat /etc/csshrc $HOME/.clusterssh/config"
|
||||
|
||||
"cat /etc/csshrc $HOME/.clusterssh/config"
|
||||
|
||||
Using the debug option (--debug) will turn on debugging output. Repeat
|
||||
the option to increase the amount of debug. However, if possible please
|
||||
only use this option with one host at a time, e.g. "cssh --debug <host>"
|
||||
due to the amount of output produced (in both main and child windows).
|
||||
* Using the debug option (--debug) will turn on debugging output.
|
||||
Repeat the option to increase the amount of debug. However, if
|
||||
possible please only use this option with one host at a time, e.g.
|
||||
"cssh --debug <host>" due to the amount of output produced (in both
|
||||
main and child windows).
|
||||
|
||||
SEE ALSO
|
||||
<https://github.com/duncs/clusterssh/wiki/>, "ssh", Tk::overview,
|
||||
<http://clusterssh.sourceforge.net/>, "ssh", Tk::overview,
|
||||
X11::Protocol, "perl"
|
||||
|
||||
CREDITS
|
||||
A web site for comments, requests, bug reports and bug fixes/patches is
|
||||
available at: <https://github.com/duncs/clusterssh>
|
||||
|
||||
AUTHOR
|
||||
Duncan Ferguson, "<duncan_j_ferguson at yahoo.co.uk>"
|
||||
|
||||
LICENSE AND COPYRIGHT
|
||||
Copyright 1999-2018 Duncan Ferguson.
|
||||
Copyright 1999-2016 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
|
||||
|
|
|
|||
1
THANKS
1
THANKS
|
|
@ -48,4 +48,3 @@ Bill Rushmore
|
|||
Ankit Vadehra
|
||||
Azenet
|
||||
Markus Frosch (lazyfrosch)
|
||||
Petr Vorel
|
||||
|
|
|
|||
0
WIP_TASKS
Normal file
0
WIP_TASKS
Normal file
|
|
@ -1,47 +1,47 @@
|
|||
#!/usr/bin/env perl
|
||||
use 5.008.004;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin qw($Bin $Script);
|
||||
use File::Basename;
|
||||
|
||||
my $bindir = "bin";
|
||||
chdir $Bin || die "Unable to chdir into $Bin: $!";
|
||||
|
||||
if ( !-d $bindir ) {
|
||||
my $bindir="$Bin/../bin";
|
||||
|
||||
if(! -d $bindir) {
|
||||
mkdir $bindir || die "Could not mkdir $bindir: $!";
|
||||
}
|
||||
|
||||
print "Using perl binary: $^X", $/;
|
||||
print "Using perl version $^V", $/;
|
||||
print "Using perl binary: $^X",$/;
|
||||
print "Using perl version $^V",$/;
|
||||
|
||||
for my $dest (@ARGV) {
|
||||
my $source = $Bin . '/' . basename($dest);
|
||||
for my $source (glob("*")) {
|
||||
my $dest="$bindir/$source";
|
||||
|
||||
next if ( $source =~ m/$Script/ );
|
||||
next if ( $source =~ m/\.x$/ );
|
||||
next if($source =~ m/$Script/);
|
||||
next if($source =~ m/\.x$/);
|
||||
|
||||
print "Generating: $source", $/;
|
||||
print "Generating: $source",$/;
|
||||
|
||||
if ( -f $dest ) {
|
||||
chmod( 0755, $dest ) || die "Could not chmod $dest for removing: $!";
|
||||
if(-f $dest) {
|
||||
chmod(0777, $dest) || die "Could not chmod $dest for removing: $!";
|
||||
}
|
||||
|
||||
open( my $sfh, '<', $source )
|
||||
|| die "Could not open $source for reading: $!";
|
||||
open( my $dfh, '>', $dest ) || die "Could not open $dest for writing: $!";
|
||||
print $dfh $_ while (<$sfh>);
|
||||
open(my $sfh, '<', $source) || die "Could not open $source for reading: $!";
|
||||
open(my $dfh, '>', $dest ) || die "Could not open $dest for writing: $!";
|
||||
print $dfh $_ while(<$sfh>);
|
||||
close($sfh);
|
||||
|
||||
if ( $source !~ m/clusterssh_bash_completion.dist/ ) {
|
||||
if($source ne "clusterssh_bash_completion.dist") {
|
||||
print $dfh "\n\n__END__\n\n";
|
||||
|
||||
my $pod = qx{ $^X $source --generate-pod };
|
||||
die "Failed to generate pod" if ($?);
|
||||
my $pod= qx{ $^X ./$source --generate-pod };
|
||||
die "Failed to generate pod" if($?);
|
||||
print $dfh $pod;
|
||||
}
|
||||
|
||||
close($dfh);
|
||||
|
||||
chmod( 0555, $dest ) || die "Could not chmod $dest: $!";
|
||||
chmod(0555, $dest) || die "Could not chmod $dest: $!";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
#!/usr/bin/env perl
|
||||
use 5.008.004;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
|
|
@ -15,9 +14,7 @@ my $app = App::ClusterSSH->new();
|
|||
|
||||
$app->add_option(
|
||||
spec => 'master|M=s',
|
||||
help => $app->loc(
|
||||
"The console client program polls master as the primary server, rather than the default set at compile time (typically ``console'')."
|
||||
),
|
||||
help => $app->loc("The console client program polls master as the primary server, rather than the default set at compile time (typically ``console'')."),
|
||||
);
|
||||
|
||||
$app->run();
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
#!/usr/bin/env perl
|
||||
use 5.008.004;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
#!/usr/bin/env perl
|
||||
use 5.008.004;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
#!/usr/bin/env perl
|
||||
use 5.008.004;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
#!/usr/bin/env perl
|
||||
use 5.008.004;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
|
|
|
|||
74
dist.ini
74
dist.ini
|
|
@ -1,74 +0,0 @@
|
|||
name = App-ClusterSSH
|
||||
author = Duncan Ferguson <duncan_j_ferguson@yahoo.co.uk>
|
||||
license = Perl_5
|
||||
copyright_holder = Duncan Ferguson
|
||||
copyright_year = 2018
|
||||
|
||||
[Git::Check]
|
||||
|
||||
[GatherDir]
|
||||
[MetaYAML]
|
||||
[ModuleBuild::Custom]
|
||||
mb_class = App::ClusterSSH:Build
|
||||
|
||||
[InstallGuide]
|
||||
[License]
|
||||
[PruneCruft]
|
||||
[PruneFiles]
|
||||
match = ^bin/
|
||||
match = \.bak$
|
||||
match = ^Build\.PL\.
|
||||
|
||||
[ManifestSkip]
|
||||
[Manifest]
|
||||
[TestRelease]
|
||||
[ConfirmRelease]
|
||||
[UploadToCPAN]
|
||||
|
||||
; for later
|
||||
;[Twitter]
|
||||
[EmailNotify]
|
||||
to = duncan_j_ferguson@yahoo.co.uk
|
||||
from = duncan_j_ferguson@yahoo.co.uk
|
||||
|
||||
[CheckChangeLog]
|
||||
|
||||
[PerlTidy]
|
||||
perltidyrc = t/perltidyrc
|
||||
|
||||
; Need to decide how to do this automatically at some point
|
||||
[VersionFromModule]
|
||||
;[Git::NextVersion]
|
||||
;[AutoVersion]
|
||||
[AutoPrereqs]
|
||||
[PkgVersion]
|
||||
[NextRelease]
|
||||
[Git::Commit]
|
||||
[Git::Tag]
|
||||
[Git::Push]
|
||||
|
||||
; optional prereqs - only used if they are installed
|
||||
[Prereqs / RuntimeRecommends]
|
||||
Sort::Naturally = 1.03
|
||||
|
||||
; Author prereqs
|
||||
; authordep Pod::Coverage::TrustPod
|
||||
; authordep Test::CPAN::Changes
|
||||
|
||||
[MetaResources]
|
||||
homepage = http://github.com/duncs/clusterssh/wiki
|
||||
bugtracker.web = https://github.com/duncs/clusterssh/issues
|
||||
repository.web = http://github.com/duncs/clusterssh
|
||||
repository.type = git
|
||||
; these two custom ones cause errors
|
||||
;Ci.web = https://travis-ci.org/duncs/clusterssh
|
||||
;Coverage.web = https://coveralls.io/github/duncs/clusterssh
|
||||
|
||||
[ExtraTests]
|
||||
; Disabled for the moment
|
||||
;[Test::Perl::Critic]
|
||||
[PodCoverageTests]
|
||||
[PodSyntaxTests]
|
||||
|
||||
[Run::BeforeBuild]
|
||||
run = bin_PL/cssh --generate-pod | pod2text > README
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -1,34 +1,11 @@
|
|||
use warnings;
|
||||
use strict;
|
||||
|
||||
package App::ClusterSSH::Base;
|
||||
|
||||
# ABSTRACT: App::ClusterSSH::Base - Base object provding utility functions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use base qw/ App::ClusterSSH::Base /;
|
||||
|
||||
# in object new method
|
||||
sub new {
|
||||
( $class, $arg_ref ) = @_;
|
||||
my $self = $class->SUPER::new($arg_ref);
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Base object to provide some utility functions on objects - should not be
|
||||
used directly
|
||||
|
||||
=cut
|
||||
|
||||
use warnings;
|
||||
use strict;
|
||||
use Carp;
|
||||
use App::ClusterSSH::L10N;
|
||||
|
||||
use Module::Load;
|
||||
|
||||
use Exception::Class 1.31 (
|
||||
use Exception::Class (
|
||||
'App::ClusterSSH::Exception',
|
||||
'App::ClusterSSH::Exception::Config' => {
|
||||
fields => 'unknown_config',
|
||||
|
|
@ -39,6 +16,10 @@ use Exception::Class 1.31 (
|
|||
'App::ClusterSSH::Exception::Getopt',
|
||||
);
|
||||
|
||||
# Don't use SVN revision as it can cause problems
|
||||
use version;
|
||||
our $VERSION = version->new('0.02');
|
||||
|
||||
my $debug_level = $ENV{CLUSTERSSH_DEBUG} || 0;
|
||||
our $language = 'en';
|
||||
our $language_handle;
|
||||
|
|
@ -161,21 +142,9 @@ sub config {
|
|||
);
|
||||
}
|
||||
|
||||
return $self->{parent}->{config}
|
||||
if $self->{parent}
|
||||
&& ref $self->{parent} eq "HASH"
|
||||
&& $self->{parent}->{config};
|
||||
|
||||
return $app_configuration;
|
||||
}
|
||||
|
||||
sub options {
|
||||
my ($self) = @_;
|
||||
return $self->{parent}->{options}
|
||||
if $self->{parent} && $self->{parent}->{options};
|
||||
return;
|
||||
}
|
||||
|
||||
sub set_config {
|
||||
my ( $self, $config ) = @_;
|
||||
|
||||
|
|
@ -301,33 +270,29 @@ sub parent {
|
|||
return $self->{parent};
|
||||
}
|
||||
|
||||
sub sort {
|
||||
my $self = shift;
|
||||
1;
|
||||
|
||||
# if the user has asked for natural sorting we need to include an extra
|
||||
# module
|
||||
my $config = $self->config();
|
||||
=pod
|
||||
|
||||
# Make sure the configuration object has been set correctly before
|
||||
# referencing anything
|
||||
if ( ref $config eq "HASH" && $config->{'use_natural_sort'} ) {
|
||||
eval { Module::Load::load('Sort::Naturally'); };
|
||||
if ($@) {
|
||||
warn(
|
||||
"natural sorting requested but unable to load Sort::Naturally: $@\n"
|
||||
);
|
||||
}
|
||||
else {
|
||||
my $sort = sub { Sort::Naturally::nsort(@_) };
|
||||
return $sort;
|
||||
}
|
||||
=head1 NAME
|
||||
|
||||
App::ClusterSSH::Base - Base object provding utility functions
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use base qw/ App::ClusterSSH::Base /;
|
||||
|
||||
# in object new method
|
||||
sub new {
|
||||
( $class, $arg_ref ) = @_;
|
||||
my $self = $class->SUPER::new($arg_ref);
|
||||
return $self;
|
||||
}
|
||||
|
||||
my $sort = sub { sort @_ };
|
||||
return $sort;
|
||||
}
|
||||
=head1 DESCRIPTION
|
||||
|
||||
1;
|
||||
Base object to provide some utility functions on objects - should not be
|
||||
used directly
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
|
|
@ -373,15 +338,11 @@ a wrapper to maketext in Locale::Maketext
|
|||
|
||||
Output text on STDOUT.
|
||||
|
||||
=item $obj->parent;
|
||||
=item $ovj->parent;
|
||||
|
||||
Returned the object that is the parent of this one, if it was set when the
|
||||
Reutrned the object that is the parent of this one, if it was set when the
|
||||
object was created
|
||||
|
||||
=item %obj->options;
|
||||
|
||||
Accessor to configured options, if it is set up by this point
|
||||
|
||||
=item $obj->exit;
|
||||
|
||||
Stub to allow program to exit neatly from wherever in the code
|
||||
|
|
@ -395,14 +356,27 @@ hasnt been called
|
|||
|
||||
Set the config to the given value - croaks if has already been called
|
||||
|
||||
=item $sort = $obj->sort
|
||||
|
||||
Code reference used to sort lists; if configured (and installed) use
|
||||
Sort;:Naturally, else use perl sort
|
||||
|
||||
=item %results = $obj->load_file( filename => '/path/to/file', type => '(cluster|config}' )
|
||||
|
||||
Load in the specified file and return a hash, parsing the file depending on
|
||||
wther it is a config file (key = value) or cluster file (key value)
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright 1999-2016 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;
|
||||
|
|
|
|||
|
|
@ -1,20 +1,13 @@
|
|||
package App::ClusterSSH::Cluster;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package App::ClusterSSH::Cluster;
|
||||
|
||||
# ABSTRACT: App::ClusterSSH::Cluster - Object representing cluster configuration
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing application configuration
|
||||
|
||||
=cut
|
||||
use version;
|
||||
our $VERSION = version->new('0.01');
|
||||
|
||||
use Carp;
|
||||
use Try::Tiny 0.28;
|
||||
use Try::Tiny;
|
||||
use English qw( -no_match_vars );
|
||||
|
||||
use base qw/ App::ClusterSSH::Base /;
|
||||
|
|
@ -87,7 +80,7 @@ sub _run_external_clusters {
|
|||
|
||||
$self->debug( 3, 'Running tags through external command' );
|
||||
$self->debug( 4, 'External command: ', $external_command );
|
||||
$self->debug( 3, 'Args ', join( ',', @args ) );
|
||||
$self->debug( 3, 'Args ', join( ',', @args ) );
|
||||
|
||||
my $command = "$external_command @args";
|
||||
|
||||
|
|
@ -294,6 +287,18 @@ sub dump_tags {
|
|||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
App::ClusterSSH::Cluster - Object representing cluster configuration
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing application configuration
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
|
@ -360,3 +365,21 @@ Returns a hash of all tag data.
|
|||
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
|
||||
|
||||
Copyright 1999-2016 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;
|
||||
|
|
|
|||
|
|
@ -1,17 +1,10 @@
|
|||
package App::ClusterSSH::Config;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package App::ClusterSSH::Config;
|
||||
|
||||
# ABSTRACT: ClusterSSH::Config - Object representing application configuration
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing application configuration
|
||||
|
||||
=cut
|
||||
use version;
|
||||
our $VERSION = version->new('0.02');
|
||||
|
||||
use Carp;
|
||||
use Try::Tiny;
|
||||
|
|
@ -49,10 +42,6 @@ my %default_config = (
|
|||
key_macros_enable => "Alt-p",
|
||||
key_paste => "Control-v",
|
||||
key_username => "Alt-u",
|
||||
key_user_1 => "Alt-1",
|
||||
key_user_2 => "Alt-2",
|
||||
key_user_3 => "Alt-3",
|
||||
key_user_4 => "Alt-4",
|
||||
mouse_paste => "Button-2",
|
||||
auto_quit => "yes",
|
||||
auto_close => 5,
|
||||
|
|
@ -98,8 +87,6 @@ my %default_config = (
|
|||
history_height => 10,
|
||||
|
||||
command => q{},
|
||||
command_pre => q{},
|
||||
command_post => q{},
|
||||
hide_menu => 0,
|
||||
max_host_menu_items => 30,
|
||||
|
||||
|
|
@ -109,16 +96,6 @@ my %default_config = (
|
|||
macro_username => '%u',
|
||||
macro_newline => '%n',
|
||||
macro_version => '%v',
|
||||
macro_user_1 => '%1',
|
||||
macro_user_2 => '%2',
|
||||
macro_user_3 => '%3',
|
||||
macro_user_4 => '%4',
|
||||
|
||||
macro_user_1_command => '',
|
||||
macro_user_2_command => '',
|
||||
macro_user_3_command => '',
|
||||
macro_user_4_command => '',
|
||||
hostname_override => '',
|
||||
|
||||
max_addhost_menu_cluster_items => 6,
|
||||
menu_send_autotearoff => 0,
|
||||
|
|
@ -295,15 +272,6 @@ sub parse_config_file {
|
|||
if ( $read_config{terminal_font} );
|
||||
|
||||
$self->validate_args(%read_config);
|
||||
|
||||
# Look at the user macros and if not set remove the hotkey for them
|
||||
for my $i (qw/ 1 2 3 4 /) {
|
||||
if ( !$self->{"macro_user_${i}_command"} ) {
|
||||
delete $self->{"key_user_${i}"};
|
||||
}
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub load_configs {
|
||||
|
|
@ -315,7 +283,7 @@ sub load_configs {
|
|||
$ENV{HOME} . '/.clusterssh/config',
|
||||
)
|
||||
{
|
||||
$self->parse_config_file($config) if ( -e $config && !-d _ );
|
||||
$self->parse_config_file($config) if ( -e $config );
|
||||
}
|
||||
|
||||
# write out default config file if necesasry
|
||||
|
|
@ -330,22 +298,10 @@ sub load_configs {
|
|||
# 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 && !-d _ );
|
||||
$self->parse_config_file($config) if ( -e $config );
|
||||
|
||||
my $file = $ENV{HOME} . '/.clusterssh/config_' . $config;
|
||||
$self->parse_config_file($file) if ( -e $file && !-d _ );
|
||||
}
|
||||
|
||||
# Override confuration via environment variable using cssh_ prefix
|
||||
# eg: terminal_size => cssh_terminal_size
|
||||
foreach my $config_key ( sort( keys(%default_config) ) ) {
|
||||
my $env_config_key = "cssh_" . $config_key;
|
||||
if ( exists $ENV{ uc($env_config_key) } ) {
|
||||
$env_config_key = uc($env_config_key);
|
||||
}
|
||||
if ( exists $ENV{$env_config_key} ) {
|
||||
$self->{$config_key} = $ENV{$env_config_key};
|
||||
}
|
||||
$self->parse_config_file($file) if ( -e $file );
|
||||
}
|
||||
|
||||
return $self;
|
||||
|
|
@ -570,6 +526,18 @@ sub dump {
|
|||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ClusterSSH::Config - Object representing application configuration
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing application configuration
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
|
@ -610,3 +578,21 @@ are loaded).
|
|||
Write currently defined configuration to STDOUT
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright 1999-2016 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;
|
||||
|
|
|
|||
|
|
@ -1,22 +1,15 @@
|
|||
package App::ClusterSSH::Getopt;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package App::ClusterSSH::Getopt;
|
||||
|
||||
# ABSTRACT: App::ClusterSSH::Getopt - module to process command line args
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing application configuration
|
||||
|
||||
=cut
|
||||
use version;
|
||||
our $VERSION = version->new('0.01');
|
||||
|
||||
use Carp;
|
||||
use Try::Tiny;
|
||||
use Pod::Usage;
|
||||
use Getopt::Long 2.48 qw(:config no_ignore_case bundling no_auto_abbrev);
|
||||
use Getopt::Long qw(:config no_ignore_case bundling no_auto_abbrev);
|
||||
use FindBin qw($Script);
|
||||
|
||||
use base qw/ App::ClusterSSH::Base /;
|
||||
|
|
@ -95,7 +88,7 @@ sub add_option {
|
|||
}
|
||||
$desc .= " $arg" if ($arg);
|
||||
$short .= " $arg" if ( $short && $arg );
|
||||
$long .= " $arg" if ( $long && $arg );
|
||||
$long .= " $arg" if ( $long && $arg );
|
||||
}
|
||||
$args{option_desc} = $desc;
|
||||
$args{option_short} = $short;
|
||||
|
|
@ -152,7 +145,7 @@ sub add_common_options {
|
|||
$self->add_option(
|
||||
spec => 'autoquit|q',
|
||||
help => $self->loc(
|
||||
'Toggle automatically quitting after the last client window has closed (overriding the config file).'
|
||||
'Toggle automatically quiting after the last client window has closed (overriding the config file).'
|
||||
),
|
||||
);
|
||||
$self->add_option(
|
||||
|
|
@ -426,7 +419,7 @@ sub output {
|
|||
sub _generate_pod {
|
||||
my ($self) = @_;
|
||||
|
||||
output $/, "=pod";
|
||||
output $/ , "=pod";
|
||||
output '=head1 ', $self->loc('NAME');
|
||||
output "$Script - ", $self->loc("Cluster administration tool");
|
||||
output '=head1 ', $self->loc('VERSION');
|
||||
|
|
@ -446,28 +439,6 @@ sub _generate_pod {
|
|||
}
|
||||
print $/, $/;
|
||||
|
||||
output '=head1 ', $self->loc('RELATED');
|
||||
output $self->loc(
|
||||
q{Also see the individual man pages for each of these utilities});
|
||||
|
||||
my %utils = (
|
||||
ctel => 'telnet',
|
||||
cssh => 'ssh',
|
||||
crsh => 'rsh',
|
||||
csftp => 'sftp',
|
||||
ccon => 'console',
|
||||
);
|
||||
|
||||
output '=over';
|
||||
|
||||
for my $util ( sort grep { !/$Script/ } keys %utils ) {
|
||||
output "=item $util - "
|
||||
. $self->loc( q{Use '[_1]' as the communication method},
|
||||
$utils{$util} );
|
||||
}
|
||||
|
||||
output '=back';
|
||||
|
||||
output '=head1 ', $self->loc('DESCRIPTION');
|
||||
output $self->loc(
|
||||
q{The command opens an administration console and an xterm to all specified hosts. Any text typed into the administration console is replicated to all windows. All windows may also be typed into directly.
|
||||
|
|
@ -581,14 +552,6 @@ would replace the <Alt-n> with the client's name in each window.}
|
|||
output $self->loc(q{Retile all the client windows.});
|
||||
output '=item ', $self->parent->config->{key_username};
|
||||
output $self->loc(q{Paste in the username for the connection});
|
||||
output '=item ', $self->parent->config->{key_user_1} || 'Alt-1';
|
||||
output '=item ', $self->parent->config->{key_user_2} || 'Alt-2';
|
||||
output '=item ', $self->parent->config->{key_user_3} || 'Alt-3';
|
||||
output '=item ', $self->parent->config->{key_user_4} || 'Alt-4';
|
||||
output $self->loc(
|
||||
q{Run the matching user defined macro on the server and send the output to the client}
|
||||
);
|
||||
|
||||
output '=back';
|
||||
|
||||
output '=head1 ' . $self->loc('EXAMPLES');
|
||||
|
|
@ -702,18 +665,6 @@ would replace the <Alt-n> with the client's name in each window.}
|
|||
'Enable or disable alternative algorithm for calculating terminal positioning.',
|
||||
);
|
||||
|
||||
output '=item command_pre =';
|
||||
output '=item command_post =';
|
||||
output $self->loc(
|
||||
q{Add extra commands around the communication method. For example:
|
||||
|
||||
command_pre= . $HOME/virtualenvs/default/bin/active ;
|
||||
command_post= | ct
|
||||
|
||||
would allow for using Python virtual envronments and then piping all shell output through C<chromaterm> for syntax highlighting. Note: you must use appropriate command separators/terminators to keep the meaning of the command pipline (such as C<;> and C<|> between commands).
|
||||
|
||||
These are not put through macro parsing.}
|
||||
);
|
||||
output '=item comms = ' . $self->parent->config->{comms};
|
||||
output $self->loc(
|
||||
'Sets the default communication method (initially taken from the name of the program, but can be overridden here).'
|
||||
|
|
@ -736,7 +687,7 @@ Commands:
|
|||
C<< open <tag|hostname> >> - open new sessions to provided tag or hostname
|
||||
|
||||
C<< retile >> - force window retiling
|
||||
|
||||
|
||||
e.g.: C<< echo 'open localhost' >> /path/to/external_command_pipe >>}
|
||||
);
|
||||
|
||||
|
|
@ -810,64 +761,15 @@ If the external command is given a C<-L> option it should output a list of tags
|
|||
'L<KEY SHORTCUTS>'
|
||||
);
|
||||
|
||||
output '=item key_user_1 = Alt-1';
|
||||
output '=item key_user_2 = Alt-2';
|
||||
output '=item key_user_3 = Alt-3';
|
||||
output '=item key_user_4 = Alt-4';
|
||||
output $self->loc(
|
||||
q{Default key sequence to send user defined macros to client. If the matching [_2] macro is undefined, the sequence is passed straight to the terminal. See [_1] for more information.},
|
||||
'L<KEY SHORTCUTS>',
|
||||
'L<macro_user_1>'
|
||||
);
|
||||
|
||||
output '=item macro_servername = %s';
|
||||
output '=item macro_hostname = %h';
|
||||
output '=item macro_username = %u';
|
||||
output '=item macro_newline = %n';
|
||||
output '=item macro_version = %v';
|
||||
output '=item macro_user_1 = %1';
|
||||
output '=item macro_user_2 = %2';
|
||||
output '=item macro_user_3 = %3';
|
||||
output '=item macro_user_4 = %4';
|
||||
output $self->loc(
|
||||
q{Change the replacement macro used when either using a 'Send' menu item, or when pasting text into the main console.}
|
||||
);
|
||||
|
||||
output '=item macro_user_1_command =';
|
||||
output '=item macro_user_2_command =';
|
||||
output '=item macro_user_3_command =';
|
||||
output '=item macro_user_4_command =';
|
||||
|
||||
output $self->loc(
|
||||
q{User defined macros - the macro is run through the shell on the server and the output is sent to the client. For example,},
|
||||
);
|
||||
|
||||
output "C<macro_user_1_command=echo echo macro_user_1>";
|
||||
output $self->loc(
|
||||
q{
|
||||
would send the text [_1] into the terminal session.
|
||||
},
|
||||
'C<echo macro_user_1>'
|
||||
);
|
||||
output "C<macro_user_1_command=env | grep CSSH>";
|
||||
output $self->loc(
|
||||
q{
|
||||
would send the CSSH environment variables to the client.
|
||||
},
|
||||
);
|
||||
|
||||
output $self->loc(
|
||||
"The following environment variables are set in the shell of the macro process"
|
||||
);
|
||||
output '=over';
|
||||
output '=item C<CSSH_SERVERNAME>';
|
||||
output '=item C<CSSH_HOSTNAME>';
|
||||
output '=item C<CSSH_USERNAME>';
|
||||
output '=item C<CSSH_CONNECTION_STRING>';
|
||||
output '=item C<CSSH_CONNECTION_PORT>';
|
||||
output '=item C<CSSH_VERSION>';
|
||||
output '=back';
|
||||
|
||||
output '=item macros_enabled = yes';
|
||||
output $self->loc(
|
||||
q{Enable or disable macro replacement. Note: this affects all the [_1] variables above.},
|
||||
|
|
@ -1112,8 +1014,9 @@ B<NOTE:> Any "generic" change to the method (e.g., specifying the ssh port to us
|
|||
);
|
||||
output '=back';
|
||||
|
||||
output '=head1 ', $self->loc('TROUBLESHOOTING');
|
||||
|
||||
output '=head1 ', $self->loc('REPORTING BUGS');
|
||||
output '=over';
|
||||
output '=item *';
|
||||
output $self->loc(
|
||||
q{If you have issues running [_1], first try:
|
||||
|
||||
|
|
@ -1134,16 +1037,16 @@ This performs two tests to confirm cssh is able to work properly with the settin
|
|||
$self->parent->config->{comms} );
|
||||
output '=back';
|
||||
|
||||
output $self->loc(q{Configuration options to watch for in ssh are:});
|
||||
output $self->loc(q{Configuration options to watch for in ssh are});
|
||||
output '=over';
|
||||
output '=item *';
|
||||
output $self->loc(
|
||||
output '=item ',
|
||||
$self->loc(
|
||||
q{SSH doesn't understand [_1] - remove the option from the [_2] file},
|
||||
'C<-o ConnectTimeout=10>',
|
||||
'F<$HOME/.clusterssh/config>'
|
||||
);
|
||||
output '=item *';
|
||||
output $self->loc(
|
||||
);
|
||||
output '=item ',
|
||||
$self->loc(
|
||||
q{OpenSSH-3.8 using untrusted ssh tunnels - use [_1] instead of [_2] or use [_3] in [_4] (if you change the default ssh options from [_5] to [_6])},
|
||||
'C<-Y>',
|
||||
'C<-X>',
|
||||
|
|
@ -1151,19 +1054,12 @@ This performs two tests to confirm cssh is able to work properly with the settin
|
|||
'F<$HOME/.ssh/ssh_config>',
|
||||
'C<-x>',
|
||||
'C<-X>'
|
||||
);
|
||||
);
|
||||
output '=back';
|
||||
|
||||
output '=head1 ', $self->loc('SUPPORT AND REPORTING BUGS');
|
||||
|
||||
output '=item *';
|
||||
output $self->loc(
|
||||
q{A web site for comments, requests, bug reports and bug fixes/patches is available at: [_1]},
|
||||
'L<https://github.com/duncs/clusterssh>'
|
||||
);
|
||||
|
||||
output $self->loc(
|
||||
q{If you require support, please run the following commands and create an issue via: [_1]},
|
||||
'L<https://github.com/duncs/clusterssh/issues>',
|
||||
q{If you require support, please run the following commands and post it on the web site in the support/problems forum:}
|
||||
);
|
||||
output 'C<< perl -V >>';
|
||||
output q{C<< perl -MTk -e 'print $Tk::VERSION,$/' >>};
|
||||
|
|
@ -1171,27 +1067,35 @@ This performs two tests to confirm cssh is able to work properly with the settin
|
|||
q{C<< perl -MX11::Protocol -e 'print $X11::Protocol::VERSION,$/' >>};
|
||||
output 'C<< cat /etc/csshrc $HOME/.clusterssh/config >>';
|
||||
|
||||
output '=item *';
|
||||
output $self->loc(
|
||||
q{Using the debug option (--debug) will turn on debugging output. Repeat the option to increase the amount of debug. However, if possible please only use this option with one host at a time, e.g. [_1] due to the amount of output produced (in both main and child windows).},
|
||||
'C<< cssh --debug <host> >>'
|
||||
);
|
||||
output '=back';
|
||||
|
||||
output '=head1 ', $self->loc('SEE ALSO');
|
||||
output $self->loc(
|
||||
q{L<https://github.com/duncs/clusterssh/wiki/>,
|
||||
q{L<http://clusterssh.sourceforge.net/>,
|
||||
C<ssh>,
|
||||
L<Tk::overview>,
|
||||
L<X11::Protocol>,
|
||||
C<perl>}
|
||||
);
|
||||
|
||||
output '=head1 ', $self->loc('CREDITS');
|
||||
output $self->loc(
|
||||
'A web site for comments, requests, bug reports and bug fixes/patches is available at: [_1]',
|
||||
'L<https://github.com/duncs/clusterssh>'
|
||||
);
|
||||
|
||||
output '=head1 ', $self->loc('AUTHOR');
|
||||
output 'Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>';
|
||||
|
||||
output '=head1 ', $self->loc('LICENSE AND COPYRIGHT');
|
||||
output $self->loc(
|
||||
q{
|
||||
Copyright 1999-2018 Duncan Ferguson.
|
||||
Copyright 1999-2016 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.
|
||||
|
||||
|
|
@ -1204,6 +1108,20 @@ See http://dev.perl.org/licenses/ for more information.
|
|||
|
||||
1;
|
||||
|
||||
__DATA__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
App::ClusterSSH::Getopt - module to process command line args
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing application configuration
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
|
@ -1218,17 +1136,17 @@ Add extra options into the allowed set for parsing from the command line
|
|||
|
||||
=item $obj=ClusterSSH::Getopts->add_common_options ({ })
|
||||
|
||||
Add common options used by most calling scripts into the allowed set for
|
||||
Add common options used by most calling scripts into the allowed set for
|
||||
parsing from the command line
|
||||
|
||||
=item $obj=ClusterSSH::Getopts->add_common_session_options ({ })
|
||||
|
||||
Add common session options used by most calling scripts into the allowed
|
||||
Add common session options used by most calling scripts into the allowed
|
||||
set for parsing from the command line
|
||||
|
||||
=item $obj=ClusterSSH::Getopts->add_common_ssh_options ({ })
|
||||
|
||||
Add common ssh options used by most calling scripts into the allowed
|
||||
Add common ssh options used by most calling scripts into the allowed
|
||||
set for parsing from the command line
|
||||
|
||||
=item $obj->getopts
|
||||
|
|
@ -1247,3 +1165,21 @@ Simple helper func to print out pod lines with double returns
|
|||
Functions to output help and usage instructions
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright 1999-2016 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;
|
||||
|
|
|
|||
|
|
@ -1,17 +1,10 @@
|
|||
package App::ClusterSSH::Helper;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package App::ClusterSSH::Helper;
|
||||
|
||||
# ABSTRACT: ClusterSSH::Helper - Object representing helper script
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing application configuration
|
||||
|
||||
=cut
|
||||
use version;
|
||||
our $VERSION = version->new('0.02');
|
||||
|
||||
use Carp;
|
||||
use Try::Tiny;
|
||||
|
|
@ -52,8 +45,6 @@ sub script {
|
|||
}
|
||||
}
|
||||
|
||||
my $command_pre = $config->{command_pre} || q{};
|
||||
my $command_post = $config->{command_post} || q{};
|
||||
my $comms = $config->{ $config->{comms} };
|
||||
my $comms_args = $config->{ $config->{comms} . '_args' };
|
||||
my $config_command = $config->{command};
|
||||
|
|
@ -71,9 +62,9 @@ sub script {
|
|||
my \$user=shift;
|
||||
my \$port=shift;
|
||||
my \$mstr=shift;
|
||||
my \$command="$command_pre $comms $comms_args ";
|
||||
my \$command="$comms $comms_args ";
|
||||
open(PIPE, ">", \$pipe) or die("Failed to open pipe: \$!\\n");
|
||||
print PIPE "\$\$:\$ENV{WINDOWID}"
|
||||
print PIPE "\$\$:\$ENV{WINDOWID}"
|
||||
or die("Failed to write to pipe: $!\\n");
|
||||
close(PIPE) or die("Failed to close pipe: $!\\n");
|
||||
if(\$svr =~ m/==\$/)
|
||||
|
|
@ -107,7 +98,6 @@ sub script {
|
|||
if("$config_command") {
|
||||
\$command .= " \\\"$config_command\\\"";
|
||||
}
|
||||
\$command .= "$command_post";
|
||||
\$command .= " ; $postcommand";
|
||||
# provide some info for debugging purposes
|
||||
warn("Running: \$command\\n");
|
||||
|
|
@ -130,6 +120,18 @@ sub script {
|
|||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ClusterSSH::Helper - Object representing helper script
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing application configuration
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
|
@ -143,3 +145,21 @@ Create a new helper object.
|
|||
Return the helper script
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright 1999-2016 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;
|
||||
|
|
|
|||
|
|
@ -1,25 +1,10 @@
|
|||
package App::ClusterSSH::Host;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package App::ClusterSSH::Host;
|
||||
|
||||
# ABSTRACT: ClusterSSH::Host - Object representing a host.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ClusterSSH::Host;
|
||||
|
||||
my $host = ClusterSSH::Host->new({
|
||||
hostname => 'hostname',
|
||||
});
|
||||
my $host = ClusterSSH::Host->parse_host_string('username@hostname:1234');
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing a host. Include details to contact the host such as
|
||||
hostname/ipaddress, username and port.
|
||||
|
||||
=cut
|
||||
use version;
|
||||
our $VERSION = version->new('0.03');
|
||||
|
||||
use Carp;
|
||||
use Net::hostent;
|
||||
|
|
@ -343,6 +328,26 @@ use overload (
|
|||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ClusterSSH::Host - Object representing a host.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use ClusterSSH::Host;
|
||||
|
||||
my $host = ClusterSSH::Host->new({
|
||||
hostname => 'hostname',
|
||||
});
|
||||
my $host = ClusterSSH::Host->parse_host_string('username@hostname:1234');
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Object representing a host. Include details to contact the host such as
|
||||
hostname/ipaddress, username and port.
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
|
@ -381,7 +386,7 @@ Set specific details about the host after its been created.
|
|||
=item get_realname
|
||||
|
||||
If the server name provided is not an IP address (either IPv4 or IPv6)
|
||||
attempt to resolve it and return the discovered names.
|
||||
attempt to resolve it and retun the discovered names.
|
||||
|
||||
=item get_givenname
|
||||
|
||||
|
|
@ -426,3 +431,21 @@ the IPv6 address or a port definition?) and assumes it is part of address.
|
|||
Use brackets to avoid seeing warning.
|
||||
|
||||
=back
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright 1999-2016 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;
|
||||
|
|
|
|||
|
|
@ -1,9 +1,22 @@
|
|||
package App::ClusterSSH::L10N;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
package App::ClusterSSH::L10N;
|
||||
use Locale::Maketext 1.01;
|
||||
use base qw(Locale::Maketext);
|
||||
|
||||
# ABSTRACT: ClusterSSH::L10N - Base translations module
|
||||
# This projects primary language is English
|
||||
|
||||
our %Lexicon = ( '_AUTO' => 1, );
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
ClusterSSH::L10N - Base translations module
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
|
@ -22,13 +35,20 @@ NOTE: the default language of this module is English.
|
|||
|
||||
See Locale::Maketext - there are currently no extra methods in this module.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright 1999-2016 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
|
||||
|
||||
use Locale::Maketext 1.01;
|
||||
use base qw(Locale::Maketext);
|
||||
|
||||
# This projects primary language is English
|
||||
|
||||
our %Lexicon = ( '_AUTO' => 1, );
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -1,6 +1,15 @@
|
|||
package App::ClusterSSH::L10N::en;
|
||||
use base 'App::ClusterSSH::L10N';
|
||||
|
||||
# ABSTRACT: App::ClusterSSH::L10N::en - Base English translations module
|
||||
%Lexicon = ( '_AUTO' => 1, );
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
App::ClusterSSH::L10N::en - Base English translations module
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
|
|
@ -13,14 +22,24 @@ package App::ClusterSSH::L10N::en;
|
|||
L<Locale::Maketext> based translation module for ClusterSSH. See
|
||||
L<Locale::Maketext> for more information and usage.
|
||||
|
||||
=cut
|
||||
|
||||
use base 'App::ClusterSSH::L10N';
|
||||
|
||||
%Lexicon = ( '_AUTO' => 1, );
|
||||
|
||||
1;
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
No method are exported. See L<Locale::Maketext>.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Duncan Ferguson, C<< <duncan_j_ferguson at yahoo.co.uk> >>
|
||||
|
||||
=head1 LICENSE AND COPYRIGHT
|
||||
|
||||
Copyright 1999-2016 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;
|
||||
|
|
|
|||
|
|
@ -1,68 +0,0 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
package App::ClusterSSH::Window;
|
||||
|
||||
# ABSTRACT: App::ClusterSSH::Window - Base obejct for different types of window module
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
Base object to allow for configuring and using different types of windows libraries
|
||||
|
||||
=cut
|
||||
|
||||
=head1 METHODS
|
||||
|
||||
=over 4
|
||||
|
||||
=cut
|
||||
|
||||
use Carp;
|
||||
|
||||
use base qw/ App::ClusterSSH::Base /;
|
||||
|
||||
# Module to contain window generic code and pull in specific code from
|
||||
# an appropriate module
|
||||
|
||||
sub import {
|
||||
my ($class) = @_;
|
||||
|
||||
# If we are building or in test here, just exit
|
||||
# as the build servers will not have Tk installed
|
||||
if ( $ENV{AUTHOR_TESTING} || $ENV{RELEASE_TESTING} ) {
|
||||
print STDERR
|
||||
"skipping initialisation; AUTHOR_TESTING or RELEASE_TESTING are set\n";
|
||||
return;
|
||||
}
|
||||
|
||||
# Find what windows module we should be using and just overlay it into
|
||||
# this object
|
||||
my $package_name = __PACKAGE__ . '::Tk';
|
||||
( my $package_path = $package_name ) =~ s{::}{/}g;
|
||||
require "$package_path.pm";
|
||||
$package_name->import();
|
||||
|
||||
{
|
||||
no strict 'refs';
|
||||
push @{ __PACKAGE__ . '::ISA' }, $package_name;
|
||||
}
|
||||
}
|
||||
|
||||
my %servers;
|
||||
|
||||
=item $obj = App::ClusterSSH::Window->new({});
|
||||
|
||||
Creates object
|
||||
|
||||
=back
|
||||
|
||||
=cut
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
my $self = $class->SUPER::new(%args);
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
1;
|
||||
File diff suppressed because it is too large
Load diff
109
t/02base.t
109
t/02base.t
|
|
@ -109,7 +109,6 @@ like(
|
|||
);
|
||||
|
||||
$base = undef;
|
||||
my $get_config;
|
||||
trap {
|
||||
$base = App::ClusterSSH::Base->new( debug => 7, );
|
||||
};
|
||||
|
|
@ -124,14 +123,9 @@ like(
|
|||
'got expected new() output'
|
||||
);
|
||||
|
||||
trap {
|
||||
$get_config = $base->config();
|
||||
};
|
||||
$trap->quiet("No issus with config call");
|
||||
is( $get_config, undef, "config set undef as expected" );
|
||||
|
||||
# config tests
|
||||
$base = undef;
|
||||
my $get_config;
|
||||
my $object;
|
||||
trap {
|
||||
$base = App::ClusterSSH::Base->new( debug => 3, );
|
||||
|
|
@ -246,104 +240,7 @@ trap {
|
|||
is( $trap->leaveby, 'die', 'died ok' );
|
||||
isa_ok( $trap->die, 'App::ClusterSSH::Exception',
|
||||
'Caught exception object OK' );
|
||||
is( $trap->die, q{"type" arg not passed}, 'missing type arg die message' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
|
||||
my $get_options;
|
||||
|
||||
$base = undef;
|
||||
trap {
|
||||
$base = App::ClusterSSH::Base->new( debug => 3 );
|
||||
};
|
||||
isa_ok( $base, 'App::ClusterSSH::Base' );
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $base->parent, undef, 'Expecting no parent set' );
|
||||
|
||||
trap {
|
||||
$get_options = $base->options();
|
||||
};
|
||||
$trap->quiet("No extra output");
|
||||
is( $get_options, undef, "options call correctly unset" );
|
||||
|
||||
$base = undef;
|
||||
trap {
|
||||
$base = App::ClusterSSH::Base->new( debug => 3, parent => 'guardian' );
|
||||
};
|
||||
isa_ok( $base, 'App::ClusterSSH::Base' );
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $base->parent, 'guardian', 'Expecting no STDOUT' );
|
||||
|
||||
trap {
|
||||
$get_options = $base->options();
|
||||
};
|
||||
$trap->quiet("No extra output");
|
||||
is( $get_options, undef, "options call correctly unset" );
|
||||
|
||||
$base = undef;
|
||||
trap {
|
||||
$base = App::ClusterSSH::Base->new(
|
||||
debug => 3,
|
||||
parent => { config => 'set', options => 'set' }
|
||||
);
|
||||
};
|
||||
isa_ok( $base, 'App::ClusterSSH::Base' );
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( ref( $base->parent ), 'HASH', 'Expecting no STDOUT' );
|
||||
is( $base->parent->{config}, 'set', 'Expecting no STDOUT' );
|
||||
|
||||
trap {
|
||||
$get_options = $base->options();
|
||||
};
|
||||
is( ref($get_options), '', "options call correctly set" );
|
||||
is( $get_options, 'set', "options call hash value correctly set" );
|
||||
$trap->quiet("No extra output");
|
||||
|
||||
my $sort;
|
||||
trap {
|
||||
$sort = $base->sort;
|
||||
};
|
||||
$trap->quiet("No errors getting 'sort'");
|
||||
|
||||
# NOTE: trap doesnt like passing code refs, so recreate here
|
||||
$sort = $base->sort;
|
||||
is( ref($sort), 'CODE', "got results from sort" );
|
||||
my @sorted = $sort->( 4, 8, 1, 5, 3 );
|
||||
my @expected = ( 1, 3, 4, 5, 8 );
|
||||
is_deeply( \@sorted, \@expected, "simple sort results okay" );
|
||||
|
||||
$base = undef;
|
||||
trap {
|
||||
$base = App::ClusterSSH::Base->new(
|
||||
debug => 3,
|
||||
parent => { config => { use_natural_sort => 1 }, options => 'set' }
|
||||
);
|
||||
};
|
||||
isa_ok( $base, 'App::ClusterSSH::Base' );
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
|
||||
trap {
|
||||
$sort = $base->sort;
|
||||
};
|
||||
|
||||
# May get an error here if Sort::Naturally is not installed
|
||||
# $trap->quiet("No errors getting 'sort'");
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
is( ref($sort), 'CODE', "got results from sort" );
|
||||
@sorted = $sort->( 4, 8, 1, 5, 3 );
|
||||
@expected = ( 1, 3, 4, 5, 8 );
|
||||
is_deeply( \@sorted, \@expected, "simple sort results okay" );
|
||||
is( $trap->die, q{"type" arg not passed}, 'missing type arg die message' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
|
||||
done_testing();
|
||||
|
|
|
|||
|
|
@ -188,7 +188,7 @@ is( $trap->stderr, '', 'Expecting no STDERR' );
|
|||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
is( $getopts->option1, 8, 'default value overridden' );
|
||||
|
||||
@ARGV = ( '--option1', '--option2', 'string', '--option3', '10' );
|
||||
@ARGV = ( '--option1', '--option2', 'string', '--option3', '10' );
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->add_option( spec => 'hidden', hidden => 1, no_acessor => 1, );
|
||||
|
|
@ -287,7 +287,7 @@ is( $trap->stderr, '', 'Expecting no STDERR' );
|
|||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
my $pod;
|
||||
@ARGV = ('--generate-pod');
|
||||
@ARGV = ('--generate-pod');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
$getopts->add_option(
|
||||
spec => 'long_opt|l=s',
|
||||
|
|
@ -295,7 +295,7 @@ $getopts->add_option(
|
|||
default => 'default string'
|
||||
);
|
||||
$getopts->add_option( spec => 'another_long_opt|n=i', );
|
||||
$getopts->add_option( spec => 'a=s', help => 'short option only', );
|
||||
$getopts->add_option( spec => 'a=s', help => 'short option only', );
|
||||
$getopts->add_option( spec => 'long', help => 'long option only', );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
|
|
@ -309,7 +309,7 @@ $pod = $trap->stdout;
|
|||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
@ARGV = ('--help');
|
||||
@ARGV = ('--help');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
|
|
@ -320,7 +320,7 @@ ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
|
|||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
@ARGV = ('-?');
|
||||
@ARGV = ('-?');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
|
|
@ -331,7 +331,7 @@ ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
|
|||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
@ARGV = ('-v');
|
||||
@ARGV = ('-v');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
|
|
@ -342,7 +342,7 @@ like( $trap->stdout, qr/^Version: /, 'Version string correct' );
|
|||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
@ARGV = ('-@');
|
||||
@ARGV = ('-@');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
|
|
@ -380,8 +380,8 @@ is( $mock_object->{show_history}, 0, 'show_history set right' );
|
|||
is( $mock_object->{use_all_a_records}, 1, 'use_all_a_records set right' );
|
||||
|
||||
@ARGV = (
|
||||
'--unique-servers', '--title', 'title', '-p', '22', '--autoquit',
|
||||
'--tile', '--show-history', '-A',
|
||||
'--unique-servers', '--title', 'title', '-p', '22', '--autoquit',
|
||||
'--tile', '--show-history', '-A',
|
||||
);
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object, );
|
||||
trap {
|
||||
|
|
@ -425,15 +425,4 @@ TODO: {
|
|||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
}
|
||||
|
||||
@ARGV = ( '--rows', 5, '--cols', 10 );
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object, );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
|
||||
$trap->did_return(" ... returned");
|
||||
$trap->quiet(" ... quietly");
|
||||
is( $mock_object->{cols}, 10, 'cols set correctly' );
|
||||
is( $mock_object->{rows}, 5, 'rows set correctly' );
|
||||
|
||||
done_testing;
|
||||
|
|
|
|||
|
|
@ -754,7 +754,7 @@ is( $trap->leaveby, 'return', 'returned ok' );
|
|||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stdout, '', 'No unexpected STDOUT' );
|
||||
isa_ok( $host, "App::ClusterSSH::Host" );
|
||||
is( $host, 'ssh_test', 'stringify works' );
|
||||
is( $host, 'ssh_test', 'stringify works' );
|
||||
is( $host->check_ssh_hostname, 0, 'check_ssh_hostname ok for ssh_test', );
|
||||
|
||||
trap {
|
||||
|
|
@ -767,9 +767,9 @@ is( $trap->leaveby, 'return', 'returned ok' );
|
|||
is( $trap->die, undef, 'returned ok' );
|
||||
is( $trap->stdout, '', 'No unexpected STDOUT' );
|
||||
isa_ok( $host, "App::ClusterSSH::Host" );
|
||||
is( $host, 'ssh_test', 'stringify works' );
|
||||
is( $host, 'ssh_test', 'stringify works' );
|
||||
is( $host->check_ssh_hostname, 0, 'check_ssh_hostname ok for ssh_test', );
|
||||
is( $host->get_type, q{}, 'hostname type is correct for ssh_test', );
|
||||
is( $host->get_type, q{}, 'hostname type is correct for ssh_test', );
|
||||
|
||||
for my $ssh_file (qw/ 10host_ssh_config 10host_ssh_include/) {
|
||||
my @hosts = (
|
||||
|
|
|
|||
42
t/15config.t
42
t/15config.t
|
|
@ -18,7 +18,7 @@ BEGIN {
|
|||
use Test::More;
|
||||
use Test::Trap;
|
||||
use File::Which qw(which);
|
||||
use File::Temp qw(tempdir);
|
||||
use File::Temp qw(tempdir);
|
||||
use Test::Differences;
|
||||
|
||||
use Readonly;
|
||||
|
|
@ -52,10 +52,6 @@ Readonly::Hash my %default_config => {
|
|||
key_macros_enable => "Alt-p",
|
||||
key_paste => "Control-v",
|
||||
key_username => "Alt-u",
|
||||
key_user_1 => "Alt-1",
|
||||
key_user_2 => "Alt-2",
|
||||
key_user_3 => "Alt-3",
|
||||
key_user_4 => "Alt-4",
|
||||
mouse_paste => "Button-2",
|
||||
auto_quit => "yes",
|
||||
auto_close => 5,
|
||||
|
|
@ -101,11 +97,7 @@ Readonly::Hash my %default_config => {
|
|||
history_width => 40,
|
||||
history_height => 10,
|
||||
|
||||
hostname_override => '',
|
||||
|
||||
command => q{},
|
||||
command_pre => q{},
|
||||
command_post => q{},
|
||||
title => q{15CONFIG.T},
|
||||
comms => q{ssh},
|
||||
hide_menu => 0,
|
||||
|
|
@ -117,15 +109,6 @@ Readonly::Hash my %default_config => {
|
|||
macro_username => '%u',
|
||||
macro_newline => '%n',
|
||||
macro_version => '%v',
|
||||
macro_user_1 => '%1',
|
||||
macro_user_2 => '%2',
|
||||
macro_user_3 => '%3',
|
||||
macro_user_4 => '%4',
|
||||
|
||||
macro_user_1_command => '',
|
||||
macro_user_2_command => '',
|
||||
macro_user_3_command => '',
|
||||
macro_user_4_command => '',
|
||||
|
||||
max_addhost_menu_cluster_items => 6,
|
||||
menu_send_autotearoff => 0,
|
||||
|
|
@ -205,9 +188,6 @@ $expected{screen_reserve_left} = 100;
|
|||
$expected{screen_reserve_right} = 100;
|
||||
$expected{screen_reserve_top} = 100;
|
||||
$expected{screen_reserve_bottom} = 160;
|
||||
|
||||
# Note: the parse_config here removes the key_user_x entries
|
||||
delete( $expected{"key_user_$_"} ) for (qw/ 1 2 3 4 /);
|
||||
trap {
|
||||
$config = $config->parse_config_file( $file, );
|
||||
};
|
||||
|
|
@ -348,9 +328,6 @@ open( my $csshrc, '>', $ENV{HOME} . '/.csshrc' );
|
|||
print $csshrc 'auto_quit = no', $/;
|
||||
close($csshrc);
|
||||
$expected{auto_quit} = 'no';
|
||||
|
||||
# Note: the load_configs here removes the key_user_x entries
|
||||
delete( $expected{"key_user_$_"} ) for (qw/ 1 2 3 4 /);
|
||||
$config = App::ClusterSSH::Config->new();
|
||||
trap {
|
||||
$config->load_configs();
|
||||
|
|
@ -537,7 +514,7 @@ SKIP: {
|
|||
chmod( 0755, $ENV{HOME} . '/.csshrc.DISABLED', $ENV{HOME} );
|
||||
}
|
||||
|
||||
note('check failure to write default config is caught when loading config');
|
||||
note('check failure to write default config is caught');
|
||||
$ENV{HOME} = tempdir( CLEANUP => 1 );
|
||||
mkdir( $ENV{HOME} . '/.clusterssh' );
|
||||
mkdir( $ENV{HOME} . '/.clusterssh/config' );
|
||||
|
|
@ -568,8 +545,6 @@ auto_close=5
|
|||
auto_quit=yes
|
||||
auto_wm_decoration_offsets=no
|
||||
cols=-1
|
||||
command_post=
|
||||
command_pre=
|
||||
console=console
|
||||
console_args=
|
||||
console_position=
|
||||
|
|
@ -582,7 +557,6 @@ fillscreen=no
|
|||
hide_menu=0
|
||||
history_height=10
|
||||
history_width=40
|
||||
hostname_override=
|
||||
key_addhost=Control-Shift-plus
|
||||
key_clientname=Alt-n
|
||||
key_history=Alt-h
|
||||
|
|
@ -591,23 +565,11 @@ key_macros_enable=Alt-p
|
|||
key_paste=Control-v
|
||||
key_quit=Alt-q
|
||||
key_retilehosts=Alt-r
|
||||
key_user_1=Alt-1
|
||||
key_user_2=Alt-2
|
||||
key_user_3=Alt-3
|
||||
key_user_4=Alt-4
|
||||
key_username=Alt-u
|
||||
lang=en
|
||||
macro_hostname=%h
|
||||
macro_newline=%n
|
||||
macro_servername=%s
|
||||
macro_user_1=%1
|
||||
macro_user_1_command=
|
||||
macro_user_2=%2
|
||||
macro_user_2_command=
|
||||
macro_user_3=%3
|
||||
macro_user_3_command=
|
||||
macro_user_4=%4
|
||||
macro_user_4_command=
|
||||
macro_username=%u
|
||||
macro_version=%v
|
||||
macros_enabled=yes
|
||||
|
|
|
|||
|
|
@ -16,10 +16,6 @@ key_paste=Control-v
|
|||
key_quit=Control-q
|
||||
key_retilehosts=Alt-r
|
||||
key_username=Alt-n
|
||||
key_user_1=Alt-1
|
||||
key_user_2=Alt-2
|
||||
key_user_3=Alt-3
|
||||
key_user_4=Alt-4
|
||||
max_host_menu_items=30
|
||||
method=ssh
|
||||
mouse_paste=Button-2
|
||||
|
|
|
|||
|
|
@ -12,7 +12,7 @@ use lib "$Bin/../lib";
|
|||
use Test::More;
|
||||
use Test::Trap;
|
||||
use File::Which qw(which);
|
||||
use File::Temp qw(tempdir);
|
||||
use File::Temp qw(tempdir);
|
||||
|
||||
use Readonly;
|
||||
|
||||
|
|
@ -81,7 +81,7 @@ trap {
|
|||
is( $trap->leaveby, 'die', 'returned ok' );
|
||||
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, q{}, 'Expecting no STDERR' );
|
||||
is( $trap->die, q{Config 'method_args' not provided}, 'missing arg' );
|
||||
is( $trap->die, q{Config 'method_args' not provided}, 'missing arg' );
|
||||
|
||||
$mock_config->{method_args} = 'rubbish';
|
||||
$mock_config->{command} = 'echo';
|
||||
|
|
|
|||
|
|
@ -84,23 +84,21 @@ isa_ok( $cluster1, 'App::ClusterSSH::Cluster' );
|
|||
|
||||
# no point running this test as root since root cannot be blocked
|
||||
# from accessing the file
|
||||
TODO: {
|
||||
if ( $EUID != 0 ) {
|
||||
my $no_read = $Bin . '/30cluster.cannot_read';
|
||||
chmod 0000, $no_read;
|
||||
trap {
|
||||
$cluster1->read_cluster_file($no_read);
|
||||
};
|
||||
chmod 0644, $no_read;
|
||||
isa_ok( $trap->die, 'App::ClusterSSH::Exception::LoadFile' );
|
||||
is( $trap->die,
|
||||
"Unable to read file $no_read: Permission denied",
|
||||
'Error on reading an existing file ok'
|
||||
);
|
||||
}
|
||||
else {
|
||||
pass('Cannot test for lack of read access when run as root');
|
||||
}
|
||||
if ( $EUID != 0 ) {
|
||||
my $no_read = $Bin . '/30cluster.cannot_read';
|
||||
chmod 0000, $no_read;
|
||||
trap {
|
||||
$cluster1->read_cluster_file($no_read);
|
||||
};
|
||||
chmod 0644, $no_read;
|
||||
isa_ok( $trap->die, 'App::ClusterSSH::Exception::LoadFile' );
|
||||
is( $trap->die,
|
||||
"Unable to read file $no_read: Permission denied",
|
||||
'Error on reading an existing file ok'
|
||||
);
|
||||
}
|
||||
else {
|
||||
pass('Cannot test for lack of read access when run as root');
|
||||
}
|
||||
|
||||
$expected{tag1} = ['host1'];
|
||||
|
|
|
|||
|
|
@ -29,24 +29,4 @@ $app = App::ClusterSSH->new();
|
|||
isa_ok( $app, 'App::ClusterSSH' );
|
||||
isa_ok( $app->config, 'App::ClusterSSH::Config' );
|
||||
|
||||
for my $submod (qw/ cluster helper options window /) {
|
||||
trap {
|
||||
$app->$submod;
|
||||
};
|
||||
$trap->quiet("$submod loaded okay");
|
||||
}
|
||||
|
||||
trap {
|
||||
$app->exit_prog;
|
||||
};
|
||||
$trap->quiet("No errors from exit_prog call");
|
||||
|
||||
my @provided = (qw/ one one one two two three four four four /);
|
||||
my @expected = sort (qw/ one two three four /);
|
||||
my @got;
|
||||
trap {
|
||||
@got = sort $app->remove_repeated_servers(@provided);
|
||||
};
|
||||
is_deeply( \@got, \@expected, "Repeated servers removed okay" );
|
||||
|
||||
done_testing();
|
||||
|
|
|
|||
|
|
@ -3,6 +3,6 @@
|
|||
# small 'fake' script to allow xterm to be found when performing tests
|
||||
# on systems that do not have it
|
||||
|
||||
warn "$_=$ENV{$_}", $/ for ( sort keys %ENV ) if ( $ENV{TEST_VERBOSE} );
|
||||
warn "$_=$ENV{$_}",$/ for (sort keys %ENV) if ( $ENV{TEST_VERBOSE} );;
|
||||
|
||||
exit 0
|
||||
|
|
|
|||
|
|
@ -1,9 +1,4 @@
|
|||
use Test::More;
|
||||
|
||||
unless ( $ENV{RELEASE_TESTING} ) {
|
||||
plan( skip_all => "Author tests not required for installation" );
|
||||
}
|
||||
|
||||
eval 'use Test::CPAN::Changes';
|
||||
plan skip_all => 'Test::CPAN::Changes required for this test' if $@;
|
||||
changes_ok();
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@ if ( $opt->{x} ) {
|
|||
|
||||
# '-L' means list out available tags
|
||||
if ( $opt->{L} ) {
|
||||
print join( ' ', sort keys %tag_lookup ), $/;
|
||||
print join(' ', sort keys %tag_lookup), $/;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
|
|
|
|||
11
t/manifest.t
Normal file
11
t/manifest.t
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
use Test::More;
|
||||
|
||||
# This is the common idiom for author test modules like this, but see
|
||||
# the full example in examples/checkmanifest.t and, more importantly,
|
||||
# Adam Kennedy's article: http://use.perl.org/~Alias/journal/38822
|
||||
eval 'use Test::DistManifest';
|
||||
if ($@) {
|
||||
plan skip_all => 'Test::DistManifest required to test MANIFEST';
|
||||
}
|
||||
|
||||
manifest_ok( 'MANIFEST', 'MANIFEST.SKIP' );
|
||||
16
t/perltidy.t
Normal file
16
t/perltidy.t
Normal file
|
|
@ -0,0 +1,16 @@
|
|||
#!perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Test::More;
|
||||
use FindBin qw($Bin);
|
||||
|
||||
eval "use Test::PerlTidy";
|
||||
plan skip_all => "Test::PerlTidy required for testing code" if $@;
|
||||
|
||||
# Please see t/perltidyrc for the authors normal perltidy options
|
||||
|
||||
run_tests(
|
||||
perltidyrc => $Bin . '/perltidyrc',
|
||||
exclude => [ '_build/', 'blib/', 'Makefile.PL', ]
|
||||
);
|
||||
|
|
@ -2,10 +2,18 @@ use strict;
|
|||
use warnings;
|
||||
use Test::More;
|
||||
|
||||
eval "use Test::Pod::Coverage 1.00";
|
||||
plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage"
|
||||
# Ensure a recent version of Test::Pod::Coverage
|
||||
my $min_tpc = 1.08;
|
||||
eval "use Test::Pod::Coverage $min_tpc";
|
||||
plan skip_all =>
|
||||
"Test::Pod::Coverage $min_tpc required for testing POD coverage"
|
||||
if $@;
|
||||
|
||||
plan skip_all => "Skipping coverage tests" unless $ENV{COVERAGE};
|
||||
# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version,
|
||||
# but older versions don't recognize some common documentation styles
|
||||
my $min_pc = 0.18;
|
||||
eval "use Pod::Coverage $min_pc";
|
||||
plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage"
|
||||
if $@;
|
||||
|
||||
all_pod_coverage_ok();
|
||||
|
|
|
|||
29
t/range.t
29
t/range.t
|
|
@ -2,9 +2,6 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin qw($Bin);
|
||||
use lib "$Bin/../lib";
|
||||
|
||||
use Test::More;
|
||||
use Test::Trap;
|
||||
use Data::Dump;
|
||||
|
|
@ -13,19 +10,19 @@ require_ok('App::ClusterSSH::Range')
|
|||
|| BAIL_OUT('Failed to use App::ClusterSSH::Range');
|
||||
|
||||
my %tests = (
|
||||
'a' => 'a',
|
||||
'c{a,b}' => 'ca cb',
|
||||
'd{a,b,c}' => 'da db dc',
|
||||
'e{0}' => 'e0',
|
||||
'f{0..3}' => 'f0 f1 f2 f3',
|
||||
'g{0..2,4}' => 'g0 g1 g2 g4',
|
||||
'h{0..2,4..6}' => 'h0 h1 h2 h4 h5 h6',
|
||||
'i{0..1,a}' => 'i0 i1 ia',
|
||||
'j{0..2,a,b,c}' => 'j0 j1 j2 ja jb jc',
|
||||
'k{4..6,a..c}' => 'k4 k5 k6 ka kb kc',
|
||||
'l{0..2,7..9,e..g}' => 'l0 l1 l2 l7 l8 l9 le lf lg',
|
||||
'm{0,1}' => 'm0 m1',
|
||||
'n0..2}' => 'n0..2}',
|
||||
'a' => 'a',
|
||||
'c{a,b}' => 'ca cb',
|
||||
'd{a,b,c}' => 'da db dc',
|
||||
'e{0}' => 'e0',
|
||||
'f{0..3}' => 'f0 f1 f2 f3',
|
||||
'g{0..2,4}' => 'g0 g1 g2 g4',
|
||||
'h{0..2,4..6}' => 'h0 h1 h2 h4 h5 h6',
|
||||
'i{0..1,a}' => 'i0 i1 ia',
|
||||
'j{0..2,a,b,c}' => 'j0 j1 j2 ja jb jc',
|
||||
'k{4..6,a..c}' => 'k4 k5 k6 ka kb kc',
|
||||
'l{0..2,7..9,e..g}' => 'l0 l1 l2 l7 l8 l9 le lf lg',
|
||||
'm{0,1}' => 'm0 m1',
|
||||
'n0..2}' => 'n0..2}',
|
||||
'host{a,b}-test{1,2}' =>
|
||||
'hosta-test1 hosta-test2 hostb-test1 hostb-test2',
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue