line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::SSH::Backend::Base;
|
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
6
|
use strict;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
4
|
1
|
|
|
1
|
|
5
|
use warnings;
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
19
|
|
5
|
1
|
|
|
1
|
|
4
|
use File::Spec;
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
24
|
|
6
|
1
|
|
|
1
|
|
4
|
use File::Glob qw(:glob);
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
133
|
|
7
|
1
|
|
|
1
|
|
6
|
use Carp;
|
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
37
|
|
8
|
1
|
|
|
1
|
|
398
|
use POSIX;
|
|
1
|
|
|
|
|
4487
|
|
|
1
|
|
|
|
|
5
|
|
9
|
1
|
|
|
1
|
|
2576
|
use FileHandle;
|
|
1
|
|
|
|
|
7316
|
|
|
1
|
|
|
|
|
5
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
687
|
use Test::SSH::Patch::URI::ssh;
|
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
59
|
|
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
my @private = qw(timeout logger test_commands path user_keys private_dir requested_uri run_server c_params);
|
14
|
|
|
|
|
|
|
my @public = qw(host port auth_method password user key_path);
|
15
|
|
|
|
|
|
|
for my $accessor (@public) {
|
16
|
1
|
|
|
1
|
|
7
|
no strict 'refs';
|
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2900
|
|
17
|
0
|
|
|
0
|
|
0
|
*$accessor = sub { shift->{$accessor} }
|
18
|
|
|
|
|
|
|
}
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub new {
|
21
|
4
|
|
|
4
|
0
|
22
|
my ($class, %opts) = @_;
|
22
|
|
|
|
|
|
|
|
23
|
4
|
|
|
|
|
11
|
my $sshd = {};
|
24
|
4
|
|
|
|
|
11
|
bless $sshd, $class;
|
25
|
4
|
|
|
|
|
69
|
$sshd->{$_} = delete($opts{$_}) for (@public, @private);
|
26
|
|
|
|
|
|
|
|
27
|
4
|
50
|
|
|
|
23
|
if (defined (my $uri_txt = $sshd->{requested_uri})) {
|
28
|
0
|
|
|
|
|
0
|
my $uri = URI->new($uri_txt);
|
29
|
0
|
0
|
|
|
|
0
|
$uri->scheme('ssh') unless defined $uri->scheme;
|
30
|
0
|
0
|
|
|
|
0
|
if ($uri->scheme ne 'ssh') {
|
31
|
0
|
|
|
|
|
0
|
$sshd->_error("not a ssh URI '$uri'");
|
32
|
0
|
|
|
|
|
0
|
return;
|
33
|
|
|
|
|
|
|
}
|
34
|
|
|
|
|
|
|
|
35
|
0
|
|
|
|
|
0
|
for my $k (qw(password host port user c_params)) {
|
36
|
0
|
|
|
|
|
0
|
my $v = $uri->$k;
|
37
|
0
|
0
|
|
|
|
0
|
$sshd->{$k} = $v if defined $v;
|
38
|
|
|
|
|
|
|
}
|
39
|
|
|
|
|
|
|
|
40
|
0
|
0
|
|
|
|
0
|
for (@{$opts{c_params} || []}) {
|
|
0
|
|
|
|
|
0
|
|
41
|
0
|
0
|
|
|
|
0
|
if (/^key_path=(.*)$/) {
|
42
|
0
|
|
|
|
|
0
|
$sshd->{user_keys} = [$1];
|
43
|
|
|
|
|
|
|
}
|
44
|
|
|
|
|
|
|
}
|
45
|
|
|
|
|
|
|
}
|
46
|
|
|
|
|
|
|
|
47
|
4
|
|
|
|
|
22
|
$sshd->_write_fh('log'); # opens log file
|
48
|
4
|
|
|
|
|
23
|
$sshd->_log("starting backend of class '$class'");
|
49
|
|
|
|
|
|
|
|
50
|
4
|
|
|
|
|
692
|
return $sshd;
|
51
|
|
|
|
|
|
|
}
|
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
sub _log {
|
54
|
31
|
|
|
31
|
|
245
|
local ($@, $!, $?, $^E);
|
55
|
31
|
|
|
|
|
85
|
my $sshd = shift;
|
56
|
31
|
|
|
|
|
82
|
my $line = join(': ', @_);
|
57
|
31
|
100
|
|
|
|
97
|
if (defined (my $fhs = $sshd->{log_fhs})) {
|
58
|
22
|
|
|
|
|
34
|
print {$fhs->[1]} "# Test::SSH > $line\n"
|
|
22
|
|
|
|
|
96
|
|
59
|
|
|
|
|
|
|
}
|
60
|
31
|
|
|
|
|
96
|
eval { $sshd->{logger}->($line) }
|
|
31
|
|
|
|
|
96
|
|
61
|
|
|
|
|
|
|
}
|
62
|
|
|
|
|
|
|
|
63
|
2
|
|
|
2
|
|
30
|
sub _error { shift->_log(error => @_) }
|
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
my $dev_null = File::Spec->devnull;
|
66
|
0
|
|
|
0
|
|
0
|
sub _dev_null { $dev_null }
|
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
my $up_dir = File::Spec->updir;
|
69
|
|
|
|
|
|
|
my $cur_dir = File::Spec->curdir;
|
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
0
|
|
0
|
sub _is_server_running { defined(shift->server_version) }
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
sub _run_remote_cmd {
|
74
|
0
|
|
|
0
|
|
0
|
my ($sshd, @cmd) = @_;
|
75
|
|
|
|
|
|
|
|
76
|
0
|
0
|
|
|
|
0
|
if ($sshd->_is_server_running) {
|
77
|
0
|
|
|
|
|
0
|
my $auth_method = $sshd->{auth_method};
|
78
|
0
|
|
|
|
|
0
|
my (@auth_args, @auth_opts);
|
79
|
0
|
0
|
|
|
|
0
|
if ($auth_method eq 'publickey') {
|
|
|
0
|
|
|
|
|
|
80
|
|
|
|
|
|
|
@auth_args = ( -i => $sshd->{key_path},
|
81
|
0
|
|
|
|
|
0
|
-o => 'PreferredAuthentications=publickey',
|
82
|
|
|
|
|
|
|
-o => 'BatchMode=yes' );
|
83
|
|
|
|
|
|
|
}
|
84
|
|
|
|
|
|
|
elsif ($auth_method eq 'password') {
|
85
|
0
|
|
|
|
|
0
|
@auth_args = ( -o => 'PreferredAuthentications=password,keyboard-interactive',
|
86
|
|
|
|
|
|
|
-o => 'BatchMode=no' );
|
87
|
0
|
|
|
|
|
0
|
@auth_opts = ( password => $sshd->{password} );
|
88
|
|
|
|
|
|
|
}
|
89
|
|
|
|
|
|
|
else {
|
90
|
0
|
|
|
|
|
0
|
$sshd->_error("unsupported authentication method $auth_method");
|
91
|
0
|
|
|
|
|
0
|
return;
|
92
|
|
|
|
|
|
|
}
|
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
return $sshd->_run_cmd( { search_binary => 1, @auth_opts },
|
95
|
|
|
|
|
|
|
'ssh',
|
96
|
|
|
|
|
|
|
'-T',
|
97
|
|
|
|
|
|
|
-F => $dev_null,
|
98
|
|
|
|
|
|
|
-p => $sshd->{port},
|
99
|
|
|
|
|
|
|
-l => $sshd->{user},
|
100
|
|
|
|
|
|
|
-o => 'StrictHostKeyChecking=no',
|
101
|
|
|
|
|
|
|
-o => "UserKnownHostsFile=$dev_null",
|
102
|
|
|
|
|
|
|
@auth_args,
|
103
|
|
|
|
|
|
|
'--',
|
104
|
|
|
|
|
|
|
$sshd->{host},
|
105
|
0
|
|
|
|
|
0
|
@cmd );
|
106
|
|
|
|
|
|
|
}
|
107
|
|
|
|
|
|
|
}
|
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub _find_binaries {
|
110
|
2
|
|
|
2
|
|
9
|
my ($sshd, @cmds) = @_;
|
111
|
2
|
|
|
|
|
11
|
$sshd->_log("resolving command(s) @cmds");
|
112
|
2
|
|
|
|
|
328
|
my @path = @{$sshd->{path}};
|
|
2
|
|
|
|
|
36
|
|
113
|
|
|
|
|
|
|
|
114
|
2
|
50
|
|
|
|
11
|
if (defined $sshd->{_ssh_executable}) {
|
115
|
0
|
|
|
|
|
0
|
my $dir = File::Spec->join((File::Spec->splitpath($sshd->{_ssh_executable}))[0,1]);
|
116
|
0
|
|
|
|
|
0
|
unshift @path, $dir, File::Spec->join($dir, $up_dir, 'sbin');
|
117
|
|
|
|
|
|
|
}
|
118
|
|
|
|
|
|
|
|
119
|
2
|
|
|
|
|
5
|
my @bins;
|
120
|
2
|
|
|
|
|
15
|
$sshd->_log("search path is " . join(":", @path));
|
121
|
2
|
|
|
|
|
357
|
for my $path (@path) {
|
122
|
24
|
|
|
|
|
55
|
for my $cmd (@cmds) {
|
123
|
24
|
|
|
|
|
208
|
my $fn = File::Spec->join($path, $cmd);
|
124
|
24
|
50
|
|
|
|
401
|
if (-f $fn) {
|
125
|
0
|
|
|
|
|
0
|
$sshd->_log("candidate found at $fn");
|
126
|
0
|
0
|
|
|
|
0
|
unless (-x $fn) {
|
127
|
0
|
|
|
|
|
0
|
$sshd->_log("file $fn is not executable");
|
128
|
0
|
|
|
|
|
0
|
next;
|
129
|
|
|
|
|
|
|
}
|
130
|
0
|
0
|
|
|
|
0
|
unless (-B $fn) {
|
131
|
0
|
|
|
|
|
0
|
$sshd->_log("file $fn looks like a wrapper, ignoring it");
|
132
|
0
|
|
|
|
|
0
|
next;
|
133
|
|
|
|
|
|
|
}
|
134
|
0
|
0
|
|
|
|
0
|
return $fn unless wantarray;
|
135
|
0
|
|
|
|
|
0
|
push @bins, $fn;
|
136
|
|
|
|
|
|
|
}
|
137
|
|
|
|
|
|
|
}
|
138
|
|
|
|
|
|
|
}
|
139
|
2
|
|
|
|
|
9
|
return @bins;
|
140
|
|
|
|
|
|
|
}
|
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
sub _find_executable {
|
143
|
2
|
|
|
2
|
|
9
|
my ($sshd, $cmd, $version_flags, $min_version) = @_;
|
144
|
2
|
|
|
|
|
7
|
my $slot = "${cmd}_executable";
|
145
|
2
|
50
|
|
|
|
8
|
defined $sshd->{$slot} and return $sshd->{$slot};
|
146
|
2
|
50
|
|
|
|
7
|
if (defined $version_flags) {
|
147
|
2
|
|
|
|
|
33
|
for my $bin ($sshd->_find_binaries($cmd)) {
|
148
|
0
|
|
|
|
|
0
|
$sshd->_log("checking version of '$bin'");
|
149
|
0
|
|
|
|
|
0
|
my $out = $sshd->_capture_cmd( $bin, $version_flags );
|
150
|
0
|
0
|
|
|
|
0
|
if (defined $out) {
|
151
|
0
|
0
|
|
|
|
0
|
if (my ($ver, $mayor) = $out =~ /^(OpenSSH[_\-](\d+)\.\d+(?:\.\d+)?(?:p\d+))/m) {
|
152
|
0
|
0
|
0
|
|
|
0
|
if (!defined($min_version) or $mayor >= $min_version) {
|
153
|
0
|
|
|
|
|
0
|
$sshd->_log("executable version is $ver, selecting it!");
|
154
|
0
|
|
|
|
|
0
|
$sshd->{$slot} = $bin;
|
155
|
0
|
|
|
|
|
0
|
last;
|
156
|
|
|
|
|
|
|
}
|
157
|
|
|
|
|
|
|
else {
|
158
|
0
|
|
|
|
|
0
|
$sshd->_log("executable is too old ($ver), $min_version.x required");
|
159
|
0
|
|
|
|
|
0
|
next;
|
160
|
|
|
|
|
|
|
}
|
161
|
|
|
|
|
|
|
}
|
162
|
|
|
|
|
|
|
}
|
163
|
0
|
|
|
|
|
0
|
$sshd->_log("command failed");
|
164
|
|
|
|
|
|
|
}
|
165
|
|
|
|
|
|
|
}
|
166
|
|
|
|
|
|
|
else {
|
167
|
0
|
|
|
|
|
0
|
$sshd->{$slot} = $sshd->_find_binaries($cmd)
|
168
|
|
|
|
|
|
|
}
|
169
|
2
|
50
|
|
|
|
10
|
if (defined (my $bin = $sshd->{$slot})) {
|
170
|
0
|
|
|
|
|
0
|
$sshd->_log("command '$cmd' resolved as '$sshd->{$slot}'");
|
171
|
0
|
|
|
|
|
0
|
return $bin;
|
172
|
|
|
|
|
|
|
}
|
173
|
|
|
|
|
|
|
else {
|
174
|
2
|
|
|
|
|
16
|
$sshd->_error("no executable found for command '$cmd'");
|
175
|
2
|
|
|
|
|
411
|
return;
|
176
|
|
|
|
|
|
|
}
|
177
|
|
|
|
|
|
|
}
|
178
|
|
|
|
|
|
|
|
179
|
0
|
|
|
0
|
|
0
|
sub _ssh_executable { shift->_find_executable('ssh', '-V', 5) }
|
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub _mkdir {
|
182
|
32
|
|
|
32
|
|
55
|
my ($sshd, $dir) = @_;
|
183
|
32
|
50
|
|
|
|
101
|
if (defined $dir) {
|
184
|
32
|
100
|
|
|
|
469
|
-d $dir and return 1;
|
185
|
15
|
50
|
33
|
|
|
1074
|
if (mkdir($dir, 0700) and -d $dir) {
|
186
|
15
|
|
|
|
|
128
|
$sshd->_log("directory '$dir' created");
|
187
|
15
|
|
|
|
|
3014
|
return 1;
|
188
|
|
|
|
|
|
|
}
|
189
|
0
|
|
|
|
|
0
|
$sshd->_error("unable to create directory '$dir'", $!);
|
190
|
|
|
|
|
|
|
}
|
191
|
0
|
|
|
|
|
0
|
return;
|
192
|
|
|
|
|
|
|
}
|
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub _private_dir {
|
195
|
8
|
|
|
8
|
|
19
|
my ($sshd, $subdir) = @_;
|
196
|
8
|
|
|
|
|
14
|
my $slot = "private_dir";
|
197
|
8
|
|
|
|
|
17
|
my $pdir = $sshd->{$slot};
|
198
|
8
|
50
|
|
|
|
25
|
$sshd->_mkdir($pdir) or return;
|
199
|
|
|
|
|
|
|
|
200
|
8
|
50
|
|
|
|
23
|
if (defined $subdir) {
|
201
|
8
|
|
|
|
|
32
|
for my $sd (split /\//, $subdir) {
|
202
|
28
|
|
|
|
|
55
|
$slot .= "/$sd";
|
203
|
28
|
100
|
|
|
|
67
|
if (defined $sshd->{$slot}) {
|
204
|
4
|
|
|
|
|
10
|
$pdir = $sshd->{$slot};
|
205
|
|
|
|
|
|
|
}
|
206
|
|
|
|
|
|
|
else {
|
207
|
24
|
|
|
|
|
284
|
$pdir = File::Spec->join($pdir, $sd);
|
208
|
24
|
50
|
|
|
|
61
|
$sshd->_mkdir($pdir) or return;
|
209
|
24
|
|
|
|
|
93
|
$sshd->{$slot} = $pdir;
|
210
|
|
|
|
|
|
|
}
|
211
|
|
|
|
|
|
|
}
|
212
|
|
|
|
|
|
|
}
|
213
|
8
|
|
|
|
|
35
|
return $pdir;
|
214
|
|
|
|
|
|
|
}
|
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub _backend_dir {
|
217
|
8
|
|
|
8
|
|
19
|
my ($sshd, $subdir) = @_;
|
218
|
8
|
50
|
|
|
|
25
|
my $class = (ref $sshd ? ref $sshd : $sshd);
|
219
|
8
|
50
|
|
|
|
87
|
if (my ($be) = $class =~ /\b(\w+)$/) {
|
220
|
8
|
|
|
|
|
40
|
return $sshd->_private_dir(lc($be) . '/' . $subdir);
|
221
|
|
|
|
|
|
|
}
|
222
|
0
|
|
|
|
|
0
|
$sshd->_error("unable to infer backend name!");
|
223
|
|
|
|
|
|
|
return
|
224
|
0
|
|
|
|
|
0
|
}
|
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
sub _run_dir {
|
227
|
10
|
|
|
10
|
|
19
|
my $sshd = shift;
|
228
|
10
|
100
|
|
|
|
30
|
unless (defined $sshd->{run_dir}) {
|
229
|
4
|
|
|
|
|
24
|
$sshd->{run_dir} = $sshd->_backend_dir("run/$$");
|
230
|
|
|
|
|
|
|
# $sshd->_log(run_dir => $sshd->{run_dir});
|
231
|
|
|
|
|
|
|
}
|
232
|
|
|
|
|
|
|
$sshd->{run_dir}
|
233
|
10
|
|
|
|
|
67
|
}
|
234
|
|
|
|
|
|
|
|
235
|
4
|
|
|
4
|
|
11
|
sub _run_dir_last { shift->_backend_dir('openssh/run/last') }
|
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub _fh {
|
238
|
4
|
|
|
4
|
|
9
|
my ($sshd, $name, $write) = @_;
|
239
|
4
|
|
|
|
|
11
|
my $slot = "${name}_fhs";
|
240
|
4
|
50
|
|
|
|
19
|
unless (defined $sshd->{$slot}) {
|
241
|
4
|
|
|
|
|
17
|
my $fn = File::Spec->join($sshd->_run_dir, "$name.out");
|
242
|
4
|
|
|
|
|
10
|
my ($rfh, $wfh);
|
243
|
4
|
50
|
|
|
|
295
|
unless (open $wfh, '>>', $fn) {
|
244
|
0
|
|
|
|
|
0
|
$sshd->_log("unable to open file '$fn' for writting");
|
245
|
0
|
|
|
|
|
0
|
return;
|
246
|
|
|
|
|
|
|
}
|
247
|
4
|
50
|
|
|
|
114
|
unless (open $rfh, '<', $fn) {
|
248
|
0
|
|
|
|
|
0
|
$sshd->_log("unable to open file '$fn' for writting");
|
249
|
0
|
|
|
|
|
0
|
return;
|
250
|
|
|
|
|
|
|
};
|
251
|
4
|
|
|
|
|
35
|
$rfh->autoflush(1);
|
252
|
4
|
|
|
|
|
238
|
$sshd->{$slot} = [$rfh, $wfh];
|
253
|
|
|
|
|
|
|
}
|
254
|
4
|
50
|
|
|
|
64
|
$sshd->{$slot}[$write ? 1 : 0];
|
255
|
|
|
|
|
|
|
}
|
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
sub _read_fh {
|
259
|
0
|
|
|
0
|
|
0
|
my ($sshd, $name) = @_;
|
260
|
0
|
|
|
|
|
0
|
$sshd->_fh($name, 0);
|
261
|
|
|
|
|
|
|
}
|
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub _write_fh {
|
264
|
4
|
|
|
4
|
|
13
|
my ($sshd, $name) = @_;
|
265
|
4
|
|
|
|
|
20
|
$sshd->_fh($name, 1);
|
266
|
|
|
|
|
|
|
}
|
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub _run_cmd {
|
269
|
0
|
|
|
0
|
|
0
|
my $sshd = shift;
|
270
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] ? %{shift()} : ());
|
|
0
|
|
|
|
|
0
|
|
271
|
0
|
|
|
|
|
0
|
my @cmd = @_;
|
272
|
|
|
|
|
|
|
|
273
|
0
|
|
|
|
|
0
|
$sshd->_log("running command '@cmd'");
|
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
0
|
delete @{$sshd}{qw(cmd_output_offset cmd_output_name)};
|
|
0
|
|
|
|
|
0
|
|
276
|
|
|
|
|
|
|
|
277
|
0
|
0
|
|
|
|
0
|
if (delete $opts{search_binary}) {
|
278
|
0
|
0
|
0
|
|
|
0
|
if (my $method = ($sshd->can("$cmd[0]_executable") or $sshd->can("_$cmd[0]_executable"))) {
|
279
|
0
|
|
|
|
|
0
|
$cmd[0] = $sshd->$method;
|
280
|
0
|
0
|
|
|
|
0
|
defined $cmd[0] or return;
|
281
|
|
|
|
|
|
|
}
|
282
|
|
|
|
|
|
|
}
|
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
0
|
my $password = delete $opts{password};
|
285
|
|
|
|
|
|
|
|
286
|
0
|
|
0
|
|
|
0
|
my $out_fn = delete $opts{out_name} || 'client';
|
287
|
0
|
0
|
|
|
|
0
|
my $out_fh = $sshd->_write_fh($out_fn) or return;
|
288
|
0
|
|
|
|
|
0
|
print $out_fh "=" x 80, "\ncmd: @cmd\n", "-" x 80, "\n";
|
289
|
0
|
|
|
|
|
0
|
$sshd->{cmd_output_offset} = tell $out_fh;
|
290
|
0
|
|
|
|
|
0
|
$sshd->{cmd_output_name} = $out_fn;
|
291
|
|
|
|
|
|
|
|
292
|
0
|
0
|
|
|
|
0
|
if ($^O =~ /^MSWin/) {
|
293
|
0
|
0
|
|
|
|
0
|
if (defined $password) {
|
294
|
0
|
|
|
|
|
0
|
$sshd->_error('running commands with a password is not supported on windows');
|
295
|
0
|
|
|
|
|
0
|
return;
|
296
|
|
|
|
|
|
|
}
|
297
|
0
|
|
|
|
|
0
|
local $@;
|
298
|
0
|
|
|
|
|
0
|
my $r = eval {
|
299
|
0
|
|
|
|
|
0
|
local (*STDIN, *STDOUT, *STDERR);
|
300
|
0
|
0
|
|
|
|
0
|
open STDIN, '<', $dev_null or die $!;
|
301
|
0
|
0
|
|
|
|
0
|
open STDOUT, '>>&', $out_fh or die $!;
|
302
|
0
|
0
|
|
|
|
0
|
open STDOUT, '>>&', *STDOUT or die $!;
|
303
|
|
|
|
|
|
|
( delete $opts{async}
|
304
|
0
|
0
|
|
|
|
0
|
? ( system 1, @cmd )
|
305
|
|
|
|
|
|
|
: ( system(@cmd) == 0 ) )
|
306
|
|
|
|
|
|
|
};
|
307
|
0
|
0
|
|
|
|
0
|
$@ and $sshd->_log($@);
|
308
|
0
|
|
|
|
|
0
|
return $r;
|
309
|
|
|
|
|
|
|
}
|
310
|
|
|
|
|
|
|
else {
|
311
|
0
|
|
|
|
|
0
|
my $pty;
|
312
|
0
|
0
|
|
|
|
0
|
if (defined $password) {
|
313
|
0
|
0
|
|
|
|
0
|
unless (eval { require IO::Pty; 1 }) {
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
314
|
0
|
|
|
|
|
0
|
$sshd->_error("IO::Pty not available");
|
315
|
0
|
|
|
|
|
0
|
return;
|
316
|
|
|
|
|
|
|
}
|
317
|
0
|
|
|
|
|
0
|
$pty = IO::Pty->new;
|
318
|
|
|
|
|
|
|
}
|
319
|
|
|
|
|
|
|
|
320
|
0
|
|
|
|
|
0
|
my $pid = fork;
|
321
|
0
|
0
|
|
|
|
0
|
unless ($pid) {
|
322
|
0
|
0
|
|
|
|
0
|
unless (defined $pid) {
|
323
|
0
|
|
|
|
|
0
|
$sshd->_log("fork failed", $!);
|
324
|
0
|
|
|
|
|
0
|
return;
|
325
|
|
|
|
|
|
|
}
|
326
|
0
|
|
|
|
|
0
|
eval {
|
327
|
0
|
0
|
|
|
|
0
|
$pty->make_slave_controlling_terminal if $pty;
|
328
|
0
|
|
|
|
|
0
|
open my $in, '
|
329
|
0
|
0
|
|
|
|
0
|
open my $out2, '>>&', $out_fh or die $!;
|
330
|
0
|
0
|
|
|
|
0
|
POSIX::dup2(fileno($in), 0) or die $!;
|
331
|
0
|
0
|
|
|
|
0
|
POSIX::dup2(fileno($out2), 1) or die $!;
|
332
|
0
|
0
|
|
|
|
0
|
POSIX::dup2(1, 2) or die $!;
|
333
|
0
|
|
|
|
|
0
|
exec @cmd;
|
334
|
|
|
|
|
|
|
};
|
335
|
0
|
0
|
|
|
|
0
|
$@ and $sshd->_error($@);
|
336
|
0
|
|
|
|
|
0
|
exit(1);
|
337
|
|
|
|
|
|
|
}
|
338
|
0
|
0
|
|
|
|
0
|
if (delete $opts{async}) {
|
339
|
0
|
0
|
|
|
|
0
|
return (wantarray ? ($pid, $pty) : $pid);
|
340
|
|
|
|
|
|
|
}
|
341
|
|
|
|
|
|
|
else {
|
342
|
0
|
|
|
|
|
0
|
local $SIG{PIPE} = 'IGNORE';
|
343
|
0
|
|
|
|
|
0
|
my $end = time + $sshd->{timeout};
|
344
|
0
|
|
|
|
|
0
|
my $buffer = '';
|
345
|
0
|
|
|
|
|
0
|
while (1) {
|
346
|
0
|
0
|
|
|
|
0
|
if (time > $end) {
|
347
|
0
|
0
|
|
|
|
0
|
kill ((time - $end > 3 ? 'KILL' : 'TERM'), $pid);
|
348
|
|
|
|
|
|
|
}
|
349
|
0
|
0
|
|
|
|
0
|
if (waitpid($pid, POSIX::WNOHANG()) > 0) {
|
350
|
0
|
0
|
|
|
|
0
|
if ($?) {
|
351
|
0
|
|
|
|
|
0
|
$sshd->_log("program failed, rc: $?");
|
352
|
|
|
|
|
|
|
return
|
353
|
0
|
|
|
|
|
0
|
}
|
354
|
0
|
|
|
|
|
0
|
return 1;
|
355
|
|
|
|
|
|
|
}
|
356
|
0
|
0
|
|
|
|
0
|
if ($pty) {
|
357
|
0
|
|
|
|
|
0
|
my $rv = '';
|
358
|
0
|
|
|
|
|
0
|
vec($rv, fileno($pty), 1) = 1;
|
359
|
0
|
0
|
|
|
|
0
|
if (select($rv, undef, undef, 0) > 0) {
|
360
|
0
|
|
|
|
|
0
|
sysread($pty, $buffer, 1024, length($buffer));
|
361
|
0
|
0
|
|
|
|
0
|
if ($buffer =~ s/.*[>:?]\s*$//s) {
|
362
|
0
|
|
|
|
|
0
|
print $pty "$password\n";
|
363
|
|
|
|
|
|
|
}
|
364
|
|
|
|
|
|
|
}
|
365
|
|
|
|
|
|
|
}
|
366
|
0
|
|
|
|
|
0
|
select(undef, undef, undef, 0.3);
|
367
|
|
|
|
|
|
|
}
|
368
|
|
|
|
|
|
|
}
|
369
|
|
|
|
|
|
|
}
|
370
|
|
|
|
|
|
|
}
|
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub _capture_cmd {
|
373
|
0
|
|
|
0
|
|
0
|
my $sshd = shift;
|
374
|
0
|
|
|
|
|
0
|
$sshd->_run_cmd(@_);
|
375
|
0
|
|
|
|
|
0
|
my $name = $sshd->{cmd_output_name};
|
376
|
0
|
0
|
|
|
|
0
|
return unless defined $name;
|
377
|
0
|
|
|
|
|
0
|
my $fh = $sshd->_read_fh($name);
|
378
|
0
|
|
|
|
|
0
|
my $off = $sshd->{cmd_output_offset};
|
379
|
0
|
|
|
|
|
0
|
seek($fh, $off, 0);
|
380
|
0
|
|
|
|
|
0
|
do { local $/; <$fh> };
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
381
|
|
|
|
|
|
|
}
|
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
sub _test_server {
|
384
|
0
|
|
|
0
|
|
0
|
my $sshd = shift;
|
385
|
0
|
|
|
|
|
0
|
for my $cmd (@{$sshd->{test_commands}}) {
|
|
0
|
|
|
|
|
0
|
|
386
|
0
|
0
|
0
|
|
|
0
|
if (defined $sshd->{requested_uri} or $sshd->_run_cmd($cmd)) {
|
387
|
0
|
0
|
|
|
|
0
|
if ($sshd->_run_remote_cmd($cmd)) {
|
388
|
0
|
|
|
|
|
0
|
$sshd->_log("connection ok");
|
389
|
0
|
|
|
|
|
0
|
return 1;
|
390
|
|
|
|
|
|
|
}
|
391
|
|
|
|
|
|
|
}
|
392
|
|
|
|
|
|
|
}
|
393
|
|
|
|
|
|
|
()
|
394
|
0
|
|
|
|
|
0
|
}
|
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
sub uri {
|
397
|
0
|
|
|
0
|
0
|
0
|
my ($sshd, %opts) = @_;
|
398
|
0
|
|
|
|
|
0
|
my $auth_method = $sshd->{auth_method};
|
399
|
0
|
|
|
|
|
0
|
my $uri = URI->new;
|
400
|
0
|
|
|
|
|
0
|
$uri->scheme('ssh');
|
401
|
0
|
|
|
|
|
0
|
$uri->user($sshd->{user});
|
402
|
0
|
|
|
|
|
0
|
$uri->host($sshd->{host});
|
403
|
0
|
|
|
|
|
0
|
$uri->port($sshd->{port});
|
404
|
0
|
0
|
|
|
|
0
|
if ($auth_method eq 'password') {
|
|
|
0
|
|
|
|
|
|
405
|
0
|
0
|
|
|
|
0
|
$uri->password($opts{hidden_password} ? '*****' : $sshd->{password});
|
406
|
|
|
|
|
|
|
}
|
407
|
|
|
|
|
|
|
elsif ($auth_method eq 'publickey') {
|
408
|
0
|
|
|
|
|
0
|
$uri->c_params(["key_path=$sshd->{key_path}"]);
|
409
|
|
|
|
|
|
|
}
|
410
|
0
|
|
|
|
|
0
|
$uri;
|
411
|
|
|
|
|
|
|
}
|
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub connection_params {
|
414
|
0
|
|
|
0
|
0
|
0
|
my $sshd = shift;
|
415
|
0
|
0
|
|
|
|
0
|
if (wantarray) {
|
416
|
0
|
|
|
|
|
0
|
my @keys = qw(host port user);
|
417
|
0
|
0
|
|
|
|
0
|
push @keys, ($sshd->{auth_method} eq 'password' ? 'password' : 'key_path');
|
418
|
0
|
|
|
|
|
0
|
return map { $_ => $sshd->$_ } @keys;
|
|
0
|
|
|
|
|
0
|
|
419
|
|
|
|
|
|
|
}
|
420
|
|
|
|
|
|
|
else {
|
421
|
0
|
|
|
|
|
0
|
return $sshd->uri;
|
422
|
|
|
|
|
|
|
}
|
423
|
|
|
|
|
|
|
}
|
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
|
427
|
|
|
|
|
|
|
sub server_version {
|
428
|
0
|
|
|
0
|
0
|
0
|
my $sshd = shift;
|
429
|
0
|
0
|
|
|
|
0
|
unless (defined $sshd->{server_version}) {
|
430
|
0
|
|
|
|
|
0
|
$sshd->_log("retrieving server version");
|
431
|
0
|
|
|
|
|
0
|
require IO::Socket::INET;
|
432
|
0
|
|
|
|
|
0
|
my $end = time + $sshd->{timeout};
|
433
|
0
|
|
|
|
|
0
|
my $buffer = '';
|
434
|
0
|
0
|
|
|
|
0
|
if (my $socket = IO::Socket::INET->new(PeerAddr => $sshd->{host},
|
435
|
|
|
|
|
|
|
PeerPort => $sshd->{port},
|
436
|
|
|
|
|
|
|
Timeout => $sshd->{timeout},
|
437
|
|
|
|
|
|
|
Proto => 'tcp',
|
438
|
|
|
|
|
|
|
Blocking => 0)) {
|
439
|
0
|
|
0
|
|
|
0
|
while (time <= $end and $buffer !~ /\n/) {
|
440
|
0
|
|
|
|
|
0
|
my $rv = '';
|
441
|
0
|
|
|
|
|
0
|
vec($rv, fileno($socket), 1) = 1;
|
442
|
0
|
0
|
|
|
|
0
|
if (select($rv, undef, undef, 1) > 0) {
|
443
|
0
|
0
|
|
|
|
0
|
sysread($socket, $buffer, 1024, length($buffer)) or last;
|
444
|
|
|
|
|
|
|
}
|
445
|
|
|
|
|
|
|
}
|
446
|
0
|
0
|
|
|
|
0
|
if ($buffer =~ /^(.*)\n/) {
|
447
|
0
|
|
|
|
|
0
|
$sshd->{server_version} = $1;
|
448
|
|
|
|
|
|
|
}
|
449
|
|
|
|
|
|
|
else {
|
450
|
0
|
|
|
|
|
0
|
$sshd->_log("unable to retrieve server version");
|
451
|
|
|
|
|
|
|
}
|
452
|
|
|
|
|
|
|
}
|
453
|
|
|
|
|
|
|
else {
|
454
|
0
|
|
|
|
|
0
|
$sshd->_log("unable to connect to server", $!);
|
455
|
|
|
|
|
|
|
}
|
456
|
|
|
|
|
|
|
}
|
457
|
|
|
|
|
|
|
$sshd->{server_version}
|
458
|
0
|
|
|
|
|
0
|
}
|
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
sub server_os {
|
461
|
0
|
|
|
0
|
0
|
0
|
my $sshd = shift;
|
462
|
0
|
0
|
|
|
|
0
|
unless (defined $sshd->{server_os}) {
|
463
|
0
|
|
|
|
|
0
|
$sshd->_log("retrieving server operating system info");
|
464
|
|
|
|
|
|
|
}
|
465
|
|
|
|
|
|
|
}
|
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
sub _rmdir {
|
468
|
4
|
|
|
4
|
|
9
|
my ($sshd, $dir) = @_;
|
469
|
4
|
50
|
|
|
|
199
|
if (opendir my $dh, $dir) {
|
470
|
4
|
|
|
|
|
90
|
while (defined (my $entry = readdir $dh)) {
|
471
|
12
|
100
|
100
|
|
|
73
|
next if $entry eq $up_dir or $entry eq $cur_dir;
|
472
|
4
|
|
|
|
|
170
|
unlink File::Spec->join($dir, $entry);
|
473
|
|
|
|
|
|
|
}
|
474
|
4
|
|
|
|
|
28
|
closedir $dh;
|
475
|
|
|
|
|
|
|
}
|
476
|
4
|
|
|
|
|
45
|
unlink $dir;
|
477
|
|
|
|
|
|
|
}
|
478
|
|
|
|
|
|
|
|
479
|
|
|
|
|
|
|
sub DESTROY {
|
480
|
4
|
|
|
4
|
|
9
|
my $sshd = shift;
|
481
|
4
|
|
|
|
|
24
|
local ($@, $!, $?, $^E);
|
482
|
4
|
|
|
|
|
9
|
eval {
|
483
|
4
|
50
|
|
|
|
10
|
if (defined (my $run_dir = $sshd->_run_dir)) {
|
484
|
4
|
50
|
|
|
|
20
|
if (defined (my $last = $sshd->_run_dir_last)) {
|
485
|
4
|
|
|
|
|
22
|
$sshd->_rmdir($run_dir);
|
486
|
4
|
|
|
|
|
372
|
rename $sshd->{run_dir}, $last;
|
487
|
4
|
|
|
|
|
48
|
$sshd->_log("SSH server logs moved to '$last'");
|
488
|
|
|
|
|
|
|
}
|
489
|
|
|
|
|
|
|
}
|
490
|
|
|
|
|
|
|
};
|
491
|
|
|
|
|
|
|
}
|
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
1;
|