package Test::SSH;
our $VERSION = '0.01';
use strict;
use warnings;
use Carp;
use File::Glob qw(:glob);
require File::Spec;
require Test::More;
my (@extra_path, @default_user_keys, $default_user, $private_dir);
if ( $^O =~ /^Win/) {
require Win32;
$default_user = Win32::LoginName();
}
else {
@extra_path = ( map { File::Spec->join($_, 'bin'), File::Spec->join($_, 'sbin') }
map { File::Spec->rel2abs($_) }
map { bsd_glob($_, GLOB_TILDE|GLOB_NOCASE) }
qw( /
/usr
/usr/local
~/
/usr/local/*ssh*
/usr/local/*ssh*/*
/opt/*SSH*
/opt/*SSH*/* ) );
@default_user_keys = bsd_glob("~/.ssh/*", GLOB_TILDE);
$default_user = getpwuid($>);
($private_dir) = bsd_glob("~/.libtest-ssh-perl", GLOB_TILDE|GLOB_NOCHECK);
}
@default_user_keys = grep {
my $fh;
open $fh, '<', $_ and <$fh> =~ /\bBEGIN\b.*\bPRIVATE\s+KEY\b/
} @default_user_keys;
my @default_path = grep { -d $_ } File::Spec->path, @extra_path;
unless (defined $private_dir) {
require File::temp;
$private_dir = File::Spec->join(File::Temp::tempdir(CLEANUP => 1),
"libtest-ssh-perl");
}
my $default_logger = sub { Test::More::diag("Test::SSH > @_") };
my %defaults = ( backends => [qw(Remote OpenSSH)],
timeout => 10,
port => 22,
host => 'localhost',
user => $default_user,
test_commands => ['true', 'exit', 'echo foo', 'date'],
path => \@default_path,
user_keys => \@default_user_keys,
private_dir => $private_dir,
logger => $default_logger,
run_server => 1,
);
sub new {
my ($class, %opts) = @_;
defined $opts{$_} or $opts{$_} = $defaults{$_} for keys %defaults;
if (defined (my $target = $ENV{TEST_SSH_TARGET})) {
$opts{requested_uri} = $target;
$opts{run_server} = 0;
}
if (defined (my $password = $ENV{TEST_SSH_PASSWORD})) {
$opts{password} = $password;
}
for my $be (@{delete $opts{backends}}) {
$be =~ /^\w+$/ or croak "bad backend name '$be'";
my $class = "Test::SSH::Backend::$be";
eval "require $class; 1" or die;
my $sshd = $class->new(%opts) or next;
$sshd->_log("connection uri", $sshd->uri(hide_password => 1));
return $sshd;
}
return;
}
1;
__END__
=head1 NAME
Test::SSH - Perl extension for testing SSH modules.
=head1 SYNOPSIS
use Test::SSH;
my $sshd = Test::SSH->new or skip_all;
my %opts;
$opts{host} = $sshd->host();
$opts{port} = $sshd->port();
$opts{user} = $sshd->user();
given($sshd->auth_method) {
when('password') {
$opts{password} = $sshd->password;
}
when('publickey') {
$opts{key_path} = $sshd->key_path;
}
}
my $openssh = Net::OpenSSH->new(%opts);
# or...
my $anyssh = Net::SSH::Any->new(%opts);
# or...
=head1 DESCRIPTION
In order to test properly Perl modules that use the SSH protocol, a
running server and a set of valid authentication credentials are
required.
If you test your modules on a controlled environment, you may know the
details of some local server or even have one configured just for that
purpose, but if you plan to upload your modules to CPAN (or for that
matter distribute them through any other medium) and want them to be
tested by the CPAN testers and by programmers installing them, things
become quite more difficult.
This module, uses several heuristics to find a local server or if none
is found, start a new one and then provide your testing scripts with
the credentials required to login.
Besides finding or starting a server the module also tests that it
works running some simple commands there. It would try hard to not
return the details of a server that is not working properly.
=head2 API
The module provides the following methods:
=over 4
=item $sshd = Test::SSH-E<gt>sshd(%opts)
Returns an object that can be queried to obtain the details of an
accesible SSH server. If no server is found or can be launched, undef
is returned.
In case a slave SSH server had been started, it will be killed once
the returned object goes out of scope.
For modules distributed through CPAN or that are going to be tested
on uncontrolled environments, commonly, no options should be
given as the default should already be the right choice.
In any case, these are the accepted options:
=over 4
=item requested_uri =E<gt> $uri
The module looks for a SSH server at the location given.
=item backends =E<gt> \@be
The module has several backend modules, every one implementing a
different approach for finding a SSH server. This argument allows to
select a specific subset of them.
=item path =E<gt> \@path
By default the module looks for SSH program binaries on the path and
on several common directories (i.e. C</opt/*SSH*>). This parameter
allows to change that.
=item timeout =E<gt> $timeout
Timeout used for running commands and stablishing remote
connections. The default is 10s.
=item test_commands =E<gt> \@cmds
When testing a SSH connection the module would try running the
commands given here until any of them succeeds. The defaults is a set
of very common Unix and shell commands (i.e. C<echo> or C<true>).
=item private_dir =E<gt> $dir
Location used to save data bewteen runs (i.e. generated user and host
key pairs).
The default is C<~/.libtest-ssh-perl>
=item private_keys =E<gt> \@key_paths
List of private keys that will be used for login into the remote host.
The default is to look for keys in C<~/.ssh>.
=item logger =E<gt> sub { ... }
Subroutine that will be called to report activity to the user.
The default is to use L<Test::More::diag>.
=item run_server => $bool
Enables/disables the backends that start a new SSH server.
For instance:
my $sshd = Test::SSH->new(run_server => ($ENV{AUTHOR_TESTING} || $ENV{AUTOMATED_TESTING}));
=back
Also, the following environment variables can be used to change the
module behaviour:
=over 4
=item TEST_SSH_TARGET
Target URI. When set, the module will look for the SSH server at the
location given. For instance:
TEST_SSH_TARGET=ssh://root:12345@ssh.google.com/ perl testing_script.pl
Setting this variable will also dissable launching a custom SSH server
for testing.
=item TEST_SSH_PASSWORD
When set, the value will be used as the login password. For instance:
TEST_SSH_PASSWORD=12345 perl testing_script.pl
=back
=item $sshd-E<gt>host
Returns the name of the host.
=item $sshd-E<gt>port
Returns the TCP port number where the server is listening.
=item $sshd-E<gt>user
Returns the name of the remote user
=item $sshd-E<gt>auth_method
Returns C<password> or C<publickey> indicating the method that can be
used to connect to the remote server.
=item $sshd-E<gt>key_path
When the authentication method is C<publickey>, this method returns
the path to the private key that can be used for loging into the
remote host.
=item $sshd-E<gt>password
When the authentication method is C<password>, this method returns the
password to be used for logging into the remote host.
=item $sshd-E<gt>uri(%opts)
Returns an L<URI> object descibing the SSH server.
The accepted options are as follows:
=over 4
=item hide_password => 1
When this option is set and in case of password authentication, the
password will be replaced by five asterisks on the returned URI.
=back
=item my %params = $sshd-E<gt>connection_params
Returns the connection parameters as a list of key/value pairs.
=back
=head1 BUGS AND SUPPORT
Well, this module is of complicated nature. It interacts in several
ways with external uncontrolled entities in an unknown environment, so
it may probably fail in lots of ways...
The good news is that if you use it and report me failures, bugs or
any unexpected failure I will try to fix it and it will improve and
mature over time!!!
In order to report bugs use the CPAN bugtracker
(L<http://rt.cpan.org>) or at your option the GitHub one
(L<https://github.com/salva/p5-Test-SSH/issues>).
The source code for the development version of the module is hosted at
GitHub: L<https://github.com/salva/p5-Test-SSH>). Patches or
pull-request are very well welcome!
=head2 Commercial support
Commercial support, professional services and custom software
development around this module are available through my current
company. Drop me an email with a rough description of your
requirements and we will get back to you ASAP.
=head2 My wishlist
If you like this module and you're feeling generous, take a look at my
Amazon Wish List: L<http://amzn.com/w/1WU1P6IR5QZ42>.
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2013 by Salvador FandiE<ntilde>o (sfandino@yahoo.com)
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.14.2 or,
at your option, any later version of Perl 5 you may have available.
=cut