File Coverage

blib/lib/Test/SSH.pm
Criterion Covered Total %
statement 23 28 82.1
branch 5 10 50.0
condition 2 2 100.0
subroutine 5 5 100.0
pod 0 1 0.0
total 35 46 76.0


line stmt bran cond sub pod time code
1             package Test::SSH;
2            
3             our $VERSION = '0.06_01';
4            
5 1     1   511 use strict;
  1         1  
  1         24  
6 1     1   3 use warnings;
  1         1  
  1         20  
7            
8 1     1   9 use Carp;
  1         1  
  1         53  
9 1     1   4 use File::Glob qw(:glob);
  1         0  
  1         706  
10             require File::Spec;
11             require Test::More;
12            
13             my (@extra_path, @default_user_keys, $default_user, $private_dir);
14            
15             my @default_test_commands = ('true', 'exit', 'echo foo', 'date',
16             'cmd /c ver', 'cmd /c echo foo');
17            
18             if ( $^O =~ /^MSWin/) {
19             require Win32;
20             $default_user = Win32::LoginName();
21            
22             my @pf;
23             for my $folder (qw(PROGRAM_FILES PROGRAM_FILES_COMMON)) {
24             my $dir = eval "Win32::GetFolderPath(Win32::$folder)";
25             if (defined $dir) {
26             push @extra_path, File::Spec->join($dir, 'PuTTY');
27             }
28             }
29             }
30             else {
31             @extra_path = ( map { File::Spec->join($_, 'bin'), File::Spec->join($_, 'sbin') }
32             map { File::Spec->rel2abs($_) }
33             map { bsd_glob($_, GLOB_TILDE|GLOB_NOCASE) }
34             qw( /
35             /usr
36             /usr/local
37             ~/
38             /usr/local/*ssh*
39             /usr/local/*ssh*/*
40             /opt/*SSH*
41             /opt/*SSH*/* ) );
42            
43             @default_user_keys = bsd_glob("~/.ssh/*", GLOB_TILDE);
44            
45             $default_user = getpwuid($>);
46            
47             ($private_dir) = bsd_glob("~/.libtest-ssh-perl", GLOB_TILDE|GLOB_NOCHECK);
48            
49             }
50            
51             @default_user_keys = grep {
52             my $fh;
53             open $fh, '<', $_ and <$fh> =~ /\bBEGIN\b.*\bPRIVATE\s+KEY\b/
54             } @default_user_keys;
55            
56            
57             my @default_path = grep { -d $_ } File::Spec->path, @extra_path;
58            
59             unless (defined $private_dir) {
60             require File::temp;
61             $private_dir = File::Spec->join(File::Temp::tempdir(CLEANUP => 1),
62             "libtest-ssh-perl");
63             }
64            
65             my $default_logger = sub { Test::More::diag("Test::SSH > @_") };
66            
67             my %defaults = ( backends => [qw(Remote OpenSSH)],
68             timeout => 10,
69             port => 22,
70             host => 'localhost',
71             user => $default_user,
72             test_commands => \@default_test_commands,
73             path => \@default_path,
74             user_keys => \@default_user_keys,
75             private_dir => $private_dir,
76             logger => $default_logger,
77             run_server => 1,
78             );
79            
80             sub new {
81 3     3 0 1873 my ($class, %opts) = @_;
82 3   100     55 defined $opts{$_} or $opts{$_} = $defaults{$_} for keys %defaults;
83            
84 3 50       9 if (defined (my $target = $ENV{TEST_SSH_TARGET})) {
85 0         0 $opts{requested_uri} = $target;
86 0         0 $opts{run_server} = 0;
87             }
88            
89 3 50       6 if (defined (my $password = $ENV{TEST_SSH_PASSWORD})) {
90 0         0 $opts{password} = $password;
91             }
92            
93 3         4 for my $be (@{delete $opts{backends}}) {
  3         6  
94 4 50       208 $be =~ /^\w+$/ or croak "bad backend name '$be'";
95 4         7 my $class = "Test::SSH::Backend::$be";
96 4 50       228 eval "require $class; 1" or die;
97 4 50       35 my $sshd = $class->new(%opts) or next;
98 0         0 $sshd->_log("connection uri", $sshd->uri(hidden_password => 1));
99 0         0 return $sshd;
100             }
101 3         619 return;
102             }
103            
104             1;
105             __END__