package Test::SSH; our $VERSION = '0.04'; 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); my @default_test_commands = ('true', 'exit', 'echo foo', 'date', 'cmd /c ver', 'cmd /c echo foo'); 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 => \@default_test_commands, 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(hidden_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-Esshd(%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 $uri The module looks for a SSH server at the location given. =item backends =E \@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 \@path By default the module looks for SSH program binaries on the path and on several common directories (i.e. C). This parameter allows to change that. =item timeout =E $timeout Timeout used for running commands and stablishing remote connections. The default is 10s. =item test_commands =E \@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 or C). =item private_dir =E $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 \@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 sub { ... } Subroutine that will be called to report activity to the user. The default is to use L. =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-Ehost Returns the name of the host. =item $sshd-Eport Returns the TCP port number where the server is listening. =item $sshd-Euser Returns the name of the remote user =item $sshd-Eauth_method Returns C or C indicating the method that can be used to connect to the remote server. =item $sshd-Ekey_path When the authentication method is C, this method returns the path to the private key that can be used for loging into the remote host. =item $sshd-Epassword When the authentication method is C, this method returns the password to be used for logging into the remote host. =item $sshd-Euri(%opts) Returns an L object descibing the SSH server. The accepted options are as follows: =over 4 =item hidden_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-Econnection_params Returns the connection parameters as a list of key/value pairs. =item $sshd-Eserver_version Connects to the server and retrieves its version signature. =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) or at your option the GitHub one (L). The source code for the development version of the module is hosted at GitHub: L). 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. =head1 COPYRIGHT AND LICENSE Copyright (C) 2013 by Salvador FandiEo (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