mirror of
https://github.com/duncs/clusterssh.git
synced 2025-07-02 01:21:14 +00:00
Merge branch 'getopt'
This commit is contained in:
Duncan Ferguson
commit
d424b59228
29 changed files with 2353 additions and 1377 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -6,6 +6,7 @@ MYMETA.json
|
|||
MYMETA.yml
|
||||
Makefile
|
||||
_build/
|
||||
bin
|
||||
blib/
|
||||
cover_db/
|
||||
pm_to_blib
|
||||
|
|
|
|||
8
Build.PL
8
Build.PL
|
|
@ -1,11 +1,14 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
use Cwd;
|
||||
|
||||
use Module::Build;
|
||||
|
||||
my $class = Module::Build->subclass(
|
||||
class => "Module::Build::Custom",
|
||||
code => q{
|
||||
use File::Slurp;
|
||||
|
||||
sub ACTION_email {
|
||||
my ($self, @args) = @_;
|
||||
|
||||
|
|
@ -39,6 +42,7 @@ SF release: http://sourceforge.net/projects/clusterssh/files/2.%20ClusterSSH%20S
|
|||
SF/net git repo: https://sourceforge.net/scm/?type=git&group_id=89139
|
||||
==========
|
||||
EOF
|
||||
return $self;
|
||||
}
|
||||
},
|
||||
);
|
||||
|
|
@ -76,12 +80,16 @@ my $build = $class->new(
|
|||
'Test::DistManifest' => 0,
|
||||
'Test::Differences' => 0,
|
||||
'CPAN::Changes' => 0.27,
|
||||
'File::Slurp' => 0,
|
||||
},
|
||||
configure_requires => { 'Module::Build' => 0, },
|
||||
add_to_cleanup => ['App-ClusterSSH-*'],
|
||||
create_makefile_pl => 'traditional',
|
||||
script_files => 'bin',
|
||||
get_options => { changes => { type => '=s' }, },
|
||||
PL_files => {
|
||||
'bin_PL/_build_docs' => [],
|
||||
},
|
||||
);
|
||||
|
||||
$build->create_build_script;
|
||||
|
|
|
|||
6
Changes
6
Changes
|
|
@ -1,3 +1,9 @@
|
|||
4.03_01 2014-??-?? Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Amended host parsing to include alternative IPv6 address port definitions, e.g. 1::2::3::4/5567
|
||||
- List available external tags with -L option and also add into 'Add Host' in UI
|
||||
[NOTE: Some options have changed!]
|
||||
- Rework options code
|
||||
|
||||
4.02_05 ????-??-?? Duncan Ferguson <duncan_ferguson@user.sf.net>
|
||||
- Add in 'Set all active' and 'Set half active' host menu options (thanks to Andrew Stevenson)
|
||||
|
||||
|
|
|
|||
23
MANIFEST
23
MANIFEST
|
|
@ -1,19 +1,21 @@
|
|||
AUTHORS
|
||||
bin/ccon
|
||||
bin/crsh
|
||||
bin/cscp
|
||||
bin/cssh
|
||||
bin/ctel
|
||||
bin_PL/_build_docs
|
||||
bin_PL/ccon
|
||||
bin_PL/crsh
|
||||
bin_PL/cscp.x
|
||||
bin_PL/cssh
|
||||
bin_PL/ctel
|
||||
Build.PL
|
||||
Changes
|
||||
lib/App/ClusterSSH.pm
|
||||
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.pm
|
||||
lib/App/ClusterSSH/L10N/en.pm
|
||||
lib/App/ClusterSSH/L10N.pm
|
||||
lib/App/ClusterSSH.pm
|
||||
Makefile.PL
|
||||
MANIFEST
|
||||
MANIFEST.SKIP
|
||||
|
|
@ -23,8 +25,9 @@ README
|
|||
t/00-load.t
|
||||
t/01l10n.t
|
||||
t/02base.t
|
||||
t/10host.t
|
||||
t/05getopts.t
|
||||
t/10host_ssh_config
|
||||
t/10host.t
|
||||
t/15config.t
|
||||
t/15config.t.file1
|
||||
t/15config.t.file2
|
||||
|
|
@ -40,8 +43,8 @@ t/80clusterssh.t
|
|||
t/boilerplate.t
|
||||
t/changes.t
|
||||
t/external_cluster_command
|
||||
THANKS
|
||||
t/manifest.t
|
||||
TODO
|
||||
t/pod-coverage.t
|
||||
t/pod.t
|
||||
THANKS
|
||||
TODO
|
||||
|
|
|
|||
|
|
@ -14,3 +14,4 @@ pm_to_blib
|
|||
.*\.swp$
|
||||
^TOAD$
|
||||
^WIP_TASKS$
|
||||
^bin/
|
||||
|
|
|
|||
1
bin/ccon
1
bin/ccon
|
|
@ -1 +0,0 @@
|
|||
cssh
|
||||
1
bin/crsh
1
bin/crsh
|
|
@ -1 +0,0 @@
|
|||
cssh
|
||||
883
bin/cssh
883
bin/cssh
|
|
@ -1,883 +0,0 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin;
|
||||
use lib $FindBin::Bin. '/../lib';
|
||||
use lib $FindBin::Bin. '/../lib/perl5';
|
||||
use App::ClusterSSH;
|
||||
|
||||
my $app = App::ClusterSSH->new();
|
||||
$app->run();
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=head1 NAME
|
||||
|
||||
cssh, crsh, ctel, ccon - Cluster administration tool
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
S<< cssh [options] [[user@]<server>[:port]|<tag>] [...] >>
|
||||
S<< crsh [options] [[user@]<server>[:port]|<tag>] [...] >>
|
||||
S<< ctel [options] [<server>[:port]|<tag>] [...] >>
|
||||
S<< ccon [options] [[user@]<server>[:port]|<tag>] [...] >>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
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.
|
||||
|
||||
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.
|
||||
|
||||
Connections are opened via ssh, so a correctly installed and configured
|
||||
ssh installation is required. If, however, the program is called by "crsh"
|
||||
then the rsh protocol is used (and the communications channel is insecure),
|
||||
or by "ctel" then telnet is used, or by "ccon" then console is used.
|
||||
|
||||
Extra caution should be taken when editing system files such as
|
||||
/etc/inet/hosts as lines may not necessarily be in the same order. Assuming
|
||||
line 5 is the same across all servers and modifying that is dangerous.
|
||||
It's better to search for the specific line to be changed and double-check
|
||||
before changes are committed.
|
||||
|
||||
=head2 Further Notes
|
||||
|
||||
Please also see L</KNOWN BUGS>.
|
||||
|
||||
=over
|
||||
|
||||
=item *
|
||||
|
||||
The dotted line on any sub-menu is a tear-off, i.e. click on it
|
||||
and the sub-menu is turned into its own window.
|
||||
|
||||
=item *
|
||||
|
||||
Unchecking a hostname on the Hosts sub-menu will unplug the host from the
|
||||
cluster control window, so any text typed into the console is not sent to
|
||||
that host. Re-selecting it will plug it back in.
|
||||
|
||||
=item *
|
||||
|
||||
If your window manager menu bars are obscured by terminal windows see
|
||||
the C<screen_reserve_XXXXX> options in the F<$HOME/.clusterssh/config> file (see L</"FILES">).
|
||||
|
||||
=item *
|
||||
|
||||
If the terminals overlap too much see the C<terminal_reserve_XXXXX>
|
||||
options in the F<$HOME/.clusterssh/config> file (see L</"FILES">).
|
||||
|
||||
=item *
|
||||
|
||||
If the code is called as crsh instead of cssh (i.e. a symlink called
|
||||
crsh points to the cssh file or the file is renamed) rsh is used as the
|
||||
communications protocol instead of ssh.
|
||||
|
||||
=item *
|
||||
|
||||
If the code is called as ctel instead of cssh (i.e. a symlink called
|
||||
ctel points to the cssh file or the file is renamed) telnet is used as the
|
||||
communications protocol instead of ssh.
|
||||
|
||||
=item *
|
||||
|
||||
If the code is called as ccon instead of cssh (i.e. a symlink called
|
||||
ccon points to the cssh file or the file is renamed) console is used as the
|
||||
communications protocol instead of ssh.
|
||||
|
||||
=item *
|
||||
|
||||
When using cssh on a large number of systems to connect back to a single
|
||||
system (e.g. you issue a command to the cluster to scp a file from a given
|
||||
location) and when these connections require authentication (i.e. you are
|
||||
going to authenticate with a password), the sshd daemon at that location
|
||||
may refuse connects after the number specified by MaxStartups in
|
||||
sshd_config is exceeded. (If this value is not set, it defaults to 10.)
|
||||
This is expected behavior; sshd uses this mechanism to prevent DoS attacks
|
||||
from unauthenticated sources. Please tune sshd_config and reload the SSH
|
||||
daemon, or consider using the ~/.ssh/authorized_keys mechanism for
|
||||
authentication if you encounter this problem.
|
||||
|
||||
=item *
|
||||
|
||||
If client windows fail to open, try running:
|
||||
|
||||
C<< cssh -e {single host name} >>
|
||||
|
||||
This will test the mechanisms used to open windows to hosts. This could
|
||||
be due to either the C<-xrm> terminal option which enables C<AllowSendEvents>
|
||||
(some terminals do not require this option, other terminals have another
|
||||
method for enabling it - see your terminal documentation) or the
|
||||
C<ConnectTimeout> ssh option (see the configuration option C<-o> or file
|
||||
C<$HOME/.clusterssh/config> below to resolve this).
|
||||
|
||||
=back
|
||||
|
||||
=head1 OPTIONS
|
||||
|
||||
Some of these options may also be defined within the configuration file.
|
||||
Default options are shown as appropriate.
|
||||
|
||||
=over
|
||||
|
||||
=item --action,-a '<command>'
|
||||
|
||||
Run the command in each session, e.g. C<-a 'vi /etc/hosts'> to drop straight
|
||||
into a vi session. NOTE: not all communications methods support this (ssh
|
||||
and rsh should, telnet and console will not).
|
||||
|
||||
=item --autoclose,-K <seconds>
|
||||
|
||||
Number of seconds to wait before closing finished terminal windows.
|
||||
|
||||
=item --autoquit,-q|--no-autoquit,-Q
|
||||
|
||||
Enable|Disable automatically quiting after the last client window has closed
|
||||
(overriding the config file)
|
||||
|
||||
=item --cluster-file,-c <file>
|
||||
|
||||
Use supplied file as additional cluster file (see also L</"FILES">)
|
||||
|
||||
=item --config-file,-C <file>
|
||||
|
||||
Use supplied file as additional configuration file (see also L</"FILES">)
|
||||
|
||||
=item -d
|
||||
|
||||
DEPRECATED. See '--debug'.
|
||||
|
||||
=item -D
|
||||
|
||||
DEPRECATED. See '--debug'.
|
||||
|
||||
=item --debug [number].
|
||||
|
||||
Enable debugging. Either a level can be provided or the option can be
|
||||
repeated multiple times. Maximum level is 4.
|
||||
|
||||
=item --evaluate,-e [user@]<hostname>[:port]
|
||||
|
||||
Display and evaluate the terminal and connection arguments to display any
|
||||
potential errors. The <hostname> is required to aid the evaluation.
|
||||
|
||||
=item --font,-f "5x8"
|
||||
|
||||
Specify the font to use in the terminal windows. Use standard X font notation.
|
||||
|
||||
=item --help,-h|-?
|
||||
|
||||
Show basic help text, and exit
|
||||
|
||||
=item --list, -L
|
||||
|
||||
List available cluster tags.
|
||||
|
||||
=item --man,-H
|
||||
|
||||
Show full help text (the man page), and exit
|
||||
|
||||
=item --master,-M <master>
|
||||
|
||||
The console client program polls master as the primary server, rather than the
|
||||
default set at compile time (typically ``console'').
|
||||
|
||||
=item --options,-o "-x -o ConnectTimeout=10" - for ssh connections
|
||||
|
||||
=item --options,-o "" - for rsh connections
|
||||
|
||||
Specify arguments to be passed to ssh or rsh when making the connection.
|
||||
|
||||
B<NOTE:> any "generic" change to the method (e.g., specifying the ssh port to use)
|
||||
should be done in the medium's own config file (see C<ssh_config> and
|
||||
F<$HOME/.ssh/config>).
|
||||
|
||||
=item --output-config,-u
|
||||
|
||||
Output the current configuration in the same format used by the
|
||||
F<$HOME/.clusterssh/config> file.
|
||||
|
||||
=item --port,-p <port>
|
||||
|
||||
Specify an alternate port for connections.
|
||||
|
||||
=item --show-history,-s
|
||||
|
||||
IN BETA: Show history within console window. This code is still being
|
||||
worked upon, but may help some users.
|
||||
|
||||
=item --tag-file,-r <file>
|
||||
|
||||
Use supplied file as additional tag file (see also L</"FILES">)
|
||||
|
||||
=item --term-args,-t ""
|
||||
|
||||
Specify arguments to be passed to terminals being used
|
||||
|
||||
=item --tile,-g|--no-tile,-G
|
||||
|
||||
Enable|Disable window tiling (overriding the config file)
|
||||
|
||||
=item --title,-T "CSSH"
|
||||
|
||||
Specify the initial part of the title used in the console and client windows
|
||||
|
||||
=item --unique-servers,-m
|
||||
|
||||
Connect to each host only once
|
||||
|
||||
=item --use_all_a_records,-A
|
||||
|
||||
If a hostname resolves to multiple IP addresses, toggle whether or not to
|
||||
connect to all of them, or just the first one (see also config file entry)
|
||||
|
||||
=item --username,-l $LOGNAME
|
||||
|
||||
Specify the default username to use for connections (if different from the
|
||||
currently logged in user). B<NOTE:> will be overridden by <user>@<host>
|
||||
|
||||
=item --version,-v
|
||||
|
||||
Show version information and exit
|
||||
|
||||
=back
|
||||
|
||||
=head1 ARGUMENTS
|
||||
|
||||
The following arguments are supported:
|
||||
|
||||
=over
|
||||
|
||||
=item [user@]<hostname>[:port] ...
|
||||
|
||||
Open an xterm to the given hostname and connect to the administration
|
||||
console. An optional port number can be used if sshd is not listening
|
||||
on the standard port (i.e., not listening on port 22) and ssh_config cannot
|
||||
be used.
|
||||
|
||||
=item <tag> ...
|
||||
|
||||
Open a series of xterms defined by <tag> in one of the supplementary
|
||||
configuration files (see L</"FILES">).
|
||||
|
||||
Note: specifying a username on a cluster tag will override any usernames
|
||||
defined in the cluster
|
||||
|
||||
=back
|
||||
|
||||
=head1 KEY SHORTCUTS
|
||||
|
||||
The following key shortcuts are available within the console window, and all
|
||||
of them may be changed via the configuration files.
|
||||
|
||||
=over
|
||||
|
||||
=item Control-q
|
||||
|
||||
Quit the program and close all connections and windows
|
||||
|
||||
=item Control-+
|
||||
|
||||
Open the 'Add Host(s) or Cluster(s)' dialogue box. Multiple host or cluster
|
||||
names can be entered, separated by spaces.
|
||||
|
||||
=item Alt-n
|
||||
|
||||
Paste in the hostname part of the specific connection string to each
|
||||
client, minus any username or port, i.e.
|
||||
|
||||
C<< scp /etc/hosts server:files/<Alt-n>.hosts >>
|
||||
|
||||
would replace the <Alt-n> with the client's name in each window
|
||||
|
||||
=item Alt-r
|
||||
|
||||
Retile all the client windows
|
||||
|
||||
=back
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
=over
|
||||
|
||||
=item Open up a session to 3 servers
|
||||
|
||||
S<$ cssh server1 server2 server3>
|
||||
|
||||
=item Open up a session to a cluster of servers identified by the tag 'farm1'
|
||||
and give the controlling window a specific title, where the cluster is defined
|
||||
in one of the default configuration files
|
||||
|
||||
S<$ cssh -T 'Web Farm Cluster 1' farm1>
|
||||
|
||||
=item Connect to different servers using different login names. NOTE: this can
|
||||
also be achieved by setting up appropriate options in the F<.ssh/config> file.
|
||||
Do not close cssh when the last terminal exits.
|
||||
|
||||
S<$ cssh -Q user1@server1 admin@server2>
|
||||
|
||||
=item Open up a cluster defined in a non-default configuration file
|
||||
|
||||
S<$ cssh -c $HOME/cssh.config db_cluster>
|
||||
|
||||
=item Use telnet on port 2022 instead of ssh
|
||||
|
||||
S<$ ctel -p 2022 server1 server2>
|
||||
|
||||
=item Use rsh instead of ssh
|
||||
|
||||
S<$ crsh server1 server2>
|
||||
|
||||
=item Use console with master as the primary server instead of ssh
|
||||
|
||||
S<$ ccon -M master server1 server2>
|
||||
|
||||
=back
|
||||
|
||||
=head1 FILES
|
||||
|
||||
=over
|
||||
|
||||
=item F</etc/clusters>, F<$HOME/.clusterssh/clusters>
|
||||
|
||||
These files contain a list of tags to server names mappings. When any name
|
||||
is used on the command line it is checked to see if it is a tag.
|
||||
If it is a tag, then the tag is replaced with the list of servers. The
|
||||
format is as follows:
|
||||
|
||||
S<< <tag> [user@]<server> [user@]<server> [...] >>
|
||||
|
||||
e.g.
|
||||
|
||||
# List of servers in live
|
||||
live admin1@server1 admin2@server2 server3 server4
|
||||
|
||||
All comments (marked by a #) and blank lines are ignored. Tags may be
|
||||
nested, but be aware of using recursive tags as they are not checked for.
|
||||
|
||||
Extra cluster files may also be specified either as an option on the
|
||||
command line (see C<cluster-file>) or in the user's F<$HOME/.clusterssh/config>
|
||||
file (see C<extra_cluster_file> configuration option).
|
||||
|
||||
NOTE: the last tag read overwrites any pre-existing tag of that name
|
||||
|
||||
NOTE: there is a special cluster tag called C<default> - any tags or hosts
|
||||
included within this tag will be automatically opened if no other tags
|
||||
are specified on the command line.
|
||||
|
||||
=item F</etc/tags>, F<$HOME/.clusterssh/tags>
|
||||
|
||||
Very similar to F<cluster> files but the definition is reversed. The
|
||||
format is:
|
||||
|
||||
S<< <host> <tag> [...] >>
|
||||
|
||||
This allows one host to be specified as a member of a number of tags. This
|
||||
format can be clearer than using F<clusters> files.
|
||||
|
||||
Extra tag files may be specified either as an option (see C<tag-file>) or within
|
||||
the user's F<$HOME/.clusterssh/config> file (see C<extra_tag_file>
|
||||
configuration option).
|
||||
|
||||
NOTE: All tags are added together
|
||||
|
||||
=item F</etc/csshrc> & F<$HOME/.clusterssh/config>
|
||||
|
||||
This file contains configuration overrides - the defaults are as marked.
|
||||
Default options are overwritten first by the global file, and then by the
|
||||
user file.
|
||||
|
||||
B<NOTE:> values for entries do not need to be quoted unless it is required
|
||||
for passing arguments, e.g.
|
||||
|
||||
terminal_allow_send_events="-xrm '*.VT100.allowSendEvents:true'"
|
||||
|
||||
should be written as
|
||||
|
||||
terminal_allow_send_events=-xrm '*.VT100.allowSendEvents:true'
|
||||
|
||||
=over
|
||||
|
||||
=item auto_close = 5
|
||||
|
||||
Close terminal window after this many seconds. If set to 0 will instead wait
|
||||
on input from the user in each window before closing. Can be overridden
|
||||
by C<-K> on the command line.
|
||||
|
||||
=item auto_quit = yes
|
||||
|
||||
Automatically quit after the last client window closes. Set to anything
|
||||
other than "yes" to disable. Can be overridden by C<-Q> on the command line.
|
||||
|
||||
=item clusters = <blank>
|
||||
|
||||
Define a number of cluster tags in addition to (or to replace) tags defined
|
||||
in the F</etc/clusters> file. The format is:
|
||||
|
||||
clusters = <tag1> <tag2> <tag3>
|
||||
<tag1> = host1 host2 host3
|
||||
<tag2> = user@host4 user@host5 host6
|
||||
<tag3> = <tag1> <tag2>
|
||||
|
||||
As with the F</etc/clusters> file, be sure not to create recursively nested tags.
|
||||
|
||||
=item comms = ssh
|
||||
|
||||
Sets the default communication method (initially taken from the name of the
|
||||
program, but can be overridden here).
|
||||
|
||||
=item console_position = <null>
|
||||
|
||||
Set the initial position of the console - if empty then let the window manager
|
||||
decide. Format is '+<x>+<y>', i.e. '+0+0' is top left hand corner of the screen,
|
||||
'+0-70' is bottom left hand side of screen (more or less).
|
||||
|
||||
=item external_cluster_command = <null>
|
||||
|
||||
Define the full path to an external command that can be used to resolve tags
|
||||
to host names. This command can be written in any language. The script must
|
||||
accept a list of tags to resolve and output a list of hosts on a single line.
|
||||
Any tags that cannot be resolved should be returned unchanged.
|
||||
|
||||
A non-0 exit code will be counted as an error, a warning will be printed and
|
||||
output ignored.
|
||||
|
||||
=item extra_cluster_file = <null>
|
||||
|
||||
Define an extra cluster file in the format of F</etc/clusters>. Multiple
|
||||
files can be specified, separated by commas. Both ~ and $HOME are acceptable
|
||||
as a reference to the user's home directory, i.e.
|
||||
|
||||
extra_cluster_file = ~/clusters, $HOME/clus
|
||||
|
||||
=item ignore_host_errors
|
||||
|
||||
THIS OPTION IS DEPRECATED. It has been left in so current systems continue
|
||||
to function as expected.
|
||||
|
||||
=item key_addhost = Control-Shift-plus
|
||||
|
||||
Default key sequence to open AddHost menu. See below notes on shortcuts.
|
||||
|
||||
=item key_clientname = Alt-n
|
||||
|
||||
Default key sequence to send cssh client names to client. See below notes
|
||||
on shortcuts.
|
||||
|
||||
=item key_localname = Alt-l
|
||||
|
||||
Default key sequence to send hostname of local server to client. See below
|
||||
notes on shortcuts.
|
||||
|
||||
=item key_paste = Control-v
|
||||
|
||||
Default key sequence to paste text into the console window. See below notes
|
||||
on shortcuts.
|
||||
|
||||
=item key_quit = Control-q
|
||||
|
||||
Default key sequence to quit the program (will terminate all open windows).
|
||||
See below notes on shortcuts.
|
||||
|
||||
=item key_retilehosts = Alt-r
|
||||
|
||||
Default key sequence to retile host windows. See below notes on shortcuts.
|
||||
|
||||
=item key_username = Alt-u
|
||||
|
||||
Default key sequence to send username to client. See below notes
|
||||
on shortcuts.
|
||||
|
||||
=item macro_servername = %s
|
||||
|
||||
=item macro_hostname = %h
|
||||
|
||||
=item macro_username = %u
|
||||
|
||||
=item macro_newline = %n
|
||||
|
||||
=item macro_version = %v
|
||||
|
||||
Change the replacement macro used when either using a 'Send' menu item, or when
|
||||
pasting text into the main console.
|
||||
|
||||
=item macros_enabled = yes
|
||||
|
||||
Enable or disable macro replacement. Note: this affects pasting into the
|
||||
main console, items on the 'Send' menu and key_clientname, key_localname,
|
||||
key_servername and key_username.
|
||||
|
||||
=item max_addhost_menu_cluster_items = 6
|
||||
|
||||
Maximum number of entries in the 'Add Host' menu cluster list before
|
||||
scrollbars are used
|
||||
|
||||
=item max_host_menu_items = 30
|
||||
|
||||
Maximum number of hosts to put into the host menu before starting a new column
|
||||
|
||||
=item menu_host_autotearoff = 0
|
||||
|
||||
=item menu_send_autotearoff = 0
|
||||
|
||||
When set to non-0 will automatically tear-off the host or send menu at
|
||||
program start
|
||||
|
||||
=item mouse_paste = Button-2 (middle mouse button)
|
||||
|
||||
Default key sequence to paste text into the console window using the mouse.
|
||||
See below notes on shortcuts.
|
||||
|
||||
=item rsh = rsh
|
||||
|
||||
=item ssh = ssh
|
||||
|
||||
=item telnet = telnet
|
||||
|
||||
Set the path to the specific binary to use for the communication method, else
|
||||
uses the first match found in $PATH
|
||||
|
||||
=item rsh_args = <blank>
|
||||
|
||||
=item ssh_args = "-x -o ConnectTimeout=10"
|
||||
|
||||
=item telnet_args = <blank>
|
||||
|
||||
Sets any arguments to be used with the communication method (defaults to ssh
|
||||
arguments).
|
||||
|
||||
B<NOTE:> The given defaults are based on OpenSSH, not commercial ssh software.
|
||||
|
||||
B<NOTE:> Any "generic" change to the method (e.g., specifying the ssh port to use)
|
||||
should be done in the medium's own config file (see C<ssh_config> and
|
||||
F<$HOME/.ssh/config>).
|
||||
|
||||
=item screen_reserve_top = 0
|
||||
|
||||
=item screen_reserve_bottom = 60
|
||||
|
||||
=item screen_reserve_left = 0
|
||||
|
||||
=item screen_reserve_right = 0
|
||||
|
||||
Number of pixels from the screen's side to reserve when calculating screen
|
||||
geometry for tiling. Setting this to something like 50 will help keep cssh
|
||||
from positioning windows over your window manager's menu bar if it draws one
|
||||
at that side of the screen.
|
||||
|
||||
=item rsh = /path/to/rsh
|
||||
|
||||
=item ssh = /path/to/ssh
|
||||
|
||||
Depending on the value of comms, set the path of the communication binary.
|
||||
|
||||
=item terminal = /path/to/terminal
|
||||
|
||||
Path to the X-Windows terminal used for the client.
|
||||
|
||||
=item terminal_args = <blank>
|
||||
|
||||
Arguments to use when opening terminal windows. Otherwise takes defaults
|
||||
from F<$HOME/.Xdefaults> or $<$HOME/.Xresources> file.
|
||||
|
||||
=item terminal_font = 6x13
|
||||
|
||||
Font to use in the terminal windows. Use standard X font notation.
|
||||
|
||||
=item terminal_reserve_top = 5
|
||||
|
||||
=item terminal_reserve_bottom = 0
|
||||
|
||||
=item terminal_reserve_left = 5
|
||||
|
||||
=item terminal_reserve_right = 0
|
||||
|
||||
Number of pixels from the terminal's side to reserve when calculating screen
|
||||
geometry for tiling. Setting these will help keep cssh from positioning
|
||||
windows over your scroll and title bars or otherwise overlapping the windows
|
||||
too much.
|
||||
|
||||
=item terminal_colorize = 1
|
||||
|
||||
If set to 1 (the default), then "-bg" and "-fg" arguments will be added
|
||||
to the terminal invocation command-line. The terminal will be colored
|
||||
in a pseudo-random way based on the host name; while the color of a terminal
|
||||
is not easily predicted, it will always be the same color for a given host
|
||||
name. After a while, you will recognize hosts by their characteristic
|
||||
terminal color.
|
||||
|
||||
=item terminal_bg_style = dark
|
||||
|
||||
If set to dark, the terminal background will be set to black and
|
||||
the foreground to the pseudo-random color. If set to light, then the
|
||||
foreground will be black and the background the pseudo-random color. If
|
||||
terminal_colorize is zero, then this option has no effect.
|
||||
|
||||
=item terminal_size = 80x24
|
||||
|
||||
Initial size of terminals to use. NOTE: the number of lines (24) will be
|
||||
decreased when resizing terminals for tiling, not the number of characters (80).
|
||||
|
||||
=item terminal_title_opt = -T
|
||||
|
||||
Option used with C<terminal> to set the title of the window
|
||||
|
||||
=item terminal_allow_send_events = -xrm '*.VT100.allowSendEvents:true'
|
||||
|
||||
Option required by the terminal to allow XSendEvents to be received
|
||||
|
||||
=item title = cssh
|
||||
|
||||
Title of windows to use for both the console and terminals.
|
||||
|
||||
=item unmap_on_redraw = no
|
||||
|
||||
Tell Tk to use the UnmapWindow request before redrawing terminal windows.
|
||||
This defaults to "no" as it causes some problems with the FVWM window
|
||||
manager. If you are experiencing problems with redraws, you can set it to
|
||||
"yes" to allow the window to be unmapped before it is repositioned.
|
||||
|
||||
=item use_all_a_records = no
|
||||
|
||||
If a hostname resolves to multiple IP addresses, set to C<yes> to connect
|
||||
to all of them, not just the first one found.
|
||||
|
||||
=item use_hotkeys = yes
|
||||
|
||||
Setting to anything other than C<yes> will disable all hotkeys.
|
||||
|
||||
=item user = $LOGNAME
|
||||
|
||||
Sets the default user for running commands on clients.
|
||||
|
||||
=item window_tiling = yes
|
||||
|
||||
Perform window tiling (set to C<no> to disable)
|
||||
|
||||
=item window_tiling_direction = right
|
||||
|
||||
Direction to tile windows, where "right" means starting top left and moving
|
||||
right and then down, and anything else means starting bottom right and moving
|
||||
left and then up
|
||||
|
||||
=back
|
||||
|
||||
B<NOTE:> The key shortcut modifiers must be in the form "Control", "Alt", or
|
||||
"Shift", i.e. with the first letter capitalised and the rest lower case. Keys
|
||||
may also be disabled individually by setting to the word "null".
|
||||
|
||||
=item F<$HOME/.csshrc_send_menu>
|
||||
|
||||
This (optional) file contains items to populate the send menu. The
|
||||
default entry could be written as:
|
||||
|
||||
<send_menu>
|
||||
<menu title="Use Macros">
|
||||
<toggle/>
|
||||
<accelerator>ALT-p</accelerator>
|
||||
</menu>
|
||||
<menu title="Remote Hostname">
|
||||
<command>%s</command>
|
||||
<accelerator>ALT-n</accelerator>
|
||||
</menu>
|
||||
<menu title="Local Hostname">
|
||||
<command>%s</command>
|
||||
<accelerator>ALT-l</accelerator>
|
||||
</menu>
|
||||
<menu title="Username">
|
||||
<command>%u</command>
|
||||
<accelerator>ALT-u</accelerator>
|
||||
</menu>
|
||||
<menu title="Test Text">
|
||||
<command>echo "ClusterSSH Version: %v%n</command>
|
||||
</menu>
|
||||
</send_menu>
|
||||
|
||||
Submenus can also be specified as follows:
|
||||
|
||||
<send_menu>
|
||||
<menu title="Default Entries">
|
||||
<detach>yes</detach>
|
||||
<menu title="Hostname">
|
||||
<command>%s</command>
|
||||
<accelerator>ALT-n</accelerator>
|
||||
</menu>
|
||||
</menu>
|
||||
</send_menu>
|
||||
|
||||
B<Caveats:>
|
||||
|
||||
=over 4
|
||||
|
||||
=item There is currently no strict format checking of this file.
|
||||
|
||||
=item The format of the file may change in the future
|
||||
|
||||
=item If the file exists, the default entry (Hostname) is not added
|
||||
|
||||
=back
|
||||
|
||||
The following replacement macros are available (note: these can be changed in the configuration file):
|
||||
|
||||
=over 4
|
||||
|
||||
=item %s
|
||||
|
||||
Hostname part of the specific connection string to each client, minus any
|
||||
username or port
|
||||
|
||||
=item %u
|
||||
|
||||
Username part of the connection string to each client
|
||||
|
||||
=item %h
|
||||
|
||||
Hostname of server where cssh is being run from
|
||||
|
||||
=item %n
|
||||
|
||||
<RETURN> code
|
||||
|
||||
=back
|
||||
|
||||
B<NOTE:> requires L<XML::Simple> to be installed
|
||||
|
||||
=back
|
||||
|
||||
=head1 KNOWN BUGS
|
||||
|
||||
=over 4
|
||||
|
||||
=item 1.
|
||||
|
||||
Catering for IPv6 addresses is minimal. This is due to a conflict
|
||||
between IPv6 addresses and port numbers within the same
|
||||
server definition since they both use the same separator, i.e. is the
|
||||
following just an IPv6 address, or an address + port number of 2323?
|
||||
|
||||
2001:db8::1428:2323
|
||||
|
||||
Exactly - I cannot tell either. The IPv6 address without a port is assumed
|
||||
in those cases where it cannot be determined and a warning is issued.
|
||||
|
||||
Possible workarounds include:
|
||||
|
||||
=over 4
|
||||
|
||||
=item a.
|
||||
|
||||
Use square brackets around the IPv6 address, i.e.
|
||||
[2001:db8::1428]:2323
|
||||
or
|
||||
[2001:db8::1428:2323]
|
||||
as appropriate so there is no ambiguity
|
||||
|
||||
=item b.
|
||||
|
||||
Use the full IPv6 address if also using a port number - the 8th colon
|
||||
is assumed to be the port separator.
|
||||
|
||||
=item c.
|
||||
|
||||
Define the IPv6 address in your /etc/hosts file, DNS or other name service
|
||||
lookup mechanism and use the hostname instead of the address.
|
||||
|
||||
=back
|
||||
|
||||
=item 2.
|
||||
|
||||
Swapping virtual desktops can cause a redraw of all the terminal windows. This
|
||||
is due to a lack of distinction within Tk between switching desktops and
|
||||
minimising/maximising windows. Until Tk can tell the difference between the
|
||||
two events, there is no fix (apart from rewriting everything directly in X)
|
||||
|
||||
=back
|
||||
|
||||
Anyone with any good ideas to fix the above bugs is more than welcome to get
|
||||
in touch and/or provide a patch.
|
||||
|
||||
=head1 REPORTING BUGS
|
||||
|
||||
=over 2
|
||||
|
||||
=item *
|
||||
|
||||
If you have issues running cssh, first try:
|
||||
|
||||
C<< cssh -e [user@]<hostname>[:port] >>
|
||||
|
||||
This performs two tests to confirm cssh is able to work properly with the
|
||||
settings provided within the F<$HOME/.clusterssh/config> file (or internal defaults).
|
||||
|
||||
1. Test the terminal window works with the options provided
|
||||
|
||||
2. Test ssh works to a host with the configured arguments
|
||||
|
||||
Configuration options to watch for in ssh are
|
||||
|
||||
- Doesn't understand "-o ConnectTimeout=10" - remove the option
|
||||
in the F<$HOME/.clusterssh/config> file
|
||||
|
||||
- OpenSSH-3.8 using untrusted ssh tunnels - use "-Y" instead of "-X"
|
||||
or use "ForwardX11Trusted yes' in ssh_config (if you change the
|
||||
default ssh options from -x to -X)
|
||||
|
||||
=item *
|
||||
|
||||
If you require support, please run the following commands
|
||||
and post it on the web site in the support/problems forum:
|
||||
|
||||
C<< perl -V >>
|
||||
|
||||
C<< perl -MTk -e 'print $Tk::VERSION,$/' >>
|
||||
|
||||
C<< perl -MX11::Protocol -e 'print $X11::Protocol::VERSION,$/' >>
|
||||
|
||||
C<< cat /etc/csshrc $HOME/.clusterssh/config >>
|
||||
|
||||
=item *
|
||||
|
||||
Using the debug switches (-d, -D, or -dD) will turn on debugging output.
|
||||
However, please only use this option with one host at a time,
|
||||
i.e. "cssh -d <host>" due to the amount of output produced (in both main
|
||||
and child windows).
|
||||
|
||||
=back
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<http://clusterssh.sourceforge.net/>,
|
||||
C<ssh>,
|
||||
L<Tk::overview>,
|
||||
L<X11::Protocol>,
|
||||
C<perl>
|
||||
|
||||
=head1 CREDITS
|
||||
|
||||
A web site for comments, requests, bug reports and bug fixes/patches is
|
||||
available at L<http://clusterssh.sourceforge.net/>
|
||||
|
||||
=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;
|
||||
1
bin/ctel
1
bin/ctel
|
|
@ -1 +0,0 @@
|
|||
cssh
|
||||
41
bin_PL/_build_docs
Executable file
41
bin_PL/_build_docs
Executable file
|
|
@ -0,0 +1,41 @@
|
|||
#!/usr/bin/perl
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin qw($Bin $Script);
|
||||
|
||||
chdir $Bin || die "Unable to chdir into $Bin: $!";
|
||||
|
||||
my $bindir="$Bin/../bin";
|
||||
|
||||
if(! -d $bindir) {
|
||||
mkdir $bindir || die "Could not mkdir $bindir: $!";
|
||||
}
|
||||
|
||||
for my $source (glob("*")) {
|
||||
my $dest="$bindir/$source";
|
||||
|
||||
next if($source =~ m/$Script/);
|
||||
next if($source =~ m/\.x$/);
|
||||
|
||||
print "Generating: $source",$/;
|
||||
|
||||
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>);
|
||||
close($sfh);
|
||||
|
||||
print $dfh "\n\n__END__\n\n";
|
||||
|
||||
my $pod= qx{ ./$source --generate-pod };
|
||||
die "Failed to generate pod" if($?);
|
||||
print $dfh $pod;
|
||||
close($dfh);
|
||||
|
||||
chmod(0555, $dest) || die "Could not chmod $dest: $!";
|
||||
}
|
||||
22
bin_PL/ccon
Executable file
22
bin_PL/ccon
Executable file
|
|
@ -0,0 +1,22 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin;
|
||||
use lib $FindBin::Bin. '/../lib';
|
||||
use lib $FindBin::Bin. '/../lib/perl5';
|
||||
use App::ClusterSSH;
|
||||
|
||||
my $app = App::ClusterSSH->new();
|
||||
|
||||
#$app->options->add_common_ssh_options;
|
||||
#$app->options->add_common_session_options;
|
||||
|
||||
$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'')."),
|
||||
);
|
||||
|
||||
$app->run();
|
||||
|
||||
1;
|
||||
16
bin_PL/crsh
Executable file
16
bin_PL/crsh
Executable file
|
|
@ -0,0 +1,16 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin;
|
||||
use lib $FindBin::Bin. '/../lib';
|
||||
use lib $FindBin::Bin. '/../lib/perl5';
|
||||
use App::ClusterSSH;
|
||||
|
||||
my $app = App::ClusterSSH->new();
|
||||
|
||||
$app->options->add_common_ssh_options;
|
||||
$app->options->add_common_session_options;
|
||||
$app->run();
|
||||
|
||||
1;
|
||||
0
bin/cscp → bin_PL/cscp.x
Executable file → Normal file
0
bin/cscp → bin_PL/cscp.x
Executable file → Normal file
16
bin_PL/cssh
Executable file
16
bin_PL/cssh
Executable file
|
|
@ -0,0 +1,16 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin;
|
||||
use lib $FindBin::Bin. '/../lib';
|
||||
use lib $FindBin::Bin. '/../lib/perl5';
|
||||
use App::ClusterSSH;
|
||||
|
||||
my $app = App::ClusterSSH->new();
|
||||
|
||||
$app->options->add_common_ssh_options;
|
||||
$app->options->add_common_session_options;
|
||||
$app->run();
|
||||
|
||||
1;
|
||||
12
bin_PL/ctel
Executable file
12
bin_PL/ctel
Executable file
|
|
@ -0,0 +1,12 @@
|
|||
#!/usr/bin/perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin;
|
||||
use lib $FindBin::Bin. '/../lib';
|
||||
use lib $FindBin::Bin. '/../lib/perl5';
|
||||
use App::ClusterSSH;
|
||||
|
||||
my $app = App::ClusterSSH->new();
|
||||
|
||||
$app->run();
|
||||
File diff suppressed because it is too large
Load diff
|
|
@ -12,6 +12,8 @@ use Exception::Class (
|
|||
},
|
||||
'App::ClusterSSH::Exception::Cluster',
|
||||
'App::ClusterSSH::Exception::LoadFile',
|
||||
'App::ClusterSSH::Exception::Helper',
|
||||
'App::ClusterSSH::Exception::Getopt',
|
||||
);
|
||||
|
||||
# Don't use SVN revision as it can cause problems
|
||||
|
|
@ -85,10 +87,7 @@ sub loc {
|
|||
|
||||
sub set_lang {
|
||||
my ( $self, $lang ) = @_;
|
||||
$language = $lang;
|
||||
if ($self) {
|
||||
$self->debug( 6, $self->loc( 'Setting language to "[_1]"', $lang ), );
|
||||
}
|
||||
$self->debug( 6, $self->loc( 'Setting language to "[_1]"', $lang ), );
|
||||
return $self;
|
||||
}
|
||||
|
||||
|
|
@ -184,10 +183,10 @@ sub load_file {
|
|||
);
|
||||
}
|
||||
|
||||
if ( !$args{type} || $args{type} !~ m/cluster|config/ ) {
|
||||
if ( !$args{type} ) {
|
||||
croak(
|
||||
App::ClusterSSH::Exception->throw(
|
||||
error => '"type" arg invalid'
|
||||
error => '"type" arg not passed'
|
||||
)
|
||||
);
|
||||
}
|
||||
|
|
@ -267,6 +266,11 @@ sub load_file {
|
|||
return %results;
|
||||
}
|
||||
|
||||
sub parent {
|
||||
my ($self) = @_;
|
||||
return $self->{parent};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
=pod
|
||||
|
|
@ -335,6 +339,11 @@ a wrapper to maketext in Locale::Maketext
|
|||
|
||||
Output text on STDOUT.
|
||||
|
||||
=item $ovj->parent;
|
||||
|
||||
Reutrned the object that is the parent of this one, if it was set when the
|
||||
object was created
|
||||
|
||||
=item $obj->exit;
|
||||
|
||||
Stub to allow program to exit neatly from wherever in the code
|
||||
|
|
|
|||
|
|
@ -48,14 +48,32 @@ sub get_tag_entries {
|
|||
return $self;
|
||||
}
|
||||
|
||||
sub list_external_clusters {
|
||||
my ( $self, ) = @_;
|
||||
|
||||
my @list = $self->_run_external_clusters('-L');
|
||||
return
|
||||
wantarray
|
||||
? sort @list
|
||||
: scalar @list;
|
||||
}
|
||||
|
||||
sub get_external_clusters {
|
||||
my ( $self, $external_command, @tags ) = @_;
|
||||
my ( $self, @tags ) = @_;
|
||||
|
||||
return $self->_run_external_clusters(@tags);
|
||||
}
|
||||
|
||||
sub _run_external_clusters {
|
||||
my ( $self, @args ) = @_;
|
||||
|
||||
my $external_command = $self->parent->config->{external_cluster_command};
|
||||
|
||||
$self->debug( 3, 'Running tags through external command' );
|
||||
$self->debug( 4, 'External command: ', $external_command );
|
||||
$self->debug( 3, 'Tags: ', join( ',', @tags ) );
|
||||
$self->debug( 3, 'Args ', join( ',', @args ) );
|
||||
|
||||
my $command = "$external_command @tags";
|
||||
my $command = "$external_command @args";
|
||||
|
||||
$self->debug( 3, 'Running ', $command );
|
||||
|
||||
|
|
@ -219,9 +237,13 @@ Create a new object. Object should be common across all invocations.
|
|||
Read in /etc/clusters, $HOME/.clusterssh/clusters and any other given
|
||||
file name and register the tags found.
|
||||
|
||||
=item @resolved_tags=get_external_clusters($path_to_binary, @tags)
|
||||
=item @external_tags=list_external_clusters()
|
||||
|
||||
Define and use an external script to resolve tags into hostnames.
|
||||
Call an external script suing C<-L> to list available tags
|
||||
|
||||
=item @resolved_tags=get_external_clusters(@tags)
|
||||
|
||||
Use an external script to resolve C<@tags> into hostnames.
|
||||
|
||||
=item $cluster->get_tag_entries($filename);
|
||||
|
||||
|
|
|
|||
|
|
@ -17,7 +17,7 @@ use App::ClusterSSH::Cluster;
|
|||
|
||||
my $clusters;
|
||||
my %old_clusters;
|
||||
my @app_specific = (qw/ command title comms method /);
|
||||
my @app_specific = (qw/ command title comms method parent /);
|
||||
|
||||
# list of config items to not write out when writing the default config
|
||||
my @ignore_default_config = (qw/ user /);
|
||||
|
|
|
|||
1070
lib/App/ClusterSSH/Getopt.pm
Normal file
1070
lib/App/ClusterSSH/Getopt.pm
Normal file
File diff suppressed because it is too large
Load diff
|
|
@ -22,6 +22,25 @@ sub new {
|
|||
sub script {
|
||||
my ( $self, $config ) = @_;
|
||||
|
||||
if(! defined $config || ! ref $config || ref $config ne "App::ClusterSSH::Config") {
|
||||
croak(
|
||||
App::ClusterSSH::Exception::Helper->throw(
|
||||
error => 'No configuration provided or in wrong format',
|
||||
),
|
||||
);
|
||||
}
|
||||
|
||||
foreach my $arg ( "comms", $config->{comms}, $config->{comms} . '_args', 'command', 'auto_close'
|
||||
) {
|
||||
if( !defined $config->{ $arg } ) {
|
||||
croak(
|
||||
App::ClusterSSH::Exception::Helper->throw(
|
||||
error => "Config '$arg' not provided",
|
||||
),
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
my $comms = $config->{ $config->{comms} };
|
||||
my $comms_args = $config->{ $config->{comms} . '_args' };
|
||||
my $config_command = $config->{command};
|
||||
|
|
@ -33,57 +52,6 @@ sub script {
|
|||
: "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;
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ use version;
|
|||
our $VERSION = version->new('0.03');
|
||||
|
||||
use Carp;
|
||||
use Net::hostent;
|
||||
|
||||
use base qw/ App::ClusterSSH::Base /;
|
||||
|
||||
|
|
@ -60,11 +61,6 @@ sub new {
|
|||
return $self;
|
||||
}
|
||||
|
||||
sub get_givenname {
|
||||
my ($self) = @_;
|
||||
return $self->{hostname};
|
||||
}
|
||||
|
||||
sub get_hostname {
|
||||
my ($self) = @_;
|
||||
return $self->{hostname};
|
||||
|
|
@ -77,6 +73,9 @@ sub get_username {
|
|||
|
||||
sub get_type {
|
||||
my ($self) = @_;
|
||||
if($self->check_ssh_hostname) {
|
||||
return 'ssh_alias';
|
||||
}
|
||||
return $self->{type} || q{};
|
||||
}
|
||||
|
||||
|
|
@ -129,22 +128,20 @@ sub get_realname {
|
|||
my ($self) = @_;
|
||||
|
||||
if ( !$self->{realname} ) {
|
||||
if ( $self->{type} && $self->{type} eq 'name' ) {
|
||||
if ( $ssh_hostname_for{ $self->{hostname} } ) {
|
||||
$self->{realname} = $self->{hostname};
|
||||
}
|
||||
else {
|
||||
my $gethost_obj = gethostbyname( $self->{hostname} );
|
||||
|
||||
$self->{realname}
|
||||
= defined($gethost_obj)
|
||||
? $gethost_obj->name()
|
||||
: $self->{hostname};
|
||||
}
|
||||
}
|
||||
else {
|
||||
if ( $self->get_type eq 'ssh_alias' ) {
|
||||
$self->{realname} = $self->{hostname};
|
||||
}
|
||||
else {
|
||||
my $gethost_obj = gethostbyname( $self->{hostname} );
|
||||
|
||||
$self->{realname}
|
||||
= defined($gethost_obj)
|
||||
? $gethost_obj->name()
|
||||
: $self->{hostname};
|
||||
}
|
||||
}
|
||||
else {
|
||||
$self->{realname} = $self->{hostname};
|
||||
}
|
||||
return $self->{realname};
|
||||
}
|
||||
|
|
@ -213,17 +210,17 @@ sub parse_host_string {
|
|||
if ( $host_string =~ s/\A(?:(.*?)@)// ) {
|
||||
|
||||
# catch where @ is in host_string but no text before it
|
||||
$username = $1 || q{};
|
||||
$username = $1;
|
||||
}
|
||||
|
||||
# Cannot check for a port with this type of IPv6 string
|
||||
#if ( $host_string =~ s/\A(?::(\d+)\A)// ) {
|
||||
# $port = $1 || q{};
|
||||
#}
|
||||
|
||||
# check for any geometry settings
|
||||
if ( $host_string =~ s/(?:=(.*?)$)// ) {
|
||||
$geometry = $1 || q{};
|
||||
$geometry = $1;
|
||||
}
|
||||
|
||||
# Check for a '/nnnn' port definition
|
||||
if ( $host_string =~ s!(?:/(\d+)$)!! ) {
|
||||
$port = $1;
|
||||
}
|
||||
|
||||
# use number of colons as a possible indicator
|
||||
|
|
@ -255,7 +252,7 @@ sub parse_host_string {
|
|||
}
|
||||
if ( $colon_count > 1
|
||||
&& $colon_count < 8
|
||||
&& $host_string =~ m/:(\d+)$/xsm )
|
||||
)
|
||||
{
|
||||
warn 'Ambiguous host string: "', $host_string, '"', $/;
|
||||
warn 'Assuming you meant "[', $host_string, ']"?', $/;
|
||||
|
|
@ -277,32 +274,6 @@ sub parse_host_string {
|
|||
type => 'ipv6',
|
||||
);
|
||||
}
|
||||
else {
|
||||
if ( $host_string =~ s/:(\d+)\A// ) {
|
||||
$port = $1;
|
||||
}
|
||||
|
||||
my $hostname = $host_string;
|
||||
|
||||
$self->debug(
|
||||
5,
|
||||
$self->loc(
|
||||
'Default parse u=[_1] h=[_2] p=[_3] g=[_4]',
|
||||
$username, $hostname, $port, $geometry,
|
||||
)
|
||||
);
|
||||
|
||||
return __PACKAGE__->new(
|
||||
parse_string => $parse_string,
|
||||
username => $username,
|
||||
hostname => $hostname,
|
||||
port => $port,
|
||||
geometry => $geometry,
|
||||
type => 'name',
|
||||
);
|
||||
}
|
||||
|
||||
# Due to above rules, we'll never get this far anyhow
|
||||
|
||||
# if we got this far, we didnt parse the host_string properly
|
||||
croak(
|
||||
|
|
@ -375,6 +346,10 @@ Create a new host object. 'hostname' is a required arg, 'username' and
|
|||
|
||||
=item $host->get_master
|
||||
|
||||
=item $host->get_geometry
|
||||
|
||||
=item $host->get_type
|
||||
|
||||
Return specific details about the host
|
||||
|
||||
=item $host->set_username
|
||||
|
|
@ -383,6 +358,10 @@ Return specific details about the host
|
|||
|
||||
=item $host->set_master
|
||||
|
||||
=item $host->set_geometry
|
||||
|
||||
=item $host->set_type
|
||||
|
||||
Set specific details about the host after its been created.
|
||||
|
||||
=item get_realname
|
||||
|
|
|
|||
35
t/02base.t
35
t/02base.t
|
|
@ -136,6 +136,17 @@ is( $trap->die, undef, 'returned ok' );
|
|||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
|
||||
$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_config = $base->config();
|
||||
};
|
||||
|
|
@ -208,4 +219,28 @@ like(
|
|||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->stdout, '', 'Got expected STDOUT' );
|
||||
|
||||
# basic checks - validity of config is tested elsewhere
|
||||
my %config;
|
||||
trap {
|
||||
%config = $object->load_file;
|
||||
};
|
||||
is( $trap->leaveby, 'die', 'died ok' );
|
||||
isa_ok( $trap->die, 'App::ClusterSSH::Exception',
|
||||
'Caught exception object OK' );
|
||||
is( $trap->die,
|
||||
q{"filename" arg not passed},
|
||||
'missing filename arg die message'
|
||||
);
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->stdout, '', 'Got expected STDOUT' );
|
||||
|
||||
trap {
|
||||
%config = $object->load_file( filename => $Bin . '/15config.t.file1' );
|
||||
};
|
||||
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' );
|
||||
|
||||
done_testing();
|
||||
|
|
|
|||
391
t/05getopts.t
Normal file
391
t/05getopts.t
Normal file
|
|
@ -0,0 +1,391 @@
|
|||
use strict;
|
||||
use warnings;
|
||||
|
||||
package Test::ClusterSSH::Mock;
|
||||
|
||||
# generate purpose object used to simplfy testing
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
my $config = {
|
||||
comms => 'testing',
|
||||
key_addhost => 'x',
|
||||
key_clientname => 'x',
|
||||
key_localname => 'x',
|
||||
key_quit => 'x',
|
||||
key_retilehosts => 'x',
|
||||
key_username => 'x',
|
||||
%args
|
||||
};
|
||||
return bless $config, $class;
|
||||
}
|
||||
|
||||
sub parent {
|
||||
my ($self) = @_;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub config {
|
||||
my ($self) = @_;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub load_configs {
|
||||
my ($self) = @_;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub config_file {
|
||||
my ($self) = @_;
|
||||
return {};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
package main;
|
||||
|
||||
use FindBin qw($Bin);
|
||||
use lib "$Bin/../lib";
|
||||
|
||||
use Test::More;
|
||||
use Test::Trap;
|
||||
|
||||
BEGIN { use_ok('App::ClusterSSH::Getopt') }
|
||||
|
||||
my $getopts;
|
||||
|
||||
my $mock_object = Test::ClusterSSH::Mock->new();
|
||||
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
isa_ok( $getopts, 'App::ClusterSSH::Getopt' );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'getops on new object okay' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
isa_ok( $getopts, 'App::ClusterSSH::Getopt' );
|
||||
|
||||
trap {
|
||||
$getopts->add_option();
|
||||
};
|
||||
is( $trap->leaveby, 'die', 'adding an empty option failed' );
|
||||
is( $trap->die,
|
||||
q{No "spec" passed to add_option},
|
||||
'empty add_option message'
|
||||
);
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
|
||||
trap {
|
||||
$getopts->add_option( spec => 'option' );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
trap {
|
||||
$getopts->option;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'calling option' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
is( $getopts->option, undef, 'Expecting no die message' );
|
||||
|
||||
local @ARGV = '--option1';
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->add_option( spec => 'option1' );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
trap {
|
||||
$getopts->option1;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'calling option' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
is( $getopts->option1, 1, 'Expecting no die message' );
|
||||
|
||||
local @ARGV = undef;
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->add_option( spec => 'option1', default => 5 );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
trap {
|
||||
$getopts->option1;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'calling option' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
is( $getopts->option1, 5, 'correct default value' );
|
||||
|
||||
local @ARGV = ( '--option1', '8' );
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->add_option( spec => 'option1=i', default => 5, );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
trap {
|
||||
$getopts->option1;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'calling option' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
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' );
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->add_option( spec => 'hidden', hidden => 1, no_acessor => 1, );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
trap {
|
||||
$getopts->add_option( spec => 'option1', help => 'help for 1' );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
trap {
|
||||
$getopts->add_option( spec => 'option2|o=s', help => 'help for 2' );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding option2 failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
trap {
|
||||
$getopts->add_option(
|
||||
spec => 'option3|alt_opt|O=i',
|
||||
help => 'help for 3',
|
||||
default => 5
|
||||
);
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding option3 failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
trap {
|
||||
$getopts->option1;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'calling option1' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
is( $getopts->option1, 1, 'option1 is as expected' );
|
||||
trap {
|
||||
$getopts->option1;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'calling option2' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
is( $getopts->option2, 'string', 'option2 is as expected' );
|
||||
trap {
|
||||
$getopts->option3;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'calling option3' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
is( $getopts->option3, 10, 'option3 is as expected' );
|
||||
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->add_common_ssh_options;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'calling option2' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->add_common_session_options;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'calling option2' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'getops on object with spec okay' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
my $pod;
|
||||
@ARGV = ('--generate-pod');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
$getopts->add_option(
|
||||
spec => 'long_opt|l=s',
|
||||
help => 'long opt help',
|
||||
default => 'default string'
|
||||
);
|
||||
$getopts->add_option( spec => 'another_long_opt|L=i', );
|
||||
$getopts->add_option( spec => 'a=s', help => 'short option only', );
|
||||
$getopts->add_option( spec => 'long', help => 'long option only', );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'exit', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
|
||||
$pod = $trap->stdout;
|
||||
|
||||
# run pod through a checker at some point as it should be 'clean'
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
@ARGV = ('--help');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'exit', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
@ARGV = ('-?');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'exit', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
@ARGV = ('-v');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'exit', 'version option exist okay' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
like( $trap->stdout, qr/^Version: /, 'Version string correct' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
@ARGV = ('-@');
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'exit', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
ok( defined( $trap->stdout ), 'Expecting no STDOUT' );
|
||||
like( $trap->stderr, qr{Unknown option: @}, 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
|
||||
# test some common options
|
||||
@ARGV = (
|
||||
'--unique-servers', '--title', 'title', '-p',
|
||||
'22', '--autoquit', '--tile', '--autoclose',
|
||||
'10',
|
||||
);
|
||||
$mock_object->{auto_close} = 0;
|
||||
$mock_object->{auto_quit} = 0;
|
||||
$mock_object->{window_tiling} = 0;
|
||||
$mock_object->{show_history} = 0;
|
||||
$mock_object->{use_all_a_records} = 1;
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object, );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
is( $mock_object->{auto_close}, 10, 'auto_close set right' );
|
||||
is( $mock_object->{auto_quit}, 1, 'auto_quit set right' );
|
||||
is( $mock_object->{window_tiling}, 1, 'window_tiling set right' );
|
||||
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',
|
||||
);
|
||||
$getopts = App::ClusterSSH::Getopt->new( parent => $mock_object, );
|
||||
trap {
|
||||
$getopts->getopts;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'adding an empty option failed' );
|
||||
is( $trap->die, undef, 'no error when spec provided' );
|
||||
is( $trap->stdout, '', 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, '', 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'Expecting no die message' );
|
||||
is( $mock_object->{auto_close}, 10, 'auto_close set right' );
|
||||
is( $mock_object->{auto_quit}, 0, 'auto_quit set right' );
|
||||
is( $mock_object->{window_tiling}, 0, 'window_tiling set right' );
|
||||
is( $mock_object->{show_history}, 1, 'show_history set right' );
|
||||
is( $mock_object->{use_all_a_records}, 0, 'use_all_a_records set right' );
|
||||
|
||||
done_testing;
|
||||
168
t/10host.t
168
t/10host.t
|
|
@ -27,6 +27,8 @@ is( $host->get_port, q{}, 'checking set works' );
|
|||
is( $host->get_username, q{}, 'username is unset' );
|
||||
is( $host->get_realname, 'hostname', 'realname set' );
|
||||
is( $host->get_geometry, q{}, 'geometry set' );
|
||||
is( $host->get_master, q{}, 'master set' );
|
||||
is( $host->get_type, q{}, 'type set' );
|
||||
|
||||
$host->set_port(2323);
|
||||
|
||||
|
|
@ -36,6 +38,8 @@ is( $host->get_port, 2323, 'checking set works' );
|
|||
is( $host->get_username, q{}, 'username is unset' );
|
||||
is( $host->get_realname, 'hostname', 'realname set' );
|
||||
is( $host->get_geometry, q{}, 'geometry set' );
|
||||
is( $host->get_master, q{}, 'master set' );
|
||||
is( $host->get_type, q{}, 'type set' );
|
||||
|
||||
$host->set_username('username');
|
||||
|
||||
|
|
@ -44,6 +48,8 @@ is( $host->get_port, 2323, 'checking set works' );
|
|||
is( $host->get_username, 'username', 'username is unset' );
|
||||
is( $host->get_realname, 'hostname', 'realname set' );
|
||||
is( $host->get_geometry, q{}, 'geometry set' );
|
||||
is( $host->get_master, q{}, 'master set' );
|
||||
is( $host->get_type, q{}, 'type set' );
|
||||
|
||||
$host->set_geometry('100x50+100+100');
|
||||
|
||||
|
|
@ -52,6 +58,28 @@ is( $host->get_port, 2323, 'checking set works' );
|
|||
is( $host->get_username, 'username', 'username is unset' );
|
||||
is( $host->get_realname, 'hostname', 'realname set' );
|
||||
is( $host->get_geometry, '100x50+100+100', 'geometry set' );
|
||||
is( $host->get_master, q{}, 'master set' );
|
||||
is( $host->get_type, q{}, 'type set' );
|
||||
|
||||
$host->set_master('some_host');
|
||||
|
||||
is( $host->get_hostname, 'hostname', 'checking set works' );
|
||||
is( $host->get_port, 2323, 'checking set works' );
|
||||
is( $host->get_username, 'username', 'username is unset' );
|
||||
is( $host->get_realname, 'hostname', 'realname set' );
|
||||
is( $host->get_geometry, '100x50+100+100', 'geometry set' );
|
||||
is( $host->get_master, 'some_host', 'master set' );
|
||||
is( $host->get_type, q{}, 'type set' );
|
||||
|
||||
$host->set_type('something');
|
||||
|
||||
is( $host->get_hostname, 'hostname', 'checking set works' );
|
||||
is( $host->get_port, 2323, 'checking set works' );
|
||||
is( $host->get_username, 'username', 'username is unset' );
|
||||
is( $host->get_realname, 'hostname', 'realname set' );
|
||||
is( $host->get_geometry, '100x50+100+100', 'geometry set' );
|
||||
is( $host->get_master, 'some_host', 'master set' );
|
||||
is( $host->get_type, 'something', 'type set' );
|
||||
|
||||
$host = undef;
|
||||
is( $host, undef, 'starting afresh' );
|
||||
|
|
@ -309,6 +337,14 @@ my %parse_tests = (
|
|||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'::1/2323' => {
|
||||
hostname => '::1',
|
||||
port => 2323,
|
||||
username => q{},
|
||||
realname => '::1',
|
||||
geometry => q{},
|
||||
type => 'ipv6',
|
||||
},
|
||||
'::1:2323=3x3+3+3' => {
|
||||
hostname => '::1:2323',
|
||||
port => q{},
|
||||
|
|
@ -318,6 +354,14 @@ my %parse_tests = (
|
|||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'::1/2323=3x3+3+3' => {
|
||||
hostname => '::1',
|
||||
port => 2323,
|
||||
username => q{},
|
||||
realname => '::1',
|
||||
geometry => '3x3+3+3',
|
||||
type => 'ipv6',
|
||||
},
|
||||
'user@::1' => {
|
||||
hostname => '::1',
|
||||
port => q{},
|
||||
|
|
@ -335,6 +379,14 @@ my %parse_tests = (
|
|||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'user@::1/4242' => {
|
||||
hostname => '::1',
|
||||
port => 4242,
|
||||
username => 'user',
|
||||
realname => '::1',
|
||||
geometry => q{},
|
||||
type => 'ipv6',
|
||||
},
|
||||
'user@::1=5x5+5+5' => {
|
||||
hostname => '::1',
|
||||
port => q{},
|
||||
|
|
@ -352,6 +404,14 @@ my %parse_tests = (
|
|||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'user@::1/4242=5x5+5+5' => {
|
||||
hostname => '::1',
|
||||
port => 4242,
|
||||
username => 'user',
|
||||
realname => '::1',
|
||||
geometry => '5x5+5+5',
|
||||
type => 'ipv6',
|
||||
},
|
||||
'[::1]' => {
|
||||
hostname => '::1',
|
||||
port => q{},
|
||||
|
|
@ -448,6 +508,14 @@ my %parse_tests = (
|
|||
geometry => q{},
|
||||
type => 'ipv6',
|
||||
},
|
||||
'2001:0db8:85a3:0000:0000:8a2e:0370:7334/22' => {
|
||||
hostname => '2001:0db8:85a3:0000:0000:8a2e:0370:7334',
|
||||
port => 22,
|
||||
username => q{},
|
||||
realname => '2001:0db8:85a3:0000:0000:8a2e:0370:7334',
|
||||
geometry => q{},
|
||||
type => 'ipv6',
|
||||
},
|
||||
'[2001:0db8:85a3:0000:0000:8a2e:0370:7334]' => {
|
||||
hostname => '2001:0db8:85a3:0000:0000:8a2e:0370:7334',
|
||||
port => q{},
|
||||
|
|
@ -497,6 +565,15 @@ my %parse_tests = (
|
|||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'2001:0db8:85a3::8a2e:0370/7334' => {
|
||||
hostname => '2001:0db8:85a3::8a2e:0370',
|
||||
port => 7334,
|
||||
username => q{},
|
||||
realname => '2001:0db8:85a3::8a2e:0370',
|
||||
geometry => q{},
|
||||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'pete@2001:0db8:85a3::8a2e:0370:7334' => {
|
||||
hostname => '2001:0db8:85a3::8a2e:0370:7334',
|
||||
port => q{},
|
||||
|
|
@ -506,6 +583,15 @@ my %parse_tests = (
|
|||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'pete@2001:0db8:85a3::8a2e:0370/7334' => {
|
||||
hostname => '2001:0db8:85a3::8a2e:0370',
|
||||
port => 7334,
|
||||
username => 'pete',
|
||||
realname => '2001:0db8:85a3::8a2e:0370',
|
||||
geometry => q{},
|
||||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'pete@2001:0db8:85a3::8a2e:0370:7334=2x3+4+5' => {
|
||||
hostname => '2001:0db8:85a3::8a2e:0370:7334',
|
||||
port => q{},
|
||||
|
|
@ -515,6 +601,15 @@ my %parse_tests = (
|
|||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'pete@2001:0db8:85a3::8a2e:0370/7334=2x3+4+5' => {
|
||||
hostname => '2001:0db8:85a3::8a2e:0370',
|
||||
port => 7334,
|
||||
username => 'pete',
|
||||
realname => '2001:0db8:85a3::8a2e:0370',
|
||||
geometry => '2x3+4+5',
|
||||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'2001:0db8:85a3::8a2e:0370:7334=2x3+4+5' => {
|
||||
hostname => '2001:0db8:85a3::8a2e:0370:7334',
|
||||
port => q{},
|
||||
|
|
@ -524,6 +619,15 @@ my %parse_tests = (
|
|||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'2001:0db8:85a3::8a2e:0370/7334=2x3+4+5' => {
|
||||
hostname => '2001:0db8:85a3::8a2e:0370',
|
||||
port => 7334,
|
||||
username => q{},
|
||||
realname => '2001:0db8:85a3::8a2e:0370',
|
||||
geometry => '2x3+4+5',
|
||||
type => 'ipv6',
|
||||
stderr => qr{Ambiguous host string:.*Assuming you meant}ms
|
||||
},
|
||||
'[2001:0db8:85a3::8a2e:0370:7334]' => {
|
||||
hostname => '2001:0db8:85a3::8a2e:0370:7334',
|
||||
port => q{},
|
||||
|
|
@ -556,25 +660,51 @@ my %parse_tests = (
|
|||
geometry => '2x3+4+5',
|
||||
type => 'ipv6',
|
||||
},
|
||||
'pete@[2001:0db8:8a2e:0370:7334]' => {
|
||||
hostname => '2001:0db8:8a2e:0370:7334',
|
||||
port => q{},
|
||||
username => 'pete',
|
||||
realname => '2001:0db8:8a2e:0370:7334',
|
||||
geometry => q{},
|
||||
type => 'ipv6',
|
||||
},
|
||||
'2001:0db8:8a2e:0370:7334:2001:0db8:8a2e:0370:7334:4535:3453:3453:3455' => {
|
||||
die => qr{Unable to parse hostname from}ms,
|
||||
},
|
||||
'some random rubbish' => {
|
||||
die => qr{Unable to parse hostname from}ms,
|
||||
},
|
||||
);
|
||||
|
||||
foreach my $ident ( keys(%parse_tests) ) {
|
||||
$host = undef;
|
||||
trap {
|
||||
$host = App::ClusterSSH::Host->parse_host_string($ident);
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
|
||||
#is( $trap->die, undef, 'returned ok' );
|
||||
#is( $trap->stdout, q{}, 'no stdout' );
|
||||
#is( $trap->stderr, q{}, 'no stderr' );
|
||||
if ( $parse_tests{$ident}{die} ) {
|
||||
is( $trap->leaveby, 'die', $ident . ' died correctly' );
|
||||
like( $trap->die, $parse_tests{$ident}{die}, $ident . ' died correctly' );
|
||||
next;
|
||||
}
|
||||
|
||||
is( $trap->leaveby, 'return', $ident . ' returned correctly' );
|
||||
is( $host, $parse_tests{$ident}{hostname}, 'stringify works on: '.$ident );
|
||||
|
||||
isa_ok( $host, "App::ClusterSSH::Host" );
|
||||
is( $host, $parse_tests{$ident}{hostname}, 'stringify works' );
|
||||
|
||||
for my $trap_undef (qw/ die /) {
|
||||
is( $trap->$trap_undef,
|
||||
$parse_tests{$ident}{$trap_undef},
|
||||
"$ident $trap_undef"
|
||||
);
|
||||
for my $trap_type (qw/ die /) {
|
||||
if ( ! $parse_tests{$ident}{$trap_type} ) {
|
||||
is( $trap->$trap_type,
|
||||
$parse_tests{$ident}{$trap_type},
|
||||
"$ident $trap_type"
|
||||
);
|
||||
} else {
|
||||
like( $trap->$trap_type,
|
||||
$parse_tests{$ident}{$trap_type},
|
||||
"$ident $trap_type"
|
||||
);
|
||||
}
|
||||
}
|
||||
|
||||
for my $trap_empty (qw/ stdout stderr /) {
|
||||
|
|
@ -591,8 +721,24 @@ foreach my $ident ( keys(%parse_tests) ) {
|
|||
"$ident $attr: " . $host->$method
|
||||
);
|
||||
}
|
||||
|
||||
is( $host->check_ssh_hostname, 0, $ident . ' not from ssh' );
|
||||
}
|
||||
|
||||
|
||||
# check for a non-existant file
|
||||
trap {
|
||||
$host = App::ClusterSSH::Host->new(
|
||||
hostname => 'ssh_test',
|
||||
ssh_config => $Bin . '/some_bad_filename',
|
||||
);
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->die, undef, 'returned ok' );
|
||||
isa_ok( $host, "App::ClusterSSH::Host" );
|
||||
is( $host, 'ssh_test', 'stringify works' );
|
||||
is( $host->check_ssh_hostname, 0, 'check_ssh_hostname ok for ssh_test', );
|
||||
|
||||
trap {
|
||||
$host = App::ClusterSSH::Host->new(
|
||||
hostname => 'ssh_test',
|
||||
|
|
@ -604,6 +750,7 @@ is( $trap->die, undef, 'returned ok' );
|
|||
isa_ok( $host, "App::ClusterSSH::Host" );
|
||||
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', );
|
||||
|
||||
for my $hostname (
|
||||
'server1', 'server2',
|
||||
|
|
@ -630,6 +777,7 @@ for my $hostname (
|
|||
'check_ssh_hostname ok for ' . $hostname );
|
||||
is( $host->get_realname, $hostname, 'realname set' );
|
||||
is( $host->get_geometry, q{}, 'geometry set' );
|
||||
is( $host->get_type, 'ssh_alias', 'geometry set' );
|
||||
}
|
||||
|
||||
done_testing();
|
||||
|
|
|
|||
23
t/15config.t
23
t/15config.t
|
|
@ -463,6 +463,29 @@ is( $trap->stderr,
|
|||
'Expecting no STDERR'
|
||||
);
|
||||
|
||||
note('move of .csshrc failure');
|
||||
$ENV{HOME} = tempdir( CLEANUP => 1 );
|
||||
open( $csshrc, '>', $ENV{HOME} . '/.csshrc' );
|
||||
print $csshrc "Something",$/;
|
||||
close($csshrc);
|
||||
open( $csshrc, '>', $ENV{HOME} . '/.csshrc.DISABLED' );
|
||||
print $csshrc "Something else",$/;
|
||||
close($csshrc);
|
||||
chmod(0666, $ENV{HOME} . '/.csshrc.DISABLED', $ENV{HOME} );
|
||||
$config = App::ClusterSSH::Config->new();
|
||||
trap {
|
||||
$config->write_user_config_file();
|
||||
};
|
||||
is( $trap->leaveby, 'die', 'died ok' );
|
||||
isa_ok( $config, "App::ClusterSSH::Config" );
|
||||
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, q{}, 'Expecting no STDERR' );
|
||||
is( $trap->die,
|
||||
q{Unable to create directory $HOME/.clusterssh: Permission denied} . $/,
|
||||
'Expected die msg ' . $trap->stderr
|
||||
);
|
||||
chmod (0755 , $ENV{HOME} . '/.csshrc.DISABLED', $ENV{HOME} );
|
||||
|
||||
note('check failure to write default config is caught');
|
||||
$ENV{HOME} = tempdir( CLEANUP => 1 );
|
||||
mkdir( $ENV{HOME} . '/.clusterssh' );
|
||||
|
|
|
|||
89
t/20helper.t
89
t/20helper.t
|
|
@ -11,6 +11,16 @@ use File::Temp qw(tempdir);
|
|||
|
||||
use Readonly;
|
||||
|
||||
package App::ClusterSSH::Config;
|
||||
|
||||
sub new {
|
||||
my ($class, %args) = @_;
|
||||
my $self = {%args};
|
||||
return bless $self, $class;
|
||||
}
|
||||
|
||||
package main;
|
||||
|
||||
BEGIN {
|
||||
use_ok("App::ClusterSSH::Helper") || BAIL_OUT('failed to use module');
|
||||
}
|
||||
|
|
@ -20,18 +30,71 @@ my $helper;
|
|||
$helper = App::ClusterSSH::Helper->new();
|
||||
isa_ok( $helper, 'App::ClusterSSH::Helper' );
|
||||
|
||||
#note('check failure to write default config is caught');
|
||||
#$ENV{HOME} = tempdir( CLEANUP => 1 );
|
||||
#mkdir($ENV{HOME}.'/.clusterssh');
|
||||
#mkdir($ENV{HOME}.'/.clusterssh/config');
|
||||
#$config = App::ClusterSSH::Config->new();
|
||||
#trap {
|
||||
# $config->load_configs();
|
||||
#};
|
||||
#is( $trap->leaveby, 'return', 'returned ok' );
|
||||
#isa_ok( $config, "App::ClusterSSH::Config" );
|
||||
#isa_ok( $config, "App::ClusterSSH::Config" );
|
||||
#is( $trap->stdout, q{}, 'Expecting no STDOUT' );
|
||||
#is( $trap->stderr, q{Unable to write default $HOME/.clusterssh/config: Is a directory}.$/, 'Expecting no STDERR' );
|
||||
my $script;
|
||||
|
||||
trap {
|
||||
$script = $helper->script;
|
||||
};
|
||||
is( $trap->leaveby, 'die', 'returned ok' );
|
||||
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, q{}, 'Expecting no STDERR' );
|
||||
is( $trap->die, 'No configuration provided or in wrong format', 'no config' );
|
||||
|
||||
trap {
|
||||
$script = $helper->script( something => 'nothing' );
|
||||
};
|
||||
is( $trap->leaveby, 'die', 'returned ok' );
|
||||
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, q{}, 'Expecting no STDERR' );
|
||||
is( $trap->die, 'No configuration provided or in wrong format',
|
||||
'bad format' );
|
||||
|
||||
my $mock_config = App::ClusterSSH::Config->new();
|
||||
trap {
|
||||
$script = $helper->script( $mock_config );
|
||||
};
|
||||
is( $trap->leaveby, 'die', 'returned ok' );
|
||||
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
|
||||
|
||||
# ignore stderr here as it will complain about missing xxx_arg var
|
||||
#is( $trap->stderr, q{}, 'Expecting no STDERR' );
|
||||
is( $trap->die, q{Config 'comms' not provided}, 'missing arg' );
|
||||
|
||||
$mock_config->{comms} = 'method';
|
||||
trap {
|
||||
$script = $helper->script( $mock_config );
|
||||
};
|
||||
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' not provided}, 'missing arg' );
|
||||
|
||||
$mock_config->{method} = 'binary';
|
||||
trap {
|
||||
$script = $helper->script( $mock_config );
|
||||
};
|
||||
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' );
|
||||
|
||||
$mock_config->{method_args} = 'rubbish';
|
||||
$mock_config->{command} = 'echo';
|
||||
$mock_config->{auto_close} = 5;
|
||||
trap {
|
||||
$script = $helper->script( $mock_config );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, q{}, 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'not died' );
|
||||
|
||||
trap {
|
||||
eval { $script };
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'returned ok' );
|
||||
is( $trap->stdout, q{}, 'Expecting no STDOUT' );
|
||||
is( $trap->stderr, q{}, 'Expecting no STDERR' );
|
||||
is( $trap->die, undef, 'not died' );
|
||||
|
||||
done_testing();
|
||||
|
|
|
|||
112
t/30cluster.t
112
t/30cluster.t
|
|
@ -12,11 +12,47 @@ use English '-no_match_vars';
|
|||
|
||||
use Readonly;
|
||||
|
||||
package Test::ClusterSSH::Mock;
|
||||
|
||||
# generate purpose object used to simplfy testing
|
||||
|
||||
sub new {
|
||||
my ( $class, %args ) = @_;
|
||||
my $config = {%args};
|
||||
return bless $config, $class;
|
||||
}
|
||||
|
||||
sub parent {
|
||||
my ($self) = @_;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub config {
|
||||
my ($self) = @_;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub load_configs {
|
||||
my ($self) = @_;
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub config_file {
|
||||
my ($self) = @_;
|
||||
return {};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
package main;
|
||||
|
||||
BEGIN {
|
||||
use_ok("App::ClusterSSH::Cluster") || BAIL_OUT('failed to use module');
|
||||
}
|
||||
|
||||
my $cluster1 = App::ClusterSSH::Cluster->new();
|
||||
my $mock_object = Test::ClusterSSH::Mock->new();
|
||||
|
||||
my $cluster1 = App::ClusterSSH::Cluster->new( parent => $mock_object );
|
||||
isa_ok( $cluster1, 'App::ClusterSSH::Cluster' );
|
||||
|
||||
my $cluster2 = App::ClusterSSH::Cluster->new();
|
||||
|
|
@ -88,34 +124,66 @@ is( scalar $cluster1->get_tag('default'),
|
|||
'Count correct'
|
||||
);
|
||||
|
||||
my $tags;
|
||||
trap {
|
||||
$tags = $cluster1->get_tag('does_not_exist');
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'non-existant tag returns correctly' );
|
||||
is( $trap->stdout, '', 'no stdout for non-existant get_tag' );
|
||||
is( $trap->stderr, '', 'no stderr for non-existant get_tag' );
|
||||
is( $tags, undef, 'non-existant tag returns undef' );
|
||||
|
||||
@default_expected
|
||||
= sort qw/ default people tag1 tag2 tag3 tag10 tag20 tag30 tag40 tag50 /;
|
||||
trap {
|
||||
@default = $cluster1->list_tags;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'list_tags returned okay' );
|
||||
is( $trap->stdout, '', 'no stdout for non-existant get_tag' );
|
||||
is( $trap->stderr, '', 'no stderr for non-existant get_tag' );
|
||||
is_deeply( \@default, \@default_expected, 'tag list correct' );
|
||||
|
||||
my $count;
|
||||
trap {
|
||||
$count = $cluster1->list_tags;
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'list_tags returned okay' );
|
||||
is( $trap->stdout, '', 'no stdout for non-existant get_tag' );
|
||||
is( $trap->stderr, '', 'no stderr for non-existant get_tag' );
|
||||
is_deeply( $count, 10, 'tag list count correct' );
|
||||
|
||||
# now checks against running an external command
|
||||
|
||||
my @external_expected;
|
||||
$mock_object->{external_cluster_command} = "$Bin/external_cluster_command";
|
||||
|
||||
@external_expected
|
||||
= $cluster1->get_external_clusters("$Bin/external_cluster_command");
|
||||
@external_expected = $cluster1->list_external_clusters();
|
||||
is_deeply(
|
||||
\@external_expected,
|
||||
[qw/ tag100 tag200 tag300 tag400 /],
|
||||
'External command no args'
|
||||
);
|
||||
is( scalar $cluster1->list_external_clusters, 4, 'External command tag count');
|
||||
|
||||
@external_expected = $cluster1->get_external_clusters();
|
||||
is_deeply( \@external_expected, [], 'External command no args' );
|
||||
|
||||
@external_expected = $cluster1->get_external_clusters(
|
||||
"$Bin/external_cluster_command tag1 tag2");
|
||||
@external_expected = $cluster1->get_external_clusters("tag1 tag2");
|
||||
is_deeply( \@external_expected, [qw/tag1 tag2 /],
|
||||
'External command: 2 args passed through' );
|
||||
|
||||
@external_expected = $cluster1->get_external_clusters(
|
||||
"$Bin/external_cluster_command tag100");
|
||||
@external_expected = $cluster1->get_external_clusters("tag100");
|
||||
is_deeply( \@external_expected, [qw/host100 /],
|
||||
'External command: 1 tag expanded to one host' );
|
||||
|
||||
@external_expected = $cluster1->get_external_clusters(
|
||||
"$Bin/external_cluster_command tag200");
|
||||
@external_expected = $cluster1->get_external_clusters("tag200");
|
||||
is_deeply(
|
||||
\@external_expected,
|
||||
[qw/host200 host205 host210 /],
|
||||
'External command: 1 tag expanded to 3 hosts and sorted'
|
||||
);
|
||||
|
||||
@external_expected = $cluster1->get_external_clusters(
|
||||
"$Bin/external_cluster_command tag400");
|
||||
@external_expected = $cluster1->get_external_clusters("tag400");
|
||||
is_deeply(
|
||||
\@external_expected,
|
||||
[ qw/host100 host200 host205 host210 host300 host325 host350 host400 host401 /
|
||||
|
|
@ -134,8 +202,7 @@ if ( $ENV{TEST_VERBOSE} ) {
|
|||
}
|
||||
|
||||
trap {
|
||||
@external_expected = $cluster1->get_external_clusters(
|
||||
"$Bin/external_cluster_command -x $redirect");
|
||||
@external_expected = $cluster1->get_external_clusters("-x $redirect");
|
||||
};
|
||||
like(
|
||||
$trap->die,
|
||||
|
|
@ -146,8 +213,7 @@ is( $trap->stdout, '', 'External command: no stdout from perl code' );
|
|||
is( $trap->stderr, '', 'External command: no stderr from perl code' );
|
||||
|
||||
trap {
|
||||
@external_expected = $cluster1->get_external_clusters(
|
||||
"$Bin/external_cluster_command -q $redirect");
|
||||
@external_expected = $cluster1->get_external_clusters("-q $redirect");
|
||||
};
|
||||
like(
|
||||
$trap->die,
|
||||
|
|
@ -157,6 +223,22 @@ like(
|
|||
is( $trap->stdout, '', 'External command: no stdout from perl code' );
|
||||
is( $trap->stderr, '', 'External command: no stderr from perl code' );
|
||||
|
||||
# check reading of cluster files
|
||||
trap {
|
||||
$cluster1->get_cluster_entries( $Bin . '/30cluster.file3' );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'exit okay on get_cluster_entries' );
|
||||
is( $trap->stdout, '', 'no stdout for get_cluster_entries' );
|
||||
is( $trap->stderr, '', 'no stderr for get_cluster_entries' );
|
||||
|
||||
# check reading of tag files
|
||||
trap {
|
||||
$cluster1->get_tag_entries( $Bin . '/30cluster.tag1' );
|
||||
};
|
||||
is( $trap->leaveby, 'return', 'exit okay on get_tag_entries' );
|
||||
is( $trap->stdout, '', 'no stdout for get_tag_entries' );
|
||||
is( $trap->stderr, '', 'no stderr for get_tag_entries' );
|
||||
|
||||
done_testing();
|
||||
|
||||
sub test_expected {
|
||||
|
|
|
|||
|
|
@ -7,7 +7,14 @@ use warnings;
|
|||
use Getopt::Std;
|
||||
|
||||
my $opt = {};
|
||||
getopts( 'qx', $opt );
|
||||
getopts( 'Lqx', $opt );
|
||||
|
||||
my %tag_lookup = (
|
||||
tag100 => [qw/ host100 /],
|
||||
tag200 => [qw/ host200 host210 host205 /],
|
||||
tag300 => [qw/ host300 host350 host325 /],
|
||||
tag400 => [qw/ tag100 tag200 tag300 host400 host401 /],
|
||||
);
|
||||
|
||||
# if we get '-q' option, force an error
|
||||
if ( $opt->{q} ) {
|
||||
|
|
@ -21,12 +28,11 @@ if ( $opt->{x} ) {
|
|||
exit 5;
|
||||
}
|
||||
|
||||
my %tag_lookup = (
|
||||
tag100 => [qw/ host100 /],
|
||||
tag200 => [qw/ host200 host210 host205 /],
|
||||
tag300 => [qw/ host300 host350 host325 /],
|
||||
tag400 => [qw/ tag100 tag200 tag300 host400 host401 /],
|
||||
);
|
||||
# '-L' means list out available tags
|
||||
if ( $opt->{L} ) {
|
||||
print join(' ', sort keys %tag_lookup), $/;
|
||||
exit 0;
|
||||
}
|
||||
|
||||
my @lookup = @ARGV;
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue