line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::OpenSSH; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $VERSION = '0.83'; |
4
|
|
|
|
|
|
|
|
5
|
5
|
|
|
5
|
|
270117
|
use strict; |
|
5
|
|
|
|
|
13
|
|
|
5
|
|
|
|
|
133
|
|
6
|
5
|
|
|
5
|
|
24
|
use warnings; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
257
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $debug ||= 0; |
9
|
|
|
|
|
|
|
our $debug_fh ||= \*STDERR; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $FACTORY; |
12
|
|
|
|
|
|
|
|
13
|
5
|
|
|
5
|
|
26
|
use Carp qw(carp croak); |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
379
|
|
14
|
5
|
|
|
5
|
|
2274
|
use POSIX qw(:sys_wait_h); |
|
5
|
|
|
|
|
30552
|
|
|
5
|
|
|
|
|
24
|
|
15
|
5
|
|
|
5
|
|
6630
|
use Socket; |
|
5
|
|
|
|
|
3103
|
|
|
5
|
|
|
|
|
2015
|
|
16
|
5
|
|
|
5
|
|
32
|
use File::Spec; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
128
|
|
17
|
5
|
|
|
5
|
|
24
|
use Cwd (); |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
58
|
|
18
|
5
|
|
|
5
|
|
19
|
use Scalar::Util (); |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
97
|
|
19
|
5
|
|
|
5
|
|
2200
|
use Errno (); |
|
5
|
|
|
|
|
6477
|
|
|
5
|
|
|
|
|
128
|
|
20
|
5
|
|
|
5
|
|
1948
|
use Net::OpenSSH::Constants qw(:error :_state); |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
657
|
|
21
|
5
|
|
|
5
|
|
1771
|
use Net::OpenSSH::ModuleLoader; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
198
|
|
22
|
5
|
|
|
5
|
|
1687
|
use Net::OpenSSH::ShellQuoter; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
129
|
|
23
|
5
|
|
|
5
|
|
29
|
use Digest::MD5; |
|
5
|
|
|
|
|
5
|
|
|
5
|
|
|
|
|
877
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
my $thread_generation = 0; |
26
|
|
|
|
|
|
|
|
27
|
0
|
|
|
0
|
|
0
|
sub CLONE { $thread_generation++ }; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub _debug { |
30
|
0
|
|
|
0
|
|
0
|
local ($!, $@); |
31
|
0
|
0
|
|
|
|
0
|
print {$debug_fh} '# ', (map { defined($_) ? $_ : '' } @_), "\n" |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
sub _debug_dump { |
35
|
0
|
|
|
0
|
|
0
|
local ($!, $@); |
36
|
0
|
|
|
|
|
0
|
require Data::Dumper; |
37
|
0
|
|
|
|
|
0
|
local $Data::Dumper::Terse = 1; |
38
|
0
|
|
|
|
|
0
|
local $Data::Dumper::Indent = 0; |
39
|
0
|
|
|
|
|
0
|
my $head = shift; |
40
|
0
|
|
|
|
|
0
|
_debug("$head: ", Data::Dumper::Dumper(@_)); |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub _hexdump { |
44
|
5
|
|
|
5
|
|
30
|
no warnings qw(uninitialized); |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
28013
|
|
45
|
0
|
|
|
0
|
|
0
|
my $data = shift; |
46
|
0
|
|
|
|
|
0
|
while ($data =~ /(.{1,32})/smg) { |
47
|
0
|
|
|
|
|
0
|
my $line=$1; |
48
|
0
|
|
|
|
|
0
|
my @c= (( map { sprintf "%02x",$_ } unpack('C*', $line)), |
|
0
|
|
|
|
|
0
|
|
49
|
|
|
|
|
|
|
((" ") x 32))[0..31]; |
50
|
0
|
0
|
|
|
|
0
|
$line=~s/(.)/ my $c=$1; unpack("c",$c)>=32 ? $c : '.' /egms; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
51
|
0
|
|
|
|
|
0
|
print {$debug_fh} "#> ", join(" ", @c, '|', $line), "\n"; |
|
0
|
|
|
|
|
0
|
|
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
} |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
{ |
56
|
|
|
|
|
|
|
my %good; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub _sub_options { |
59
|
90
|
|
|
90
|
|
110
|
my $sub = shift; |
60
|
90
|
|
|
|
|
118
|
$good{__PACKAGE__ . "::$sub"} = { map { $_ => 1 } @_ }; |
|
1350
|
|
|
|
|
1831
|
|
61
|
|
|
|
|
|
|
} |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
sub _croak_bad_options (\%) { |
64
|
9
|
|
|
9
|
|
18
|
my $opts = shift; |
65
|
9
|
100
|
|
|
|
24
|
if (%$opts) { |
66
|
3
|
|
|
|
|
21
|
my $sub = (caller 1)[3]; |
67
|
3
|
|
|
|
|
18
|
my $good = $good{$sub}; |
68
|
3
|
50
|
|
|
|
27
|
my @keys = grep defined($opts->{$_}), ( $good ? grep !$good->{$_}, keys %$opts : keys %$opts); |
69
|
3
|
50
|
|
|
|
12
|
if (@keys) { |
70
|
0
|
|
|
|
|
0
|
croak "Invalid or bad combination of options ('" . CORE::join("', '", @keys) . "')"; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
} |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub _croak_scalar_context { |
77
|
0
|
|
|
0
|
|
0
|
my ($sub, $wantarray) = (caller 1)[3, 5]; |
78
|
0
|
0
|
|
|
|
0
|
unless ($wantarray) { |
79
|
0
|
|
|
|
|
0
|
$sub =~ s/^.*:://; |
80
|
0
|
|
|
|
|
0
|
croak "method '$sub' called in scalar context"; |
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub _tcroak { |
85
|
0
|
0
|
|
0
|
|
0
|
if (${^TAINT} > 0) { |
86
|
0
|
|
|
|
|
0
|
push @_, " while running with -T switch"; |
87
|
0
|
|
|
|
|
0
|
goto &croak; |
88
|
|
|
|
|
|
|
} |
89
|
0
|
0
|
|
|
|
0
|
if (${^TAINT} < 0) { |
90
|
0
|
|
|
|
|
0
|
push @_, " while running with -t switch"; |
91
|
0
|
|
|
|
|
0
|
goto &carp; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub _catch_tainted_args { |
96
|
0
|
|
|
0
|
|
0
|
my $i; |
97
|
0
|
|
|
|
|
0
|
for (@_) { |
98
|
0
|
0
|
|
|
|
0
|
next unless $i++; |
99
|
0
|
0
|
|
|
|
0
|
if (Scalar::Util::tainted($_)) { |
|
|
0
|
|
|
|
|
|
100
|
0
|
|
|
|
|
0
|
my (undef, undef, undef, $subn) = caller 1; |
101
|
0
|
0
|
|
|
|
0
|
my $msg = ( $subn =~ /::([a-z]\w*)$/ |
102
|
|
|
|
|
|
|
? "Insecure argument '$_' on '$1' method call" |
103
|
|
|
|
|
|
|
: "Insecure argument '$_' on method call" ); |
104
|
0
|
|
|
|
|
0
|
_tcroak($msg); |
105
|
|
|
|
|
|
|
} |
106
|
|
|
|
|
|
|
elsif (ref($_) eq 'HASH') { |
107
|
0
|
|
|
|
|
0
|
for (grep Scalar::Util::tainted($_), values %$_) { |
108
|
0
|
|
|
|
|
0
|
my (undef, undef, undef, $subn) = caller 1; |
109
|
0
|
0
|
|
|
|
0
|
my $msg = ( $subn =~ /::([a-z]\w*)$/ |
110
|
|
|
|
|
|
|
? "Insecure argument on '$1' method call" |
111
|
|
|
|
|
|
|
: "Insecure argument on method call" ); |
112
|
0
|
|
|
|
|
0
|
_tcroak($msg); |
113
|
|
|
|
|
|
|
} |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub _set_error { |
119
|
3
|
|
|
3
|
|
7
|
my $self = shift; |
120
|
3
|
|
100
|
|
|
19
|
my $code = shift || 0; |
121
|
3
|
|
|
|
|
134
|
my @extra = grep defined, @_; |
122
|
|
|
|
|
|
|
my $err = $self->{_error} = ( $code |
123
|
3
|
50
|
|
|
|
14
|
? Scalar::Util::dualvar($code, join(': ', @{$self->{_error_prefix}}, |
|
1
|
100
|
|
|
|
24
|
|
124
|
|
|
|
|
|
|
(@extra ? @extra : "Unknown error $code"))) |
125
|
|
|
|
|
|
|
: 0 ); |
126
|
3
|
50
|
33
|
|
|
32
|
$debug and $debug & 1 and _debug "set_error($code - $err)"; |
127
|
3
|
|
|
|
|
7
|
return $err |
128
|
|
|
|
|
|
|
} |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
my $check_eval_re = do { |
131
|
|
|
|
|
|
|
my $path = quotemeta $INC{"Net/OpenSSH.pm"}; |
132
|
|
|
|
|
|
|
qr/at $path line \d+.$/ |
133
|
|
|
|
|
|
|
}; |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
sub _check_eval_ok { |
136
|
0
|
|
|
0
|
|
0
|
my ($self, $code) = @_; |
137
|
0
|
0
|
|
|
|
0
|
if ($@) { |
138
|
0
|
|
|
|
|
0
|
my $err = $@; |
139
|
0
|
|
|
|
|
0
|
$err =~ s/$check_eval_re//; |
140
|
0
|
|
|
|
|
0
|
$self->_set_error($code, $err); |
141
|
0
|
|
|
|
|
0
|
return; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
1 |
144
|
0
|
|
|
|
|
0
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
sub _or_set_error { |
147
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
148
|
0
|
0
|
|
|
|
0
|
$self->{_error} or $self->_set_error(@_); |
149
|
|
|
|
|
|
|
} |
150
|
|
|
|
|
|
|
|
151
|
33
|
|
100
|
33
|
|
111
|
sub _first_defined { defined && return $_ for @_; return } |
|
9
|
|
|
|
|
15
|
|
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
my $obfuscate = sub { |
154
|
|
|
|
|
|
|
# just for the casual observer... |
155
|
|
|
|
|
|
|
my $txt = shift; |
156
|
|
|
|
|
|
|
$txt =~ s/(.)/chr(ord($1) ^ 47)/ges |
157
|
|
|
|
|
|
|
if defined $txt; |
158
|
|
|
|
|
|
|
$txt; |
159
|
|
|
|
|
|
|
}; |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
my $deobfuscate = $obfuscate; |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
# regexp from Regexp::IPv6 |
164
|
|
|
|
|
|
|
my $IPv6_re = qr((?-xism::(?::[0-9a-fA-F]{1,4}){0,5}(?:(?::[0-9a-fA-F]{1,4}){1,2}|:(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})))|[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}:(?:[0-9a-fA-F]{1,4}|:)|(?::(?:[0-9a-fA-F]{1,4})?|(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))))|:(?:(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|[0-9a-fA-F]{1,4}(?::[0-9a-fA-F]{1,4})?|))|(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|:[0-9a-fA-F]{1,4}(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|(?::[0-9a-fA-F]{1,4}){0,2})|:))|(?:(?::[0-9a-fA-F]{1,4}){0,2}(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|(?::[0-9a-fA-F]{1,4}){1,2})|:))|(?:(?::[0-9a-fA-F]{1,4}){0,3}(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|(?::[0-9a-fA-F]{1,4}){1,2})|:))|(?:(?::[0-9a-fA-F]{1,4}){0,4}(?::(?:(?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](?:25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))|(?::[0-9a-fA-F]{1,4}){1,2})|:)))); |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
sub parse_connection_opts { |
167
|
22
|
|
|
22
|
0
|
5111
|
my ($class, $opts) = @_; |
168
|
22
|
|
|
|
|
47
|
my ($user, $passwd, $ipv6, $host, $port, $host_squared); |
169
|
|
|
|
|
|
|
|
170
|
22
|
|
|
|
|
270
|
my $target = delete $opts->{host}; |
171
|
22
|
50
|
|
|
|
62
|
defined $target or croak "mandatory host argument missing"; |
172
|
|
|
|
|
|
|
|
173
|
22
|
50
|
|
|
|
4166
|
($user, $passwd, $ipv6, $host, $port) = |
174
|
|
|
|
|
|
|
$target =~ m{^ |
175
|
|
|
|
|
|
|
\s* # space |
176
|
|
|
|
|
|
|
(?: |
177
|
|
|
|
|
|
|
([^:]+) # username |
178
|
|
|
|
|
|
|
(?::(.*))? # : password |
179
|
|
|
|
|
|
|
\@ # @ |
180
|
|
|
|
|
|
|
)? |
181
|
|
|
|
|
|
|
(?: # host |
182
|
|
|
|
|
|
|
( # IPv6... |
183
|
|
|
|
|
|
|
\[$IPv6_re(?:\%[^\[\]]*)\] # [IPv6] |
184
|
|
|
|
|
|
|
| # or |
185
|
|
|
|
|
|
|
$IPv6_re # IPv6 |
186
|
|
|
|
|
|
|
) |
187
|
|
|
|
|
|
|
| # or |
188
|
|
|
|
|
|
|
([^\[\]\@:]+) # hostname / ipv4 |
189
|
|
|
|
|
|
|
) |
190
|
|
|
|
|
|
|
(?::([^\@:]+))? # port |
191
|
|
|
|
|
|
|
\s* # space |
192
|
|
|
|
|
|
|
$}ix |
193
|
|
|
|
|
|
|
or croak "bad host/target '$target' specification"; |
194
|
|
|
|
|
|
|
|
195
|
22
|
100
|
|
|
|
146
|
if (defined $ipv6) { |
196
|
1
|
|
|
|
|
7
|
($host) = $ipv6 =~ /^\[?(.*?)\]?$/; |
197
|
1
|
|
|
|
|
4
|
$host_squared = "[$host]"; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
else { |
200
|
21
|
|
|
|
|
37
|
$host_squared = $host; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
22
|
100
|
|
|
|
42
|
$user = delete $opts->{user} unless defined $user; |
204
|
22
|
50
|
|
|
|
54
|
$port = delete $opts->{port} unless defined $port; |
205
|
22
|
100
|
|
|
|
42
|
$passwd = delete $opts->{passwd} unless defined $passwd; |
206
|
22
|
100
|
|
|
|
38
|
$passwd = delete $opts->{password} unless defined $passwd; |
207
|
|
|
|
|
|
|
|
208
|
22
|
100
|
|
|
|
78
|
wantarray and return ($host, $port, $user, $passwd, $host_squared); |
209
|
|
|
|
|
|
|
|
210
|
19
|
|
|
|
|
57
|
my %r = ( user => $user, |
211
|
|
|
|
|
|
|
password => $passwd, |
212
|
|
|
|
|
|
|
host => $host, |
213
|
|
|
|
|
|
|
host_squared => $host_squared, |
214
|
|
|
|
|
|
|
port => $port ); |
215
|
19
|
100
|
|
|
|
40
|
$r{ipv6} = 1 if defined $ipv6; |
216
|
19
|
|
|
|
|
51
|
return \%r; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
my $sizeof_sun_path = ($^O eq 'linux' ? 108 : |
220
|
|
|
|
|
|
|
$^O =~ /bsd/i ? 104 : |
221
|
|
|
|
|
|
|
$^O eq 'hpux' ? 92 : undef); |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
sub new { |
224
|
3
|
50
|
|
3
|
1
|
3761013
|
${^TAINT} and &_catch_tainted_args; |
225
|
|
|
|
|
|
|
|
226
|
3
|
|
|
|
|
27
|
my $class = shift; |
227
|
3
|
50
|
|
|
|
42
|
@_ & 1 and unshift @_, 'host'; |
228
|
|
|
|
|
|
|
|
229
|
3
|
50
|
|
|
|
21
|
return $FACTORY->($class, @_) if defined $FACTORY; |
230
|
|
|
|
|
|
|
|
231
|
3
|
|
|
|
|
45
|
my %opts = @_; |
232
|
|
|
|
|
|
|
|
233
|
3
|
|
|
|
|
18
|
my $external_master = delete $opts{external_master}; |
234
|
|
|
|
|
|
|
# reuse_master is an obsolete alias: |
235
|
3
|
50
|
|
|
|
39
|
$external_master = delete $opts{reuse_master} unless defined $external_master; |
236
|
|
|
|
|
|
|
|
237
|
3
|
50
|
33
|
|
|
36
|
if (not defined $opts{host} and defined $external_master) { |
238
|
0
|
|
|
|
|
0
|
$opts{host} = '0.0.0.0'; |
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
3
|
|
|
|
|
45
|
my ($host, $port, $user, $passwd, $host_squared) = $class->parse_connection_opts(\%opts); |
242
|
|
|
|
|
|
|
|
243
|
3
|
|
|
|
|
9
|
my ($passphrase, $key_path, $login_handler); |
244
|
3
|
50
|
|
|
|
12
|
unless (defined $passwd) { |
245
|
3
|
|
|
|
|
6
|
$key_path = delete $opts{key_path}; |
246
|
3
|
|
|
|
|
6
|
$passwd = delete $opts{passphrase}; |
247
|
3
|
50
|
|
|
|
9
|
if (defined $passwd) { |
248
|
0
|
|
|
|
|
0
|
$passphrase = 1; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
else { |
251
|
3
|
|
|
|
|
3
|
$login_handler = delete $opts{login_handler}; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
3
|
|
|
|
|
6
|
my $ssh_version = delete $opts{ssh_version}; |
256
|
3
|
|
|
|
|
6
|
my $batch_mode = delete $opts{batch_mode}; |
257
|
3
|
|
|
|
|
6
|
my $ctl_path = delete $opts{ctl_path}; |
258
|
3
|
|
|
|
|
6
|
my $ctl_dir = delete $opts{ctl_dir}; |
259
|
3
|
|
|
|
|
6
|
my $proxy_command = delete $opts{proxy_command}; |
260
|
3
|
50
|
|
|
|
12
|
my $gateway = delete $opts{gateway} unless defined $proxy_command; |
261
|
3
|
|
|
|
|
24
|
my $ssh_cmd = _first_defined delete $opts{ssh_cmd}, 'ssh'; |
262
|
3
|
|
|
|
|
9
|
my $rsync_cmd = _first_defined delete $opts{rsync_cmd}, 'rsync'; |
263
|
3
|
|
|
|
|
3
|
my $scp_cmd = delete $opts{scp_cmd}; |
264
|
3
|
|
|
|
|
9
|
my $sshfs_cmd = _first_defined delete $opts{sshfs_cmd}, 'sshfs'; |
265
|
|
|
|
|
|
|
my $sftp_server_cmd = _first_defined delete $opts{sftp_server_cmd}, |
266
|
3
|
|
|
|
|
6
|
'/usr/lib/openssh/sftp-server'; |
267
|
3
|
|
|
|
|
6
|
my $timeout = delete $opts{timeout}; |
268
|
3
|
|
|
|
|
6
|
my $kill_ssh_on_timeout = delete $opts{kill_ssh_on_timeout}; |
269
|
3
|
|
|
|
|
6
|
my $strict_mode = _first_defined delete $opts{strict_mode}, 1; |
270
|
3
|
|
|
|
|
9
|
my $connect = _first_defined delete $opts{connect}, 1; |
271
|
3
|
|
|
|
|
3
|
my $async = delete $opts{async}; |
272
|
3
|
|
|
|
|
9
|
my $remote_shell = _first_defined delete $opts{remote_shell}, 'POSIX'; |
273
|
3
|
|
|
|
|
6
|
my $expand_vars = delete $opts{expand_vars}; |
274
|
3
|
|
|
|
|
18
|
my $vars = _first_defined delete $opts{vars}, {}; |
275
|
3
|
|
|
|
|
6
|
my $default_encoding = delete $opts{default_encoding}; |
276
|
|
|
|
|
|
|
my $default_stream_encoding = |
277
|
3
|
|
|
|
|
9
|
_first_defined delete $opts{default_stream_encoding}, $default_encoding; |
278
|
|
|
|
|
|
|
my $default_argument_encoding = |
279
|
3
|
|
|
|
|
9
|
_first_defined delete $opts{default_argument_encoding}, $default_encoding; |
280
|
3
|
|
|
|
|
6
|
my $forward_agent = delete $opts{forward_agent}; |
281
|
3
|
50
|
33
|
|
|
9
|
$forward_agent and $passphrase and |
282
|
|
|
|
|
|
|
croak "agent forwarding can not be used when a passphrase has also been given"; |
283
|
3
|
|
|
|
|
6
|
my $forward_X11 = delete $opts{forward_X11}; |
284
|
3
|
|
|
|
|
6
|
my $passwd_prompt = delete $opts{password_prompt}; |
285
|
3
|
|
|
|
|
6
|
my $master_pty_force = delete $opts{master_pty_force}; |
286
|
3
|
50
|
|
|
|
15
|
$passwd_prompt = delete $opts{passwd_prompt} unless defined $passwd_prompt; |
287
|
|
|
|
|
|
|
|
288
|
3
|
|
|
|
|
12
|
my ($master_opts, @master_opts, |
289
|
|
|
|
|
|
|
$master_stdout_fh, $master_stderr_fh, |
290
|
|
|
|
|
|
|
$master_stdout_discard, $master_stderr_discard, |
291
|
|
|
|
|
|
|
$master_setpgrp); |
292
|
3
|
50
|
|
|
|
9
|
unless ($external_master) { |
293
|
|
|
|
|
|
|
($master_stdout_fh = delete $opts{master_stdout_fh} or |
294
|
3
|
50
|
|
|
|
9
|
$master_stdout_discard = delete $opts{master_stdout_discard}); |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
($master_stderr_fh = delete $opts{master_stderr_fh} or |
297
|
3
|
50
|
|
|
|
15
|
$master_stderr_discard = delete $opts{master_stderr_discard}); |
298
|
|
|
|
|
|
|
|
299
|
3
|
|
|
|
|
6
|
$master_opts = delete $opts{master_opts}; |
300
|
3
|
50
|
|
|
|
15
|
if (defined $master_opts) { |
301
|
3
|
50
|
|
|
|
9
|
if (ref $master_opts) { |
302
|
3
|
|
|
|
|
9
|
@master_opts = @$master_opts; |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
else { |
305
|
0
|
0
|
|
|
|
0
|
carp "'master_opts' argument looks like if it should be splited first" |
306
|
|
|
|
|
|
|
if $master_opts =~ /^-\w\s+\S/; |
307
|
0
|
|
|
|
|
0
|
@master_opts = $master_opts; |
308
|
|
|
|
|
|
|
} |
309
|
|
|
|
|
|
|
} |
310
|
3
|
|
|
|
|
6
|
$master_setpgrp = delete $opts{master_setpgrp}; |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
# when a password/passphrase is given, calling setpgrp is |
313
|
|
|
|
|
|
|
# useless because the process runs attached to a different tty |
314
|
3
|
50
|
33
|
|
|
36
|
undef $master_setpgrp if $login_handler or defined $passwd; |
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
3
|
|
|
|
|
6
|
my $default_ssh_opts = delete $opts{default_ssh_opts}; |
318
|
3
|
0
|
33
|
|
|
12
|
carp "'default_ssh_opts' argument looks like if it should be splited first" |
|
|
|
33
|
|
|
|
|
319
|
|
|
|
|
|
|
if defined $default_ssh_opts and not ref $default_ssh_opts and $default_ssh_opts =~ /^-\w\s+\S/; |
320
|
|
|
|
|
|
|
|
321
|
3
|
|
|
|
|
6
|
my ($default_stdout_fh, $default_stderr_fh, $default_stdin_fh, |
322
|
|
|
|
|
|
|
$default_stdout_file, $default_stderr_file, $default_stdin_file, |
323
|
|
|
|
|
|
|
$default_stdout_discard, $default_stderr_discard, $default_stdin_discard); |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
$default_stdout_file = (delete $opts{default_stdout_discard} |
326
|
|
|
|
|
|
|
? '/dev/null' |
327
|
3
|
50
|
|
|
|
27
|
: delete $opts{default_stdout_file}); |
328
|
|
|
|
|
|
|
$default_stdout_fh = delete $opts{default_stdout_fh} |
329
|
3
|
50
|
|
|
|
12
|
unless defined $default_stdout_file; |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
$default_stderr_file = (delete $opts{default_stderr_discard} |
332
|
|
|
|
|
|
|
? '/dev/null' |
333
|
3
|
50
|
|
|
|
6
|
: delete $opts{default_stderr_file}); |
334
|
|
|
|
|
|
|
$default_stderr_fh = delete $opts{default_stderr_fh} |
335
|
3
|
50
|
|
|
|
9
|
unless defined $default_stderr_file; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
$default_stdin_file = (delete $opts{default_stdin_discard} |
338
|
|
|
|
|
|
|
? '/dev/null' |
339
|
3
|
50
|
|
|
|
9
|
: delete $opts{default_stdin_file}); |
340
|
|
|
|
|
|
|
$default_stdin_fh = delete $opts{default_stdin_fh} |
341
|
3
|
50
|
|
|
|
6
|
unless defined $default_stdin_file; |
342
|
|
|
|
|
|
|
|
343
|
3
|
|
|
|
|
24
|
_croak_bad_options %opts; |
344
|
|
|
|
|
|
|
|
345
|
3
|
|
|
|
|
6
|
my @ssh_opts; |
346
|
|
|
|
|
|
|
# TODO: are those options really requiered or just do they eat on |
347
|
|
|
|
|
|
|
# the command line limited length? |
348
|
3
|
50
|
|
|
|
9
|
push @ssh_opts, -l => $user if defined $user; |
349
|
3
|
50
|
|
|
|
9
|
push @ssh_opts, -p => $port if defined $port; |
350
|
|
|
|
|
|
|
|
351
|
3
|
|
|
|
|
3
|
my $home = do { |
352
|
3
|
|
|
|
|
36
|
local ($@, $SIG{__DIE__}); |
353
|
3
|
|
|
|
|
6
|
eval { Cwd::realpath((getpwuid $>)[7]) } |
|
3
|
|
|
|
|
396
|
|
354
|
|
|
|
|
|
|
}; |
355
|
|
|
|
|
|
|
|
356
|
3
|
50
|
|
|
|
15
|
if (${^TAINT}) { |
357
|
0
|
|
|
|
|
0
|
($home) = $home =~ /^(.*)$/; |
358
|
0
|
0
|
|
|
|
0
|
Scalar::Util::tainted($ENV{PATH}) and |
359
|
|
|
|
|
|
|
_tcroak('Insecure $ENV{PATH}'); |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
|
362
|
3
|
|
|
|
|
33
|
my $self = { _error => 0, |
363
|
|
|
|
|
|
|
_error_prefix => [], |
364
|
|
|
|
|
|
|
_perl_pid => $$, |
365
|
|
|
|
|
|
|
_thread_generation => $thread_generation, |
366
|
|
|
|
|
|
|
_ssh_version => $ssh_version, |
367
|
|
|
|
|
|
|
_ssh_cmd => $ssh_cmd, |
368
|
|
|
|
|
|
|
_scp_cmd => $scp_cmd, |
369
|
|
|
|
|
|
|
_rsync_cmd => $rsync_cmd, |
370
|
|
|
|
|
|
|
_sshfs_cmd => $sshfs_cmd, |
371
|
|
|
|
|
|
|
_sftp_server_cmd => $sftp_server_cmd, |
372
|
|
|
|
|
|
|
_pid => undef, |
373
|
|
|
|
|
|
|
_host => $host, |
374
|
|
|
|
|
|
|
_host_squared => $host_squared, |
375
|
|
|
|
|
|
|
_user => $user, |
376
|
|
|
|
|
|
|
_port => $port, |
377
|
|
|
|
|
|
|
_passwd => $obfuscate->($passwd), |
378
|
|
|
|
|
|
|
_passwd_prompt => $passwd_prompt, |
379
|
|
|
|
|
|
|
_passphrase => $passphrase, |
380
|
|
|
|
|
|
|
_key_path => $key_path, |
381
|
|
|
|
|
|
|
_login_handler => $login_handler, |
382
|
|
|
|
|
|
|
_timeout => $timeout, |
383
|
|
|
|
|
|
|
_proxy_command => $proxy_command, |
384
|
|
|
|
|
|
|
_gateway_args => $gateway, |
385
|
|
|
|
|
|
|
_kill_ssh_on_timeout => $kill_ssh_on_timeout, |
386
|
|
|
|
|
|
|
_batch_mode => $batch_mode, |
387
|
|
|
|
|
|
|
_home => $home, |
388
|
|
|
|
|
|
|
_forward_agent => $forward_agent, |
389
|
|
|
|
|
|
|
_forward_X11 => $forward_X11, |
390
|
|
|
|
|
|
|
_external_master => $external_master, |
391
|
|
|
|
|
|
|
_default_ssh_opts => $default_ssh_opts, |
392
|
|
|
|
|
|
|
_default_stdin_fh => $default_stdin_fh, |
393
|
|
|
|
|
|
|
_default_stdout_fh => $default_stdout_fh, |
394
|
|
|
|
|
|
|
_default_stderr_fh => $default_stderr_fh, |
395
|
|
|
|
|
|
|
_master_stdout_fh => $master_stdout_fh, |
396
|
|
|
|
|
|
|
_master_stderr_fh => $master_stderr_fh, |
397
|
|
|
|
|
|
|
_master_stdout_discard => $master_stdout_discard, |
398
|
|
|
|
|
|
|
_master_stderr_discard => $master_stderr_discard, |
399
|
|
|
|
|
|
|
_master_setpgrp => $master_setpgrp, |
400
|
|
|
|
|
|
|
_master_pty_force => $master_pty_force, |
401
|
|
|
|
|
|
|
_remote_shell => $remote_shell, |
402
|
|
|
|
|
|
|
_default_stream_encoding => $default_stream_encoding, |
403
|
|
|
|
|
|
|
_default_argument_encoding => $default_argument_encoding, |
404
|
|
|
|
|
|
|
_expand_vars => $expand_vars, |
405
|
|
|
|
|
|
|
_vars => $vars, |
406
|
|
|
|
|
|
|
_master_state => _STATE_START, |
407
|
|
|
|
|
|
|
}; |
408
|
3
|
|
|
|
|
15
|
bless $self, $class; |
409
|
|
|
|
|
|
|
|
410
|
3
|
|
|
|
|
27
|
$self->_detect_ssh_version; |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
# default file handles are opened so late in order to have the |
413
|
|
|
|
|
|
|
# $self object to report errors |
414
|
2
|
50
|
|
|
|
8
|
$self->{_default_stdout_fh} = $self->_open_file('>', $default_stdout_file) |
415
|
|
|
|
|
|
|
if defined $default_stdout_file; |
416
|
2
|
50
|
|
|
|
6
|
$self->{_default_stderr_fh} = $self->_open_file('>', $default_stderr_file) |
417
|
|
|
|
|
|
|
if defined $default_stderr_file; |
418
|
2
|
50
|
|
|
|
18
|
$self->{_default_stdin_fh} = $self->_open_file('<', $default_stdin_file) |
419
|
|
|
|
|
|
|
if defined $default_stdin_file; |
420
|
|
|
|
|
|
|
|
421
|
2
|
50
|
|
|
|
10
|
if ($self->{_error} == OSSH_SLAVE_PIPE_FAILED) { |
422
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, "Unable to create default slave stream", $self->{_error}); |
423
|
0
|
|
|
|
|
0
|
return $self; |
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
2
|
|
|
|
|
24
|
$self->{_ssh_opts} = [$self->_expand_vars(@ssh_opts)]; |
427
|
2
|
|
|
|
|
20
|
$self->{_master_opts} = [$self->_expand_vars(@master_opts)]; |
428
|
|
|
|
|
|
|
|
429
|
2
|
|
|
|
|
14
|
$ctl_path = $self->_expand_vars($ctl_path); |
430
|
2
|
|
|
|
|
6
|
$ctl_dir = $self->_expand_vars($ctl_dir); |
431
|
|
|
|
|
|
|
|
432
|
2
|
50
|
|
|
|
6
|
if (defined $ctl_path) { |
433
|
0
|
0
|
|
|
|
0
|
if ($external_master) { |
434
|
0
|
0
|
|
|
|
0
|
unless (-S $ctl_path) { |
435
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, "ctl_path $ctl_path does not point to a socket"); |
436
|
0
|
|
|
|
|
0
|
return $self; |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
else { |
440
|
0
|
0
|
|
|
|
0
|
if (-e $ctl_path) { |
441
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, "unable to use ctl_path $ctl_path, a file object already exists there"); |
442
|
0
|
|
|
|
|
0
|
return $self; |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
else { |
447
|
2
|
50
|
|
|
|
6
|
$external_master and croak "external_master is set but ctl_path is not defined"; |
448
|
|
|
|
|
|
|
|
449
|
2
|
50
|
|
|
|
6
|
unless (defined $ctl_dir) { |
450
|
2
|
50
|
|
|
|
6
|
unless (defined $self->{_home}) { |
451
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, "unable to determine home directory for uid $>"); |
452
|
0
|
|
|
|
|
0
|
return $self; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
|
455
|
2
|
|
|
|
|
78
|
$ctl_dir = File::Spec->catdir($self->{_home}, ".libnet-openssh-perl"); |
456
|
|
|
|
|
|
|
} |
457
|
|
|
|
|
|
|
|
458
|
2
|
|
|
|
|
310
|
mkdir $ctl_dir, 0700; |
459
|
2
|
50
|
|
|
|
42
|
unless (-d $ctl_dir) { |
460
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, "unable to create ctl_dir $ctl_dir"); |
461
|
0
|
|
|
|
|
0
|
return $self; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
|
464
|
2
|
|
|
|
|
22
|
my $target = join('-', grep defined, $user, $host, $port); |
465
|
|
|
|
|
|
|
|
466
|
2
|
|
|
|
|
14
|
for (1..10) { |
467
|
2
|
|
|
|
|
82
|
my $ctl_file = Digest::MD5::md5_hex(sprintf "%s-%d-%d-%d", $target, $$, time, rand 1e6); |
468
|
2
|
|
|
|
|
112
|
$ctl_path = File::Spec->join($ctl_dir, $ctl_file); |
469
|
2
|
50
|
|
|
|
38
|
last unless -e $ctl_path |
470
|
|
|
|
|
|
|
} |
471
|
2
|
50
|
|
|
|
36
|
if (-e $ctl_path) { |
472
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, "unable to find unused name for ctl_path inside ctl_dir $ctl_dir"); |
473
|
0
|
|
|
|
|
0
|
return $self; |
474
|
|
|
|
|
|
|
} |
475
|
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
|
|
477
|
2
|
50
|
33
|
|
|
22
|
if (defined $sizeof_sun_path and length $ctl_path > $sizeof_sun_path) { |
478
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, "ctl_path $ctl_path is too long (max permissible size for $^O is $sizeof_sun_path)"); |
479
|
0
|
|
|
|
|
0
|
return $self; |
480
|
|
|
|
|
|
|
} |
481
|
|
|
|
|
|
|
|
482
|
2
|
|
|
|
|
160
|
$ctl_dir = File::Spec->catpath((File::Spec->splitpath($ctl_path))[0,1], ""); |
483
|
2
|
50
|
33
|
|
|
10
|
$debug and $debug & 2 and _debug "ctl_path: $ctl_path, ctl_dir: $ctl_dir"; |
484
|
|
|
|
|
|
|
|
485
|
2
|
50
|
33
|
|
|
8
|
if ($strict_mode and !$self->_is_secure_path($ctl_dir)) { |
486
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, "ctl_dir $ctl_dir is not secure"); |
487
|
0
|
|
|
|
|
0
|
return $self; |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
|
490
|
2
|
|
|
|
|
6
|
$self->{_ctl_path} = $ctl_path; |
491
|
|
|
|
|
|
|
|
492
|
2
|
50
|
|
|
|
26
|
$self->_master_wait($async) if $connect; |
493
|
|
|
|
|
|
|
|
494
|
1
|
|
|
|
|
50
|
$self; |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
0
|
|
|
0
|
1
|
0
|
sub get_user { shift->{_user} } |
498
|
0
|
|
|
0
|
1
|
0
|
sub get_host { shift->{_host} } |
499
|
0
|
|
|
0
|
1
|
0
|
sub get_port { shift->{_port} } |
500
|
0
|
|
|
0
|
1
|
0
|
sub get_master_pid { shift->{_pid} } |
501
|
0
|
|
|
0
|
1
|
0
|
sub get_ctl_path { shift->{_ctl_path} } |
502
|
0
|
|
|
0
|
1
|
0
|
sub get_expand_vars { shift->{_expand_vars} } |
503
|
|
|
|
|
|
|
|
504
|
0
|
|
|
0
|
1
|
0
|
sub get_master_pty_log { shift->{_master_pty_log} } |
505
|
|
|
|
|
|
|
|
506
|
|
|
|
|
|
|
sub set_expand_vars { |
507
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
508
|
0
|
0
|
|
|
|
0
|
$self->{_expand_vars} = (shift(@_) ? 1 : 0); |
509
|
|
|
|
|
|
|
} |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
sub set_var { |
512
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
513
|
0
|
|
|
|
|
0
|
my $self = shift; |
514
|
0
|
|
|
|
|
0
|
my $k = shift; |
515
|
0
|
0
|
|
|
|
0
|
$k =~ /^(?:USER|HOST|PORT)$/ |
516
|
|
|
|
|
|
|
and croak "internal variable %$k% can not be set"; |
517
|
0
|
|
|
|
|
0
|
$self->{_vars}{$k} = shift; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
sub get_var { |
521
|
0
|
|
|
0
|
1
|
0
|
my ($self, $k) = @_; |
522
|
|
|
|
|
|
|
my $v = ( $k =~ /^(?:USER|HOST|PORT)$/ |
523
|
|
|
|
|
|
|
? $self->{lc "_$k"} |
524
|
0
|
0
|
|
|
|
0
|
: $self->{_vars}{$k} ); |
525
|
0
|
0
|
|
|
|
0
|
(defined $v ? $v : ''); |
526
|
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
sub _expand_vars { |
529
|
17
|
|
|
17
|
|
65
|
my ($self, @str) = @_; |
530
|
17
|
50
|
33
|
|
|
101
|
if (ref $self and $self->{_expand_vars}) { |
531
|
0
|
|
|
|
|
0
|
for (@str) { |
532
|
0
|
0
|
|
|
|
0
|
s{%(\w*)%}{length ($1) ? $self->get_var($1) : '%'}ge |
|
0
|
0
|
|
|
|
0
|
|
533
|
|
|
|
|
|
|
if defined $_; |
534
|
|
|
|
|
|
|
} |
535
|
|
|
|
|
|
|
} |
536
|
17
|
100
|
|
|
|
157
|
wantarray ? @str : $str[0] |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
|
539
|
1
|
|
|
1
|
1
|
27
|
sub error { shift->{_error} } |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
sub die_on_error { |
542
|
0
|
|
|
0
|
0
|
0
|
my $ssh = shift; |
543
|
0
|
0
|
|
|
|
0
|
$ssh->{_error} and croak(@_ ? "@_: $ssh->{_error}" : $ssh->{_error}); |
|
|
0
|
|
|
|
|
|
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
|
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
sub _is_secure_path { |
548
|
0
|
|
|
0
|
|
0
|
my ($self, $path) = @_; |
549
|
0
|
|
|
|
|
0
|
my @parts = File::Spec->splitdir(Cwd::realpath($path)); |
550
|
0
|
|
|
|
|
0
|
my $home = $self->{_home}; |
551
|
0
|
|
|
|
|
0
|
for my $last (reverse 0..$#parts) { |
552
|
0
|
|
|
|
|
0
|
my $dir = File::Spec->catdir(@parts[0..$last]); |
553
|
0
|
0
|
|
|
|
0
|
unless (-d $dir) { |
554
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 2 and _debug "$dir is not a directory"; |
555
|
0
|
|
|
|
|
0
|
return undef; |
556
|
|
|
|
|
|
|
} |
557
|
0
|
|
|
|
|
0
|
my ($mode, $uid) = (stat $dir)[2, 4]; |
558
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 2 and _debug "_is_secure_path(dir: $dir, file mode: $mode, file uid: $uid, euid: $>"; |
559
|
0
|
0
|
0
|
|
|
0
|
return undef unless(($uid == $> or $uid == 0 ) and (($mode & 022) == 0 or ($mode & 01000))); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
560
|
0
|
0
|
0
|
|
|
0
|
return 1 if (defined $home and $home eq $dir); |
561
|
|
|
|
|
|
|
} |
562
|
0
|
|
|
|
|
0
|
return 1; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
_sub_options _capture_local_ssh => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file); |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
sub _capture_local_ssh { |
568
|
3
|
|
|
3
|
|
6
|
my $self = shift; |
569
|
3
|
50
|
|
|
|
15
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
3
|
|
|
|
|
12
|
|
570
|
3
|
|
|
|
|
9
|
_croak_bad_options %opts; |
571
|
|
|
|
|
|
|
my (undef, $out, undef, $pid) = $self->open_ex({ %opts, |
572
|
|
|
|
|
|
|
_cmd => 'raw', |
573
|
|
|
|
|
|
|
_no_master_required => 1, |
574
|
|
|
|
|
|
|
stdout_pipe => 1, |
575
|
|
|
|
|
|
|
stdin_discard => 1 }, |
576
|
3
|
|
|
|
|
63
|
$self->{_ssh_cmd}, @_); |
577
|
2
|
|
|
|
|
98
|
my ($txt) = $self->_io3($out, undef, undef, undef, 10, 'bytes'); |
578
|
2
|
|
|
|
|
10
|
local $self->{_kill_ssh_on_timeout} = 1; |
579
|
2
|
|
|
|
|
28
|
$self->_waitpid($pid, 10); |
580
|
2
|
|
|
|
|
30
|
return $txt |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
sub _detect_ssh_version { |
584
|
3
|
|
|
3
|
|
9
|
my $self = shift; |
585
|
3
|
50
|
|
|
|
39
|
if (defined $self->{_ssh_version}) { |
586
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "ssh version given as $self->{_ssh_version}"; |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
else { |
589
|
3
|
|
|
|
|
27
|
my $txt = $self->_capture_local_ssh({stderr_to_stdout => 1}, '-V'); |
590
|
2
|
50
|
|
|
|
44
|
if (my ($full, $num) = $txt =~ /^OpenSSH_((\d+\.\d+)\S*)/mi) { |
591
|
2
|
50
|
33
|
|
|
10
|
$debug and $debug & 4 and _debug "OpenSSH version is $full"; |
592
|
2
|
|
|
|
|
8
|
$self->{_ssh_version} = $num; |
593
|
|
|
|
|
|
|
} |
594
|
|
|
|
|
|
|
else { |
595
|
0
|
|
|
|
|
0
|
$self->{_ssh_version} = 0; |
596
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "unable to determine version, '$self->{_ssh_cmd} -V', output:\n$txt" |
597
|
|
|
|
|
|
|
} |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
sub default_ssh_configuration { |
602
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
603
|
|
|
|
|
|
|
$self->_capture_local_ssh('-qG', $self->{_host}) |
604
|
0
|
|
|
|
|
0
|
} |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
sub _make_ssh_call { |
607
|
2
|
|
|
2
|
|
4
|
my $self = shift; |
608
|
2
|
50
|
|
|
|
2
|
my @before = @{shift || []}; |
|
2
|
|
|
|
|
8
|
|
609
|
|
|
|
|
|
|
my @args = ($self->{_ssh_cmd}, @before, |
610
|
|
|
|
|
|
|
-S => $self->{_ctl_path}, |
611
|
2
|
|
|
|
|
18
|
@{$self->{_ssh_opts}}, $self->{_host}, |
612
|
2
|
50
|
|
|
|
6
|
'--', |
613
|
|
|
|
|
|
|
(@_ ? "@_" : ())); |
614
|
2
|
50
|
33
|
|
|
8
|
$debug and $debug & 8 and _debug_dump 'call args' => \@args; |
615
|
2
|
|
|
|
|
36
|
@args; |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
sub _scp_cmd { |
619
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
620
|
0
|
|
0
|
|
|
0
|
$self->{_scp_cmd} ||= do { |
621
|
0
|
|
|
|
|
0
|
my $scp = $self->{_ssh_cmd}; |
622
|
0
|
0
|
|
|
|
0
|
$scp =~ s/ssh$/scp/i or croak "scp command name not set"; |
623
|
0
|
|
|
|
|
0
|
$scp; |
624
|
|
|
|
|
|
|
} |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
sub _make_scp_call { |
628
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
629
|
0
|
0
|
|
|
|
0
|
my @before = @{shift || []}; |
|
0
|
|
|
|
|
0
|
|
630
|
|
|
|
|
|
|
my @args = ($self->_scp_cmd, @before, |
631
|
|
|
|
|
|
|
-o => "ControlPath=$self->{_ctl_path}", |
632
|
|
|
|
|
|
|
-S => $self->{_ssh_cmd}, |
633
|
0
|
0
|
|
|
|
0
|
(defined $self->{_port} ? (-P => $self->{_port}) : ()), |
634
|
|
|
|
|
|
|
'--', @_); |
635
|
|
|
|
|
|
|
|
636
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 8 and _debug_dump 'scp call args' => \@args; |
637
|
0
|
|
|
|
|
0
|
@args; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
sub _rsync_quote { |
641
|
0
|
|
|
0
|
|
0
|
my ($self, @args) = @_; |
642
|
0
|
|
|
|
|
0
|
for (@args) { |
643
|
0
|
0
|
|
|
|
0
|
if (/['"\s]/) { |
644
|
0
|
|
|
|
|
0
|
s/"/""/g; |
645
|
0
|
|
|
|
|
0
|
$_ = qq|"$_"|; |
646
|
|
|
|
|
|
|
} |
647
|
0
|
|
|
|
|
0
|
s/%/%%/; |
648
|
|
|
|
|
|
|
} |
649
|
0
|
0
|
|
|
|
0
|
wantarray ? @args : join(' ', @args); |
650
|
|
|
|
|
|
|
} |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
sub _make_rsync_call { |
653
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
654
|
0
|
|
|
|
|
0
|
my $before = shift; |
655
|
|
|
|
|
|
|
my @transport = ($self->{_ssh_cmd}, @$before, |
656
|
0
|
|
|
|
|
0
|
-S => $self->{_ctl_path}); |
657
|
0
|
|
|
|
|
0
|
my $transport = $self->_rsync_quote(@transport); |
658
|
|
|
|
|
|
|
my @args = ( $self->{_rsync_cmd}, |
659
|
0
|
|
|
|
|
0
|
-e => $transport, |
660
|
|
|
|
|
|
|
@_); |
661
|
|
|
|
|
|
|
|
662
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 8 and _debug_dump 'rsync call args' => \@args; |
663
|
0
|
|
|
|
|
0
|
@args; |
664
|
|
|
|
|
|
|
} |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
sub _make_W_option { |
667
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
668
|
0
|
0
|
|
|
|
0
|
if (@_ == 1) { |
669
|
0
|
|
|
|
|
0
|
my $path = shift; |
670
|
0
|
0
|
|
|
|
0
|
$path = "./$path" unless $path =~ m|/|; |
671
|
0
|
|
|
|
|
0
|
$path =~ s/([\\:])/\\$1/g; |
672
|
0
|
|
|
|
|
0
|
return "-W$path"; |
673
|
|
|
|
|
|
|
} |
674
|
0
|
0
|
|
|
|
0
|
if (@_ == 2) { |
675
|
0
|
|
|
|
|
0
|
return "-W" . join(':', @_); |
676
|
|
|
|
|
|
|
} |
677
|
0
|
|
|
|
|
0
|
croak "bad number of arguments for creating a tunnel" |
678
|
|
|
|
|
|
|
} |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
sub _make_tunnel_call { |
681
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
682
|
0
|
0
|
|
|
|
0
|
my @before = @{shift||[]}; |
|
0
|
|
|
|
|
0
|
|
683
|
0
|
|
|
|
|
0
|
push @before, $self->_make_W_option(@_); |
684
|
0
|
|
|
|
|
0
|
my @args = $self->_make_ssh_call(\@before); |
685
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 8 and _debug_dump 'tunnel call args' => \@args; |
686
|
0
|
|
|
|
|
0
|
@args; |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
sub master_exited { |
690
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
691
|
0
|
|
|
|
|
0
|
$self->_master_gone(1) |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
|
694
|
|
|
|
|
|
|
sub _master_gone { |
695
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
696
|
0
|
|
|
|
|
0
|
my $async = shift; |
697
|
0
|
|
|
|
|
0
|
delete $self->{_pid}; |
698
|
0
|
0
|
|
|
|
0
|
$self->_master_fail($async, (@_ ? @_ : "master process exited unexpectedly")); |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
my @kill_signal = qw(0 0 TERM TERM TERM KILL); |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
sub __has_sigchld_handle { |
704
|
2
|
|
|
2
|
|
18
|
my $h = $SIG{CHLD}; |
705
|
2
|
50
|
33
|
|
|
52
|
defined $h and $h ne 'IGNORE' and $h ne 'DEFAULT' |
706
|
|
|
|
|
|
|
} |
707
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
sub _master_kill { |
709
|
0
|
|
|
0
|
|
0
|
my ($self, $async) = @_; |
710
|
|
|
|
|
|
|
|
711
|
0
|
0
|
|
|
|
0
|
if (my $pid = $self->_my_master_pid) { |
712
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 32 and _debug '_master_kill: ', $pid; |
713
|
|
|
|
|
|
|
|
714
|
0
|
|
|
|
|
0
|
my $now = time; |
715
|
0
|
|
0
|
|
|
0
|
my $start = $self->{_master_kill_start} ||= $now; |
716
|
0
|
|
0
|
|
|
0
|
$self->{_master_kill_last} ||= $now; |
717
|
0
|
|
0
|
|
|
0
|
$self->{_master_kill_count} ||= 0; |
718
|
|
|
|
|
|
|
|
719
|
0
|
0
|
0
|
0
|
|
0
|
local $SIG{CHLD} = sub {} unless $async or __has_sigchld_handle; |
720
|
0
|
|
|
|
|
0
|
while (1) { |
721
|
0
|
0
|
|
|
|
0
|
if ($self->{_master_kill_last} < $now) { |
722
|
0
|
|
|
|
|
0
|
$self->{_master_kill_last} = $now; |
723
|
0
|
|
|
|
|
0
|
my $sig = $kill_signal[$self->{_master_kill_count}++]; |
724
|
0
|
0
|
|
|
|
0
|
$sig = 'KILL' unless defined $sig; |
725
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 32 and _debug "killing master $$ with signal $sig"; |
726
|
0
|
|
|
|
|
0
|
kill $sig, $pid; |
727
|
|
|
|
|
|
|
} |
728
|
0
|
|
|
|
|
0
|
my $deceased = waitpid($pid, WNOHANG); |
729
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 32 and _debug "waitpid(master: $pid) => pid: $deceased, rc: $!"; |
730
|
0
|
0
|
0
|
|
|
0
|
last if $deceased == $pid or ($deceased < 0 and $! == Errno::ECHILD()); |
|
|
|
0
|
|
|
|
|
731
|
0
|
0
|
|
|
|
0
|
if ($self->{_master_kill_count} > 20) { |
732
|
|
|
|
|
|
|
# FIXME: remove the hard-coded 20 retries? |
733
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 32 and _debug "unable to kill SSH master process, giving up"; |
734
|
0
|
|
|
|
|
0
|
last; |
735
|
|
|
|
|
|
|
} |
736
|
0
|
0
|
|
|
|
0
|
return if $async; |
737
|
0
|
|
|
|
|
0
|
select(undef, undef, undef, 0.2); |
738
|
0
|
|
|
|
|
0
|
$now = time; |
739
|
|
|
|
|
|
|
} |
740
|
|
|
|
|
|
|
} |
741
|
|
|
|
|
|
|
else { |
742
|
|
|
|
|
|
|
$debug and $debug & 32 and _debug("not killing master SSH (", $self->{_pid}, ") started from " . |
743
|
|
|
|
|
|
|
"process ", $self->{_perl_pid}, "/", $self->{_thread_generation}, |
744
|
0
|
0
|
0
|
|
|
0
|
", current ", $$, "/", $thread_generation, ")"); |
745
|
|
|
|
|
|
|
} |
746
|
0
|
|
|
|
|
0
|
$self->_master_gone($async); |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
sub disconnect { |
750
|
0
|
|
|
0
|
1
|
0
|
my ($self, $async) = @_; |
751
|
0
|
0
|
|
|
|
0
|
@_ <= 2 or croak 'Usage: $self->disconnect([$async])'; |
752
|
0
|
|
|
|
|
0
|
$self->_disconnect($async, 1); |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
sub disown_master { |
756
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
757
|
0
|
0
|
|
|
|
0
|
if (my $pid = $self->_my_master_pid) { |
758
|
0
|
0
|
|
|
|
0
|
if ($self->wait_for_master) { |
759
|
0
|
|
|
|
|
0
|
$self->{_external_master} = 1; |
760
|
0
|
|
|
|
|
0
|
return $pid; |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
} |
763
|
0
|
|
|
|
|
0
|
undef; |
764
|
|
|
|
|
|
|
} |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
sub restart { |
767
|
0
|
|
|
0
|
1
|
0
|
my ($self, $async) = @_; |
768
|
0
|
0
|
|
|
|
0
|
$self->{_external_master} and croak "Can restart SSH connection when using external master"; |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
# user is responsible for calling us in STATE_GONE in async mode |
771
|
0
|
0
|
|
|
|
0
|
$self->_disconnect($async, 1) unless $async; |
772
|
|
|
|
|
|
|
|
773
|
0
|
0
|
|
|
|
0
|
if ($self->{_master_state} != _STATE_GONE) { |
774
|
0
|
0
|
|
|
|
0
|
croak "restart method called in wrong state (terminate the connection first!)" if $async; |
775
|
0
|
|
|
|
|
0
|
return $self->_master_fail($async, "Unable to restart SSH session from state $self->{_master_state}") |
776
|
|
|
|
|
|
|
} |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
# These slots should be deleted when exiting the KILLING state but |
779
|
|
|
|
|
|
|
# I like keeping them around for throubleshoting purposes. |
780
|
0
|
|
|
|
|
0
|
delete $self->{_master_kill_start}; |
781
|
0
|
|
|
|
|
0
|
delete $self->{_master_kill_last}; |
782
|
0
|
|
|
|
|
0
|
delete $self->{_master_kill_count}; |
783
|
0
|
|
|
|
|
0
|
$self->_master_jump_state(_STATE_START, $async); |
784
|
|
|
|
|
|
|
} |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
sub _my_master_pid { |
787
|
4
|
|
|
4
|
|
9
|
my $self = shift; |
788
|
4
|
50
|
|
|
|
24
|
unless ($self->{_external_master}) { |
789
|
4
|
|
|
|
|
11
|
my $pid = $self->{_pid}; |
790
|
|
|
|
|
|
|
return $pid if |
791
|
4
|
50
|
66
|
|
|
54
|
$pid and $self->{_perl_pid} == $$ and $self->{_thread_generation} == $thread_generation; |
|
|
|
66
|
|
|
|
|
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
() |
794
|
3
|
|
|
|
|
8
|
} |
795
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
sub _disconnect { |
797
|
1
|
|
|
1
|
|
4
|
my ($self, $async, $send_ctl) = @_; |
798
|
1
|
50
|
|
|
|
433
|
return if $self->{_master_state} == _STATE_GONE; |
799
|
|
|
|
|
|
|
|
800
|
0
|
0
|
0
|
|
|
0
|
if (!$async and |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
801
|
|
|
|
|
|
|
$self->{_master_state} == _STATE_RUNNING and |
802
|
|
|
|
|
|
|
($send_ctl or $self->_my_master_pid)) { |
803
|
|
|
|
|
|
|
# we have successfully created the master connection so we |
804
|
|
|
|
|
|
|
# can send control commands: |
805
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 32 and _debug("sending exit control to master"); |
806
|
0
|
|
|
|
|
0
|
$self->_master_ctl('exit'); |
807
|
|
|
|
|
|
|
} |
808
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, 'aborted') |
809
|
|
|
|
|
|
|
} |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
sub _check_is_system_fh { |
812
|
6
|
|
|
6
|
|
27
|
my ($name, $fh) = @_; |
813
|
6
|
100
|
|
|
|
24
|
my $fn = fileno(defined $fh ? $fh : $name); |
814
|
6
|
50
|
33
|
|
|
36
|
defined $fn and $fn >= 0 and return; |
815
|
0
|
|
|
|
|
0
|
croak "child process $name is not a real system file handle"; |
816
|
|
|
|
|
|
|
} |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
sub _master_redirect { |
819
|
2
|
|
|
2
|
|
14
|
my $self = shift; |
820
|
2
|
|
|
|
|
11
|
my $uname = uc shift; |
821
|
2
|
|
|
|
|
8
|
my $name = lc $uname; |
822
|
|
|
|
|
|
|
|
823
|
5
|
|
|
5
|
|
39
|
no strict 'refs'; |
|
5
|
|
|
|
|
10
|
|
|
5
|
|
|
|
|
54978
|
|
824
|
2
|
50
|
|
|
|
16
|
if ($self->{"_master_${name}_discard"}) { |
825
|
0
|
|
|
|
|
0
|
open *$uname, '>>', '/dev/null'; |
826
|
|
|
|
|
|
|
} |
827
|
|
|
|
|
|
|
else { |
828
|
2
|
|
|
|
|
8
|
my $fh = $self->{"_master_${name}_fh"}; |
829
|
2
|
50
|
|
|
|
18
|
$fh = $self->{"_default_${name}_fh"} unless defined $fh; |
830
|
2
|
50
|
|
|
|
16
|
if (defined $fh) { |
831
|
0
|
|
|
|
|
0
|
_check_is_system_fh $uname => $fh; |
832
|
0
|
0
|
|
|
|
0
|
if (fileno $fh != fileno *$uname) { |
833
|
0
|
0
|
|
|
|
0
|
open *$uname, '>>&', $fh or POSIX::_exit(255); |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
} |
837
|
|
|
|
|
|
|
} |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
sub _waitpid { |
840
|
2
|
|
|
2
|
|
8
|
my ($self, $pid, $timeout) = @_; |
841
|
2
|
|
|
|
|
16
|
$? = 0; |
842
|
2
|
50
|
|
|
|
8
|
if ($pid) { |
843
|
2
|
50
|
|
|
|
8
|
$timeout = $self->{_timeout} unless defined $timeout; |
844
|
|
|
|
|
|
|
|
845
|
2
|
|
|
|
|
28
|
my $time_limit; |
846
|
2
|
50
|
33
|
|
|
22
|
if (defined $timeout and $self->{_kill_ssh_on_timeout}) { |
847
|
2
|
50
|
|
|
|
10
|
$timeout = 0 if $self->{_error} == OSSH_SLAVE_TIMEOUT; |
848
|
2
|
|
|
|
|
4
|
$time_limit = time + $timeout; |
849
|
|
|
|
|
|
|
} |
850
|
2
|
50
|
|
0
|
|
20
|
local $SIG{CHLD} = sub {} unless __has_sigchld_handle; |
851
|
2
|
|
|
|
|
6
|
while (1) { |
852
|
2
|
|
|
|
|
4
|
my $deceased; |
853
|
2
|
50
|
|
|
|
18
|
if (defined $time_limit) { |
854
|
2
|
|
|
|
|
8
|
while (1) { |
855
|
|
|
|
|
|
|
# TODO: we assume that all OSs return 0 when the |
856
|
|
|
|
|
|
|
# process is still running, that may be wrong! |
857
|
2
|
50
|
|
|
|
90
|
$deceased = waitpid($pid, WNOHANG) and last; |
858
|
0
|
|
|
|
|
0
|
my $remaining = $time_limit - time; |
859
|
0
|
0
|
|
|
|
0
|
if ($remaining <= 0) { |
860
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 16 and _debug "killing SSH slave, pid: $pid"; |
861
|
0
|
|
|
|
|
0
|
kill TERM => $pid; |
862
|
0
|
|
|
|
|
0
|
$self->_or_set_error(OSSH_SLAVE_TIMEOUT, "ssh slave failed", "timed out"); |
863
|
|
|
|
|
|
|
} |
864
|
|
|
|
|
|
|
# There is a race condition here. We try to |
865
|
|
|
|
|
|
|
# minimize it keeping the waitpid and the select |
866
|
|
|
|
|
|
|
# together and limiting the sleep time to 1s: |
867
|
0
|
0
|
|
|
|
0
|
my $sleep = ($remaining < 0.1 ? 0.1 : 1); |
868
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 16 and |
869
|
|
|
|
|
|
|
_debug "waiting for slave, timeout: $timeout, remaining: $remaining, sleep: $sleep"; |
870
|
0
|
0
|
|
|
|
0
|
$deceased = waitpid($pid, WNOHANG) and last; |
871
|
0
|
|
|
|
|
0
|
select(undef, undef, undef, $sleep); |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
} |
874
|
|
|
|
|
|
|
else { |
875
|
0
|
|
|
|
|
0
|
$deceased = waitpid($pid, 0); |
876
|
|
|
|
|
|
|
} |
877
|
2
|
50
|
33
|
|
|
10
|
$debug and $debug & 16 and _debug "_waitpid($pid) => pid: $deceased, rc: $?, err: $!"; |
878
|
2
|
50
|
|
|
|
8
|
if ($deceased == $pid) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
879
|
2
|
50
|
|
|
|
8
|
if ($?) { |
880
|
0
|
|
|
|
|
0
|
my $signal = ($? & 255); |
881
|
0
|
|
|
|
|
0
|
my $errstr = "child exited with code " . ($? >> 8); |
882
|
0
|
0
|
|
|
|
0
|
$errstr .= ", signal $signal" if $signal; |
883
|
0
|
|
|
|
|
0
|
$self->_or_set_error(OSSH_SLAVE_CMD_FAILED, $errstr); |
884
|
0
|
|
|
|
|
0
|
return undef; |
885
|
|
|
|
|
|
|
} |
886
|
2
|
|
|
|
|
28
|
return 1; |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
elsif ($deceased < 0) { |
889
|
|
|
|
|
|
|
# at this point $deceased < 0 and so, $! has a valid error value. |
890
|
0
|
0
|
|
|
|
0
|
next if $! == Errno::EINTR(); |
891
|
0
|
0
|
|
|
|
0
|
if ($! == Errno::ECHILD()) { |
892
|
0
|
|
|
|
|
0
|
$self->_or_set_error(OSSH_SLAVE_FAILED, "child process $pid does not exist", $!); |
893
|
|
|
|
|
|
|
return undef |
894
|
0
|
|
|
|
|
0
|
} |
895
|
0
|
|
|
|
|
0
|
warn "Internal error: unexpected error (".($!+0).": $!) from waitpid($pid) = $deceased. Report it, please!"; |
896
|
|
|
|
|
|
|
} |
897
|
|
|
|
|
|
|
elsif ($deceased > 0) { |
898
|
0
|
|
|
|
|
0
|
warn "Internal error: spurious process $deceased exited" |
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
# wait a bit before trying again |
902
|
0
|
|
|
|
|
0
|
select(undef, undef, undef, 0.1); |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
} |
905
|
|
|
|
|
|
|
else { |
906
|
0
|
|
|
|
|
0
|
$self->_or_set_error(OSSH_SLAVE_FAILED, "spawning of new process failed"); |
907
|
0
|
|
|
|
|
0
|
return undef; |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
sub check_master { |
912
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
913
|
0
|
0
|
|
|
|
0
|
@_ and croak 'Usage: $ssh->check_master()'; |
914
|
0
|
|
|
|
|
0
|
$self->_master_check(0); |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
|
917
|
|
|
|
|
|
|
sub wait_for_master { |
918
|
0
|
|
|
0
|
1
|
0
|
my ($self, $async) = @_; |
919
|
0
|
0
|
|
|
|
0
|
@_ <= 2 or croak 'Usage: $ssh->wait_for_master([$async])'; |
920
|
|
|
|
|
|
|
$self->{_error} = 0 |
921
|
0
|
0
|
|
|
|
0
|
unless $self->{_error} == OSSH_MASTER_FAILED; |
922
|
0
|
|
|
|
|
0
|
$self->_master_wait($async); |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
|
925
|
|
|
|
|
|
|
sub _master_start { |
926
|
2
|
|
|
2
|
|
6
|
my ($self, $async) = @_; |
927
|
2
|
|
|
|
|
18
|
$self->_set_error; |
928
|
|
|
|
|
|
|
|
929
|
2
|
|
50
|
|
|
14
|
my $timeout = int((($self->{_timeout} || 90) + 2)/3); |
930
|
2
|
|
|
|
|
10
|
my $ssh_flags= '-2MN'; |
931
|
2
|
0
|
|
|
|
8
|
$ssh_flags .= ($self->{_forward_agent} ? 'A' : 'a') if defined $self->{_forward_agent}; |
|
|
50
|
|
|
|
|
|
932
|
2
|
50
|
|
|
|
10
|
$ssh_flags .= ($self->{_forward_X11} ? 'X' : 'x'); |
933
|
2
|
|
|
|
|
38
|
my @master_opts = (@{$self->{_master_opts}}, |
934
|
|
|
|
|
|
|
-o => "ServerAliveInterval=$timeout", |
935
|
2
|
50
|
|
|
|
4
|
($self->{_ssh_version} >= 5.6 ? (-o => "ControlPersist=no") : ()), |
936
|
|
|
|
|
|
|
$ssh_flags); |
937
|
|
|
|
|
|
|
|
938
|
2
|
|
|
|
|
8
|
my ($mpty, $use_pty, $pref_auths); |
939
|
|
|
|
|
|
|
$use_pty = 1 if ( $self->{_master_pty_force} or |
940
|
2
|
50
|
33
|
|
|
18
|
defined $self->{_login_handler} ); |
941
|
2
|
50
|
|
|
|
64
|
if (defined $self->{_passwd}) { |
|
|
50
|
|
|
|
|
|
942
|
0
|
|
|
|
|
0
|
$use_pty = 1; |
943
|
|
|
|
|
|
|
$pref_auths = ($self->{_passphrase} |
944
|
0
|
0
|
|
|
|
0
|
? 'publickey' |
945
|
|
|
|
|
|
|
: 'keyboard-interactive,password'); |
946
|
0
|
|
|
|
|
0
|
push @master_opts, -o => 'NumberOfPasswordPrompts=1'; |
947
|
|
|
|
|
|
|
} |
948
|
|
|
|
|
|
|
elsif ($self->{_batch_mode}) { |
949
|
0
|
|
|
|
|
0
|
push @master_opts, -o => 'BatchMode=yes'; |
950
|
|
|
|
|
|
|
} |
951
|
|
|
|
|
|
|
|
952
|
2
|
50
|
|
|
|
8
|
if (defined $self->{_key_path}) { |
953
|
0
|
|
|
|
|
0
|
$pref_auths = 'publickey'; |
954
|
0
|
|
|
|
|
0
|
push @master_opts, -i => $self->{_key_path}; |
955
|
|
|
|
|
|
|
} |
956
|
|
|
|
|
|
|
|
957
|
2
|
|
|
|
|
4
|
my $proxy_command = $self->{_proxy_command}; |
958
|
|
|
|
|
|
|
|
959
|
2
|
|
|
|
|
4
|
my $gateway; |
960
|
2
|
50
|
|
|
|
8
|
if (my $gateway_args = $self->{_gateway_args}) { |
961
|
0
|
0
|
|
|
|
0
|
if (ref $gateway_args eq 'HASH') { |
962
|
0
|
|
|
|
|
0
|
_load_module('Net::OpenSSH::Gateway'); |
963
|
0
|
|
|
|
|
0
|
my $errors; |
964
|
0
|
0
|
|
|
|
0
|
unless ($gateway = Net::OpenSSH::Gateway->find_gateway(errors => $errors, |
965
|
|
|
|
|
|
|
host => $self->{_host}, port => $self->{_port}, |
966
|
|
|
|
|
|
|
%$gateway_args)) { |
967
|
0
|
|
|
|
|
0
|
return $self->_master_fail($async, 'Unable to build gateway object', join(', ', @$errors)); |
968
|
|
|
|
|
|
|
} |
969
|
|
|
|
|
|
|
} |
970
|
|
|
|
|
|
|
else { |
971
|
0
|
|
|
|
|
0
|
$gateway = $gateway_args |
972
|
|
|
|
|
|
|
} |
973
|
0
|
|
|
|
|
0
|
$self->{_gateway} = $gateway; |
974
|
0
|
0
|
|
|
|
0
|
$gateway->before_ssh_connect or |
975
|
|
|
|
|
|
|
return $self->_master_fail($async, 'Gateway setup failed', join(', ', $gateway->errors)); |
976
|
0
|
|
|
|
|
0
|
$proxy_command = $gateway->proxy_command; |
977
|
|
|
|
|
|
|
} |
978
|
|
|
|
|
|
|
|
979
|
2
|
50
|
|
|
|
14
|
if (defined $proxy_command) { |
980
|
0
|
|
|
|
|
0
|
push @master_opts, -o => "ProxyCommand=$proxy_command"; |
981
|
|
|
|
|
|
|
} |
982
|
|
|
|
|
|
|
|
983
|
2
|
50
|
|
|
|
8
|
if ($use_pty) { |
984
|
0
|
|
|
|
|
0
|
_load_module('IO::Pty'); |
985
|
0
|
|
|
|
|
0
|
$self->{_mpty} = $mpty = IO::Pty->new; |
986
|
|
|
|
|
|
|
} |
987
|
|
|
|
|
|
|
|
988
|
2
|
50
|
|
|
|
4
|
push @master_opts, -o => "PreferredAuthentications=$pref_auths" |
989
|
|
|
|
|
|
|
if defined $pref_auths; |
990
|
|
|
|
|
|
|
|
991
|
2
|
|
|
|
|
12
|
my @call = $self->_make_ssh_call(\@master_opts); |
992
|
|
|
|
|
|
|
|
993
|
2
|
|
|
|
|
2249
|
my $pid = fork; |
994
|
2
|
100
|
|
|
|
117
|
unless ($pid) { |
995
|
1
|
50
|
|
|
|
19
|
defined $pid |
996
|
|
|
|
|
|
|
or return $self->_master_fail($async, "unable to fork ssh master: $!"); |
997
|
|
|
|
|
|
|
|
998
|
1
|
50
|
33
|
|
|
23
|
if ($debug and $debug & 512) { |
999
|
0
|
|
|
|
|
0
|
require Net::OpenSSH::OSTracer; |
1000
|
0
|
|
|
|
|
0
|
Net::OpenSSH::OSTracer->trace; |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
|
1003
|
1
|
50
|
|
|
|
8
|
$mpty->make_slave_controlling_terminal if $mpty; |
1004
|
|
|
|
|
|
|
|
1005
|
1
|
|
|
|
|
68
|
$self->_master_redirect('STDOUT'); |
1006
|
1
|
|
|
|
|
12
|
$self->_master_redirect('STDERR'); |
1007
|
|
|
|
|
|
|
|
1008
|
1
|
50
|
|
|
|
10
|
delete $ENV{SSH_ASKPASS} if defined $self->{_passwd}; |
1009
|
1
|
50
|
|
|
|
15
|
delete $ENV{SSH_AUTH_SOCK} if defined $self->{_passphrase}; |
1010
|
|
|
|
|
|
|
|
1011
|
1
|
50
|
|
|
|
6
|
setpgrp if $self->{_master_setpgrp}; |
1012
|
|
|
|
|
|
|
|
1013
|
1
|
|
|
|
|
25
|
local $SIG{__DIE__}; |
1014
|
1
|
|
|
|
|
13
|
eval { exec @call }; |
|
1
|
|
|
|
|
0
|
|
1015
|
0
|
|
|
|
|
0
|
POSIX::_exit(255); |
1016
|
|
|
|
|
|
|
} |
1017
|
1
|
|
|
|
|
13
|
$self->{_pid} = $pid; |
1018
|
1
|
|
|
|
|
97
|
1; |
1019
|
|
|
|
|
|
|
} |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
sub _master_check { |
1022
|
0
|
|
|
0
|
|
0
|
my ($self, $async) = @_; |
1023
|
0
|
|
|
|
|
0
|
my $error; |
1024
|
0
|
0
|
|
|
|
0
|
if ($async) { |
1025
|
0
|
0
|
|
|
|
0
|
if (-S $self->{_ctl_path}) { |
1026
|
0
|
|
|
|
|
0
|
delete $self->{_master_pty_log}; |
1027
|
0
|
|
|
|
|
0
|
return 1 |
1028
|
|
|
|
|
|
|
} |
1029
|
0
|
|
|
|
|
0
|
$error = "master SSH connection broken"; |
1030
|
|
|
|
|
|
|
} |
1031
|
|
|
|
|
|
|
else { |
1032
|
0
|
|
|
|
|
0
|
my $out = $self->_master_ctl('check'); |
1033
|
0
|
|
|
|
|
0
|
$error = $self->{_error}; |
1034
|
0
|
0
|
|
|
|
0
|
unless ($error) { |
1035
|
0
|
|
|
|
|
0
|
my $pid = $self->{_pid}; |
1036
|
0
|
0
|
|
|
|
0
|
if ($out =~ /pid=(\d+)/) { |
1037
|
0
|
0
|
0
|
|
|
0
|
if (!$pid or $1 == $pid) { |
1038
|
0
|
|
|
|
|
0
|
delete $self->{_master_pty_log}; |
1039
|
0
|
|
|
|
|
0
|
return 1; |
1040
|
|
|
|
|
|
|
} |
1041
|
0
|
|
|
|
|
0
|
$error = "bad ssh master at $self->{_ctl_path} socket owned by pid $1 (pid $pid expected)"; |
1042
|
|
|
|
|
|
|
} |
1043
|
|
|
|
|
|
|
else { |
1044
|
0
|
0
|
|
|
|
0
|
$error = ($out =~ /illegal option/i |
1045
|
|
|
|
|
|
|
? 'OpenSSH 4.1 or later required' |
1046
|
|
|
|
|
|
|
: 'unknown error'); |
1047
|
|
|
|
|
|
|
} |
1048
|
|
|
|
|
|
|
} |
1049
|
|
|
|
|
|
|
} |
1050
|
0
|
|
|
|
|
0
|
$self->_master_fail($async, $error); |
1051
|
|
|
|
|
|
|
} |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
sub _master_fail { |
1054
|
1
|
|
|
1
|
|
3
|
my $self = shift; |
1055
|
1
|
|
|
|
|
3
|
my $async = shift; |
1056
|
1
|
50
|
|
|
|
13
|
if ($self->{_error} != OSSH_MASTER_FAILED) { |
1057
|
1
|
|
|
|
|
14
|
$self->_set_error(OSSH_MASTER_FAILED, @_); |
1058
|
|
|
|
|
|
|
} |
1059
|
1
|
50
|
|
|
|
113
|
$self->_master_jump_state($self->{_pid} ? _STATE_KILLING : _STATE_GONE, $async); |
1060
|
|
|
|
|
|
|
} |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
sub _master_jump_state { |
1063
|
2
|
|
|
2
|
|
21
|
my ($self, $state, $async) = @_; |
1064
|
2
|
50
|
33
|
|
|
17
|
$debug and $debug & 4 and _debug "master state jumping from $self->{_master_state} to $state"; |
1065
|
2
|
0
|
33
|
|
|
14
|
if ($state == $self->{_master_state} and |
|
|
|
33
|
|
|
|
|
1066
|
|
|
|
|
|
|
$state != _STATE_KILLING and |
1067
|
|
|
|
|
|
|
$state != _STATE_GONE) { |
1068
|
0
|
|
|
|
|
0
|
croak "internal error: state jump to itself ($state)!"; |
1069
|
|
|
|
|
|
|
} |
1070
|
2
|
|
|
|
|
11
|
$self->{_master_state} = $state; |
1071
|
2
|
|
|
|
|
57
|
return $self->_master_wait($async); |
1072
|
|
|
|
|
|
|
} |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
sub _master_wait { |
1075
|
4
|
|
|
4
|
|
14
|
my ($self, $async) = @_; |
1076
|
|
|
|
|
|
|
|
1077
|
4
|
|
|
|
|
51
|
my $pid = $self->_my_master_pid; |
1078
|
4
|
100
|
|
|
|
12
|
if ($pid) { |
1079
|
1
|
|
|
|
|
6
|
my $deceased = waitpid($pid, WNOHANG); |
1080
|
1
|
50
|
33
|
|
|
28
|
if ($deceased == $pid or ($deceased < 0 and $! == Errno::ECHILD())) { |
|
|
|
33
|
|
|
|
|
1081
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "master $pid exited, rc:", $?,", err: ",$!; |
1082
|
0
|
|
|
|
|
0
|
return $self->_master_gone($async); |
1083
|
|
|
|
|
|
|
} |
1084
|
|
|
|
|
|
|
} |
1085
|
|
|
|
|
|
|
|
1086
|
4
|
50
|
|
|
|
12
|
if ($self->{_master_state} == _STATE_RUNNING) { |
1087
|
0
|
0
|
|
|
|
0
|
return 1 if -S $self->{_ctl_path}; |
1088
|
0
|
|
|
|
|
0
|
return $self->_master_fail($async, "master SSH connection broken"); |
1089
|
|
|
|
|
|
|
} |
1090
|
|
|
|
|
|
|
|
1091
|
4
|
50
|
|
|
|
11
|
if ($self->{_master_state} == _STATE_KILLING) { |
1092
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "killing master"; |
1093
|
0
|
|
|
|
|
0
|
return $self->_master_kill($async); |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
|
1096
|
4
|
100
|
|
|
|
14
|
if ($self->{_master_state} == _STATE_START) { |
1097
|
2
|
50
|
|
|
|
6
|
if ($self->{_external_master}) { |
1098
|
0
|
|
0
|
|
|
0
|
return ($self->_master_jump_state(_STATE_RUNNING, $async) and |
1099
|
|
|
|
|
|
|
$self->_master_check($async)) |
1100
|
|
|
|
|
|
|
} |
1101
|
|
|
|
|
|
|
|
1102
|
2
|
50
|
|
|
|
20
|
$self->_master_start($async) or return; |
1103
|
1
|
50
|
|
|
|
28
|
if ($self->{_mpty}) { |
1104
|
0
|
|
|
|
|
0
|
$self->{_wfm_bout} = ''; |
1105
|
0
|
|
|
|
|
0
|
$self->{_master_pty_log} = ''; |
1106
|
0
|
0
|
0
|
|
|
0
|
if (defined $self->{_passwd} or $self->{_login_handler}) { |
1107
|
0
|
|
|
|
|
0
|
return $self->_master_jump_state(_STATE_LOGIN, $async); |
1108
|
|
|
|
|
|
|
} |
1109
|
|
|
|
|
|
|
} |
1110
|
1
|
|
|
|
|
29
|
return $self->_master_jump_state(_STATE_AWAITING_MUX, $async); |
1111
|
|
|
|
|
|
|
} |
1112
|
|
|
|
|
|
|
|
1113
|
2
|
100
|
|
|
|
14
|
if ($self->{_master_state} == _STATE_GONE) { |
1114
|
1
|
50
|
|
|
|
4
|
if (my $mpty = delete $self->{_mpty}) { |
1115
|
0
|
|
|
|
|
0
|
close($mpty) |
1116
|
|
|
|
|
|
|
} |
1117
|
1
|
|
|
|
|
6
|
return 0; |
1118
|
|
|
|
|
|
|
} |
1119
|
1
|
50
|
|
|
|
13
|
if ($self->{_master_state} == _STATE_STOPPED) { |
1120
|
0
|
|
|
|
|
0
|
return 0; |
1121
|
|
|
|
|
|
|
} |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
# At this point we are either in state AWAITIN_MUX or LOGIN |
1124
|
|
|
|
|
|
|
|
1125
|
1
|
|
|
|
|
3
|
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, |
|
1
|
|
|
|
|
20
|
|
1126
|
|
|
|
|
|
|
"unable to establish master SSH connection"]; |
1127
|
|
|
|
|
|
|
|
1128
|
1
|
50
|
|
|
|
12
|
$pid or return $self->_master_gone($async, |
1129
|
|
|
|
|
|
|
"perl process was forked or threaded before SSH connection had been established"); |
1130
|
|
|
|
|
|
|
|
1131
|
1
|
|
|
|
|
7
|
my $old_tcpgrp; |
1132
|
1
|
0
|
33
|
|
|
4
|
if ($self->{_master_setpgrp} and not $async and |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1133
|
|
|
|
|
|
|
not $self->{_batch_mode} and not $self->{_external_master}) { |
1134
|
0
|
|
|
|
|
0
|
$old_tcpgrp = POSIX::tcgetpgrp(0); |
1135
|
0
|
0
|
|
|
|
0
|
if ($old_tcpgrp > 0) { |
1136
|
|
|
|
|
|
|
# let the master process ask for passwords at the TTY |
1137
|
0
|
|
|
|
|
0
|
POSIX::tcsetpgrp(0, $pid); |
1138
|
|
|
|
|
|
|
} |
1139
|
|
|
|
|
|
|
else { |
1140
|
0
|
|
|
|
|
0
|
undef $old_tcpgrp; |
1141
|
|
|
|
|
|
|
} |
1142
|
|
|
|
|
|
|
} |
1143
|
|
|
|
|
|
|
|
1144
|
1
|
|
|
|
|
2
|
my $mpty = $self->{_mpty}; |
1145
|
1
|
|
|
|
|
2
|
my $fnopty; |
1146
|
1
|
|
|
|
|
8
|
my $rv = ''; |
1147
|
1
|
0
|
0
|
|
|
4
|
if ($mpty and |
|
|
|
33
|
|
|
|
|
1148
|
|
|
|
|
|
|
( $self->{_master_state} == _STATE_LOGIN or |
1149
|
|
|
|
|
|
|
$self->{_master_state} == _STATE_AWAITING_MUX )) { |
1150
|
0
|
|
|
|
|
0
|
$fnopty = fileno $mpty; |
1151
|
0
|
|
|
|
|
0
|
vec($rv, $fnopty, 1) = 1 |
1152
|
|
|
|
|
|
|
} |
1153
|
|
|
|
|
|
|
|
1154
|
1
|
|
|
|
|
8
|
my $timeout = $self->{_timeout}; |
1155
|
1
|
50
|
|
|
|
3
|
my $dt = ($async ? 0 : 0.02); |
1156
|
1
|
|
|
|
|
7
|
my $start_time = time; |
1157
|
1
|
|
|
|
|
8
|
my $error; |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
# Loop until the mux socket appears or something goes wrong: |
1160
|
1
|
|
|
|
|
3
|
while (1) { |
1161
|
15
|
50
|
|
|
|
159
|
$dt *= 1.10 if $dt < 0.2; # adaptative delay |
1162
|
15
|
50
|
|
|
|
336
|
if (-e $self->{_ctl_path}) { |
1163
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "file object found at $self->{_ctl_path}"; |
1164
|
0
|
|
|
|
|
0
|
last; |
1165
|
|
|
|
|
|
|
} |
1166
|
15
|
50
|
33
|
|
|
647
|
$debug and $debug & 4 and _debug "file object not yet found at $self->{_ctl_path}, state:", $self->{_master_state}; |
1167
|
|
|
|
|
|
|
|
1168
|
15
|
50
|
33
|
|
|
156
|
if (defined $timeout and (time - $start_time) > $timeout) { |
1169
|
0
|
|
|
|
|
0
|
$error = "login timeout"; |
1170
|
0
|
|
|
|
|
0
|
last; |
1171
|
|
|
|
|
|
|
} |
1172
|
|
|
|
|
|
|
|
1173
|
15
|
|
|
|
|
165
|
my $deceased = waitpid($pid, WNOHANG); |
1174
|
15
|
100
|
33
|
|
|
122
|
if ($deceased == $pid or ($deceased < 0 and $! == Errno::ECHILD())) { |
|
|
|
66
|
|
|
|
|
1175
|
1
|
|
|
|
|
10
|
$error = "master process exited unexpectedly"; |
1176
|
|
|
|
|
|
|
$error = "bad pass" . ($self->{_passphrase} ? 'phrase' : 'word') . " or $error" |
1177
|
1
|
0
|
|
|
|
8
|
if defined $self->{_passwd}; |
|
|
50
|
|
|
|
|
|
1178
|
1
|
|
|
|
|
12
|
delete $self->{_pid}; |
1179
|
1
|
|
|
|
|
3
|
last; |
1180
|
|
|
|
|
|
|
} |
1181
|
|
|
|
|
|
|
|
1182
|
14
|
50
|
33
|
|
|
68
|
if ($self->{_login_handler} and $self->{_master_state} == _STATE_LOGIN) { |
1183
|
0
|
|
|
|
|
0
|
local ($@, $SIG{__DIE__}); |
1184
|
0
|
0
|
|
|
|
0
|
if (eval { $self->{_login_handler}->($self, $mpty, \$self->{_wfm_bout}) }) { |
|
0
|
|
|
|
|
0
|
|
1185
|
0
|
|
|
|
|
0
|
$self->{_master_state} = _STATE_AWAITING_MUX; |
1186
|
0
|
|
|
|
|
0
|
next; |
1187
|
|
|
|
|
|
|
} |
1188
|
0
|
0
|
|
|
|
0
|
if ($@) { |
1189
|
0
|
|
|
|
|
0
|
$error = "custom login handler failed: $@"; |
1190
|
0
|
|
|
|
|
0
|
last; |
1191
|
|
|
|
|
|
|
} |
1192
|
|
|
|
|
|
|
# fallback |
1193
|
|
|
|
|
|
|
} |
1194
|
|
|
|
|
|
|
else { |
1195
|
|
|
|
|
|
|
# we keep reading from mpty even after leaving state |
1196
|
|
|
|
|
|
|
# STATE_LOGIN in order to search for additional password |
1197
|
|
|
|
|
|
|
# prompts. |
1198
|
14
|
|
|
|
|
30
|
my $rv1 = $rv; |
1199
|
14
|
|
|
|
|
625087
|
my $n = select($rv1, undef, undef, $dt); |
1200
|
14
|
50
|
|
|
|
143
|
if ($n > 0) { |
1201
|
0
|
0
|
|
|
|
0
|
vec($rv1, $fnopty, 1) or die "internal error"; |
1202
|
0
|
|
|
|
|
0
|
my $read = sysread($mpty, $self->{_wfm_bout}, 4096, length $self->{_wfm_bout}); |
1203
|
0
|
0
|
|
|
|
0
|
if ($read) { |
1204
|
0
|
|
|
|
|
0
|
$self->{_master_pty_log} .= substr($self->{_wfm_bout}, -$read); |
1205
|
0
|
0
|
|
|
|
0
|
if ((my $remove = length($self->{_master_pty_log}) - 4096) > 0) { |
1206
|
0
|
|
|
|
|
0
|
substr($self->{_master_pty_log}, 0, $remove) = '' |
1207
|
|
|
|
|
|
|
} |
1208
|
|
|
|
|
|
|
|
1209
|
0
|
0
|
|
|
|
0
|
if ($self->{_wfm_bout} =~ /The authenticity of host.*can't be established/si) { |
1210
|
0
|
|
|
|
|
0
|
$error = "the authenticity of the target host can't be established; the remote host " . |
1211
|
|
|
|
|
|
|
"public key is probably not present in the '~/.ssh/known_hosts' file"; |
1212
|
0
|
|
|
|
|
0
|
last; |
1213
|
|
|
|
|
|
|
} |
1214
|
|
|
|
|
|
|
|
1215
|
0
|
0
|
|
|
|
0
|
if ($self->{_wfm_bout} =~ /WARNING: REMOTE HOST IDENTIFICATION HAS CHANGED/si) { |
1216
|
0
|
|
|
|
|
0
|
$error = "the authenticity of the target host can't be established; the remote host " . |
1217
|
|
|
|
|
|
|
"public key doesn't match the one stored locally"; |
1218
|
0
|
|
|
|
|
0
|
last; |
1219
|
|
|
|
|
|
|
} |
1220
|
|
|
|
|
|
|
|
1221
|
0
|
|
|
|
|
0
|
my $passwd_prompt = _first_defined $self->{_passwd_prompt}, qr/[:?]/; |
1222
|
0
|
0
|
|
|
|
0
|
$passwd_prompt = quotemeta $passwd_prompt unless ref $passwd_prompt; |
1223
|
|
|
|
|
|
|
|
1224
|
0
|
0
|
0
|
|
|
0
|
if ($self->{_master_state} == _STATE_LOGIN) { |
|
|
0
|
|
|
|
|
|
1225
|
0
|
0
|
|
|
|
0
|
if ($self->{_wfm_bout} =~ /^(.*$passwd_prompt)/s) { |
1226
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "passwd/passphrase requested ($1)"; |
1227
|
0
|
|
|
|
|
0
|
print $mpty $deobfuscate->($self->{_passwd}) . "\n"; |
1228
|
0
|
|
|
|
|
0
|
$self->{_wfm_bout} = ''; # reset |
1229
|
0
|
|
|
|
|
0
|
$self->{_master_state} = _STATE_AWAITING_MUX; |
1230
|
|
|
|
|
|
|
} |
1231
|
|
|
|
|
|
|
} |
1232
|
|
|
|
|
|
|
elsif (length($passwd_prompt) and $self->{_wfm_bout} =~ /^(.*$passwd_prompt)\s*$/s) { |
1233
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and _debug "passwd/passphrase requested again ($1)"; |
1234
|
0
|
|
|
|
|
0
|
$error = "password authentication failed"; |
1235
|
0
|
|
|
|
|
0
|
last; |
1236
|
|
|
|
|
|
|
} |
1237
|
0
|
|
|
|
|
0
|
next; # skip delay |
1238
|
|
|
|
|
|
|
} |
1239
|
|
|
|
|
|
|
} |
1240
|
|
|
|
|
|
|
} |
1241
|
14
|
50
|
|
|
|
50
|
return if $async; |
1242
|
14
|
|
|
|
|
617094
|
select(undef, undef, undef, $dt); |
1243
|
|
|
|
|
|
|
} |
1244
|
|
|
|
|
|
|
|
1245
|
1
|
50
|
|
|
|
5
|
if (defined $old_tcpgrp) { |
1246
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 4 and |
1247
|
|
|
|
|
|
|
_debug("ssh pid: $pid, pgrp: ", getpgrp($pid), |
1248
|
|
|
|
|
|
|
", \$\$: ", $$, |
1249
|
|
|
|
|
|
|
", tcpgrp: ", POSIX::tcgetpgrp(0), |
1250
|
|
|
|
|
|
|
", old_tcppgrp: ", $old_tcpgrp); |
1251
|
0
|
|
|
|
|
0
|
local $SIG{TTOU} = 'IGNORE'; |
1252
|
0
|
|
|
|
|
0
|
POSIX::tcsetpgrp(0, $old_tcpgrp); |
1253
|
|
|
|
|
|
|
} |
1254
|
|
|
|
|
|
|
|
1255
|
1
|
50
|
|
|
|
13
|
if ($error) { |
1256
|
1
|
|
|
|
|
12
|
return $self->_master_fail($async, $error); |
1257
|
|
|
|
|
|
|
} |
1258
|
|
|
|
|
|
|
|
1259
|
0
|
0
|
|
|
|
0
|
$self->_master_jump_state(_STATE_RUNNING, $async) |
1260
|
|
|
|
|
|
|
and $self->_master_check($async); |
1261
|
|
|
|
|
|
|
} |
1262
|
|
|
|
|
|
|
|
1263
|
|
|
|
|
|
|
sub _master_ctl { |
1264
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1265
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
1266
|
0
|
|
|
|
|
0
|
my $cmd = shift; |
1267
|
|
|
|
|
|
|
|
1268
|
0
|
|
|
|
|
0
|
local $?; |
1269
|
0
|
|
|
|
|
0
|
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, |
|
0
|
|
|
|
|
0
|
|
1270
|
|
|
|
|
|
|
"control command failed"]; |
1271
|
0
|
|
|
|
|
0
|
$self->capture({ %opts, |
1272
|
|
|
|
|
|
|
encoding => 'bytes', # don't let the encoding |
1273
|
|
|
|
|
|
|
# stuff get in the way |
1274
|
|
|
|
|
|
|
stdin_discard => 1, tty => 0, |
1275
|
|
|
|
|
|
|
stderr_to_stdout => 1, ssh_opts => [-O => $cmd]}); |
1276
|
|
|
|
|
|
|
} |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
sub stop { |
1279
|
0
|
|
|
0
|
0
|
0
|
my ($self, $timeout) = @_; |
1280
|
0
|
|
|
|
|
0
|
my $pid = $self->{_pid}; |
1281
|
0
|
|
|
|
|
0
|
local $self->{_kill_ssh_on_timeout} = 1; |
1282
|
0
|
|
|
|
|
0
|
$self->_master_ctl({timeout => $timeout}, 'stop'); |
1283
|
0
|
0
|
|
|
|
0
|
unless ($self->{_error}) { |
1284
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_MASTER_FAILED, "master stopped"); |
1285
|
0
|
|
|
|
|
0
|
$self->_master_jump_state(_STATE_STOPPED, 1); |
1286
|
|
|
|
|
|
|
} |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
sub _make_pipe { |
1290
|
3
|
|
|
3
|
|
6
|
my $self = shift; |
1291
|
3
|
|
|
|
|
6
|
my ($r, $w); |
1292
|
3
|
50
|
|
|
|
126
|
if (pipe $r, $w) { |
1293
|
3
|
|
|
|
|
18
|
my $old = select; |
1294
|
3
|
|
|
|
|
9
|
select $r; $ |= 1; |
|
3
|
|
|
|
|
18
|
|
1295
|
3
|
|
|
|
|
9
|
select $w; $ |= 1; |
|
3
|
|
|
|
|
6
|
|
1296
|
3
|
|
|
|
|
9
|
select $old; |
1297
|
3
|
|
|
|
|
18
|
return ($r, $w); |
1298
|
|
|
|
|
|
|
} |
1299
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_PIPE_FAILED, "unable to create pipe: $!"); |
1300
|
0
|
|
|
|
|
0
|
return; |
1301
|
|
|
|
|
|
|
} |
1302
|
|
|
|
|
|
|
|
1303
|
|
|
|
|
|
|
sub _remote_quoter { |
1304
|
3
|
|
|
3
|
|
9
|
my ($self, $remote_shell) = @_; |
1305
|
3
|
50
|
33
|
|
|
48
|
if (ref $self and (!defined $remote_shell or $remote_shell eq $self->{_remote_shell})) { |
|
|
|
33
|
|
|
|
|
1306
|
3
|
|
33
|
|
|
90
|
return $self->{remote_quoter} ||= Net::OpenSSH::ShellQuoter->quoter($self->{_remote_shell}); |
1307
|
|
|
|
|
|
|
} |
1308
|
0
|
|
|
|
|
0
|
Net::OpenSSH::ShellQuoter->quoter($remote_shell); |
1309
|
|
|
|
|
|
|
} |
1310
|
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
|
sub _quote_args { |
1312
|
3
|
|
|
3
|
|
9
|
my $self = shift; |
1313
|
3
|
|
|
|
|
3
|
my $opts = shift; |
1314
|
3
|
50
|
|
|
|
15
|
ref $opts eq 'HASH' or die "internal error"; |
1315
|
3
|
|
|
|
|
6
|
my $quote = delete $opts->{quote_args}; |
1316
|
3
|
|
|
|
|
6
|
my $quote_extended = delete $opts->{quote_args_extended}; |
1317
|
3
|
|
|
|
|
6
|
my $glob_quoting = delete $opts->{glob_quoting}; |
1318
|
3
|
50
|
|
|
|
12
|
$quote = (@_ > 1) unless defined $quote; |
1319
|
|
|
|
|
|
|
|
1320
|
3
|
50
|
|
|
|
9
|
if ($quote) { |
1321
|
3
|
|
|
|
|
3
|
my $remote_shell = delete $opts->{remote_shell}; |
1322
|
3
|
|
|
|
|
12
|
my $quoter = $self->_remote_quoter($remote_shell); |
1323
|
3
|
50
|
|
|
|
12
|
my $quote_method = ($glob_quoting ? 'quote_glob' : 'quote'); |
1324
|
|
|
|
|
|
|
# foo => $quoter |
1325
|
|
|
|
|
|
|
# \foo => $quoter_glob |
1326
|
|
|
|
|
|
|
# \\foo => no quoting at all and disable extended quoting as it is not safe |
1327
|
3
|
|
|
|
|
3
|
my @quoted; |
1328
|
3
|
|
|
|
|
9
|
for (@_) { |
1329
|
6
|
50
|
|
|
|
18
|
if (ref $_) { |
1330
|
0
|
0
|
0
|
|
|
0
|
if (ref $_ eq 'SCALAR') { |
|
|
0
|
|
|
|
|
|
1331
|
0
|
|
|
|
|
0
|
push @quoted, $quoter->quote_glob($self->_expand_vars($$_)); |
1332
|
|
|
|
|
|
|
} |
1333
|
|
|
|
|
|
|
elsif (ref $_ eq 'REF' and ref $$_ eq 'SCALAR') { |
1334
|
0
|
|
|
|
|
0
|
push @quoted, $self->_expand_vars($$$_); |
1335
|
0
|
|
|
|
|
0
|
undef $quote_extended; |
1336
|
|
|
|
|
|
|
} |
1337
|
|
|
|
|
|
|
else { |
1338
|
0
|
|
|
|
|
0
|
croak "invalid reference in remote command argument list" |
1339
|
|
|
|
|
|
|
} |
1340
|
|
|
|
|
|
|
} |
1341
|
|
|
|
|
|
|
else { |
1342
|
6
|
|
|
|
|
21
|
push @quoted, $quoter->$quote_method($self->_expand_vars($_)); |
1343
|
|
|
|
|
|
|
} |
1344
|
|
|
|
|
|
|
} |
1345
|
|
|
|
|
|
|
|
1346
|
3
|
50
|
|
|
|
9
|
if ($quote_extended) { |
1347
|
0
|
|
|
|
|
0
|
my @fragments; |
1348
|
0
|
0
|
0
|
|
|
0
|
if ( $opts->{stdout_discard} and |
|
|
|
0
|
|
|
|
|
1349
|
|
|
|
|
|
|
( $opts->{stderr_discard} or $opts->{stderr_to_stdout} ) ) { |
1350
|
0
|
|
|
|
|
0
|
@fragments = ('stdout_and_stderr_discard'); |
1351
|
0
|
0
|
|
|
|
0
|
push @fragments, 'stdin_discard' if $opts->{stdin_discard}; |
1352
|
|
|
|
|
|
|
} |
1353
|
|
|
|
|
|
|
else { |
1354
|
0
|
|
|
|
|
0
|
@fragments = grep $opts->{$_}, qw(stdin_discard stdout_discard |
1355
|
|
|
|
|
|
|
stderr_discard stderr_to_stdout); |
1356
|
|
|
|
|
|
|
} |
1357
|
0
|
|
|
|
|
0
|
push @quoted, $quoter->shell_fragments(@fragments); |
1358
|
|
|
|
|
|
|
} |
1359
|
3
|
50
|
|
|
|
15
|
wantarray ? @quoted : join(" ", @quoted); |
1360
|
|
|
|
|
|
|
} |
1361
|
|
|
|
|
|
|
else { |
1362
|
0
|
0
|
|
|
|
0
|
croak "reference found in argument list when argument quoting is disabled" |
1363
|
|
|
|
|
|
|
if (grep ref, @_); |
1364
|
|
|
|
|
|
|
|
1365
|
0
|
|
|
|
|
0
|
my @args = $self->_expand_vars(@_); |
1366
|
0
|
0
|
|
|
|
0
|
wantarray ? @args : join(" ", @args); |
1367
|
|
|
|
|
|
|
} |
1368
|
|
|
|
|
|
|
} |
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
sub shell_quote { |
1371
|
0
|
|
|
0
|
1
|
0
|
shift->_quote_args({quote_args => 1}, @_); |
1372
|
|
|
|
|
|
|
} |
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
sub shell_quote_glob { |
1375
|
0
|
|
|
0
|
1
|
0
|
shift->_quote_args({quote_args => 1, glob_quoting => 1}, @_); |
1376
|
|
|
|
|
|
|
} |
1377
|
|
|
|
|
|
|
|
1378
|
5
|
0
|
|
5
|
|
46
|
sub _array_or_scalar_to_list { map { defined($_) ? (ref $_ eq 'ARRAY' ? @$_ : $_ ) : () } @_ } |
|
5
|
50
|
|
|
|
38
|
|
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
sub make_remote_command { |
1381
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
1382
|
0
|
0
|
|
|
|
0
|
$self->wait_for_master or return; |
1383
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
1384
|
0
|
|
|
|
|
0
|
my @ssh_opts = _array_or_scalar_to_list delete $opts{ssh_opts}; |
1385
|
0
|
|
|
|
|
0
|
my $tty = delete $opts{tty}; |
1386
|
0
|
|
|
|
|
0
|
my $ssh_flags = ''; |
1387
|
0
|
0
|
|
|
|
0
|
$ssh_flags .= ($tty ? 'qtt' : 'T') if defined $tty; |
|
|
0
|
|
|
|
|
|
1388
|
0
|
0
|
|
|
|
0
|
if ($self->{_forward_agent}) { |
1389
|
0
|
0
|
|
|
|
0
|
my $forward_always = (($self->{_forward_agent} eq 'always') ? 1 : undef); |
1390
|
0
|
|
|
|
|
0
|
my $forward_agent = _first_defined(delete($opts{forward_agent}), $forward_always); |
1391
|
0
|
0
|
|
|
|
0
|
$ssh_flags .= ($forward_agent ? 'A' : 'a') if defined $forward_agent; |
|
|
0
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
} |
1393
|
0
|
0
|
|
|
|
0
|
if ($self->{_forward_X11}) { |
1394
|
0
|
|
|
|
|
0
|
my $forward_X11 = delete $opts{forward_X11}; |
1395
|
0
|
0
|
|
|
|
0
|
$ssh_flags .= ($forward_X11 ? 'X' : 'x'); |
1396
|
|
|
|
|
|
|
} |
1397
|
0
|
|
|
|
|
0
|
my $tunnel = delete $opts{tunnel}; |
1398
|
0
|
|
|
|
|
0
|
my (@args); |
1399
|
0
|
0
|
|
|
|
0
|
if ($tunnel) { |
1400
|
0
|
|
|
|
|
0
|
push @ssh_opts, $self->_make_W_option(@_); |
1401
|
|
|
|
|
|
|
} |
1402
|
|
|
|
|
|
|
else { |
1403
|
0
|
|
|
|
|
0
|
my $subsystem = delete $opts{subsystem}; |
1404
|
0
|
0
|
|
|
|
0
|
if ($subsystem) { |
1405
|
0
|
|
|
|
|
0
|
push @ssh_opts, '-s'; |
1406
|
0
|
0
|
|
|
|
0
|
@_ == 1 or croak "wrong number of arguments for subsystem command"; |
1407
|
|
|
|
|
|
|
} |
1408
|
0
|
|
|
|
|
0
|
@args = $self->_quote_args(\%opts, @_); |
1409
|
|
|
|
|
|
|
} |
1410
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
1411
|
|
|
|
|
|
|
|
1412
|
0
|
0
|
|
|
|
0
|
push @ssh_opts, "-$ssh_flags" if length $ssh_flags; |
1413
|
0
|
|
|
|
|
0
|
my @call = $self->_make_ssh_call(\@ssh_opts, @args); |
1414
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
1415
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 16 and _debug_dump make_remote_command => \@call; |
1416
|
0
|
|
|
|
|
0
|
return @call; |
1417
|
|
|
|
|
|
|
} |
1418
|
|
|
|
|
|
|
else { |
1419
|
0
|
|
|
|
|
0
|
my $call = join ' ', $self->shell_quote(@call); |
1420
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 16 and _debug_dump 'make_remote_command (quoted)' => $call; |
1421
|
0
|
|
|
|
|
0
|
return $call |
1422
|
|
|
|
|
|
|
} |
1423
|
|
|
|
|
|
|
} |
1424
|
|
|
|
|
|
|
|
1425
|
|
|
|
|
|
|
sub _open_file { |
1426
|
0
|
|
|
0
|
|
0
|
my ($self, $default_mode, $name_or_args) = @_; |
1427
|
0
|
0
|
|
|
|
0
|
my ($mode, @args) = (ref $name_or_args |
1428
|
|
|
|
|
|
|
? @$name_or_args |
1429
|
|
|
|
|
|
|
: ($default_mode, $name_or_args)); |
1430
|
0
|
|
|
|
|
0
|
@args = $self->_expand_vars(@args); |
1431
|
0
|
0
|
|
|
|
0
|
if (open my $fh, $mode, @args) { |
1432
|
0
|
|
|
|
|
0
|
return $fh; |
1433
|
|
|
|
|
|
|
} |
1434
|
|
|
|
|
|
|
else { |
1435
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_PIPE_FAILED, |
1436
|
|
|
|
|
|
|
"Unable to open file '$args[0]': $!"); |
1437
|
0
|
|
|
|
|
0
|
return undef; |
1438
|
|
|
|
|
|
|
} |
1439
|
|
|
|
|
|
|
} |
1440
|
|
|
|
|
|
|
|
1441
|
|
|
|
|
|
|
sub _fileno_dup_over { |
1442
|
3
|
|
|
3
|
|
11
|
my ($good_fn, $fh) = @_; |
1443
|
3
|
100
|
|
|
|
7
|
if (defined $fh) { |
1444
|
2
|
|
|
|
|
5
|
my $fn = fileno $fh; |
1445
|
2
|
|
|
|
|
19
|
for (1..5) { |
1446
|
2
|
50
|
|
|
|
18
|
$fn >= $good_fn and return $fn; |
1447
|
0
|
|
|
|
|
0
|
$fn = POSIX::dup($fn); |
1448
|
|
|
|
|
|
|
} |
1449
|
0
|
|
|
|
|
0
|
POSIX::_exit(255); |
1450
|
|
|
|
|
|
|
} |
1451
|
1
|
|
|
|
|
12
|
undef; |
1452
|
|
|
|
|
|
|
} |
1453
|
|
|
|
|
|
|
|
1454
|
|
|
|
|
|
|
sub _exec_dpipe { |
1455
|
0
|
|
|
0
|
|
0
|
my ($self, $cmd, $io, $err) = @_; |
1456
|
0
|
|
|
|
|
0
|
my $io_fd = _fileno_dup_over(3 => $io); |
1457
|
0
|
|
|
|
|
0
|
my $err_fd = _fileno_dup_over(3 => $err); |
1458
|
0
|
|
|
|
|
0
|
POSIX::dup2($io_fd, 0); |
1459
|
0
|
|
|
|
|
0
|
POSIX::dup2($io_fd, 1); |
1460
|
0
|
0
|
|
|
|
0
|
POSIX::dup2($err_fd, 2) if defined $err_fd; |
1461
|
0
|
0
|
|
|
|
0
|
if (ref $cmd) { |
1462
|
0
|
|
|
|
|
0
|
exec @$cmd; |
1463
|
|
|
|
|
|
|
} |
1464
|
|
|
|
|
|
|
else { |
1465
|
0
|
|
|
|
|
0
|
exec $cmd; |
1466
|
|
|
|
|
|
|
} |
1467
|
|
|
|
|
|
|
} |
1468
|
|
|
|
|
|
|
|
1469
|
|
|
|
|
|
|
sub _delete_stream_encoding { |
1470
|
0
|
|
|
0
|
|
0
|
my ($self, $opts) = @_; |
1471
|
|
|
|
|
|
|
_first_defined(delete $opts->{stream_encoding}, |
1472
|
|
|
|
|
|
|
$opts->{encoding}, |
1473
|
0
|
|
|
|
|
0
|
$self->{_default_stream_encoding}); |
1474
|
|
|
|
|
|
|
} |
1475
|
|
|
|
|
|
|
|
1476
|
|
|
|
|
|
|
sub _delete_argument_encoding { |
1477
|
3
|
|
|
3
|
|
6
|
my ($self, $opts) = @_; |
1478
|
|
|
|
|
|
|
_first_defined(delete $opts->{argument_encoding}, |
1479
|
|
|
|
|
|
|
delete $opts->{encoding}, |
1480
|
3
|
|
|
|
|
12
|
$self->{_default_argument_encoding}); |
1481
|
|
|
|
|
|
|
} |
1482
|
|
|
|
|
|
|
|
1483
|
|
|
|
|
|
|
sub open_ex { |
1484
|
3
|
50
|
|
3
|
1
|
15
|
${^TAINT} and &_catch_tainted_args; |
1485
|
3
|
|
|
|
|
9
|
my $self = shift; |
1486
|
3
|
50
|
|
|
|
18
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
3
|
|
|
|
|
18
|
|
1487
|
3
|
50
|
|
|
|
12
|
unless (delete $opts{_no_master_required}) { |
1488
|
0
|
0
|
|
|
|
0
|
$self->wait_for_master or return; |
1489
|
|
|
|
|
|
|
} |
1490
|
|
|
|
|
|
|
|
1491
|
3
|
|
|
|
|
12
|
my $ssh_flags = ''; |
1492
|
3
|
|
|
|
|
9
|
my $tunnel = delete $opts{tunnel}; |
1493
|
3
|
|
|
|
|
6
|
my ($cmd, $close_slave_pty, @args); |
1494
|
3
|
50
|
|
|
|
9
|
if ($tunnel) { |
1495
|
0
|
|
|
|
|
0
|
@args = @_; |
1496
|
|
|
|
|
|
|
} |
1497
|
|
|
|
|
|
|
else { |
1498
|
3
|
|
|
|
|
15
|
my $argument_encoding = $self->_delete_argument_encoding(\%opts); |
1499
|
3
|
|
|
|
|
30
|
my $tty = delete $opts{tty}; |
1500
|
3
|
0
|
|
|
|
12
|
$ssh_flags .= ($tty ? 'qtt' : 'T') if defined $tty; |
|
|
50
|
|
|
|
|
|
1501
|
|
|
|
|
|
|
|
1502
|
3
|
|
50
|
|
|
12
|
$cmd = delete $opts{_cmd} || 'ssh'; |
1503
|
|
|
|
|
|
|
$opts{quote_args_extended} = 1 |
1504
|
3
|
50
|
33
|
|
|
27
|
if (not defined $opts{quote_args_extended} and $cmd eq 'ssh'); |
1505
|
3
|
|
|
|
|
36
|
@args = $self->_quote_args(\%opts, @_); |
1506
|
3
|
50
|
|
|
|
33
|
$self->_encode_args($argument_encoding, @args) or return; |
1507
|
|
|
|
|
|
|
} |
1508
|
|
|
|
|
|
|
|
1509
|
3
|
|
|
|
|
6
|
my ($stdinout_socket, $stdinout_dpipe_make_parent); |
1510
|
3
|
|
|
|
|
6
|
my $stdinout_dpipe = delete $opts{stdinout_dpipe}; |
1511
|
3
|
50
|
|
|
|
6
|
if ($stdinout_dpipe) { |
1512
|
0
|
|
|
|
|
0
|
$stdinout_dpipe_make_parent = delete $opts{stdinout_dpipe_make_parent}; |
1513
|
0
|
|
|
|
|
0
|
$stdinout_socket = 1; |
1514
|
|
|
|
|
|
|
} |
1515
|
|
|
|
|
|
|
else { |
1516
|
3
|
|
|
|
|
6
|
$stdinout_socket = delete $opts{stdinout_socket}; |
1517
|
|
|
|
|
|
|
} |
1518
|
|
|
|
|
|
|
|
1519
|
3
|
|
|
|
|
6
|
my ($stdin_discard, $stdin_pipe, $stdin_fh, $stdin_file, $stdin_pty, |
1520
|
|
|
|
|
|
|
$stdout_discard, $stdout_pipe, $stdout_fh, $stdout_file, $stdout_pty, |
1521
|
|
|
|
|
|
|
$stderr_discard, $stderr_pipe, $stderr_fh, $stderr_file, $stderr_to_stdout); |
1522
|
3
|
50
|
|
|
|
9
|
unless ($stdinout_socket) { |
1523
|
3
|
0
|
33
|
|
|
12
|
unless ($stdin_discard = delete $opts{stdin_discard} or |
|
|
|
33
|
|
|
|
|
|
|
|
0
|
|
|
|
|
1524
|
|
|
|
|
|
|
$stdin_pipe = delete $opts{stdin_pipe} or |
1525
|
|
|
|
|
|
|
$stdin_fh = delete $opts{stdin_fh} or |
1526
|
|
|
|
|
|
|
$stdin_file = delete $opts{stdin_file}) { |
1527
|
0
|
0
|
|
|
|
0
|
unless ($tunnel) { |
1528
|
0
|
0
|
|
|
|
0
|
if ($stdin_pty = delete $opts{stdin_pty}) { |
1529
|
0
|
|
|
|
|
0
|
$close_slave_pty = _first_defined delete $opts{close_slave_pty}, 1; |
1530
|
|
|
|
|
|
|
} |
1531
|
|
|
|
|
|
|
} |
1532
|
|
|
|
|
|
|
} |
1533
|
|
|
|
|
|
|
|
1534
|
|
|
|
|
|
|
( $stdout_discard = delete $opts{stdout_discard} or |
1535
|
|
|
|
|
|
|
$stdout_pipe = delete $opts{stdout_pipe} or |
1536
|
|
|
|
|
|
|
$stdout_fh = delete $opts{stdout_fh} or |
1537
|
|
|
|
|
|
|
$stdout_file = delete $opts{stdout_file} or |
1538
|
3
|
0
|
0
|
|
|
33
|
(not $tunnel and $stdout_pty = delete $opts{stdout_pty}) ); |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1539
|
|
|
|
|
|
|
|
1540
|
3
|
50
|
33
|
|
|
12
|
$stdout_pty and !$stdin_pty |
1541
|
|
|
|
|
|
|
and croak "option stdout_pty requires stdin_pty set"; |
1542
|
|
|
|
|
|
|
} |
1543
|
|
|
|
|
|
|
|
1544
|
|
|
|
|
|
|
( $stderr_discard = delete $opts{stderr_discard} or |
1545
|
|
|
|
|
|
|
$stderr_pipe = delete $opts{stderr_pipe} or |
1546
|
|
|
|
|
|
|
$stderr_fh = delete $opts{stderr_fh} or |
1547
|
|
|
|
|
|
|
$stderr_to_stdout = delete $opts{stderr_to_stdout} or |
1548
|
3
|
50
|
33
|
|
|
48
|
$stderr_file = delete $opts{stderr_file} ); |
|
|
|
33
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1549
|
|
|
|
|
|
|
|
1550
|
3
|
|
|
|
|
9
|
my $ssh_opts = delete $opts{ssh_opts}; |
1551
|
3
|
50
|
|
|
|
9
|
$ssh_opts = $self->{_default_ssh_opts} unless defined $ssh_opts; |
1552
|
3
|
|
|
|
|
12
|
my @ssh_opts = $self->_expand_vars(_array_or_scalar_to_list $ssh_opts); |
1553
|
3
|
50
|
|
|
|
9
|
if ($self->{_forward_agent}) { |
1554
|
0
|
0
|
|
|
|
0
|
my $forward_always = (($self->{_forward_agent} eq 'always') ? 1 : undef); |
1555
|
0
|
|
|
|
|
0
|
my $forward_agent = _first_defined(delete($opts{forward_agent}), $forward_always); |
1556
|
0
|
0
|
|
|
|
0
|
$ssh_flags .= ($forward_agent ? 'A' : 'a') if defined $forward_agent; |
|
|
0
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
} |
1558
|
3
|
50
|
|
|
|
9
|
if ($self->{_forward_X11}) { |
1559
|
0
|
|
|
|
|
0
|
my $forward_X11 = delete $opts{forward_X11}; |
1560
|
0
|
0
|
|
|
|
0
|
$ssh_flags .= ($forward_X11 ? 'X' : 'x'); |
1561
|
|
|
|
|
|
|
} |
1562
|
3
|
50
|
|
|
|
6
|
if (delete $opts{subsystem}) { |
1563
|
0
|
|
|
|
|
0
|
$ssh_flags .= 's'; |
1564
|
|
|
|
|
|
|
} |
1565
|
|
|
|
|
|
|
|
1566
|
3
|
|
|
|
|
6
|
my $setpgrp = delete $opts{setpgrp}; |
1567
|
3
|
50
|
|
|
|
9
|
undef $setpgrp if defined $stdin_pty; |
1568
|
|
|
|
|
|
|
|
1569
|
3
|
|
|
|
|
30
|
_croak_bad_options %opts; |
1570
|
|
|
|
|
|
|
|
1571
|
3
|
50
|
|
|
|
6
|
if (defined $stdin_file) { |
1572
|
0
|
0
|
|
|
|
0
|
$stdin_fh = $self->_open_file('<', $stdin_file) or return |
1573
|
|
|
|
|
|
|
} |
1574
|
3
|
50
|
|
|
|
9
|
if (defined $stdout_file) { |
1575
|
0
|
0
|
|
|
|
0
|
$stdout_fh = $self->_open_file('>', $stdout_file) or return |
1576
|
|
|
|
|
|
|
} |
1577
|
3
|
50
|
|
|
|
9
|
if (defined $stderr_file) { |
1578
|
0
|
0
|
|
|
|
0
|
$stderr_fh = $self->_open_file('>', $stderr_file) or return |
1579
|
|
|
|
|
|
|
} |
1580
|
|
|
|
|
|
|
|
1581
|
3
|
|
|
|
|
6
|
my ($rin, $win, $rout, $wout, $rerr, $werr); |
1582
|
|
|
|
|
|
|
|
1583
|
3
|
50
|
|
|
|
9
|
if ($stdinout_socket) { |
1584
|
0
|
0
|
|
|
|
0
|
unless(socketpair $rin, $win, AF_UNIX, SOCK_STREAM, PF_UNSPEC) { |
1585
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_PIPE_FAILED, "socketpair failed: $!"); |
1586
|
0
|
|
|
|
|
0
|
return; |
1587
|
|
|
|
|
|
|
} |
1588
|
0
|
|
|
|
|
0
|
$wout = $rin; |
1589
|
|
|
|
|
|
|
} |
1590
|
|
|
|
|
|
|
else { |
1591
|
3
|
50
|
|
|
|
12
|
if ($stdin_pipe) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1592
|
0
|
0
|
|
|
|
0
|
($rin, $win) = $self->_make_pipe or return; |
1593
|
|
|
|
|
|
|
} |
1594
|
|
|
|
|
|
|
elsif ($stdin_pty) { |
1595
|
0
|
|
|
|
|
0
|
_load_module('IO::Pty'); |
1596
|
0
|
|
|
|
|
0
|
$win = IO::Pty->new; |
1597
|
0
|
0
|
|
|
|
0
|
unless ($win) { |
1598
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_PIPE_FAILED, "unable to allocate pseudo-tty: $!"); |
1599
|
0
|
|
|
|
|
0
|
return; |
1600
|
|
|
|
|
|
|
} |
1601
|
0
|
|
|
|
|
0
|
$rin = $win->slave; |
1602
|
|
|
|
|
|
|
} |
1603
|
|
|
|
|
|
|
elsif (defined $stdin_fh) { |
1604
|
0
|
|
|
|
|
0
|
$rin = $stdin_fh; |
1605
|
|
|
|
|
|
|
} |
1606
|
|
|
|
|
|
|
else { |
1607
|
|
|
|
|
|
|
$rin = $self->{_default_stdin_fh} |
1608
|
3
|
|
|
|
|
6
|
} |
1609
|
3
|
|
|
|
|
87
|
_check_is_system_fh STDIN => $rin; |
1610
|
|
|
|
|
|
|
|
1611
|
3
|
50
|
|
|
|
9
|
if ($stdout_pipe) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1612
|
3
|
50
|
|
|
|
12
|
($rout, $wout) = $self->_make_pipe or return; |
1613
|
|
|
|
|
|
|
} |
1614
|
|
|
|
|
|
|
elsif ($stdout_pty) { |
1615
|
0
|
|
|
|
|
0
|
$wout = $rin; |
1616
|
|
|
|
|
|
|
} |
1617
|
|
|
|
|
|
|
elsif (defined $stdout_fh) { |
1618
|
0
|
|
|
|
|
0
|
$wout = $stdout_fh; |
1619
|
|
|
|
|
|
|
} |
1620
|
|
|
|
|
|
|
else { |
1621
|
0
|
|
|
|
|
0
|
$wout = $self->{_default_stdout_fh}; |
1622
|
|
|
|
|
|
|
} |
1623
|
3
|
|
|
|
|
6
|
_check_is_system_fh STDOUT => $wout; |
1624
|
|
|
|
|
|
|
} |
1625
|
|
|
|
|
|
|
|
1626
|
3
|
50
|
|
|
|
9
|
unless ($stderr_to_stdout) { |
1627
|
0
|
0
|
|
|
|
0
|
if ($stderr_pipe) { |
|
|
0
|
|
|
|
|
|
1628
|
0
|
0
|
|
|
|
0
|
($rerr, $werr) = $self->_make_pipe or return; |
1629
|
|
|
|
|
|
|
} |
1630
|
|
|
|
|
|
|
elsif (defined $stderr_fh) { |
1631
|
0
|
|
|
|
|
0
|
$werr = $stderr_fh; |
1632
|
|
|
|
|
|
|
} |
1633
|
|
|
|
|
|
|
else { |
1634
|
0
|
|
|
|
|
0
|
$werr = $self->{_default_stderr_fh}; |
1635
|
|
|
|
|
|
|
} |
1636
|
0
|
|
|
|
|
0
|
_check_is_system_fh STDERR => $werr; |
1637
|
|
|
|
|
|
|
} |
1638
|
|
|
|
|
|
|
|
1639
|
3
|
50
|
|
|
|
12
|
push @ssh_opts, "-$ssh_flags" if length $ssh_flags; |
1640
|
|
|
|
|
|
|
|
1641
|
3
|
50
|
|
|
|
63
|
my @call = ( $tunnel ? $self->_make_tunnel_call(\@ssh_opts, @args) : |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1642
|
|
|
|
|
|
|
$cmd eq 'ssh' ? $self->_make_ssh_call(\@ssh_opts, @args) : |
1643
|
|
|
|
|
|
|
$cmd eq 'scp' ? $self->_make_scp_call(\@ssh_opts, @args) : |
1644
|
|
|
|
|
|
|
$cmd eq 'rsync' ? $self->_make_rsync_call(\@ssh_opts, @args) : |
1645
|
|
|
|
|
|
|
$cmd eq 'raw' ? @args : |
1646
|
|
|
|
|
|
|
die "Internal error: bad _cmd protocol" ); |
1647
|
|
|
|
|
|
|
|
1648
|
3
|
50
|
33
|
|
|
12
|
$debug and $debug & 16 and _debug_dump open_ex => \@call; |
1649
|
|
|
|
|
|
|
|
1650
|
3
|
|
|
|
|
2896
|
my $pid = fork; |
1651
|
3
|
100
|
|
|
|
177
|
unless ($pid) { |
1652
|
1
|
50
|
|
|
|
22
|
unless (defined $pid) { |
1653
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_FAILED, |
1654
|
|
|
|
|
|
|
"unable to fork new ssh slave: $!"); |
1655
|
0
|
|
|
|
|
0
|
return; |
1656
|
|
|
|
|
|
|
} |
1657
|
|
|
|
|
|
|
|
1658
|
1
|
50
|
|
|
|
14
|
setpgrp if $setpgrp; |
1659
|
|
|
|
|
|
|
|
1660
|
1
|
50
|
33
|
|
|
212
|
$stdin_discard and (open $rin, '<', '/dev/null' or POSIX::_exit(255)); |
1661
|
1
|
50
|
0
|
|
|
8
|
$stdout_discard and (open $wout, '>', '/dev/null' or POSIX::_exit(255)); |
1662
|
1
|
50
|
0
|
|
|
18
|
$stderr_discard and (open $werr, '>', '/dev/null' or POSIX::_exit(255)); |
1663
|
|
|
|
|
|
|
|
1664
|
1
|
50
|
|
|
|
8
|
if ($stdinout_dpipe) { |
1665
|
0
|
|
|
|
|
0
|
my $pid1 = fork; |
1666
|
0
|
0
|
|
|
|
0
|
defined $pid1 or POSIX::_exit(255); |
1667
|
|
|
|
|
|
|
|
1668
|
0
|
0
|
0
|
|
|
0
|
unless ($pid1 xor $stdinout_dpipe_make_parent) { |
1669
|
0
|
|
|
|
|
0
|
eval { $self->_exec_dpipe($stdinout_dpipe, $win, $werr) }; |
|
0
|
|
|
|
|
0
|
|
1670
|
0
|
|
|
|
|
0
|
POSIX::_exit(255); |
1671
|
|
|
|
|
|
|
} |
1672
|
|
|
|
|
|
|
} |
1673
|
|
|
|
|
|
|
|
1674
|
1
|
|
|
|
|
18
|
my $rin_fd = _fileno_dup_over(0 => $rin); |
1675
|
1
|
|
|
|
|
8
|
my $wout_fd = _fileno_dup_over(1 => $wout); |
1676
|
1
|
|
|
|
|
14
|
my $werr_fd = _fileno_dup_over(2 => $werr); |
1677
|
|
|
|
|
|
|
|
1678
|
1
|
50
|
|
|
|
9
|
if (defined $rin_fd) { |
1679
|
1
|
50
|
|
|
|
4
|
$win->make_slave_controlling_terminal if $stdin_pty; |
1680
|
1
|
50
|
33
|
|
|
50
|
$rin_fd == 0 or POSIX::dup2($rin_fd, 0) or POSIX::_exit(255); |
1681
|
|
|
|
|
|
|
} |
1682
|
1
|
50
|
|
|
|
11
|
if (defined $wout_fd) { |
1683
|
1
|
50
|
33
|
|
|
13
|
$wout_fd == 1 or POSIX::dup2($wout_fd, 1) or POSIX::_exit(255); |
1684
|
|
|
|
|
|
|
} |
1685
|
1
|
50
|
|
|
|
16
|
if (defined $werr_fd) { |
|
|
50
|
|
|
|
|
|
1686
|
0
|
0
|
0
|
|
|
0
|
$werr_fd == 2 or POSIX::dup2($werr_fd, 2) or POSIX::_exit(255); |
1687
|
|
|
|
|
|
|
} |
1688
|
|
|
|
|
|
|
elsif ($stderr_to_stdout) { |
1689
|
1
|
50
|
|
|
|
7
|
POSIX::dup2(1, 2) or POSIX::_exit(255); |
1690
|
|
|
|
|
|
|
} |
1691
|
1
|
|
|
|
|
247
|
do { exec @call }; |
|
1
|
|
|
|
|
0
|
|
1692
|
0
|
|
|
|
|
0
|
POSIX::_exit(255); |
1693
|
|
|
|
|
|
|
} |
1694
|
2
|
50
|
|
|
|
50
|
$win->close_slave() if $close_slave_pty; |
1695
|
2
|
50
|
|
|
|
32
|
undef $win if defined $stdinout_dpipe; |
1696
|
2
|
50
|
|
|
|
284
|
wantarray ? ($win, $rout, $rerr, $pid) : $pid; |
1697
|
|
|
|
|
|
|
} |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
sub pipe_in { |
1700
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
1701
|
0
|
|
|
|
|
0
|
my $self = shift; |
1702
|
0
|
0
|
|
|
|
0
|
$self->wait_for_master or return; |
1703
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
1704
|
0
|
|
|
|
|
0
|
my $argument_encoding = $self->_delete_argument_encoding(\%opts); |
1705
|
0
|
|
|
|
|
0
|
my @args = $self->_quote_args(\%opts, @_); |
1706
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
1707
|
|
|
|
|
|
|
|
1708
|
0
|
0
|
|
|
|
0
|
$self->_encode_args($argument_encoding, @args) or return; |
1709
|
0
|
|
|
|
|
0
|
my @call = $self->_make_ssh_call([], @args); |
1710
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 16 and _debug_dump pipe_in => @call; |
1711
|
0
|
|
|
|
|
0
|
my $pid = open my $rin, '|-', @call; |
1712
|
0
|
0
|
|
|
|
0
|
unless ($pid) { |
1713
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_FAILED, |
1714
|
|
|
|
|
|
|
"unable to fork new ssh slave: $!"); |
1715
|
0
|
|
|
|
|
0
|
return; |
1716
|
|
|
|
|
|
|
} |
1717
|
0
|
0
|
|
|
|
0
|
wantarray ? ($rin, $pid) : $rin; |
1718
|
|
|
|
|
|
|
} |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
sub pipe_out { |
1721
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
1722
|
0
|
|
|
|
|
0
|
my $self = shift; |
1723
|
0
|
0
|
|
|
|
0
|
$self->wait_for_master or return; |
1724
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
1725
|
0
|
|
|
|
|
0
|
my $argument_encoding = $self->_delete_argument_encoding(\%opts); |
1726
|
0
|
|
|
|
|
0
|
my @args = $self->_quote_args(\%opts, @_); |
1727
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
1728
|
|
|
|
|
|
|
|
1729
|
0
|
0
|
|
|
|
0
|
$self->_encode_args($argument_encoding, @args) or return; |
1730
|
0
|
|
|
|
|
0
|
my @call = $self->_make_ssh_call([], @args); |
1731
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 16 and _debug_dump pipe_out => @call; |
1732
|
0
|
|
|
|
|
0
|
my $pid = open my $rout, '-|', @call; |
1733
|
0
|
0
|
|
|
|
0
|
unless ($pid) { |
1734
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_FAILED, |
1735
|
|
|
|
|
|
|
"unable to fork new ssh slave: $!"); |
1736
|
0
|
|
|
|
|
0
|
return; |
1737
|
|
|
|
|
|
|
} |
1738
|
0
|
0
|
|
|
|
0
|
wantarray ? ($rout, $pid) : $rout; |
1739
|
|
|
|
|
|
|
} |
1740
|
|
|
|
|
|
|
|
1741
|
|
|
|
|
|
|
sub _find_encoding { |
1742
|
5
|
|
|
5
|
|
20
|
my ($self, $encoding, $data) = @_; |
1743
|
5
|
50
|
66
|
|
|
44
|
if (defined $encoding and $encoding ne 'bytes') { |
1744
|
0
|
|
|
|
|
0
|
_load_module('Encode'); |
1745
|
0
|
|
|
|
|
0
|
my $enc = Encode::find_encoding($encoding); |
1746
|
0
|
0
|
|
|
|
0
|
unless (defined $enc) { |
1747
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_ENCODING_ERROR, "bad encoding '$encoding'"); |
1748
|
|
|
|
|
|
|
return |
1749
|
0
|
|
|
|
|
0
|
} |
1750
|
0
|
|
|
|
|
0
|
return $enc |
1751
|
|
|
|
|
|
|
} |
1752
|
|
|
|
|
|
|
return undef |
1753
|
5
|
|
|
|
|
12
|
} |
1754
|
|
|
|
|
|
|
|
1755
|
|
|
|
|
|
|
sub _encode { |
1756
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1757
|
0
|
|
|
|
|
0
|
my $enc = shift; |
1758
|
0
|
0
|
0
|
|
|
0
|
if (defined $enc and @_) { |
1759
|
0
|
|
|
|
|
0
|
local ($@, $SIG{__DIE__}); |
1760
|
0
|
|
|
|
|
0
|
eval { |
1761
|
0
|
|
|
|
|
0
|
for (@_) { |
1762
|
0
|
0
|
|
|
|
0
|
defined or next; |
1763
|
0
|
|
|
|
|
0
|
$_ = $enc->encode($_, Encode::FB_CROAK()); |
1764
|
|
|
|
|
|
|
} |
1765
|
|
|
|
|
|
|
}; |
1766
|
0
|
0
|
|
|
|
0
|
$self->_check_eval_ok(OSSH_ENCODING_ERROR) or return undef; |
1767
|
|
|
|
|
|
|
} |
1768
|
0
|
|
|
|
|
0
|
1; |
1769
|
|
|
|
|
|
|
} |
1770
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
sub _encode_args { |
1772
|
3
|
50
|
|
3
|
|
15
|
if (@_ > 2) { |
1773
|
3
|
|
|
|
|
6
|
my $self = shift; |
1774
|
3
|
|
|
|
|
3
|
my $encoding = shift; |
1775
|
|
|
|
|
|
|
|
1776
|
3
|
|
|
|
|
21
|
my $enc = $self->_find_encoding($encoding); |
1777
|
3
|
50
|
|
|
|
9
|
if ($enc) { |
1778
|
0
|
|
|
|
|
0
|
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, "argument encoding failed"]; |
|
0
|
|
|
|
|
0
|
|
1779
|
0
|
|
|
|
|
0
|
$self->_encode($enc, @_); |
1780
|
|
|
|
|
|
|
} |
1781
|
3
|
|
|
|
|
15
|
return !$self->{_error}; |
1782
|
|
|
|
|
|
|
} |
1783
|
0
|
|
|
|
|
0
|
1; |
1784
|
|
|
|
|
|
|
} |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
sub _decode { |
1787
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
1788
|
0
|
|
|
|
|
0
|
my $enc = shift; |
1789
|
0
|
|
|
|
|
0
|
local ($@, $SIG{__DIE__}); |
1790
|
0
|
|
|
|
|
0
|
eval { |
1791
|
0
|
|
|
|
|
0
|
for (@_) { |
1792
|
0
|
0
|
|
|
|
0
|
defined or next; |
1793
|
0
|
|
|
|
|
0
|
$_ = $enc->decode($_, Encode::FB_CROAK()); |
1794
|
|
|
|
|
|
|
} |
1795
|
|
|
|
|
|
|
}; |
1796
|
0
|
|
|
|
|
0
|
$self->_check_eval_ok(OSSH_ENCODING_ERROR); |
1797
|
|
|
|
|
|
|
} |
1798
|
|
|
|
|
|
|
|
1799
|
|
|
|
|
|
|
my @retriable = (Errno::EINTR(), Errno::EAGAIN()); |
1800
|
|
|
|
|
|
|
push @retriable, Errno::EWOULDBLOCK() if Errno::EWOULDBLOCK() != Errno::EAGAIN(); |
1801
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
sub _io3 { |
1803
|
2
|
|
|
2
|
|
12
|
my ($self, $out, $err, $in, $stdin_data, $timeout, $encoding, $keep_in_open) = @_; |
1804
|
|
|
|
|
|
|
# $self->wait_for_master or return; |
1805
|
2
|
|
|
|
|
56
|
my @data = _array_or_scalar_to_list $stdin_data; |
1806
|
2
|
|
|
|
|
30
|
my ($cout, $cerr, $cin) = (defined($out), defined($err), defined($in)); |
1807
|
2
|
50
|
|
|
|
66
|
$timeout = $self->{_timeout} unless defined $timeout; |
1808
|
|
|
|
|
|
|
|
1809
|
2
|
0
|
|
|
|
8
|
my $has_input = grep { defined and length } @data; |
|
0
|
|
|
|
|
0
|
|
1810
|
2
|
50
|
33
|
|
|
60
|
if ($cin and !$has_input) { |
|
|
50
|
33
|
|
|
|
|
1811
|
0
|
0
|
|
|
|
0
|
close $in unless $keep_in_open; |
1812
|
0
|
|
|
|
|
0
|
undef $cin; |
1813
|
|
|
|
|
|
|
} |
1814
|
|
|
|
|
|
|
elsif (!$cin and $has_input) { |
1815
|
0
|
|
|
|
|
0
|
croak "remote input channel is not defined but data is available for sending" |
1816
|
|
|
|
|
|
|
} |
1817
|
|
|
|
|
|
|
|
1818
|
2
|
|
|
|
|
140
|
my $enc = $self->_find_encoding($encoding); |
1819
|
2
|
50
|
33
|
|
|
18
|
if ($enc and @data) { |
1820
|
0
|
|
|
|
|
0
|
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, "stdin data encoding failed"]; |
|
0
|
|
|
|
|
0
|
|
1821
|
0
|
0
|
|
|
|
0
|
$self->_encode($enc, @data) if $has_input; |
1822
|
0
|
0
|
|
|
|
0
|
return if $self->{_error}; |
1823
|
|
|
|
|
|
|
} |
1824
|
|
|
|
|
|
|
|
1825
|
2
|
|
|
|
|
18
|
my $bout = ''; |
1826
|
2
|
|
|
|
|
6
|
my $berr = ''; |
1827
|
2
|
|
|
|
|
4
|
my ($fnoout, $fnoerr, $fnoin); |
1828
|
2
|
|
|
|
|
106
|
local $SIG{PIPE} = 'IGNORE'; |
1829
|
|
|
|
|
|
|
|
1830
|
2
|
|
66
|
|
|
10
|
MLOOP: while ($cout or $cerr or $cin) { |
|
|
|
66
|
|
|
|
|
1831
|
2
|
50
|
0
|
|
|
18
|
$debug and $debug & 64 and _debug "io3 mloop, cin: " . ($cin || 0) . |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1832
|
|
|
|
|
|
|
", cout: " . ($cout || 0) . ", cerr: " . ($cerr || 0); |
1833
|
2
|
|
|
|
|
6
|
my ($rv, $wv); |
1834
|
|
|
|
|
|
|
|
1835
|
2
|
50
|
33
|
|
|
20
|
if ($cout or $cerr) { |
1836
|
2
|
|
|
|
|
6
|
$rv = ''; |
1837
|
2
|
50
|
|
|
|
10
|
if ($cout) { |
1838
|
2
|
|
|
|
|
320
|
$fnoout = fileno $out; |
1839
|
2
|
|
|
|
|
28
|
vec($rv, $fnoout, 1) = 1; |
1840
|
|
|
|
|
|
|
} |
1841
|
2
|
50
|
|
|
|
10
|
if ($cerr) { |
1842
|
0
|
|
|
|
|
0
|
$fnoerr = fileno $err; |
1843
|
0
|
|
|
|
|
0
|
vec($rv, $fnoerr, 1) = 1 |
1844
|
|
|
|
|
|
|
} |
1845
|
|
|
|
|
|
|
} |
1846
|
|
|
|
|
|
|
|
1847
|
2
|
50
|
|
|
|
6
|
if ($cin) { |
1848
|
0
|
|
|
|
|
0
|
$fnoin = fileno $in; |
1849
|
0
|
|
|
|
|
0
|
$wv = ''; |
1850
|
0
|
|
|
|
|
0
|
vec($wv, $fnoin, 1) = 1; |
1851
|
|
|
|
|
|
|
} |
1852
|
|
|
|
|
|
|
|
1853
|
2
|
|
|
|
|
2
|
my $recalc_vecs; |
1854
|
2
|
|
|
|
|
6
|
FAST: until ($recalc_vecs) { |
1855
|
4
|
50
|
0
|
|
|
12
|
$debug and $debug & 64 and |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
33
|
|
|
|
|
1856
|
|
|
|
|
|
|
_debug "io3 fast, cin: " . ($cin || 0) . |
1857
|
|
|
|
|
|
|
", cout: " . ($cout || 0) . ", cerr: " . ($cerr || 0); |
1858
|
4
|
|
|
|
|
18
|
my ($rv1, $wv1) = ($rv, $wv); |
1859
|
4
|
|
|
|
|
2330580
|
my $n = select ($rv1, $wv1, undef, $timeout); |
1860
|
4
|
50
|
|
|
|
34
|
if ($n > 0) { |
1861
|
4
|
50
|
33
|
|
|
46
|
if ($cout and vec($rv1, $fnoout, 1)) { |
1862
|
4
|
|
|
|
|
8
|
my $offset = length $bout; |
1863
|
4
|
|
|
|
|
136
|
my $read = sysread($out, $bout, 20480, $offset); |
1864
|
4
|
50
|
33
|
|
|
20
|
if ($debug and $debug & 64) { |
1865
|
0
|
|
|
|
|
0
|
_debug "stdout, bytes read: ", $read, " at offset $offset"; |
1866
|
0
|
0
|
0
|
|
|
0
|
$read and $debug & 128 and _hexdump substr $bout, $offset; |
1867
|
|
|
|
|
|
|
} |
1868
|
4
|
100
|
66
|
|
|
58
|
unless ($read or grep $! == $_, @retriable) { |
1869
|
2
|
|
|
|
|
38
|
close $out; |
1870
|
2
|
|
|
|
|
8
|
undef $cout; |
1871
|
2
|
|
|
|
|
4
|
$recalc_vecs = 1; |
1872
|
|
|
|
|
|
|
} |
1873
|
|
|
|
|
|
|
} |
1874
|
4
|
50
|
33
|
|
|
56
|
if ($cerr and vec($rv1, $fnoerr, 1)) { |
1875
|
0
|
|
|
|
|
0
|
my $read = sysread($err, $berr, 20480, length($berr)); |
1876
|
0
|
0
|
0
|
|
|
0
|
$debug and $debug & 64 and _debug "stderr, bytes read: ", $read; |
1877
|
0
|
0
|
0
|
|
|
0
|
unless ($read or grep $! == $_, @retriable) { |
1878
|
0
|
|
|
|
|
0
|
close $err; |
1879
|
0
|
|
|
|
|
0
|
undef $cerr; |
1880
|
0
|
|
|
|
|
0
|
$recalc_vecs = 1; |
1881
|
|
|
|
|
|
|
} |
1882
|
|
|
|
|
|
|
} |
1883
|
4
|
50
|
33
|
|
|
48
|
if ($cin and vec($wv1, $fnoin, 1)) { |
1884
|
0
|
|
|
|
|
0
|
my $written = syswrite($in, $data[0], 20480); |
1885
|
0
|
0
|
0
|
|
|
0
|
if ($debug and $debug & 64) { |
1886
|
0
|
|
|
|
|
0
|
_debug "stdin, bytes written: ", $written; |
1887
|
0
|
0
|
0
|
|
|
0
|
$written and $debug & 128 and _hexdump substr $data[0], 0, $written; |
1888
|
|
|
|
|
|
|
} |
1889
|
0
|
0
|
|
|
|
0
|
if ($written) { |
|
|
0
|
|
|
|
|
|
1890
|
0
|
|
|
|
|
0
|
substr($data[0], 0, $written, ''); |
1891
|
0
|
|
|
|
|
0
|
while (@data) { |
1892
|
|
|
|
|
|
|
next FAST |
1893
|
0
|
0
|
0
|
|
|
0
|
if (defined $data[0] and length $data[0]); |
1894
|
0
|
|
|
|
|
0
|
shift @data; |
1895
|
|
|
|
|
|
|
} |
1896
|
|
|
|
|
|
|
# fallback when stdin queue is exhausted |
1897
|
|
|
|
|
|
|
} |
1898
|
|
|
|
|
|
|
elsif (grep $! == $_, @retriable) { |
1899
|
0
|
|
|
|
|
0
|
next FAST; |
1900
|
|
|
|
|
|
|
} |
1901
|
0
|
0
|
|
|
|
0
|
close $in unless $keep_in_open; |
1902
|
0
|
|
|
|
|
0
|
undef $cin; |
1903
|
0
|
|
|
|
|
0
|
$recalc_vecs = 1; |
1904
|
|
|
|
|
|
|
} |
1905
|
|
|
|
|
|
|
} |
1906
|
|
|
|
|
|
|
else { |
1907
|
0
|
0
|
0
|
|
|
0
|
next if $n < 0 and grep $! == $_, @retriable; |
1908
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_TIMEOUT, 'ssh slave failed', 'timed out'); |
1909
|
0
|
|
|
|
|
0
|
last MLOOP; |
1910
|
|
|
|
|
|
|
} |
1911
|
|
|
|
|
|
|
} |
1912
|
|
|
|
|
|
|
} |
1913
|
2
|
50
|
|
|
|
6
|
close $out if $cout; |
1914
|
2
|
50
|
|
|
|
6
|
close $err if $cerr; |
1915
|
2
|
50
|
33
|
|
|
6
|
close $in if $cin and not $keep_in_open; |
1916
|
|
|
|
|
|
|
|
1917
|
2
|
50
|
|
|
|
20
|
if ($enc) { |
1918
|
0
|
|
|
|
|
0
|
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, 'output decoding failed']; |
|
0
|
|
|
|
|
0
|
|
1919
|
0
|
0
|
|
|
|
0
|
unless ($self->_decode($enc, $bout, $berr)) { |
1920
|
0
|
|
|
|
|
0
|
undef $bout; |
1921
|
0
|
|
|
|
|
0
|
undef $berr; |
1922
|
|
|
|
|
|
|
} |
1923
|
|
|
|
|
|
|
} |
1924
|
2
|
50
|
33
|
|
|
18
|
$debug and $debug & 64 and _debug "leaving _io3()"; |
1925
|
2
|
|
|
|
|
40
|
return ($bout, $berr); |
1926
|
|
|
|
|
|
|
} |
1927
|
|
|
|
|
|
|
|
1928
|
|
|
|
|
|
|
|
1929
|
|
|
|
|
|
|
|
1930
|
|
|
|
|
|
|
_sub_options spawn => qw(stderr_to_stdout stdin_discard stdin_fh stdin_file stdout_discard stdout_fh |
1931
|
|
|
|
|
|
|
stdout_file stderr_discard stderr_fh stderr_file stdinout_dpipe |
1932
|
|
|
|
|
|
|
stdinout_dpipe_make_parent quote_args quote_args_extended remote_shell |
1933
|
|
|
|
|
|
|
glob_quoting tty ssh_opts tunnel encoding argument_encoding forward_agent |
1934
|
|
|
|
|
|
|
forward_X11 setpgrp subsystem); |
1935
|
|
|
|
|
|
|
sub spawn { |
1936
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
1937
|
0
|
|
|
|
|
0
|
my $self = shift; |
1938
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
1939
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
1940
|
|
|
|
|
|
|
|
1941
|
0
|
|
|
|
|
0
|
return scalar $self->open_ex(\%opts, @_); |
1942
|
|
|
|
|
|
|
} |
1943
|
|
|
|
|
|
|
|
1944
|
|
|
|
|
|
|
_sub_options open2 => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file quote_args quote_args_extended |
1945
|
|
|
|
|
|
|
remote_shell glob_quoting tty ssh_opts tunnel encoding argument_encoding forward_agent |
1946
|
|
|
|
|
|
|
forward_X11 setpgrp subsystem); |
1947
|
|
|
|
|
|
|
sub open2 { |
1948
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
1949
|
0
|
|
|
|
|
0
|
my $self = shift; |
1950
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
1951
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
1952
|
0
|
|
|
|
|
0
|
_croak_scalar_context; |
1953
|
|
|
|
|
|
|
|
1954
|
0
|
0
|
|
|
|
0
|
my ($in, $out, undef, $pid) = |
1955
|
|
|
|
|
|
|
$self->open_ex({ stdout_pipe => 1, |
1956
|
|
|
|
|
|
|
stdin_pipe => 1, |
1957
|
|
|
|
|
|
|
%opts }, @_) or return (); |
1958
|
0
|
|
|
|
|
0
|
return ($in, $out, $pid); |
1959
|
|
|
|
|
|
|
} |
1960
|
|
|
|
|
|
|
|
1961
|
|
|
|
|
|
|
_sub_options open2pty => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file |
1962
|
|
|
|
|
|
|
quote_args quote_args_extended remote_shell glob_quoting tty |
1963
|
|
|
|
|
|
|
close_slave_pty ssh_opts encoding argument_encoding forward_agent |
1964
|
|
|
|
|
|
|
forward_X11 setpgrp subsystem); |
1965
|
|
|
|
|
|
|
sub open2pty { |
1966
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
1967
|
0
|
|
|
|
|
0
|
my $self = shift; |
1968
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
1969
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
1970
|
|
|
|
|
|
|
|
1971
|
0
|
0
|
|
|
|
0
|
my ($pty, undef, undef, $pid) = |
1972
|
|
|
|
|
|
|
$self->open_ex({ stdout_pty => 1, |
1973
|
|
|
|
|
|
|
stdin_pty => 1, |
1974
|
|
|
|
|
|
|
tty => 1, |
1975
|
|
|
|
|
|
|
%opts }, @_) or return (); |
1976
|
0
|
0
|
|
|
|
0
|
wantarray ? ($pty, $pid) : $pty; |
1977
|
|
|
|
|
|
|
} |
1978
|
|
|
|
|
|
|
|
1979
|
|
|
|
|
|
|
_sub_options open2socket => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file |
1980
|
|
|
|
|
|
|
quote_args quote_args_extended remote_shell glob_quoting tty |
1981
|
|
|
|
|
|
|
ssh_opts tunnel encoding argument_encoding forward_agent |
1982
|
|
|
|
|
|
|
forward_X11 setpgrp subsystem); |
1983
|
|
|
|
|
|
|
sub open2socket { |
1984
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
1985
|
0
|
|
|
|
|
0
|
my $self = shift; |
1986
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
1987
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
1988
|
|
|
|
|
|
|
|
1989
|
0
|
0
|
|
|
|
0
|
my ($socket, undef, undef, $pid) = |
1990
|
|
|
|
|
|
|
$self->open_ex({ stdinout_socket => 1, |
1991
|
|
|
|
|
|
|
%opts }, @_) or return (); |
1992
|
0
|
0
|
|
|
|
0
|
wantarray ? ($socket, $pid) : $socket; |
1993
|
|
|
|
|
|
|
} |
1994
|
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
|
_sub_options open3 => qw(quote_args quote_args_extended remote_shell glob_quoting tty ssh_opts |
1996
|
|
|
|
|
|
|
encoding argument_encoding forward_agent forward_X11 setpgrp subsystem); |
1997
|
|
|
|
|
|
|
sub open3 { |
1998
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
1999
|
0
|
|
|
|
|
0
|
my $self = shift; |
2000
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2001
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2002
|
0
|
|
|
|
|
0
|
_croak_scalar_context; |
2003
|
|
|
|
|
|
|
|
2004
|
0
|
0
|
|
|
|
0
|
my ($in, $out, $err, $pid) = |
2005
|
|
|
|
|
|
|
$self->open_ex({ stdout_pipe => 1, |
2006
|
|
|
|
|
|
|
stdin_pipe => 1, |
2007
|
|
|
|
|
|
|
stderr_pipe => 1, |
2008
|
|
|
|
|
|
|
%opts }, |
2009
|
|
|
|
|
|
|
@_) or return (); |
2010
|
0
|
|
|
|
|
0
|
return ($in, $out, $err, $pid); |
2011
|
|
|
|
|
|
|
} |
2012
|
|
|
|
|
|
|
|
2013
|
|
|
|
|
|
|
_sub_options open3pty => qw(quote_args quote_args_extended remote_shell glob_quoting tty close_slave_pty ssh_opts |
2014
|
|
|
|
|
|
|
encoding argument_encoding forward_agent forward_X11 setpgrp subsystem); |
2015
|
|
|
|
|
|
|
sub open3pty { |
2016
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2017
|
0
|
|
|
|
|
0
|
my $self = shift; |
2018
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2019
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2020
|
0
|
|
|
|
|
0
|
_croak_scalar_context; |
2021
|
|
|
|
|
|
|
|
2022
|
0
|
0
|
|
|
|
0
|
my ($pty, undef, $err, $pid) = |
2023
|
|
|
|
|
|
|
$self->open_ex({ stdout_pty => 1, |
2024
|
|
|
|
|
|
|
stdin_pty => 1, |
2025
|
|
|
|
|
|
|
tty => 1, |
2026
|
|
|
|
|
|
|
stderr_pipe => 1, |
2027
|
|
|
|
|
|
|
%opts }, |
2028
|
|
|
|
|
|
|
@_) or return (); |
2029
|
0
|
|
|
|
|
0
|
return ($pty, $err, $pid); |
2030
|
|
|
|
|
|
|
} |
2031
|
|
|
|
|
|
|
|
2032
|
|
|
|
|
|
|
_sub_options open3socket => qw(quote_args quote_args_extended remote_shell glob_quoting tty ssh_opts encoding |
2033
|
|
|
|
|
|
|
argument_encoding forward_agent forward_X11 setpgrp subsystem); |
2034
|
|
|
|
|
|
|
sub open3socket { |
2035
|
0
|
0
|
|
0
|
0
|
0
|
${^TAINT} and &_catch_tainted_args; |
2036
|
0
|
|
|
|
|
0
|
my $self = shift; |
2037
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2038
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2039
|
0
|
|
|
|
|
0
|
_croak_scalar_context; |
2040
|
|
|
|
|
|
|
|
2041
|
0
|
0
|
|
|
|
0
|
my ($socket, undef, $err, $pid) = |
2042
|
|
|
|
|
|
|
$self->open_ex({ stdinout_socket => 1, |
2043
|
|
|
|
|
|
|
stderr_pipe => 1, |
2044
|
|
|
|
|
|
|
%opts }, @_) or return (); |
2045
|
0
|
|
|
|
|
0
|
return ($socket, $err, $pid); |
2046
|
|
|
|
|
|
|
} |
2047
|
|
|
|
|
|
|
|
2048
|
|
|
|
|
|
|
_sub_options system => qw(stdout_discard stdout_fh stdin_discard stdout_file stdin_fh stdin_file |
2049
|
|
|
|
|
|
|
quote_args quote_args_extended remote_shell glob_quoting |
2050
|
|
|
|
|
|
|
stderr_to_stdout stderr_discard stderr_fh stderr_file |
2051
|
|
|
|
|
|
|
stdinout_dpipe stdinout_dpipe_make_parent tty ssh_opts tunnel encoding |
2052
|
|
|
|
|
|
|
argument_encoding forward_agent forward_X11 setpgrp subsystem); |
2053
|
|
|
|
|
|
|
sub system { |
2054
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2055
|
0
|
|
|
|
|
0
|
my $self = shift; |
2056
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2057
|
0
|
|
|
|
|
0
|
my $stdin_data = delete $opts{stdin_data}; |
2058
|
0
|
|
|
|
|
0
|
my $timeout = delete $opts{timeout}; |
2059
|
0
|
|
|
|
|
0
|
my $async = delete $opts{async}; |
2060
|
0
|
0
|
|
|
|
0
|
my $stdin_keep_open = ($async ? undef : delete $opts{stdin_keep_open}); |
2061
|
|
|
|
|
|
|
|
2062
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2063
|
|
|
|
|
|
|
|
2064
|
0
|
0
|
0
|
|
|
0
|
$stdin_data = '' if $stdin_keep_open and not defined $stdin_data; |
2065
|
|
|
|
|
|
|
|
2066
|
0
|
|
|
|
|
0
|
my $stream_encoding; |
2067
|
0
|
0
|
|
|
|
0
|
if (defined $stdin_data) { |
2068
|
0
|
|
|
|
|
0
|
$opts{stdin_pipe} = 1; |
2069
|
0
|
|
|
|
|
0
|
$stream_encoding = $self->_delete_stream_encoding(\%opts); |
2070
|
|
|
|
|
|
|
} |
2071
|
|
|
|
|
|
|
|
2072
|
0
|
|
|
|
|
0
|
local $SIG{INT} = 'IGNORE'; |
2073
|
0
|
|
|
|
|
0
|
local $SIG{QUIT} = 'IGNORE'; |
2074
|
0
|
|
|
|
|
0
|
local $SIG{CHLD}; |
2075
|
|
|
|
|
|
|
|
2076
|
0
|
0
|
|
|
|
0
|
my ($in, undef, undef, $pid) = $self->open_ex(\%opts, @_) or return undef; |
2077
|
|
|
|
|
|
|
|
2078
|
0
|
0
|
|
|
|
0
|
$self->_io3(undef, undef, $in, $stdin_data, |
2079
|
|
|
|
|
|
|
$timeout, $stream_encoding, $stdin_keep_open) if defined $stdin_data; |
2080
|
0
|
0
|
|
|
|
0
|
return $pid if $async; |
2081
|
0
|
|
|
|
|
0
|
$self->_waitpid($pid, $timeout); |
2082
|
|
|
|
|
|
|
} |
2083
|
|
|
|
|
|
|
|
2084
|
|
|
|
|
|
|
_sub_options test => qw(stdout_discard stdout_fh stdin_discard stdout_file stdin_fh stdin_file |
2085
|
|
|
|
|
|
|
quote_args quote_args_extended remote_shell glob_quoting stderr_to_stdout |
2086
|
|
|
|
|
|
|
stderr_discard stderr_fh stderr_file stdinout_dpipe |
2087
|
|
|
|
|
|
|
stdinout_dpipe_make_parent tty ssh_opts timeout stdin_data stdin_keep_open |
2088
|
|
|
|
|
|
|
encoding stream_encoding argument_encoding forward_agent forward_X11 |
2089
|
|
|
|
|
|
|
setpgrp subsystem); |
2090
|
|
|
|
|
|
|
|
2091
|
|
|
|
|
|
|
sub test { |
2092
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2093
|
0
|
|
|
|
|
0
|
my $self = shift; |
2094
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2095
|
0
|
0
|
|
|
|
0
|
$opts{stdout_discard} = 1 unless grep defined($opts{$_}), qw(stdout_discard stdout_fh |
2096
|
|
|
|
|
|
|
stdout_file stdinout_dpipe); |
2097
|
0
|
0
|
|
|
|
0
|
$opts{stderr_discard} = 1 unless grep defined($opts{$_}), qw(stderr_discard stderr_fh |
2098
|
|
|
|
|
|
|
stderr_file stderr_to_stdout); |
2099
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2100
|
|
|
|
|
|
|
|
2101
|
0
|
|
|
|
|
0
|
$self->system(\%opts, @_); |
2102
|
0
|
|
|
|
|
0
|
my $error = $self->{_error}; |
2103
|
0
|
0
|
|
|
|
0
|
unless ($error) { |
2104
|
0
|
|
|
|
|
0
|
return 1; |
2105
|
|
|
|
|
|
|
} |
2106
|
0
|
0
|
|
|
|
0
|
if ($error == OSSH_SLAVE_CMD_FAILED) { |
2107
|
0
|
|
|
|
|
0
|
$self->_set_error(0); |
2108
|
0
|
|
|
|
|
0
|
return 0; |
2109
|
|
|
|
|
|
|
} |
2110
|
0
|
|
|
|
|
0
|
return undef; |
2111
|
|
|
|
|
|
|
} |
2112
|
|
|
|
|
|
|
|
2113
|
|
|
|
|
|
|
_sub_options capture => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file stdin_discard |
2114
|
|
|
|
|
|
|
stdin_fh stdin_file quote_args quote_args_extended remote_shell |
2115
|
|
|
|
|
|
|
glob_quoting tty ssh_opts tunnel encoding argument_encoding forward_agent |
2116
|
|
|
|
|
|
|
forward_X11 setpgrp subsystem); |
2117
|
|
|
|
|
|
|
sub capture { |
2118
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2119
|
0
|
|
|
|
|
0
|
my $self = shift; |
2120
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2121
|
0
|
|
|
|
|
0
|
my $stdin_data = delete $opts{stdin_data}; |
2122
|
0
|
|
|
|
|
0
|
my $stdin_keep_open = delete $opts{stdin_keep_open}; |
2123
|
0
|
|
|
|
|
0
|
my $timeout = delete $opts{timeout}; |
2124
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2125
|
|
|
|
|
|
|
|
2126
|
0
|
0
|
0
|
|
|
0
|
$stdin_data = '' if $stdin_keep_open and not defined $stdin_data; |
2127
|
|
|
|
|
|
|
|
2128
|
0
|
|
|
|
|
0
|
my $stream_encoding = $self->_delete_stream_encoding(\%opts); |
2129
|
0
|
|
|
|
|
0
|
$opts{stdout_pipe} = 1; |
2130
|
0
|
0
|
|
|
|
0
|
$opts{stdin_pipe} = 1 if defined $stdin_data; |
2131
|
|
|
|
|
|
|
|
2132
|
0
|
|
|
|
|
0
|
local $SIG{INT} = 'IGNORE'; |
2133
|
0
|
|
|
|
|
0
|
local $SIG{QUIT} = 'IGNORE'; |
2134
|
0
|
|
|
|
|
0
|
local $SIG{CHLD}; |
2135
|
|
|
|
|
|
|
|
2136
|
0
|
0
|
|
|
|
0
|
my ($in, $out, undef, $pid) = $self->open_ex(\%opts, @_) or return (); |
2137
|
0
|
|
|
|
|
0
|
my ($output) = $self->_io3($out, undef, $in, $stdin_data, |
2138
|
|
|
|
|
|
|
$timeout, $stream_encoding, $stdin_keep_open); |
2139
|
0
|
|
|
|
|
0
|
$self->_waitpid($pid, $timeout); |
2140
|
0
|
0
|
|
|
|
0
|
if (wantarray) { |
2141
|
0
|
|
|
|
|
0
|
my $pattern = quotemeta $/; |
2142
|
0
|
|
|
|
|
0
|
return split /(?<=$pattern)/, $output; |
2143
|
|
|
|
|
|
|
} |
2144
|
|
|
|
|
|
|
$output |
2145
|
0
|
|
|
|
|
0
|
} |
2146
|
|
|
|
|
|
|
|
2147
|
|
|
|
|
|
|
_sub_options capture2 => qw(stdin_discard stdin_fh stdin_file quote_args quote_args_extended |
2148
|
|
|
|
|
|
|
remote_shell glob_quoting tty ssh_opts encoding stream_encoding |
2149
|
|
|
|
|
|
|
argument_encoding forward_agent forward_X11 setpgrp subsystem); |
2150
|
|
|
|
|
|
|
sub capture2 { |
2151
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2152
|
0
|
|
|
|
|
0
|
my $self = shift; |
2153
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2154
|
0
|
|
|
|
|
0
|
my $stdin_data = delete $opts{stdin_data}; |
2155
|
0
|
|
|
|
|
0
|
my $stdin_keep_open = delete $opts{stdin_keep_open}; |
2156
|
0
|
|
|
|
|
0
|
my $timeout = delete $opts{timeout}; |
2157
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2158
|
|
|
|
|
|
|
|
2159
|
0
|
0
|
0
|
|
|
0
|
$stdin_data = '' if $stdin_keep_open and not defined $stdin_data; |
2160
|
|
|
|
|
|
|
|
2161
|
0
|
|
|
|
|
0
|
my $stream_encoding = $self->_delete_stream_encoding(\%opts); |
2162
|
0
|
|
|
|
|
0
|
$opts{stdout_pipe} = 1; |
2163
|
0
|
|
|
|
|
0
|
$opts{stderr_pipe} = 1; |
2164
|
0
|
0
|
|
|
|
0
|
$opts{stdin_pipe} = 1 if defined $stdin_data; |
2165
|
|
|
|
|
|
|
|
2166
|
0
|
|
|
|
|
0
|
local $SIG{INT} = 'IGNORE'; |
2167
|
0
|
|
|
|
|
0
|
local $SIG{QUIT} = 'IGNORE'; |
2168
|
0
|
|
|
|
|
0
|
local $SIG{CHLD}; |
2169
|
|
|
|
|
|
|
|
2170
|
0
|
0
|
|
|
|
0
|
my ($in, $out, $err, $pid) = $self->open_ex( \%opts, @_) or return (); |
2171
|
0
|
|
|
|
|
0
|
my @capture = $self->_io3($out, $err, $in, $stdin_data, |
2172
|
|
|
|
|
|
|
$timeout, $stream_encoding, $stdin_keep_open); |
2173
|
0
|
|
|
|
|
0
|
$self->_waitpid($pid, $timeout); |
2174
|
0
|
0
|
|
|
|
0
|
wantarray ? @capture : $capture[0]; |
2175
|
|
|
|
|
|
|
} |
2176
|
|
|
|
|
|
|
|
2177
|
|
|
|
|
|
|
_sub_options open_tunnel => qw(ssh_opts stderr_discard stderr_fh stderr_file |
2178
|
|
|
|
|
|
|
encoding argument_encoding forward_agent setpgrp); |
2179
|
|
|
|
|
|
|
sub open_tunnel { |
2180
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2181
|
0
|
|
|
|
|
0
|
my $self = shift; |
2182
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2183
|
0
|
0
|
|
|
|
0
|
$opts{stderr_discard} = 1 unless grep defined $opts{$_}, qw(stderr_discard stderr_fh stderr_file); |
2184
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2185
|
0
|
0
|
|
|
|
0
|
@_ == 2 or croak 'Usage: $ssh->open_tunnel(\%opts, $host, $port)'; |
2186
|
0
|
|
|
|
|
0
|
$opts{tunnel} = 1; |
2187
|
0
|
|
|
|
|
0
|
$self->open2socket(\%opts, @_); |
2188
|
|
|
|
|
|
|
} |
2189
|
|
|
|
|
|
|
|
2190
|
|
|
|
|
|
|
_sub_options capture_tunnel => qw(ssh_opts stderr_discard stderr_fh stderr_file stdin_discard |
2191
|
|
|
|
|
|
|
stdin_fh stdin_file stdin_data timeout encoding stream_encoding |
2192
|
|
|
|
|
|
|
argument_encoding forward_agent setpgrp); |
2193
|
|
|
|
|
|
|
sub capture_tunnel { |
2194
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2195
|
0
|
|
|
|
|
0
|
my $self = shift; |
2196
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2197
|
0
|
0
|
|
|
|
0
|
$opts{stderr_discard} = 1 unless grep defined $opts{$_}, qw(stderr_discard stderr_fh stderr_file); |
2198
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2199
|
0
|
0
|
|
|
|
0
|
@_ == 2 or croak 'Usage: $ssh->capture_tunnel(\%opts, $host, $port)'; |
2200
|
0
|
|
|
|
|
0
|
$opts{tunnel} = 1; |
2201
|
0
|
|
|
|
|
0
|
$self->capture(\%opts, @_); |
2202
|
|
|
|
|
|
|
} |
2203
|
|
|
|
|
|
|
|
2204
|
|
|
|
|
|
|
sub _calling_method { |
2205
|
0
|
|
|
0
|
|
0
|
my $method = (caller 2)[3]; |
2206
|
0
|
|
|
|
|
0
|
$method =~ s/.*:://; |
2207
|
0
|
|
|
|
|
0
|
$method; |
2208
|
|
|
|
|
|
|
} |
2209
|
|
|
|
|
|
|
|
2210
|
|
|
|
|
|
|
sub _scp_get_args { |
2211
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2212
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2213
|
|
|
|
|
|
|
|
2214
|
0
|
0
|
|
|
|
0
|
@_ > 0 or croak |
2215
|
|
|
|
|
|
|
'Usage: $ssh->' . _calling_method . '(\%opts, $remote_fn1, $remote_fn2, ..., $local_fn_or_dir)'; |
2216
|
|
|
|
|
|
|
|
2217
|
0
|
|
|
|
|
0
|
my $glob = delete $opts{glob}; |
2218
|
|
|
|
|
|
|
|
2219
|
0
|
0
|
|
|
|
0
|
my $target = (@_ > 1 ? pop @_ : '.'); |
2220
|
0
|
0
|
|
|
|
0
|
$target =~ m|^[^/]*:| and $target = "./$target"; |
2221
|
|
|
|
|
|
|
|
2222
|
0
|
|
|
|
|
0
|
my $prefix = $self->{_host_squared}; |
2223
|
0
|
0
|
|
|
|
0
|
$prefix = "$self->{_user}\@$prefix" if defined $self->{_user}; |
2224
|
|
|
|
|
|
|
|
2225
|
0
|
|
|
|
|
0
|
my $src = "$prefix:". join(" ", $self->_quote_args({quote_args => 1, |
2226
|
|
|
|
|
|
|
glob_quoting => $glob}, |
2227
|
|
|
|
|
|
|
@_)); |
2228
|
0
|
|
|
|
|
0
|
($self, \%opts, $target, $src); |
2229
|
|
|
|
|
|
|
} |
2230
|
|
|
|
|
|
|
|
2231
|
|
|
|
|
|
|
sub scp_get { |
2232
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2233
|
0
|
|
|
|
|
0
|
my ($self, $opts, $target, @src) = _scp_get_args @_; |
2234
|
0
|
|
|
|
|
0
|
$self->_scp($opts, @src, $target); |
2235
|
|
|
|
|
|
|
} |
2236
|
|
|
|
|
|
|
|
2237
|
|
|
|
|
|
|
sub rsync_get { |
2238
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2239
|
0
|
|
|
|
|
0
|
my ($self, $opts, $target, @src) = _scp_get_args @_; |
2240
|
0
|
|
|
|
|
0
|
$self->_rsync($opts, @src, $target); |
2241
|
|
|
|
|
|
|
} |
2242
|
|
|
|
|
|
|
|
2243
|
|
|
|
|
|
|
sub _scp_put_args { |
2244
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2245
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2246
|
|
|
|
|
|
|
|
2247
|
0
|
0
|
|
|
|
0
|
@_ > 0 or croak |
2248
|
|
|
|
|
|
|
'Usage: $ssh->' . _calling_method . '(\%opts, $local_fn1, $local_fn2, ..., $remote_dir_or_fn)'; |
2249
|
|
|
|
|
|
|
|
2250
|
0
|
|
|
|
|
0
|
my $glob = delete $opts{glob}; |
2251
|
0
|
0
|
0
|
|
|
0
|
my $glob_flags = ($glob ? delete $opts{glob_flags} || 0 : undef); |
2252
|
|
|
|
|
|
|
|
2253
|
0
|
|
|
|
|
0
|
my $prefix = $self->{_host_squared}; |
2254
|
0
|
0
|
|
|
|
0
|
$prefix = "$self->{_user}\@$prefix" if defined $self->{_user}; |
2255
|
|
|
|
|
|
|
|
2256
|
0
|
|
|
|
|
0
|
my $remote_shell = delete $opts{remote_shell}; |
2257
|
0
|
0
|
|
|
|
0
|
my $target = $prefix . ':' . ( @_ > 1 |
2258
|
|
|
|
|
|
|
? $self->_quote_args({quote_args => 1, remote_shell => $remote_shell}, pop(@_)) |
2259
|
|
|
|
|
|
|
: ''); |
2260
|
|
|
|
|
|
|
|
2261
|
0
|
|
|
|
|
0
|
my @src = @_; |
2262
|
0
|
0
|
|
|
|
0
|
if ($glob) { |
2263
|
0
|
|
|
|
|
0
|
require File::Glob; |
2264
|
0
|
|
|
|
|
0
|
@src = map File::Glob::bsd_glob($_, $glob_flags), @src; |
2265
|
0
|
0
|
|
|
|
0
|
unless (@src) { |
2266
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_FAILED, |
2267
|
|
|
|
|
|
|
"given file name patterns did not match any file"); |
2268
|
0
|
|
|
|
|
0
|
return undef; |
2269
|
|
|
|
|
|
|
} |
2270
|
|
|
|
|
|
|
} |
2271
|
0
|
|
|
|
|
0
|
$_ = "./$_" for grep m|^[^/]*:|, @src; |
2272
|
|
|
|
|
|
|
|
2273
|
0
|
|
|
|
|
0
|
($self, \%opts, $target, @src); |
2274
|
|
|
|
|
|
|
} |
2275
|
|
|
|
|
|
|
|
2276
|
|
|
|
|
|
|
sub scp_put { |
2277
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2278
|
0
|
|
|
|
|
0
|
my ($self, $opts, $target, @src) = _scp_put_args @_; |
2279
|
0
|
0
|
|
|
|
0
|
return unless $self; |
2280
|
0
|
|
|
|
|
0
|
$self->_scp($opts, @src, $target); |
2281
|
|
|
|
|
|
|
} |
2282
|
|
|
|
|
|
|
|
2283
|
|
|
|
|
|
|
sub rsync_put { |
2284
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2285
|
0
|
|
|
|
|
0
|
my ($self, $opts, $target, @src) = _scp_put_args @_; |
2286
|
0
|
0
|
|
|
|
0
|
return unless $self; |
2287
|
0
|
|
|
|
|
0
|
$self->_rsync($opts, @src, $target); |
2288
|
|
|
|
|
|
|
} |
2289
|
|
|
|
|
|
|
|
2290
|
|
|
|
|
|
|
_sub_options _scp => qw(stderr_to_stdout stderr_discard stderr_fh |
2291
|
|
|
|
|
|
|
stderr_file stdout_discard stdout_fh |
2292
|
|
|
|
|
|
|
stdout_file encoding argument_encoding |
2293
|
|
|
|
|
|
|
forward_agent setpgrp); |
2294
|
|
|
|
|
|
|
sub _scp { |
2295
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2296
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2297
|
0
|
|
|
|
|
0
|
my $quiet = delete $opts{quiet}; |
2298
|
0
|
0
|
|
|
|
0
|
$quiet = 1 unless defined $quiet; |
2299
|
0
|
|
|
|
|
0
|
my $recursive = delete $opts{recursive}; |
2300
|
0
|
|
|
|
|
0
|
my $copy_attrs = delete $opts{copy_attrs}; |
2301
|
0
|
|
|
|
|
0
|
my $bwlimit = delete $opts{bwlimit}; |
2302
|
0
|
|
|
|
|
0
|
my $async = delete $opts{async}; |
2303
|
0
|
|
|
|
|
0
|
my $ssh_opts = delete $opts{ssh_opts}; |
2304
|
0
|
|
|
|
|
0
|
my $timeout = delete $opts{timeout}; |
2305
|
0
|
|
|
|
|
0
|
my $verbose = delete $opts{verbose}; |
2306
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2307
|
|
|
|
|
|
|
|
2308
|
0
|
|
|
|
|
0
|
my @opts; |
2309
|
0
|
0
|
|
|
|
0
|
@opts = @$ssh_opts if $ssh_opts; |
2310
|
0
|
0
|
|
|
|
0
|
push @opts, '-q' if $quiet; |
2311
|
0
|
0
|
|
|
|
0
|
push @opts, '-v' if $verbose; |
2312
|
0
|
0
|
|
|
|
0
|
push @opts, '-r' if $recursive; |
2313
|
0
|
0
|
|
|
|
0
|
push @opts, '-p' if $copy_attrs; |
2314
|
0
|
0
|
|
|
|
0
|
push @opts, '-l', $bwlimit if $bwlimit; |
2315
|
|
|
|
|
|
|
|
2316
|
0
|
|
|
|
|
0
|
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, 'scp failed']; |
|
0
|
|
|
|
|
0
|
|
2317
|
|
|
|
|
|
|
|
2318
|
0
|
|
|
|
|
0
|
my $pid = $self->open_ex({ %opts, |
2319
|
|
|
|
|
|
|
_cmd => 'scp', |
2320
|
|
|
|
|
|
|
ssh_opts => \@opts, |
2321
|
|
|
|
|
|
|
quote_args => 0 }, |
2322
|
|
|
|
|
|
|
@_); |
2323
|
|
|
|
|
|
|
|
2324
|
0
|
0
|
|
|
|
0
|
return $pid if $async; |
2325
|
0
|
|
|
|
|
0
|
$self->_waitpid($pid, $timeout); |
2326
|
|
|
|
|
|
|
} |
2327
|
|
|
|
|
|
|
|
2328
|
|
|
|
|
|
|
my %rsync_opt_with_arg = map { $_ => 1 } qw(chmod suffix backup-dir rsync-path max-delete max-size min-size partial-dir |
2329
|
|
|
|
|
|
|
timeout modify-window temp-dir compare-dest copy-dest link-dest compress-level |
2330
|
|
|
|
|
|
|
skip-compress filter exclude exclude-from include include-from |
2331
|
|
|
|
|
|
|
out-format log-file log-file-format bwlimit protocol iconv checksum-seed files-from); |
2332
|
|
|
|
|
|
|
|
2333
|
|
|
|
|
|
|
my %rsync_opt_forbidden = map { $_ => 1 } qw(rsh address port sockopts password-file write-batch |
2334
|
|
|
|
|
|
|
only-write-batch read-batch ipv4 ipv6 version help daemon config detach |
2335
|
|
|
|
|
|
|
protect-args list-only); |
2336
|
|
|
|
|
|
|
|
2337
|
|
|
|
|
|
|
$rsync_opt_forbidden{"no-$_"} = 1 for (keys %rsync_opt_with_arg, keys %rsync_opt_forbidden); |
2338
|
|
|
|
|
|
|
|
2339
|
|
|
|
|
|
|
my %rsync_error = (1, 'syntax or usage error', |
2340
|
|
|
|
|
|
|
2, 'protocol incompatibility', |
2341
|
|
|
|
|
|
|
3, 'errors selecting input/output files, dirs', |
2342
|
|
|
|
|
|
|
4, 'requested action not supported: an attempt was made to manipulate 64-bit files on a platform '. |
2343
|
|
|
|
|
|
|
'that cannot support them; or an option was specified that is supported by the client and not '. |
2344
|
|
|
|
|
|
|
'by the server.', |
2345
|
|
|
|
|
|
|
5, 'error starting client-server protocol', |
2346
|
|
|
|
|
|
|
6, 'daemon unable to append to log-file', |
2347
|
|
|
|
|
|
|
10, 'error in socket I/O', |
2348
|
|
|
|
|
|
|
11, 'error in file I/O', |
2349
|
|
|
|
|
|
|
12, 'error in rsync protocol data stream', |
2350
|
|
|
|
|
|
|
13, 'errors with program diagnostics', |
2351
|
|
|
|
|
|
|
14, 'error in IPC code', |
2352
|
|
|
|
|
|
|
20, 'received SIGUSR1 or SIGINT', |
2353
|
|
|
|
|
|
|
21, 'some error returned by waitpid()', |
2354
|
|
|
|
|
|
|
22, 'error allocating core memory buffers', |
2355
|
|
|
|
|
|
|
23, 'partial transfer due to error', |
2356
|
|
|
|
|
|
|
24, 'partial transfer due to vanished source files', |
2357
|
|
|
|
|
|
|
25, 'the --max-delete limit stopped deletions', |
2358
|
|
|
|
|
|
|
30, 'timeout in data send/receive', |
2359
|
|
|
|
|
|
|
35, 'timeout waiting for daemon connection'); |
2360
|
|
|
|
|
|
|
|
2361
|
|
|
|
|
|
|
my %rsync_opt_open_ex = map { $_ => 1 } qw(stderr_to_stdout |
2362
|
|
|
|
|
|
|
stderr_discard stderr_fh |
2363
|
|
|
|
|
|
|
stderr_file stdout_discard |
2364
|
|
|
|
|
|
|
stdout_fh stdout_file encoding |
2365
|
|
|
|
|
|
|
argument_encoding); |
2366
|
|
|
|
|
|
|
sub _rsync { |
2367
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
2368
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2369
|
0
|
|
|
|
|
0
|
my $async = delete $opts{async}; |
2370
|
0
|
|
|
|
|
0
|
my $verbose = delete $opts{verbose}; |
2371
|
0
|
|
|
|
|
0
|
my $quiet = delete $opts{quiet}; |
2372
|
0
|
|
|
|
|
0
|
my $copy_attrs = delete $opts{copy_attrs}; |
2373
|
0
|
|
|
|
|
0
|
my $timeout = delete $opts{timeout}; |
2374
|
0
|
0
|
0
|
|
|
0
|
$quiet = 1 unless (defined $quiet or $verbose); |
2375
|
|
|
|
|
|
|
|
2376
|
0
|
|
|
|
|
0
|
my @opts; |
2377
|
0
|
0
|
|
|
|
0
|
push @opts, '-q' if $quiet; |
2378
|
0
|
0
|
|
|
|
0
|
push @opts, '-pt' if $copy_attrs; |
2379
|
0
|
0
|
|
|
|
0
|
push @opts, '-' . ($verbose =~ /^\d+$/ ? 'v' x $verbose : 'v') if $verbose; |
|
|
0
|
|
|
|
|
|
2380
|
|
|
|
|
|
|
|
2381
|
0
|
|
|
|
|
0
|
my %opts_open_ex = ( _cmd => 'rsync', |
2382
|
|
|
|
|
|
|
quote_args => 0 ); |
2383
|
|
|
|
|
|
|
|
2384
|
0
|
|
|
|
|
0
|
for my $opt (keys %opts) { |
2385
|
0
|
|
|
|
|
0
|
my $value = $opts{$opt}; |
2386
|
0
|
0
|
|
|
|
0
|
if (defined $value) { |
2387
|
0
|
0
|
|
|
|
0
|
if ($rsync_opt_open_ex{$opt}) { |
2388
|
0
|
|
|
|
|
0
|
$opts_open_ex{$opt} = $value; |
2389
|
|
|
|
|
|
|
} |
2390
|
|
|
|
|
|
|
else { |
2391
|
0
|
|
|
|
|
0
|
my $opt1 = $opt; |
2392
|
0
|
|
|
|
|
0
|
$opt1 =~ tr/_/-/; |
2393
|
0
|
0
|
|
|
|
0
|
$rsync_opt_forbidden{$opt1} and croak "forbidden rsync option '$opt' used"; |
2394
|
0
|
0
|
|
|
|
0
|
if ($rsync_opt_with_arg{$opt1}) { |
2395
|
0
|
|
|
|
|
0
|
push @opts, "--$opt1=$_" for _array_or_scalar_to_list($value) |
2396
|
|
|
|
|
|
|
} |
2397
|
|
|
|
|
|
|
else { |
2398
|
0
|
0
|
|
|
|
0
|
$value = !$value if $opt1 =~ s/^no-//; |
2399
|
0
|
0
|
|
|
|
0
|
push @opts, ($value ? "--$opt1" : "--no-$opt1"); |
2400
|
|
|
|
|
|
|
} |
2401
|
|
|
|
|
|
|
} |
2402
|
|
|
|
|
|
|
} |
2403
|
|
|
|
|
|
|
} |
2404
|
|
|
|
|
|
|
|
2405
|
0
|
|
|
|
|
0
|
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, 'rsync failed']; |
|
0
|
|
|
|
|
0
|
|
2406
|
|
|
|
|
|
|
|
2407
|
0
|
|
|
|
|
0
|
my $pid = $self->open_ex(\%opts_open_ex, @opts, '--', @_); |
2408
|
0
|
0
|
|
|
|
0
|
return $pid if $async; |
2409
|
0
|
0
|
|
|
|
0
|
$self->_waitpid($pid, $timeout) and return 1; |
2410
|
|
|
|
|
|
|
|
2411
|
0
|
0
|
0
|
|
|
0
|
if ($self->{_error} == OSSH_SLAVE_CMD_FAILED and $?) { |
2412
|
0
|
|
|
|
|
0
|
my $err = ($? >> 8); |
2413
|
0
|
|
|
|
|
0
|
my $errstr = $rsync_error{$err}; |
2414
|
0
|
0
|
|
|
|
0
|
$errstr = 'Unknown rsync error' unless defined $errstr; |
2415
|
0
|
|
|
|
|
0
|
my $signal = $? & 255; |
2416
|
0
|
0
|
|
|
|
0
|
my $signalstr = ($signal ? " (signal $signal)" : ''); |
2417
|
0
|
|
|
|
|
0
|
$self->_set_error(OSSH_SLAVE_CMD_FAILED, |
2418
|
|
|
|
|
|
|
"command exited with code $err$signalstr: $errstr"); |
2419
|
|
|
|
|
|
|
} |
2420
|
|
|
|
|
|
|
return undef |
2421
|
0
|
|
|
|
|
0
|
} |
2422
|
|
|
|
|
|
|
|
2423
|
|
|
|
|
|
|
_sub_options sftp => qw(autoflush timeout argument_encoding encoding block_size queue_size autodie |
2424
|
|
|
|
|
|
|
late_set_perm forward_agent setpgrp min_block_size read_ahead write_delay |
2425
|
|
|
|
|
|
|
dirty_cleanup remote_has_volumes autodisconnect more); |
2426
|
|
|
|
|
|
|
|
2427
|
|
|
|
|
|
|
sub sftp { |
2428
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2429
|
0
|
0
|
|
|
|
0
|
@_ & 1 or croak 'Usage: $ssh->sftp(%sftp_opts)'; |
2430
|
0
|
|
|
|
|
0
|
_load_module('Net::SFTP::Foreign', '1.47'); |
2431
|
0
|
|
|
|
|
0
|
my ($self, %opts) = @_; |
2432
|
0
|
|
|
|
|
0
|
my $stderr_fh = delete $opts{stderr_fh}; |
2433
|
0
|
|
|
|
|
0
|
my $stderr_discard = delete $opts{stderr_discard}; |
2434
|
|
|
|
|
|
|
my $fs_encoding = _first_defined(delete $opts{fs_encoding}, |
2435
|
|
|
|
|
|
|
$opts{argument_encoding}, |
2436
|
|
|
|
|
|
|
$opts{encoding}, |
2437
|
0
|
|
|
|
|
0
|
$self->{_default_argument_encoding}); |
2438
|
0
|
0
|
0
|
|
|
0
|
undef $fs_encoding if (defined $fs_encoding and $fs_encoding eq 'bytes'); |
2439
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2440
|
0
|
0
|
|
|
|
0
|
$opts{timeout} = $self->{_timeout} unless defined $opts{timeout}; |
2441
|
0
|
0
|
|
|
|
0
|
$self->wait_for_master or return undef; |
2442
|
0
|
0
|
|
|
|
0
|
my ($in, $out, $pid) = $self->open2( { subsystem => 1, |
2443
|
|
|
|
|
|
|
stderr_fh => $stderr_fh, |
2444
|
|
|
|
|
|
|
stderr_discard => $stderr_discard }, |
2445
|
|
|
|
|
|
|
'sftp' ) |
2446
|
|
|
|
|
|
|
or return undef; |
2447
|
|
|
|
|
|
|
|
2448
|
0
|
|
|
|
|
0
|
my $sftp = Net::SFTP::Foreign->new(transport => [$out, $in, $pid], |
2449
|
|
|
|
|
|
|
dirty_cleanup => 0, |
2450
|
|
|
|
|
|
|
fs_encoding => $fs_encoding, |
2451
|
|
|
|
|
|
|
%opts); |
2452
|
0
|
0
|
|
|
|
0
|
if ($sftp->error) { |
2453
|
0
|
|
|
|
|
0
|
$self->_or_set_error(OSSH_SLAVE_SFTP_FAILED, "unable to create SFTP client", $sftp->error); |
2454
|
0
|
|
|
|
|
0
|
return undef; |
2455
|
|
|
|
|
|
|
} |
2456
|
|
|
|
|
|
|
$sftp |
2457
|
0
|
|
|
|
|
0
|
} |
2458
|
|
|
|
|
|
|
|
2459
|
|
|
|
|
|
|
_sub_options sshfs_import => qw(stderr_discard stderr_fh stderr_file |
2460
|
|
|
|
|
|
|
ssh_opts argument_encoding sshfs_opts setpgrp); |
2461
|
|
|
|
|
|
|
sub sshfs_import { |
2462
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2463
|
0
|
|
|
|
|
0
|
my $self = shift; |
2464
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2465
|
0
|
0
|
|
|
|
0
|
@_ == 2 or croak 'Usage: $ssh->sshfs_import(\%opts, $remote, $local)'; |
2466
|
0
|
|
|
|
|
0
|
my ($from, $to) = @_; |
2467
|
|
|
|
|
|
|
my @sshfs_opts = ( -o => 'slave', |
2468
|
0
|
|
|
|
|
0
|
_array_or_scalar_to_list delete $opts{sshfs_opts} ); |
2469
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2470
|
|
|
|
|
|
|
|
2471
|
0
|
|
|
|
|
0
|
$opts{ssh_opts} = ['-s', _array_or_scalar_to_list delete $opts{ssh_opts}]; |
2472
|
0
|
|
|
|
|
0
|
$opts{stdinout_dpipe} = [$self->{_sshfs_cmd}, "$self->{_host_squared}:$from", $to, @sshfs_opts]; |
2473
|
0
|
|
|
|
|
0
|
$opts{stdinout_dpipe_make_parent} = 1; |
2474
|
0
|
|
|
|
|
0
|
$self->spawn(\%opts, 'sftp'); |
2475
|
|
|
|
|
|
|
} |
2476
|
|
|
|
|
|
|
|
2477
|
|
|
|
|
|
|
_sub_options sshfs_export => qw(stderr_discard stderr_fh stderr_file |
2478
|
|
|
|
|
|
|
ssh_opts argument_encoding sshfs_opts setpgrp); |
2479
|
|
|
|
|
|
|
sub sshfs_export { |
2480
|
0
|
0
|
|
0
|
1
|
0
|
${^TAINT} and &_catch_tainted_args; |
2481
|
0
|
|
|
|
|
0
|
my $self = shift; |
2482
|
0
|
0
|
|
|
|
0
|
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ()); |
|
0
|
|
|
|
|
0
|
|
2483
|
0
|
0
|
|
|
|
0
|
@_ == 2 or croak 'Usage: $ssh->sshfs_export(\%opts, $local, $remote)'; |
2484
|
0
|
|
|
|
|
0
|
my ($from, $to) = @_; |
2485
|
|
|
|
|
|
|
my @sshfs_opts = ( -o => 'slave', |
2486
|
0
|
|
|
|
|
0
|
_array_or_scalar_to_list delete $opts{sshfs_opts} ); |
2487
|
0
|
|
|
|
|
0
|
_croak_bad_options %opts; |
2488
|
0
|
|
|
|
|
0
|
$opts{stdinout_dpipe} = $self->{_sftp_server_cmd}; |
2489
|
|
|
|
|
|
|
|
2490
|
0
|
|
|
|
|
0
|
my $hostname = do { |
2491
|
0
|
|
|
|
|
0
|
local ($@, $SIG{__DIE__}); |
2492
|
0
|
|
|
|
|
0
|
eval { |
2493
|
0
|
|
|
|
|
0
|
require Sys::Hostname; |
2494
|
0
|
|
|
|
|
0
|
Sys::Hostname::hostname(); |
2495
|
|
|
|
|
|
|
}; |
2496
|
|
|
|
|
|
|
}; |
2497
|
0
|
0
|
0
|
|
|
0
|
$hostname = 'remote' if (not defined $hostname or |
|
|
|
0
|
|
|
|
|
2498
|
|
|
|
|
|
|
not length $hostname or |
2499
|
|
|
|
|
|
|
$hostname=~/^localhost\b/); |
2500
|
0
|
|
|
|
|
0
|
$self->spawn(\%opts, $self->{_sshfs_cmd}, "$hostname:$from", $to, @sshfs_opts); |
2501
|
|
|
|
|
|
|
} |
2502
|
|
|
|
|
|
|
|
2503
|
|
|
|
|
|
|
sub object_remote { |
2504
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
2505
|
0
|
0
|
|
|
|
0
|
_load_module('Object::Remote') or return; |
2506
|
0
|
0
|
|
|
|
0
|
_load_module('Net::OpenSSH::ObjectRemote') or return; |
2507
|
0
|
|
|
|
|
0
|
my $connector = Net::OpenSSH::ObjectRemote->new(net_openssh => $self); |
2508
|
0
|
|
|
|
|
0
|
$connector->connect(@_); |
2509
|
|
|
|
|
|
|
} |
2510
|
|
|
|
|
|
|
|
2511
|
|
|
|
|
|
|
sub any { |
2512
|
0
|
|
|
0
|
1
|
0
|
my $self = shift; |
2513
|
0
|
|
|
|
|
0
|
_load_module('Net::SSH::Any'); |
2514
|
|
|
|
|
|
|
Net::SSH::Any->new($self->{_host}, user => $self->{_user}, port => $self->{_port}, |
2515
|
0
|
|
|
|
|
0
|
backend => 'Net_OpenSSH', |
2516
|
|
|
|
|
|
|
backend_opts => { Net_OpenSSH => { instance => $self } }); |
2517
|
|
|
|
|
|
|
} |
2518
|
|
|
|
|
|
|
|
2519
|
|
|
|
|
|
|
sub DESTROY { |
2520
|
1
|
|
|
1
|
|
2577
|
my $self = shift; |
2521
|
1
|
50
|
33
|
|
|
6
|
$debug and $debug & 2 and _debug("DESTROY($self, pid: ", $self->{_pid}, ")"); |
2522
|
1
|
|
|
|
|
24
|
local ($SIG{__DIE__}, $@, $?, $!); |
2523
|
1
|
|
|
|
|
4
|
$self->_disconnect; |
2524
|
|
|
|
|
|
|
} |
2525
|
|
|
|
|
|
|
|
2526
|
|
|
|
|
|
|
1; |
2527
|
|
|
|
|
|
|
__END__ |