File Coverage

blib/lib/Test/SSH/Backend/OpenSSH.pm
Criterion Covered Total %
statement 25 108 23.1
branch 4 42 9.5
condition 1 8 12.5
subroutine 7 14 50.0
pod 0 1 0.0
total 37 173 21.3


line stmt bran cond sub pod time code
1             package Test::SSH::Backend::OpenSSH;
2              
3 1     1   3 use strict;
  1         1  
  1         28  
4 1     1   3 use warnings;
  1         1  
  1         21  
5              
6 1     1   615 use IO::Socket::INET;
  1         9998  
  1         6  
7              
8             require Test::SSH::Backend::Base;
9             our @ISA = qw(Test::SSH::Backend::Base);
10              
11             sub new {
12 2     2 0 8 my ($class, %opts) = @_;
13 2   50     10 my $override_server_config = delete $opts{override_server_config} || {};
14 2         14 my $sshd = $class->SUPER::new(%opts, auth_method => 'publickey');
15 2 50       10 unless ($sshd->{run_server}) {
16 0         0 $sshd->_log("backend skipped because run_server is set to false");
17 0         0 return;
18             }
19              
20 2 50       4 my $exe = $sshd->_sshd_executable or return;
21 0 0       0 $sshd->_create_keys or return;
22 0         0 my $run_dir = $sshd->_run_dir;
23 0         0 my $port = $sshd->{port} = $sshd->_find_unused_port;
24 1     1   915 use Tie::IxHash; # order must be preserved because Port must come before ListenAddress
  1         2313  
  1         794  
25              
26             tie my %Config, 'Tie::IxHash',
27             ( HostKey => $sshd->{host_key_path},
28             AuthorizedKeysFile => $sshd->_user_key_path_quoted . ".pub",
29             AllowUsers => $sshd->{user}, # only user running the script can log
30 0         0 AllowTcpForwarding => 'yes',
31             GatewayPorts => 'no', # bind port forwarder listener to localhost only
32             ChallengeResponseAuthentication => 'no',
33             PasswordAuthentication => 'no',
34             Port => $port,
35             ListenAddress => "localhost:$port",
36             LogLevel => 'INFO',
37             PermitRootLogin => 'yes',
38             PidFile => "$run_dir/sshd.pid",
39             PrintLastLog => 'no',
40             PrintMotd => 'no',
41             Subsystem => 'sftp /usr/lib/openssh/sftp-server',
42             UseDNS => 'no',
43             UsePrivilegeSeparation => 'no',
44             );
45 0         0 while (my($k,$v) = each %$override_server_config) {
46 0 0       0 if (defined $v) {
47 0         0 $Config{$k} = $v;
48             } else {
49 0         0 delete $Config{$k};
50             }
51             }
52 0 0       0 $sshd->_write_config(%Config)
53             or return;
54              
55 0         0 $sshd->_log('starting SSH server');
56 0 0       0 unless ($sshd->{server_pid} = $sshd->_run_cmd({out_name => 'server',
57             async => 1},
58             $exe,
59             '-D', # no daemon
60             '-e', # send output to STDERR
61             '-f', $sshd->{config_file})) {
62 0         0 $sshd->_error("unable to start SSH server at '$exe' on port $port", $!);
63 0         0 return undef;
64             }
65              
66 0         0 $sshd->_log("SSH server listening on port $port");
67              
68 0         0 $sshd->_log("trying to authenticate using keys");
69 0         0 $sshd->{auth_method} = 'publickey';
70 0         0 for my $key (@{$sshd->{user_keys}}) {
  0         0  
71 0         0 $sshd->_log("trying user key '$key'");
72 0         0 $sshd->{key_path} = $key;
73 0 0       0 if ($sshd->_test_server) {
74 0         0 $sshd->_log("key '$key' can be used to connect to host");
75 0         0 return $sshd;
76             }
77             }
78             ()
79 0         0 }
80              
81             sub _write_config {
82 0     0   0 my $sshd = shift;
83 0         0 my $fn = $sshd->{config_file} = "$sshd->{run_dir}/sshd_config";
84 0 0       0 if (open my $fn, '>', $fn) {
85 0         0 while (@_) {
86 0         0 my $k = shift;
87 0         0 my $v = shift;
88 0         0 print $fn "$k=$v\n";
89             }
90 0 0       0 close $fn and return 1
91             }
92 0         0 $sshd->_error("unable to create sshd configuration file at '$fn': $!");
93             ()
94 0         0 }
95              
96             sub _is_server_running {
97 0     0   0 my $sshd = shift;
98 0 0       0 if (defined (my $pid = $sshd->{server_pid})) {
99 0         0 my $rc = waitpid($pid, POSIX::WNOHANG());
100 0 0       0 $rc <= 0 and return $sshd->SUPER::_is_server_running;
101 0         0 delete $sshd->{server_pid};
102 0         0 $sshd->_log("server process has terminated (rc: $?)");
103             }
104 0         0 $sshd->_error("SSH server is not running");
105             return
106 0         0 }
107              
108             sub DESTROY {
109 2     2   3 my $sshd = shift;
110 2         11 local ($@, $!, $?, $^E);
111 2         3 eval {
112 2 50       6 if (defined (my $run_dir = $sshd->_run_dir)) {
113 2         4 for my $signal (qw(TERM TERM TERM TERM KILL)) {
114 2 50       65 open my $fh, '<', "$run_dir/sshd.pid" or last;
115 0         0 my $pid = <$fh>;
116 0 0       0 defined $pid or last;
117 0         0 chomp $pid;
118 0 0       0 $pid or last;
119 0         0 $sshd->_log("sending $signal signal to server (pid: $pid)");
120 0         0 kill $signal => $pid;
121 0         0 sleep 1;
122             }
123             }
124 2         10 $sshd->SUPER::DESTROY;
125             };
126             }
127              
128 2     2   20 sub _sshd_executable { shift->_find_executable('sshd', '-zalacain', 5) }
129              
130 0     0     sub _ssh_keygen_executable { shift->_find_executable('ssh-keygen') }
131              
132             sub _create_key {
133 0     0     my ($sshd, $fn) = @_;
134 0 0 0       -f $fn and -f "$fn.pub" and return 1;
135 0           $sshd->_log("generating key '$fn'");
136 0           my $tmpfn = join('.', $fn, $$, int(rand(9999999)));
137 0 0         if ($sshd->_run_cmd( { search_binary => 1 },
138             'ssh_keygen', -t => 'rsa', -b => 1024, -f => $tmpfn, -P => '')) {
139 0           unlink $fn;
140 0           unlink "$fn.pub";
141 0 0 0       if (rename $tmpfn, $fn and
142             rename "$tmpfn.pub", "$fn.pub") {
143 0           $sshd->_log("key generated");
144 0           return 1;
145             }
146             }
147 0           $sshd->_error("key generation failed");
148 0           return;
149             }
150              
151             sub _user_key_path_quoted {
152 0     0     my $sshd = shift;
153 0           my $key = $sshd->{user_key_path};
154 0           $key =~ s/%/%%/g;
155 0           $key;
156             }
157              
158             sub _create_keys {
159 0     0     my $sshd = shift;
160 0 0         my $kdir = $sshd->_private_dir('openssh/keys') or return;
161 0           my $user_key = $sshd->{user_key_path} = "$kdir/user_key";
162 0           my $host_key = $sshd->{host_key_path} = "$kdir/host_key";
163 0           $sshd->{user_keys} = [$user_key];
164 0 0         $sshd->_create_key($user_key) and
165             $sshd->_create_key($host_key);
166             }
167              
168             sub _find_unused_port {
169 0     0     my $sshd = shift;
170 0           $sshd->_log("looking for an unused TCP port");
171 0           for (1..32) {
172 0           my $port = 5000 + int rand 27000;
173 0 0         unless (IO::Socket::INET->new(PeerAddr => "localhost:$port",
174             Proto => 'tcp',
175             Timeout => $sshd->{timeout})) {
176 0           $sshd->_log("port $port is available");
177 0           return $port;
178             }
179             }
180 0           $sshd->_error("Can't find free TCP port for SSH server");
181 0           return;
182             }
183              
184             1;