~ubuntu-branches/ubuntu/wily/libnet-openssh-perl/wily-proposed
» Revision
4
: .pc/pod-wording.patch/lib/Net/OpenSSH.pm
« back to all changes in this revision
Viewing changes to .pc/pod-wording.patch/lib/Net/OpenSSH.pm
- browse files at revision 4
- compare with another revision
- download diff
- download tarball
- view history from revision 4
- Committer: Package Import Robot
- Author(s): gregor herrmann
- Date: 2014-06-14 14:55:17 UTC
- mfrom: (1.1.2)
- Revision ID: package-import@ubuntu.com-20140614145517-o61gchpbz76ne5e9
Tags: 0.62-1
* Team upload.
* New upstream release.
* Strip trailing slash from metacpan URLs.
* Update years of upstream copyright.
* Drop spelling.patch, fixed upstream.
* Add patch to improve wording in POD.
* Declare compliance with Debian Policy 3.9.5.
* New upstream release.
* Strip trailing slash from metacpan URLs.
* Update years of upstream copyright.
* Drop spelling.patch, fixed upstream.
* Add patch to improve wording in POD.
* Declare compliance with Debian Policy 3.9.5.
- files added:
- .pc/pod-wording.patch
- .pc/pod-wording.patch/lib
- .pc/pod-wording.patch/lib/Net
- lib/Net/OpenSSH/ShellQuoter
- files removed:
- .pc/spelling.patch
- .pc/spelling.patch/lib
- .pc/spelling.patch/lib/Net
- .pc/spelling.patch/lib/Net/OpenSSH
- files modified:
- .pc/applied-patches
added
removed
.pc/pod-wording.patch/lib/Net/OpenSSH.pm
1
package Net::OpenSSH;
2
3
our $VERSION = '0.62';
4
5
use strict;
6
use warnings;
7
8
our $debug ||= 0;
9
10
our $FACTORY;
11
12
use Carp qw(carp croak);
13
use POSIX qw(:sys_wait_h);
14
use Socket;
15
use File::Spec;
16
use Cwd ();
17
use Scalar::Util ();
18
use Errno ();
19
use Net::OpenSSH::Constants qw(:error);
20
use Net::OpenSSH::ModuleLoader;
21
use Net::OpenSSH::ShellQuoter;
22
23
my $thread_generation = 0;
24
25
sub CLONE { $thread_generation++ };
26
27
sub _debug {
28
local ($!, $@);
29
print STDERR '# ', (map { defined($_) ? $_ : '<undef>' } @_), "\n"
30
}
31
32
sub _debug_dump {
33
local ($!, $@);
34
require Data::Dumper;
35
local $Data::Dumper::Terse = 1;
36
local $Data::Dumper::Indent = 0;
37
my $head = shift;
38
_debug("$head: ", Data::Dumper::Dumper(@_));
39
}
40
41
sub _hexdump {
42
no warnings qw(uninitialized);
43
my $data = shift;
44
while ($data =~ /(.{1,32})/smg) {
45
my $line=$1;
46
my @c= (( map { sprintf "%02x",$_ } unpack('C*', $line)),
47
((" ") x 32))[0..31];
48
$line=~s/(.)/ my $c=$1; unpack("c",$c)>=32 ? $c : '.' /egms;
49
print STDERR "#> ", join(" ", @c, '|', $line), "\n";
50
}
51
}
52
53
{
54
my %good;
55
56
sub _sub_options {
57
my $sub = shift;
58
$good{__PACKAGE__ . "::$sub"} = { map { $_ => 1 } @_ };
59
}
60
61
sub _croak_bad_options (\%) {
62
my $opts = shift;
63
if (%$opts) {
64
my $sub = (caller 1)[3];
65
my $good = $good{$sub};
66
my @keys = ( $good ? grep !$good->{$_}, keys %$opts : keys %$opts);
67
if (@keys) {
68
croak "Invalid or bad combination of options ('" . CORE::join("', '", @keys) . "')";
69
}
70
}
71
}
72
}
73
74
sub _croak_scalar_context {
75
my ($sub, $wantarray) = (caller 1)[3, 5];
76
unless ($wantarray) {
77
$sub =~ s/^.*:://;
78
croak "method '$sub' called in scalar context";
79
}
80
}
81
82
sub _tcroak {
83
if (${^TAINT} > 0) {
84
push @_, " while running with -T switch";
85
goto &croak;
86
}
87
if (${^TAINT} < 0) {
88
push @_, " while running with -t switch";
89
goto &carp;
90
}
91
}
92
93
sub _catch_tainted_args {
94
my $i;
95
for (@_) {
96
next unless $i++;
97
if (Scalar::Util::tainted($_)) {
98
my (undef, undef, undef, $subn) = caller 1;
99
my $msg = ( $subn =~ /::([a-z]\w*)$/
100
? "Insecure argument '$_' on '$1' method call"
101
: "Insecure argument '$_' on method call" );
102
_tcroak($msg);
103
}
104
elsif (ref($_) eq 'HASH') {
105
for (grep Scalar::Util::tainted($_), values %$_) {
106
my (undef, undef, undef, $subn) = caller 1;
107
my $msg = ( $subn =~ /::([a-z]\w*)$/
108
? "Insecure argument on '$1' method call"
109
: "Insecure argument on method call" );
110
_tcroak($msg);
111
}
112
}
113
}
114
}
115
116
sub _set_error {
117
my $self = shift;
118
my $code = shift || 0;
119
my $err = $self->{_error} = ( $code
120
? Scalar::Util::dualvar($code, join(': ', @{$self->{_error_prefix}},
121
(@_ ? @_ : "Unknown error $code")))
122
: 0 );
123
$debug and $debug & 1 and _debug "set_error($code - $err)";
124
return $err
125
}
126
127
my $check_eval_re = do {
128
my $path = quotemeta $INC{"Net/OpenSSH.pm"};
129
qr/at $path line \d+.$/
130
};
131
132
sub _check_eval_ok {
133
my ($self, $code) = @_;
134
if ($@) {
135
my $err = $@;
136
$err =~ s/$check_eval_re//;
137
$self->_set_error($code, $err);
138
return;
139
}
140
1
141
}
142
143
sub _or_set_error {
144
my $self = shift;
145
$self->{_error} or $self->_set_error(@_);
146
}
147
148
sub _first_defined { defined && return $_ for @_; return }
149
150
my $obfuscate = sub {
151
# just for the casual observer...
152
my $txt = shift;
153
$txt =~ s/(.)/chr(ord($1) ^ 47)/ges
154
if defined $txt;
155
$txt;
156
};
157
158
my $deobfuscate = $obfuscate;
159
160
# regexp from Regexp::IPv6
161
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})|:))));
162
163
sub parse_connection_opts {
164
my ($class, $opts) = @_;
165
my ($user, $passwd, $ipv6, $host, $port, $host_squared);
166
167
my $target = delete $opts->{host};
168
defined $target or croak "mandatory host argument missing";
169
170
($user, $passwd, $ipv6, $host, $port) =
171
$target =~ m{^
172
\s* # space
173
(?:
174
([^\@:]+) # username
175
(?::(.*))? # : password
176
\@ # @
177
)?
178
(?: # host
179
( # IPv6...
180
\[$IPv6_re\] # [IPv6]
181
| # or
182
$IPv6_re # IPv6
183
)
184
| # or
185
([^\[\]\@:]+) # hostname / ipv4
186
)
187
(?::([^\@:]+))? # port
188
\s* # space
189
$}ix
190
or croak "bad host/target '$target' specification";
191
192
if (defined $ipv6) {
193
($host) = $ipv6 =~ /^\[?(.*?)\]?$/;
194
$host_squared = "[$host]";
195
}
196
else {
197
$host_squared = $host;
198
}
199
200
$user = delete $opts->{user} unless defined $user;
201
$port = delete $opts->{port} unless defined $port;
202
$passwd = delete $opts->{passwd} unless defined $passwd;
203
$passwd = delete $opts->{password} unless defined $passwd;
204
205
wantarray and return ($host, $port, $user, $passwd, $host_squared);
206
207
my %r = ( user => $user,
208
password => $passwd,
209
host => $host,
210
host_squared => $host_squared,
211
port => $port );
212
$r{ipv6} = 1 if defined $ipv6;
213
return \%r;
214
}
215
216
sub new {
217
${^TAINT} and &_catch_tainted_args;
218
219
my $class = shift;
220
@_ & 1 and unshift @_, 'host';
221
222
return $FACTORY->($class, @_) if defined $FACTORY;
223
224
my %opts = @_;
225
226
my $external_master = delete $opts{external_master};
227
# reuse_master is an obsolete alias:
228
$external_master = delete $opts{reuse_master} unless defined $external_master;
229
230
if (not defined $opts{host} and defined $external_master) {
231
$opts{host} = '0.0.0.0';
232
}
233
234
my ($host, $port, $user, $passwd, $host_squared) = $class->parse_connection_opts(\%opts);
235
236
my ($passphrase, $key_path, $login_handler);
237
unless (defined $passwd) {
238
$key_path = delete $opts{key_path};
239
$passwd = delete $opts{passphrase};
240
if (defined $passwd) {
241
$passphrase = 1;
242
}
243
else {
244
$login_handler = delete $opts{login_handler};
245
}
246
}
247
248
my $ssh_version = delete $opts{ssh_version};
249
my $batch_mode = delete $opts{batch_mode};
250
my $ctl_path = delete $opts{ctl_path};
251
my $ctl_dir = delete $opts{ctl_dir};
252
my $proxy_command = delete $opts{proxy_command};
253
my $gateway = delete $opts{gateway} unless defined $proxy_command;
254
my $ssh_cmd = _first_defined delete $opts{ssh_cmd}, 'ssh';
255
my $rsync_cmd = _first_defined delete $opts{rsync_cmd}, 'rsync';
256
my $scp_cmd = delete $opts{scp_cmd};
257
my $sshfs_cmd = _first_defined delete $opts{sshfs_cmd}, 'sshfs';
258
my $sftp_server_cmd = _first_defined delete $opts{sftp_server_cmd},
259
'/usr/lib/openssh/sftp-server';
260
my $timeout = delete $opts{timeout};
261
my $kill_ssh_on_timeout = delete $opts{kill_ssh_on_timeout};
262
my $strict_mode = _first_defined delete $opts{strict_mode}, 1;
263
my $async = delete $opts{async};
264
my $remote_shell = _first_defined delete $opts{remote_shell}, 'POSIX';
265
my $expand_vars = delete $opts{expand_vars};
266
my $vars = _first_defined delete $opts{vars}, {};
267
my $default_encoding = delete $opts{default_encoding};
268
my $default_stream_encoding =
269
_first_defined delete $opts{default_stream_encoding}, $default_encoding;
270
my $default_argument_encoding =
271
_first_defined delete $opts{default_argument_encoding}, $default_encoding;
272
my $forward_agent = delete $opts{forward_agent};
273
$forward_agent and $passphrase and
274
croak "agent forwarding can not be used when a passphrase has also been given";
275
my $forward_X11 = delete $opts{forward_X11};
276
my $passwd_prompt = delete $opts{password_prompt};
277
$passwd_prompt = delete $opts{passwd_prompt} unless defined $passwd_prompt;
278
279
my ($master_opts, @master_opts,
280
$master_stdout_fh, $master_stderr_fh,
281
$master_stdout_discard, $master_stderr_discard,
282
$master_setpgrp);
283
unless ($external_master) {
284
($master_stdout_fh = delete $opts{master_stdout_fh} or
285
$master_stdout_discard = delete $opts{master_stdout_discard});
286
287
($master_stderr_fh = delete $opts{master_stderr_fh} or
288
$master_stderr_discard = delete $opts{master_stderr_discard});
289
290
$master_opts = delete $opts{master_opts};
291
if (defined $master_opts) {
292
if (ref $master_opts) {
293
@master_opts = @$master_opts;
294
}
295
else {
296
carp "'master_opts' argument looks like if it should be splited first"
297
if $master_opts =~ /^-\w\s+\S/;
298
@master_opts = $master_opts;
299
}
300
}
301
$master_setpgrp = delete $opts{master_setpgrp};
302
303
# when a password/passphrase is given, calling setpgrp is
304
# useless because the process runs attached to a different tty
305
undef $master_setpgrp if $login_handler or defined $passwd;
306
}
307
308
my $default_ssh_opts = delete $opts{default_ssh_opts};
309
carp "'default_ssh_opts' argument looks like if it should be splited first"
310
if defined $default_ssh_opts and not ref $default_ssh_opts and $default_ssh_opts =~ /^-\w\s+\S/;
311
312
my ($default_stdout_fh, $default_stderr_fh, $default_stdin_fh,
313
$default_stdout_file, $default_stderr_file, $default_stdin_file,
314
$default_stdout_discard, $default_stderr_discard, $default_stdin_discard);
315
316
$default_stdout_file = (delete $opts{default_stdout_discard}
317
? '/dev/null'
318
: delete $opts{default_stdout_file});
319
$default_stdout_fh = delete $opts{default_stdout_fh}
320
unless defined $default_stdout_file;
321
322
$default_stderr_file = (delete $opts{default_stderr_discard}
323
? '/dev/null'
324
: delete $opts{default_stderr_file});
325
$default_stderr_fh = delete $opts{default_stderr_fh}
326
unless defined $default_stderr_file;
327
328
$default_stdin_file = (delete $opts{default_stdin_discard}
329
? '/dev/null'
330
: delete $opts{default_stdin_file});
331
$default_stdin_fh = delete $opts{default_stdin_fh}
332
unless defined $default_stdin_file;
333
334
_croak_bad_options %opts;
335
336
my @ssh_opts;
337
# TODO: are those options really requiered or just do they eat on
338
# the command line limited length?
339
push @ssh_opts, -l => $user if defined $user;
340
push @ssh_opts, -p => $port if defined $port;
341
342
my $home = do {
343
local ($@, $SIG{__DIE__});
344
eval { Cwd::realpath((getpwuid $>)[7]) }
345
};
346
347
if (${^TAINT}) {
348
($home) = $home =~ /^(.*)$/;
349
Scalar::Util::tainted($ENV{PATH}) and
350
_tcroak('Insecure $ENV{PATH}');
351
}
352
353
my $self = { _error => 0,
354
_error_prefix => [],
355
_perl_pid => $$,
356
_thread_generation => $thread_generation,
357
_ssh_version => $ssh_version,
358
_ssh_cmd => $ssh_cmd,
359
_scp_cmd => $scp_cmd,
360
_rsync_cmd => $rsync_cmd,
361
_sshfs_cmd => $sshfs_cmd,
362
_sftp_server_cmd => $sftp_server_cmd,
363
_pid => undef,
364
_host => $host,
365
_host_squared => $host_squared,
366
_user => $user,
367
_port => $port,
368
_passwd => $obfuscate->($passwd),
369
_passwd_prompt => $passwd_prompt,
370
_passphrase => $passphrase,
371
_key_path => $key_path,
372
_login_handler => $login_handler,
373
_timeout => $timeout,
374
_proxy_command => $proxy_command,
375
_gateway_args => $gateway,
376
_kill_ssh_on_timeout => $kill_ssh_on_timeout,
377
_batch_mode => $batch_mode,
378
_home => $home,
379
_forward_agent => $forward_agent,
380
_forward_X11 => $forward_X11,
381
_external_master => $external_master,
382
_default_ssh_opts => $default_ssh_opts,
383
_default_stdin_fh => $default_stdin_fh,
384
_default_stdout_fh => $default_stdout_fh,
385
_default_stderr_fh => $default_stderr_fh,
386
_master_stdout_fh => $master_stdout_fh,
387
_master_stderr_fh => $master_stderr_fh,
388
_master_stdout_discard => $master_stdout_discard,
389
_master_stderr_discard => $master_stderr_discard,
390
_master_setpgrp => $master_setpgrp,
391
_remote_shell => $remote_shell,
392
_default_stream_encoding => $default_stream_encoding,
393
_default_argument_encoding => $default_argument_encoding,
394
_expand_vars => $expand_vars,
395
_vars => $vars,
396
};
397
bless $self, $class;
398
399
$self->_detect_ssh_version;
400
401
# default file handles are opened so late in order to have the
402
# $self object to report errors
403
$self->{_default_stdout_fh} = $self->_open_file('>', $default_stdout_file)
404
if defined $default_stdout_file;
405
$self->{_default_stderr_fh} = $self->_open_file('>', $default_stderr_file)
406
if defined $default_stderr_file;
407
$self->{_default_stdin_fh} = $self->_open_file('<', $default_stdin_file)
408
if defined $default_stdin_file;
409
410
if ($self->error == OSSH_SLAVE_PIPE_FAILED) {
411
$self->_set_error(OSSH_MASTER_FAILED,
412
"Unable to create default slave stream: " . $self->error);
413
return $self;
414
}
415
416
$self->{_ssh_opts} = [$self->_expand_vars(@ssh_opts)];
417
$self->{_master_opts} = [$self->_expand_vars(@master_opts)];
418
419
$ctl_path = $self->_expand_vars($ctl_path);
420
$ctl_dir = $self->_expand_vars($ctl_dir);
421
422
unless (defined $ctl_path) {
423
$external_master and croak "external_master is set but ctl_path is not defined";
424
425
unless (defined $ctl_dir) {
426
unless (defined $self->{_home}) {
427
$self->_set_error(OSSH_MASTER_FAILED, "unable to determine home directory for uid $>");
428
return $self;
429
}
430
431
$ctl_dir = File::Spec->catdir($self->{_home}, ".libnet-openssh-perl");
432
}
433
434
my $old_umask = umask 077;
435
mkdir $ctl_dir;
436
umask $old_umask;
437
unless (-d $ctl_dir) {
438
$self->_set_error(OSSH_MASTER_FAILED, "unable to create ctl_dir $ctl_dir");
439
return $self;
440
}
441
442
my $target = join('-', grep defined, $user, $host, $port);
443
444
for (1..10) {
445
$ctl_path = File::Spec->join($ctl_dir, sprintf("%s-%d-%d", substr($target, 0, 20), $$, rand(1e6)));
446
last unless -e $ctl_path
447
}
448
if (-e $ctl_path) {
449
$self->_set_error(OSSH_MASTER_FAILED,
450
"unable to find unused name for ctl_path inside ctl_dir $ctl_dir");
451
return $self;
452
}
453
}
454
$ctl_dir = File::Spec->catpath((File::Spec->splitpath($ctl_path))[0,1], "");
455
$debug and $debug & 2 and _debug "ctl_path: $ctl_path, ctl_dir: $ctl_dir";
456
457
if ($strict_mode and !$self->_is_secure_path($ctl_dir)) {
458
$self->_set_error(OSSH_MASTER_FAILED, "ctl_dir $ctl_dir is not secure");
459
return $self;
460
}
461
462
$self->{_ctl_path} = $ctl_path;
463
464
if ($external_master) {
465
$self->_wait_for_master($async, 1);
466
}
467
else {
468
$self->_connect($async);
469
}
470
$self;
471
}
472
473
sub get_user { shift->{_user} }
474
sub get_host { shift->{_host} }
475
sub get_port { shift->{_port} }
476
sub get_master_pid { shift->{_pid} }
477
sub get_ctl_path { shift->{_ctl_path} }
478
sub get_expand_vars { shift->{_expand_vars} }
479
480
sub set_expand_vars {
481
my $self = shift;
482
$self->{_expand_vars} = (shift(@_) ? 1 : 0);
483
}
484
485
sub set_var {
486
${^TAINT} and &_catch_tainted_args;
487
my $self = shift;
488
my $k = shift;
489
$k =~ /^(?:USER|HOST|PORT)$/
490
and croak "internal variable %$k% can not be set";
491
$self->{_vars}{$k} = shift;
492
}
493
494
sub get_var {
495
my ($self, $k) = @_;
496
my $v = ( $k =~ /^(?:USER|HOST|PORT)$/
497
? $self->{lc "_$k"}
498
: $self->{_vars}{$k} );
499
(defined $v ? $v : '');
500
}
501
502
sub _expand_vars {
503
my ($self, @str) = @_;
504
if (ref $self and $self->{_expand_vars}) {
505
for (@str) {
506
s{%(\w*)%}{length ($1) ? $self->get_var($1) : '%'}ge
507
if defined $_;
508
}
509
}
510
wantarray ? @str : $str[0]
511
}
512
513
sub error { shift->{_error} }
514
515
sub die_on_error {
516
my $ssh = shift;
517
$ssh->{_error} and croak(@_ ? "@_: $ssh->{_error}" : $ssh->{_error});
518
}
519
520
521
sub _is_secure_path {
522
my ($self, $path) = @_;
523
my @parts = File::Spec->splitdir(Cwd::realpath($path));
524
my $home = $self->{_home};
525
for my $last (reverse 0..$#parts) {
526
my $dir = File::Spec->catdir(@parts[0..$last]);
527
unless (-d $dir) {
528
$debug and $debug & 2 and _debug "$dir is not a directory";
529
return undef;
530
}
531
my ($mode, $uid) = (stat $dir)[2, 4];
532
$debug and $debug & 2 and _debug "_is_secure_path(dir: $dir, file mode: $mode, file uid: $uid, euid: $>";
533
return undef unless(($uid == $> or $uid == 0 ) and (($mode & 022) == 0 or ($mode & 01000)));
534
return 1 if (defined $home and $home eq $dir);
535
}
536
return 1;
537
}
538
539
sub _detect_ssh_version {
540
my $self = shift;
541
if (defined $self->{_ssh_version}) {
542
$debug and $debug & 4 and _debug "ssh version given as $self->{_ssh_version}";
543
}
544
else {
545
my (undef, $out, undef, $pid) = $self->open_ex({_cmd => 'raw',
546
_no_master_required => 1,
547
stdout_pipe => 1,
548
stdin_discard => 1,
549
stderr_to_stdout => 1 },
550
$self->{_ssh_cmd}, '-V');
551
my ($txt) = $self->_io3($out, undef, undef, undef, 10, 'bytes');
552
local $self->{_kill_ssh_on_timeout} = 1;
553
$self->_waitpid($pid, 10);
554
if (my ($full, $num) = $txt =~ /^OpenSSH_((\d+\.\d+)\S*)/mi) {
555
$debug and $debug & 4 and _debug "OpenSSH verion is $full";
556
$self->{_ssh_version} = $num;
557
}
558
else {
559
$self->{_ssh_version} = 0;
560
$debug and $debug & 4 and _debug "unable to determine version, '$self->{_ssh_cmd} -V', output:\n$txt"
561
}
562
}
563
}
564
565
sub _make_ssh_call {
566
my $self = shift;
567
my @before = @{shift || []};
568
my @args = ($self->{_ssh_cmd}, @before,
569
-S => $self->{_ctl_path},
570
@{$self->{_ssh_opts}}, $self->{_host},
571
'--',
572
(@_ ? "@_" : ()));
573
$debug and $debug & 8 and _debug_dump 'call args' => \@args;
574
@args;
575
}
576
577
sub _scp_cmd {
578
my $self = shift;
579
$self->{_scp_cmd} ||= do {
580
my $scp = $self->{_ssh_cmd};
581
$scp =~ s/ssh$/scp/i or croak "scp command name not set";
582
$scp;
583
}
584
}
585
586
sub _make_scp_call {
587
my $self = shift;
588
my @before = @{shift || []};
589
my @args = ($self->_scp_cmd, @before,
590
-o => "ControlPath=$self->{_ctl_path}",
591
-S => $self->{_ssh_cmd},
592
(defined $self->{_port} ? (-P => $self->{_port}) : ()),
593
'--', @_);
594
595
$debug and $debug & 8 and _debug_dump 'scp call args' => \@args;
596
@args;
597
}
598
599
sub _rsync_quote {
600
my ($self, @args) = @_;
601
for (@args) {
602
if (/['"\s]/) {
603
s/"/""/g;
604
$_ = qq|"$_"|;
605
}
606
s/%/%%/;
607
}
608
wantarray ? @args : join(' ', @args);
609
}
610
611
sub _make_rsync_call {
612
my $self = shift;
613
my $before = shift;
614
my @transport = ($self->{_ssh_cmd}, @$before,
615
-S => $self->{_ctl_path});
616
my $transport = $self->_rsync_quote(@transport);
617
my @args = ( $self->{_rsync_cmd},
618
-e => $transport,
619
@_);
620
621
$debug and $debug & 8 and _debug_dump 'rsync call args' => \@args;
622
@args;
623
}
624
625
sub _make_tunnel_call {
626
@_ == 4 or croak "bad number of arguments for creating a tunnel";
627
my $self = shift;
628
my @before = @{shift||[]};
629
my $dest = join(':', @_);
630
push @before, "-W$dest";
631
my @args = $self->_make_ssh_call(\@before);
632
$debug and $debug & 8 and _debug_dump 'tunnel call args' => \@args;
633
@args;
634
}
635
636
sub master_exited {
637
my $self = shift;
638
my $pid = delete $self->{_pid};
639
delete $self->{_wfm_state};
640
$self->_set_error(OSSH_MASTER_FAILED, "master ssh connection broken");
641
undef;
642
}
643
644
sub _kill_master {
645
my $self = shift;
646
my $pid = delete $self->{_pid};
647
$debug and $debug & 32 and _debug '_kill_master: ', $pid;
648
if ($pid and $self->{_perl_pid} == $$ and $self->{_thread_generation} == $thread_generation) {
649
local $SIG{CHLD} = sub {};
650
for my $sig (0, 0, 'TERM', 'TERM', 'TERM', 'KILL', 'KILL') {
651
if ($sig) {
652
$debug and $debug & 32 and _debug "killing master with signal $sig";
653
kill $sig, $pid
654
or return;
655
}
656
for (0..5) {
657
my $r = waitpid($pid, WNOHANG);
658
$debug and $debug & 32 and _debug "waitpid(master: $pid) => pid: $r, rc: $!";
659
return if ($r == $pid or $! == Errno::ECHILD);
660
select(undef, undef, undef, 0.2);
661
}
662
}
663
warn "unable to kill SSH master connection (pid: $pid)";
664
}
665
}
666
667
sub _check_is_system_fh {
668
my ($name, $fh) = @_;
669
my $fn = fileno(defined $fh ? $fh : $name);
670
defined $fn and $fn >= 0 and return;
671
croak "child process $name is not a real system file handle";
672
}
673
674
sub _master_redirect {
675
my $self = shift;
676
my $uname = uc shift;
677
my $name = lc $uname;
678
679
no strict 'refs';
680
if ($self->{"_master_${name}_discard"}) {
681
open *$uname, '>>', '/dev/null';
682
}
683
else {
684
my $fh = $self->{"_master_${name}_fh"};
685
$fh = $self->{"_default_${name}_fh"} unless defined $fh;
686
if (defined $fh) {
687
_check_is_system_fh $uname => $fh;
688
if (fileno $fh != fileno *$uname) {
689
open *$uname, '>>&', $fh or POSIX::_exit(255);
690
}
691
}
692
}
693
}
694
695
sub _connect {
696
my ($self, $async) = @_;
697
$self->_set_error;
698
699
my $timeout = int((($self->{_timeout} || 90) + 2)/3);
700
my $ssh_flags= '-2MN';
701
$ssh_flags .= ($self->{_forward_agent} ? 'A' : 'a') if defined $self->{_forward_agent};
702
$ssh_flags .= ($self->{_forward_X11} ? 'X' : 'x');
703
my @master_opts = (@{$self->{_master_opts}},
704
-o => "ServerAliveInterval=$timeout",
705
($self->{_ssh_version} >= 5.6 ? (-o => "ControlPersist=no") : ()),
706
$ssh_flags);
707
708
my ($mpty, $use_pty, $pref_auths);
709
$use_pty = 1 if defined $self->{_login_handler};
710
if (defined $self->{_passwd}) {
711
$use_pty = 1;
712
$pref_auths = ($self->{_passphrase}
713
? 'publickey'
714
: 'keyboard-interactive,password');
715
push @master_opts, -o => 'NumberOfPasswordPrompts=1';
716
}
717
elsif ($self->{_batch_mode}) {
718
push @master_opts, -o => 'BatchMode=yes';
719
}
720
721
if (defined $self->{_key_path}) {
722
$pref_auths = 'publickey';
723
push @master_opts, -i => $self->{_key_path};
724
}
725
726
my $proxy_command = $self->{_proxy_command};
727
728
my $gateway;
729
if (my $gateway_args = $self->{_gateway_args}) {
730
if (ref $gateway_args eq 'HASH') {
731
_load_module('Net::OpenSSH::Gateway');
732
my $errors;
733
unless ($gateway = Net::OpenSSH::Gateway->find_gateway(errors => $errors,
734
host => $self->{_host}, port => $self->{_port},
735
%$gateway_args)) {
736
$self->_set_error(OSSH_MASTER_FAILED, 'Unable to build gateway object', join(', ', @$errors));
737
return undef;
738
}
739
}
740
else {
741
$gateway = $gateway_args
742
}
743
$self->{_gateway} = $gateway;
744
unless ($gateway->before_ssh_connect) {
745
$self->_set_error(OSSH_MASTER_FAILED, 'Gateway setup failed', join(', ', $gateway->errors));
746
return;
747
}
748
$proxy_command = $gateway->proxy_command;
749
}
750
751
if (defined $proxy_command) {
752
push @master_opts, -o => "ProxyCommand=$proxy_command";
753
}
754
755
if ($use_pty) {
756
_load_module('IO::Pty');
757
$self->{_mpty} = $mpty = IO::Pty->new;
758
}
759
760
push @master_opts, -o => "PreferredAuthentications=$pref_auths"
761
if defined $pref_auths;
762
763
my @call = $self->_make_ssh_call(\@master_opts);
764
765
local $SIG{CHLD};
766
my $pid = fork;
767
unless ($pid) {
768
unless (defined $pid) {
769
$self->_set_error(OSSH_MASTER_FAILED, "unable to fork ssh master: $!");
770
return undef;
771
}
772
773
if ($debug and $debug & 512) {
774
require Net::OpenSSH::OSTracer;
775
Net::OpenSSH::OSTracer->trace;
776
}
777
778
$mpty->make_slave_controlling_terminal if $mpty;
779
780
$self->_master_redirect('STDOUT');
781
$self->_master_redirect('STDERR');
782
783
delete $ENV{SSH_ASKPASS} if defined $self->{_passwd};
784
delete $ENV{SSH_AUTH_SOCK} if defined $self->{_passphrase};
785
786
setpgrp if $self->{_master_setpgrp};
787
788
local $SIG{__DIE__};
789
eval { exec @call };
790
POSIX::_exit(255);
791
}
792
$self->{_pid} = $pid;
793
my $r = $self->_wait_for_master($async, 1);
794
$mpty->close_slave if $mpty;
795
$r;
796
}
797
798
sub _waitpid {
799
my ($self, $pid, $timeout) = @_;
800
$? = 0;
801
if ($pid) {
802
$timeout = $self->{_timeout} unless defined $timeout;
803
804
my $time_limit;
805
if (defined $timeout and $self->{_kill_ssh_on_timeout}) {
806
$timeout = 0 if $self->error == OSSH_SLAVE_TIMEOUT;
807
$time_limit = time + $timeout;
808
}
809
local $SIG{CHLD} = sub {};
810
while (1) {
811
my $r;
812
if (defined $time_limit) {
813
while (1) {
814
# TODO: we assume that all OSs return 0 when the
815
# process is still running, that may not be true!
816
$r = waitpid($pid, WNOHANG) and last;
817
my $remaining = $time_limit - time;
818
if ($remaining <= 0) {
819
$debug and $debug & 16 and _debug "killing SSH slave, pid: $pid";
820
kill TERM => $pid;
821
$self->_or_set_error(OSSH_SLAVE_TIMEOUT, "ssh slave failed", "timed out");
822
}
823
# There is a race condition here. We try to
824
# minimize it keeping the waitpid and the select
825
# together and limiting the sleep time to 1s:
826
my $sleep = ($remaining < 0.1 ? 0.1 : 1);
827
$debug and $debug & 16 and
828
_debug "waiting for slave, timeout: $timeout, remaining: $remaining, sleep: $sleep";
829
$r = waitpid($pid, WNOHANG) and last;
830
select(undef, undef, undef, $sleep);
831
}
832
}
833
else {
834
$r = waitpid($pid, 0);
835
}
836
$debug and $debug & 16 and _debug "_waitpid($pid) => pid: $r, rc: $!";
837
if ($r == $pid) {
838
if ($?) {
839
my $signal = ($? & 255);
840
my $errstr = "child exited with code " . ($? >> 8);
841
$errstr .= ", signal $signal" if $signal;
842
$self->_or_set_error(OSSH_SLAVE_CMD_FAILED, $errstr);
843
return undef;
844
}
845
return 1;
846
}
847
if ($r > 0) {
848
warn "internal error: spurious process $r exited";
849
next;
850
}
851
next if $! == Errno::EINTR();
852
if ($! == Errno::ECHILD) {
853
$self->_or_set_error(OSSH_SLAVE_FAILED, "child process $pid does not exist", $!);
854
return undef
855
}
856
warn "Internal error: unexpected error (".($!+0).": $!) from waitpid($pid) = $r. Report it, please!";
857
858
# wait a bit before trying again
859
select(undef, undef, undef, 0.1);
860
}
861
}
862
else {
863
$self->_or_set_error(OSSH_SLAVE_FAILED, "spawning of new process failed");
864
return undef;
865
}
866
}
867
868
sub wait_for_master {
869
my $self = shift;
870
@_ <= 1 or croak 'Usage: $ssh->wait_for_master([$async])';
871
return undef if $self->{_error} == OSSH_MASTER_FAILED;
872
$self->{_error} = 0;
873
return $self->_wait_for_master($_[0]) if $self->{_wfm_state};
874
875
unless (-S $self->{_ctl_path}) {
876
$self->_set_error(OSSH_MASTER_FAILED, "master ssh connection broken");
877
return undef;
878
}
879
1;
880
}
881
882
sub check_master {
883
my $self = shift;
884
@_ and croak 'Usage: $ssh->check_master()';
885
$self->{_error} = 0;
886
$self->_wait_for_master;
887
}
888
889
sub _wait_for_master {
890
my ($self, $async, $reset) = @_;
891
892
my $state = delete $self->{_wfm_state} || 'waiting_for_mux_socket';
893
my $bout = \ ($self->{_wfm_bout});
894
895
my $mpty = $self->{_mpty};
896
my $passwd = $deobfuscate->($self->{_passwd});
897
my $login_handler = $self->{_login_handler};
898
my $pid = $self->{_pid};
899
# an undefined pid indicates we are reusing a master connection
900
901
if ($reset) {
902
$$bout = '';
903
$state = ( (defined $passwd and $pid) ? 'waiting_for_passwd_prompt' :
904
(defined $login_handler) ? 'waiting_for_login_handler' :
905
'waiting_for_mux_socket' );
906
}
907
908
my $ctl_path = $self->{_ctl_path};
909
my $dt = ($async ? 0 : 0.1);
910
my $timeout = $self->{_timeout};
911
my $start_time = time;
912
913
my $fnopty;
914
my $rv = '';
915
if ($state eq 'waiting_for_passwd_prompt') {
916
$fnopty = fileno $mpty;
917
vec($rv, $fnopty, 1) = 1
918
}
919
920
my $old_tcpgrp;
921
if ($pid and $self->{_master_setpgrp} and not $async and not $self->{_batch_mode}) {
922
$old_tcpgrp = POSIX::tcgetpgrp(0);
923
if ($old_tcpgrp > 0) {
924
# let the master process ask for passwords at the TTY
925
POSIX::tcsetpgrp(0, $pid);
926
}
927
else {
928
undef $old_tcpgrp;
929
}
930
}
931
932
# Loop until the mux socket appears or something goes wrong:
933
local $self->{_error_prefix} = [@{$self->{_error_prefix}},
934
"unable to establish master SSH connection"];
935
while (1) {
936
last if (defined $timeout and (time - $start_time) > $timeout);
937
938
if (-e $ctl_path) {
939
$debug and $debug & 4 and _debug "file object found at $ctl_path";
940
unless (-S $ctl_path) {
941
$self->_set_error(OSSH_MASTER_FAILED,
942
"bad ssh master at $ctl_path, object is not a socket");
943
goto kill_master_and_fail;
944
}
945
my $check = $self->_master_ctl('check');
946
if (defined $check) {
947
my $error;
948
if ($check =~ /pid=(\d+)/) {
949
if (!$pid or $1 == $pid) {
950
if ($self->{_master_setpgrp} and $old_tcpgrp) {
951
if ($debug and $debug & 4) {
952
my $pgrp = getpgrp($pid);
953
my $tcpgrp = POSIX::tcgetpgrp(0);
954
$debug and _debug "ssh pid: $pid, pgrp: $pgrp \$\$: $$, tcpgrp: $tcpgrp old_tcppgrp: $old_tcpgrp";
955
}
956
local $SIG{TTOU} = 'IGNORE';
957
POSIX::tcsetpgrp(0, $old_tcpgrp);
958
}
959
return 1;
960
}
961
$error = "bad ssh master at $ctl_path, socket owned by pid $1 (pid $pid expected)";
962
}
963
elsif ($check =~ /illegal option/i) {
964
$error = "OpenSSH 4.1 or later required";
965
}
966
else {
967
$error = "Unknown error";
968
}
969
$self->_or_set_error(OSSH_MASTER_FAILED, $error);
970
}
971
goto kill_master_and_fail;
972
}
973
$debug and $debug & 4 and _debug "file object not yet found at $ctl_path, state: $state";
974
975
if ($self->{_perl_pid} != $$ or $self->{_thread_generation} != $thread_generation) {
976
$self->_set_error(OSSH_MASTER_FAILED,
977
"process was forked or threaded before SSH connection had been established");
978
# just return, the thread creating the mess should clean it all up!
979
return undef;
980
}
981
982
if (!$pid) {
983
# when using an external master the mux socket must be
984
# there from the first time
985
$self->_set_error(OSSH_MASTER_FAILED,
986
"socket does not exist");
987
goto fail;
988
}
989
elsif (waitpid($pid, WNOHANG) == $pid or $! == Errno::ECHILD) {
990
my $error = "master process exited unexpectedly";
991
$error = "bad pass" . ($self->{_passphrase} ? 'phrase' : 'word') . " or $error"
992
if defined $self->{_passwd};
993
$self->_set_error(OSSH_MASTER_FAILED, $error);
994
goto fail; # master has already died
995
}
996
997
if ($state eq 'waiting_for_login_handler') {
998
local ($@, $SIG{__DIE__});
999
if (eval { $login_handler->($self, $mpty, $bout) }) {
1000
$state = 'waiting_for_mux_socket';
1001
next;
1002
}
1003
if ($@) {
1004
$self->_set_error(OSSH_MASTER_FAILED,
1005
"custom login handler failed: $@");
1006
goto kill_master_and_fail;
1007
}
1008
}
1009
else {
1010
my $rv1 = $rv;
1011
my $n = select($rv1, undef, undef, $dt);
1012
if ($n > 0) {
1013
vec($rv1, $fnopty, 1)
1014
or die "internal error";
1015
my $read = sysread($mpty, $$bout, 4096, length $$bout);
1016
if ($read) {
1017
my $passwd_prompt = _first_defined $self->{_passwd_prompt}, qr/[:?]/;
1018
$passwd_prompt = quotemeta $passwd_prompt unless ref $passwd_prompt;
1019
1020
if ($state eq 'waiting_for_passwd_prompt') {
1021
if ($$bout =~ /The authenticity of host.*can't be established/si) {
1022
$self->_set_error(OSSH_MASTER_FAILED,
1023
"the authenticity of the target host can't be established, the remote host "
1024
. "public key is probably not present on the '~/.ssh/known_hosts' file");
1025
goto kill_master_and_fail;
1026
}
1027
1028
if ($$bout =~ /^(.*$passwd_prompt)/s) {
1029
$debug and $debug & 4 and _debug "passwd/passphrase requested ($1)";
1030
print $mpty "$passwd\n";
1031
$$bout = ''; # reset
1032
$state = 'waiting_for_mux_socket';
1033
}
1034
}
1035
elsif (length($passwd_prompt) and $$bout =~ /^(.*$passwd_prompt)\s*$/s) {
1036
$debug and $debug & 4 and _debug "passwd/passphrase requested again ($1)";
1037
$self->_set_error(OSSH_MASTER_FAILED, "password authentication failed");
1038
goto kill_master_and_fail;
1039
}
1040
next;
1041
}
1042
}
1043
}
1044
if ($async) {
1045
$self->{_wfm_state} = $state;
1046
return 0;
1047
}
1048
else {
1049
select(undef, undef, undef, $dt);
1050
}
1051
}
1052
$self->_set_error(OSSH_MASTER_FAILED, "login timeout");
1053
1054
kill_master_and_fail:
1055
$self->_kill_master;
1056
1057
fail:
1058
if ($pid and $self->{_master_setpgrp} and $old_tcpgrp) {
1059
if ($debug and $debug & 4) {
1060
my $pgrp = getpgrp($pid);
1061
my $tcpgrp = POSIX::tcgetpgrp(0);
1062
$debug and _debug "ssh pid: $pid, pgrp: $pgrp \$\$: $$, tcpgrp: $tcpgrp old_tcppgrp: $old_tcpgrp";
1063
}
1064
local $SIG{TTOU} = 'IGNORE';
1065
POSIX::tcsetpgrp(0, $old_tcpgrp);
1066
}
1067
return undef;
1068
}
1069
1070
sub _master_ctl {
1071
my ($self, $cmd) = @_;
1072
local $self->{_error_prefix} = [@{$self->{_error_prefix}},
1073
"control command failed"];
1074
$self->capture({ encoding => 'bytes', # don't let the encoding
1075
# stuff go in the way
1076
stdin_discard => 1, tty => 0,
1077
stderr_to_stdout => 1, ssh_opts => [-O => $cmd]});
1078
}
1079
1080
sub stop {
1081
# FIXME: this method currently fails because of a bug in ssh.
1082
my ($self, $timeout) = @_;
1083
my $pid = $self->{_pid};
1084
$self->_master_ctl('stop');
1085
if (not $self->error and
1086
$pid and
1087
$self->{_perl_pid} == $$ and
1088
$self->{_thread_generation} == $thread_generation) {
1089
1090
local $self->{_kill_ssh_on_timeout};
1091
if ($self->_waitpid($pid, $timeout)) {
1092
delete $self->{_pid};
1093
$self->_set_error(OSSH_MASTER_FAILED, "master ssh connection stopped");
1094
return 1;
1095
}
1096
else {
1097
return $self->_kill_master;
1098
}
1099
}
1100
undef;
1101
}
1102
1103
sub _make_pipe {
1104
my $self = shift;
1105
my ($r, $w);
1106
if (pipe $r, $w) {
1107
my $old = select;
1108
select $r; $ |= 1;
1109
select $w; $ |= 1;
1110
select $old;
1111
return ($r, $w);
1112
}
1113
$self->_set_error(OSSH_SLAVE_PIPE_FAILED, "unable to create pipe: $!");
1114
return;
1115
}
1116
1117
sub _remote_quoter {
1118
my ($self, $remote_shell) = @_;
1119
if (ref $self and not defined $remote_shell) {
1120
return $self->{remote_quoter} ||= Net::OpenSSH::ShellQuoter->quoter($self->{_remote_shell});
1121
}
1122
Net::OpenSSH::ShellQuoter->quoter($remote_shell);
1123
}
1124
1125
sub _quote_args {
1126
my $self = shift;
1127
my $opts = shift;
1128
ref $opts eq 'HASH' or die "internal error";
1129
my $quote = delete $opts->{quote_args};
1130
my $quote_extended = delete $opts->{quote_args_extended};
1131
my $glob_quoting = delete $opts->{glob_quoting};
1132
$quote = (@_ > 1) unless defined $quote;
1133
1134
if ($quote) {
1135
my $remote_shell = delete $opts->{remote_shell};
1136
my $quoter = $self->_remote_quoter($remote_shell);
1137
my $quote_method = ($glob_quoting ? 'quote_glob' : 'quote');
1138
# foo => $quoter
1139
# \foo => $quoter_glob
1140
# \\foo => no quoting at all and disable extended quoting as it is not safe
1141
my @quoted;
1142
for (@_) {
1143
if (ref $_) {
1144
if (ref $_ eq 'SCALAR') {
1145
push @quoted, $quoter->quote_glob($self->_expand_vars($$_));
1146
}
1147
elsif (ref $_ eq 'REF' and ref $$_ eq 'SCALAR') {
1148
push @quoted, $self->_expand_vars($$$_);
1149
undef $quote_extended;
1150
}
1151
else {
1152
croak "invalid reference in remote command argument list"
1153
}
1154
}
1155
else {
1156
push @quoted, $quoter->$quote_method($self->_expand_vars($_));
1157
}
1158
}
1159
1160
if ($quote_extended) {
1161
my @fragments;
1162
if ( $opts->{stdout_discard} and
1163
( $opts->{stderr_discard} or $opts->{stderr_to_stdout} ) ) {
1164
@fragments = ('stdout_and_stderr_discard');
1165
push @fragments, 'stdin_discard' if $opts->{stdin_discard};
1166
}
1167
else {
1168
@fragments = grep $opts->{$_}, qw(stdin_discard stdout_discard
1169
stderr_discard stderr_to_stdout);
1170
}
1171
push @quoted, $quoter->shell_fragments(@fragments);
1172
}
1173
wantarray ? @quoted : join(" ", @quoted);
1174
}
1175
else {
1176
croak "reference found in argument list when argument quoting is disabled"
1177
if (grep ref, @_);
1178
1179
my @args = $self->_expand_vars(@_);
1180
wantarray ? @args : join(" ", @args);
1181
}
1182
}
1183
1184
sub shell_quote {
1185
shift->_quote_args({quote_args => 1}, @_);
1186
}
1187
1188
sub shell_quote_glob {
1189
shift->_quote_args({quote_args => 1, glob_quoting => 1}, @_);
1190
}
1191
1192
sub _array_or_scalar_to_list { map { defined($_) ? (ref $_ eq 'ARRAY' ? @$_ : $_ ) : () } @_ }
1193
1194
sub make_remote_command {
1195
my $self = shift;
1196
$self->wait_for_master or return;
1197
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1198
my @ssh_opts = _array_or_scalar_to_list delete $opts{ssh_opts};
1199
my $tty = delete $opts{tty};
1200
my $ssh_flags = '';
1201
$ssh_flags .= ($tty ? 'qtt' : 'T') if defined $tty;
1202
if ($self->{_forward_agent}) {
1203
my $forward_agent = delete $opts{forward_agent};
1204
$ssh_flags .= ($forward_agent ? 'A' : 'a') if defined $forward_agent;
1205
}
1206
if ($self->{_forward_X11}) {
1207
my $forward_X11 = delete $opts{forward_X11};
1208
$ssh_flags .= ($forward_X11 ? 'X' : 'x');
1209
}
1210
my $tunnel = delete $opts{tunnel};
1211
my (@args);
1212
if ($tunnel) {
1213
@_ == 2 or croak "two arguments are required for tunnel command";
1214
push @ssh_opts, "-W" . join(":", @_);
1215
}
1216
else {
1217
@args = $self->_quote_args(\%opts, @_);
1218
}
1219
_croak_bad_options %opts;
1220
1221
push @ssh_opts, "-$ssh_flags" if length $ssh_flags;
1222
my @call = $self->_make_ssh_call(\@ssh_opts, @args);
1223
if (wantarray) {
1224
$debug and $debug & 16 and _debug_dump make_remote_command => \@call;
1225
return @call;
1226
}
1227
else {
1228
my $call = join ' ', $self->shell_quote(@call);
1229
$debug and $debug & 16 and _debug_dump 'make_remote_command (quoted)' => $call;
1230
return $call
1231
}
1232
}
1233
1234
sub _open_file {
1235
my ($self, $default_mode, $name_or_args) = @_;
1236
my ($mode, @args) = (ref $name_or_args
1237
? @$name_or_args
1238
: ($default_mode, $name_or_args));
1239
@args = $self->_expand_vars(@args);
1240
if (open my $fh, $mode, @args) {
1241
return $fh;
1242
}
1243
else {
1244
$self->_set_error(OSSH_SLAVE_PIPE_FAILED,
1245
"Unable to open file '$args[0]': $!");
1246
return undef;
1247
}
1248
}
1249
1250
sub _fileno_dup_over {
1251
my ($good_fn, $fh) = @_;
1252
if (defined $fh) {
1253
my $fn = fileno $fh;
1254
for (1..5) {
1255
$fn >= $good_fn and return $fn;
1256
$fn = POSIX::dup($fn);
1257
}
1258
POSIX::_exit(255);
1259
}
1260
undef;
1261
}
1262
1263
sub _exec_dpipe {
1264
my ($self, $cmd, $io, $err) = @_;
1265
my $io_fd = _fileno_dup_over(3 => $io);
1266
my $err_fd = _fileno_dup_over(3 => $err);
1267
POSIX::dup2($io_fd, 0);
1268
POSIX::dup2($io_fd, 1);
1269
POSIX::dup2($err_fd, 2) if defined $err_fd;
1270
if (ref $cmd) {
1271
exec @$cmd;
1272
}
1273
else {
1274
exec $cmd;
1275
}
1276
}
1277
1278
sub _delete_stream_encoding {
1279
my ($self, $opts) = @_;
1280
_first_defined(delete $opts->{stream_encoding},
1281
$opts->{encoding},
1282
$self->{_default_stream_encoding});
1283
}
1284
1285
sub _delete_argument_encoding {
1286
my ($self, $opts) = @_;
1287
_first_defined(delete $opts->{argument_encoding},
1288
delete $opts->{encoding},
1289
$self->{_default_argument_encoding});
1290
}
1291
1292
sub open_ex {
1293
${^TAINT} and &_catch_tainted_args;
1294
my $self = shift;
1295
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1296
unless (delete $opts{_no_master_required}) {
1297
$self->wait_for_master or return;
1298
}
1299
1300
my $ssh_flags = '';
1301
my $tunnel = delete $opts{tunnel};
1302
my ($cmd, $close_slave_pty, @args);
1303
if ($tunnel) {
1304
@_ == 2 or croak 'bad number of arguments for tunnel, use $ssh->method(\\%opts, $host, $port)';
1305
@args = @_;
1306
}
1307
else {
1308
my $argument_encoding = $self->_delete_argument_encoding(\%opts);
1309
my $tty = delete $opts{tty};
1310
$ssh_flags .= ($tty ? 'qtt' : 'T') if defined $tty;
1311
1312
$cmd = delete $opts{_cmd} || 'ssh';
1313
$opts{quote_args_extended} = 1
1314
if (not defined $opts{quote_args_extended} and $cmd eq 'ssh');
1315
@args = $self->_quote_args(\%opts, @_);
1316
$self->_encode_args($argument_encoding, @args) or return;
1317
}
1318
1319
my ($stdinout_socket, $stdinout_dpipe_make_parent);
1320
my $stdinout_dpipe = delete $opts{stdinout_dpipe};
1321
if ($stdinout_dpipe) {
1322
$stdinout_dpipe_make_parent = delete $opts{stdinout_dpipe_make_parent};
1323
$stdinout_socket = 1;
1324
}
1325
else {
1326
$stdinout_socket = delete $opts{stdinout_socket};
1327
}
1328
1329
my ($stdin_discard, $stdin_pipe, $stdin_fh, $stdin_file, $stdin_pty,
1330
$stdout_discard, $stdout_pipe, $stdout_fh, $stdout_file, $stdout_pty,
1331
$stderr_discard, $stderr_pipe, $stderr_fh, $stderr_file, $stderr_to_stdout);
1332
unless ($stdinout_socket) {
1333
unless ($stdin_discard = delete $opts{stdin_discard} or
1334
$stdin_pipe = delete $opts{stdin_pipe} or
1335
$stdin_fh = delete $opts{stdin_fh} or
1336
$stdin_file = delete $opts{stdin_file}) {
1337
unless ($tunnel) {
1338
if ($stdin_pty = delete $opts{stdin_pty}) {
1339
$close_slave_pty = _first_defined delete $opts{close_slave_pty}, 1;
1340
}
1341
}
1342
}
1343
1344
( $stdout_discard = delete $opts{stdout_discard} or
1345
$stdout_pipe = delete $opts{stdout_pipe} or
1346
$stdout_fh = delete $opts{stdout_fh} or
1347
$stdout_file = delete $opts{stdout_file} or
1348
(not $tunnel and $stdout_pty = delete $opts{stdout_pty}) );
1349
1350
$stdout_pty and !$stdin_pty
1351
and croak "option stdout_pty requires stdin_pty set";
1352
}
1353
1354
( $stderr_discard = delete $opts{stderr_discard} or
1355
$stderr_pipe = delete $opts{stderr_pipe} or
1356
$stderr_fh = delete $opts{stderr_fh} or
1357
$stderr_to_stdout = delete $opts{stderr_to_stdout} or
1358
$stderr_file = delete $opts{stderr_file} );
1359
1360
my $ssh_opts = delete $opts{ssh_opts};
1361
$ssh_opts = $self->{_default_ssh_opts} unless defined $ssh_opts;
1362
my @ssh_opts = $self->_expand_vars(_array_or_scalar_to_list $ssh_opts);
1363
1364
if ($self->{_forward_agent}) {
1365
my $forward_agent = delete $opts{forward_agent};
1366
$ssh_flags .= ($forward_agent ? 'A' : 'a') if defined $forward_agent;
1367
}
1368
if ($self->{_forward_X11}) {
1369
my $forward_X11 = delete $opts{forward_X11};
1370
$ssh_flags .= ($forward_X11 ? 'X' : 'x');
1371
}
1372
1373
my $setpgrp = delete $opts{setpgrp};
1374
undef $setpgrp if defined $stdin_pty;
1375
1376
_croak_bad_options %opts;
1377
1378
if (defined $stdin_file) {
1379
$stdin_fh = $self->_open_file('<', $stdin_file) or return
1380
}
1381
if (defined $stdout_file) {
1382
$stdout_fh = $self->_open_file('>', $stdout_file) or return
1383
}
1384
if (defined $stderr_file) {
1385
$stderr_fh = $self->_open_file('>', $stderr_file) or return
1386
}
1387
1388
my ($rin, $win, $rout, $wout, $rerr, $werr);
1389
1390
if ($stdinout_socket) {
1391
unless(socketpair $rin, $win, AF_UNIX, SOCK_STREAM, PF_UNSPEC) {
1392
$self->_set_error(OSSH_SLAVE_PIPE_FAILED, "socketpair failed: $!");
1393
return;
1394
}
1395
$wout = $rin;
1396
}
1397
else {
1398
if ($stdin_pipe) {
1399
($rin, $win) = $self->_make_pipe or return;
1400
}
1401
elsif ($stdin_pty) {
1402
_load_module('IO::Pty');
1403
$win = IO::Pty->new;
1404
unless ($win) {
1405
$self->_set_error(OSSH_SLAVE_PIPE_FAILED, "unable to allocate pseudo-tty: $!");
1406
return;
1407
}
1408
$rin = $win->slave;
1409
}
1410
elsif (defined $stdin_fh) {
1411
$rin = $stdin_fh;
1412
}
1413
else {
1414
$rin = $self->{_default_stdin_fh}
1415
}
1416
_check_is_system_fh STDIN => $rin;
1417
1418
if ($stdout_pipe) {
1419
($rout, $wout) = $self->_make_pipe or return;
1420
}
1421
elsif ($stdout_pty) {
1422
$wout = $rin;
1423
}
1424
elsif (defined $stdout_fh) {
1425
$wout = $stdout_fh;
1426
}
1427
else {
1428
$wout = $self->{_default_stdout_fh};
1429
}
1430
_check_is_system_fh STDOUT => $wout;
1431
}
1432
1433
unless ($stderr_to_stdout) {
1434
if ($stderr_pipe) {
1435
($rerr, $werr) = $self->_make_pipe or return;
1436
}
1437
elsif (defined $stderr_fh) {
1438
$werr = $stderr_fh;
1439
}
1440
else {
1441
$werr = $self->{_default_stderr_fh};
1442
}
1443
_check_is_system_fh STDERR => $werr;
1444
}
1445
1446
push @ssh_opts, "-$ssh_flags" if length $ssh_flags;
1447
1448
my @call = ( $tunnel ? $self->_make_tunnel_call(\@ssh_opts, @args) :
1449
$cmd eq 'ssh' ? $self->_make_ssh_call(\@ssh_opts, @args) :
1450
$cmd eq 'scp' ? $self->_make_scp_call(\@ssh_opts, @args) :
1451
$cmd eq 'rsync' ? $self->_make_rsync_call(\@ssh_opts, @args) :
1452
$cmd eq 'raw' ? @args :
1453
die "internal error: bad _cmd protocol" );
1454
1455
$debug and $debug & 16 and _debug_dump open_ex => \@call;
1456
1457
my $pid = fork;
1458
unless ($pid) {
1459
unless (defined $pid) {
1460
$self->_set_error(OSSH_SLAVE_FAILED,
1461
"unable to fork new ssh slave: $!");
1462
return;
1463
}
1464
1465
setpgrp if $setpgrp;
1466
1467
$stdin_discard and (open $rin, '<', '/dev/null' or POSIX::_exit(255));
1468
$stdout_discard and (open $wout, '>', '/dev/null' or POSIX::_exit(255));
1469
$stderr_discard and (open $werr, '>', '/dev/null' or POSIX::_exit(255));
1470
1471
if ($stdinout_dpipe) {
1472
my $pid1 = fork;
1473
defined $pid1 or POSIX::_exit(255);
1474
1475
unless ($pid1 xor $stdinout_dpipe_make_parent) {
1476
eval { $self->_exec_dpipe($stdinout_dpipe, $win, $werr) };
1477
POSIX::_exit(255);
1478
}
1479
}
1480
1481
my $rin_fd = _fileno_dup_over(0 => $rin);
1482
my $wout_fd = _fileno_dup_over(1 => $wout);
1483
my $werr_fd = _fileno_dup_over(2 => $werr);
1484
1485
if (defined $rin_fd) {
1486
$win->make_slave_controlling_terminal if $stdin_pty;
1487
$rin_fd == 0 or POSIX::dup2($rin_fd, 0) or POSIX::_exit(255);
1488
}
1489
if (defined $wout_fd) {
1490
$wout_fd == 1 or POSIX::dup2($wout_fd, 1) or POSIX::_exit(255);
1491
}
1492
if (defined $werr_fd) {
1493
$werr_fd == 2 or POSIX::dup2($werr_fd, 2) or POSIX::_exit(255);
1494
}
1495
elsif ($stderr_to_stdout) {
1496
POSIX::dup2(1, 2) or POSIX::_exit(255);
1497
}
1498
do { exec @call };
1499
POSIX::_exit(255);
1500
}
1501
$win->close_slave() if $close_slave_pty;
1502
undef $win if defined $stdinout_dpipe;
1503
wantarray ? ($win, $rout, $rerr, $pid) : $pid;
1504
}
1505
1506
sub pipe_in {
1507
${^TAINT} and &_catch_tainted_args;
1508
my $self = shift;
1509
$self->wait_for_master or return;
1510
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1511
my $argument_encoding = $self->_delete_argument_encoding(\%opts);
1512
my @args = $self->_quote_args(\%opts, @_);
1513
_croak_bad_options %opts;
1514
1515
$self->_encode_args($argument_encoding, @args) or return;
1516
my @call = $self->_make_ssh_call([], @args);
1517
$debug and $debug & 16 and _debug_dump pipe_in => @call;
1518
my $pid = open my $rin, '|-', @call;
1519
unless ($pid) {
1520
$self->_set_error(OSSH_SLAVE_FAILED,
1521
"unable to fork new ssh slave: $!");
1522
return;
1523
}
1524
wantarray ? ($rin, $pid) : $rin;
1525
}
1526
1527
sub pipe_out {
1528
${^TAINT} and &_catch_tainted_args;
1529
my $self = shift;
1530
$self->wait_for_master or return;
1531
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1532
my $argument_encoding = $self->_delete_argument_encoding(\%opts);
1533
my @args = $self->_quote_args(\%opts, @_);
1534
_croak_bad_options %opts;
1535
1536
$self->_encode_args($argument_encoding, @args) or return;
1537
my @call = $self->_make_ssh_call([], @args);
1538
$debug and $debug & 16 and _debug_dump pipe_out => @call;
1539
my $pid = open my $rout, '-|', @call;
1540
unless ($pid) {
1541
$self->_set_error(OSSH_SLAVE_FAILED,
1542
"unable to fork new ssh slave: $!");
1543
return;
1544
}
1545
wantarray ? ($rout, $pid) : $rout;
1546
}
1547
1548
sub _find_encoding {
1549
my ($self, $encoding, $data) = @_;
1550
if (defined $encoding and $encoding ne 'bytes') {
1551
_load_module('Encode');
1552
my $enc = Encode::find_encoding($encoding);
1553
unless (defined $enc) {
1554
$self->_set_error(OSSH_ENCODING_ERROR, "bad encoding '$encoding'");
1555
return
1556
}
1557
return $enc
1558
}
1559
return undef
1560
}
1561
1562
sub _encode {
1563
my $self = shift;
1564
my $enc = shift;
1565
if (defined $enc and @_) {
1566
local ($@, $SIG{__DIE__});
1567
eval {
1568
for (@_) {
1569
defined or next;
1570
$_ = $enc->encode($_, Encode::FB_CROAK());
1571
}
1572
};
1573
$self->_check_eval_ok(OSSH_ENCODING_ERROR) or return undef;
1574
}
1575
1;
1576
}
1577
1578
sub _encode_args {
1579
if (@_ > 2) {
1580
my $self = shift;
1581
my $encoding = shift;
1582
1583
my $enc = $self->_find_encoding($encoding);
1584
if ($enc) {
1585
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, "argument encoding failed"];
1586
$self->_encode($enc, @_);
1587
}
1588
return !$self->error;
1589
}
1590
1;
1591
}
1592
1593
sub _decode {
1594
my $self = shift;
1595
my $enc = shift;
1596
local ($@, $SIG{__DIE__});
1597
eval {
1598
for (@_) {
1599
defined or next;
1600
$_ = $enc->decode($_, Encode::FB_CROAK());
1601
}
1602
};
1603
$self->_check_eval_ok(OSSH_ENCODING_ERROR);
1604
}
1605
1606
my @retriable = (Errno::EINTR, Errno::EAGAIN);
1607
push @retriable, Errno::EWOULDBLOCK if Errno::EWOULDBLOCK != Errno::EAGAIN;
1608
1609
sub _io3 {
1610
my ($self, $out, $err, $in, $stdin_data, $timeout, $encoding) = @_;
1611
# $self->wait_for_master or return;
1612
my @data = _array_or_scalar_to_list $stdin_data;
1613
my ($cout, $cerr, $cin) = (defined($out), defined($err), defined($in));
1614
$timeout = $self->{_timeout} unless defined $timeout;
1615
1616
my $has_input = grep { defined and length } @data;
1617
if ($cin and !$has_input) {
1618
close $in;
1619
undef $cin;
1620
}
1621
elsif (!$cin and $has_input) {
1622
croak "remote input channel is not defined but data is available for sending"
1623
}
1624
1625
my $enc = $self->_find_encoding($encoding);
1626
if ($enc and @data) {
1627
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, "stdin data encoding failed"];
1628
$self->_encode($enc, @data) if $has_input;
1629
return if $self->error;
1630
}
1631
1632
my $bout = '';
1633
my $berr = '';
1634
my ($fnoout, $fnoerr, $fnoin);
1635
local $SIG{PIPE} = 'IGNORE';
1636
1637
MLOOP: while ($cout or $cerr or $cin) {
1638
$debug and $debug & 64 and _debug "io3 mloop, cin: " . ($cin || 0) .
1639
", cout: " . ($cout || 0) . ", cerr: " . ($cerr || 0);
1640
my ($rv, $wv);
1641
1642
if ($cout or $cerr) {
1643
$rv = '';
1644
if ($cout) {
1645
$fnoout = fileno $out;
1646
vec($rv, $fnoout, 1) = 1;
1647
}
1648
if ($cerr) {
1649
$fnoerr = fileno $err;
1650
vec($rv, $fnoerr, 1) = 1
1651
}
1652
}
1653
1654
if ($cin) {
1655
$fnoin = fileno $in;
1656
$wv = '';
1657
vec($wv, $fnoin, 1) = 1;
1658
}
1659
1660
my $recalc_vecs;
1661
FAST: until ($recalc_vecs) {
1662
$debug and $debug & 64 and
1663
_debug "io3 fast, cin: " . ($cin || 0) .
1664
", cout: " . ($cout || 0) . ", cerr: " . ($cerr || 0);
1665
my ($rv1, $wv1) = ($rv, $wv);
1666
my $n = select ($rv1, $wv1, undef, $timeout);
1667
if ($n > 0) {
1668
if ($cout and vec($rv1, $fnoout, 1)) {
1669
my $offset = length $bout;
1670
my $read = sysread($out, $bout, 20480, $offset);
1671
if ($debug and $debug & 64) {
1672
_debug "stdout, bytes read: ", $read, " at offset $offset";
1673
$read and $debug & 128 and _hexdump substr $bout, $offset;
1674
}
1675
unless ($read or grep $! == $_, @retriable) {
1676
close $out;
1677
undef $cout;
1678
$recalc_vecs = 1;
1679
}
1680
}
1681
if ($cerr and vec($rv1, $fnoerr, 1)) {
1682
my $read = sysread($err, $berr, 20480, length($berr));
1683
$debug and $debug & 64 and _debug "stderr, bytes read: ", $read;
1684
unless ($read or grep $! == $_, @retriable) {
1685
close $err;
1686
undef $cerr;
1687
$recalc_vecs = 1;
1688
}
1689
}
1690
if ($cin and vec($wv1, $fnoin, 1)) {
1691
my $written = syswrite($in, $data[0], 20480);
1692
if ($debug and $debug & 64) {
1693
_debug "stdin, bytes written: ", $written;
1694
$written and $debug & 128 and _hexdump substr $data[0], 0, $written;
1695
}
1696
if ($written) {
1697
substr($data[0], 0, $written, '');
1698
while (@data) {
1699
next FAST
1700
if (defined $data[0] and length $data[0]);
1701
shift @data;
1702
}
1703
# fallback when stdin queue is exhausted
1704
}
1705
elsif (grep $! == $_, @retriable) {
1706
next FAST;
1707
}
1708
close $in;
1709
undef $cin;
1710
$recalc_vecs = 1;
1711
}
1712
}
1713
else {
1714
next if $n < 0 and grep $! == $_, @retriable;
1715
$self->_set_error(OSSH_SLAVE_TIMEOUT, 'ssh slave failed', 'timed out');
1716
last MLOOP;
1717
}
1718
}
1719
}
1720
close $out if $cout;
1721
close $err if $cerr;
1722
close $in if $cin;
1723
1724
if ($enc) {
1725
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, 'output decoding failed'];
1726
unless ($self->_decode($enc, $bout, $berr)) {
1727
undef $bout;
1728
undef $berr;
1729
}
1730
}
1731
$debug and $debug & 64 and _debug "leaving _io3()";
1732
return ($bout, $berr);
1733
}
1734
1735
1736
1737
_sub_options spawn => qw(stderr_to_stdout stdin_discard stdin_fh stdin_file stdout_discard
1738
stdout_fh stdout_file stderr_discard stderr_fh stderr_file
1739
stdinout_dpipe stdinout_dpipe_make_parent quote_args quote_args_extended remote_shell glob_quoting
1740
tty ssh_opts tunnel encoding argument_encoding forward_agent forward_X11 setpgrp);
1741
sub spawn {
1742
${^TAINT} and &_catch_tainted_args;
1743
my $self = shift;
1744
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1745
_croak_bad_options %opts;
1746
1747
return scalar $self->open_ex(\%opts, @_);
1748
}
1749
1750
_sub_options open2 => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file quote_args quote_args_extended
1751
remote_shell glob_quoting tty ssh_opts tunnel encoding argument_encoding forward_agent
1752
forward_X11 setpgrp);
1753
sub open2 {
1754
${^TAINT} and &_catch_tainted_args;
1755
my $self = shift;
1756
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1757
_croak_bad_options %opts;
1758
_croak_scalar_context;
1759
1760
my ($in, $out, undef, $pid) =
1761
$self->open_ex({ stdout_pipe => 1,
1762
stdin_pipe => 1,
1763
%opts }, @_) or return ();
1764
return ($in, $out, $pid);
1765
}
1766
1767
_sub_options open2pty => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file
1768
quote_args quote_args_extended remote_shell glob_quoting tty
1769
close_slave_pty ssh_opts encoding argument_encoding forward_agent
1770
forward_X11 setpgrp);
1771
sub open2pty {
1772
${^TAINT} and &_catch_tainted_args;
1773
my $self = shift;
1774
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1775
_croak_bad_options %opts;
1776
1777
my ($pty, undef, undef, $pid) =
1778
$self->open_ex({ stdout_pty => 1,
1779
stdin_pty => 1,
1780
tty => 1,
1781
%opts }, @_) or return ();
1782
wantarray ? ($pty, $pid) : $pty;
1783
}
1784
1785
_sub_options open2socket => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file
1786
quote_args quote_args_extended remote_shell glob_quoting tty
1787
ssh_opts tunnel encoding argument_encoding forward_agent
1788
forward_X11 setpgrp);
1789
sub open2socket {
1790
${^TAINT} and &_catch_tainted_args;
1791
my $self = shift;
1792
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1793
_croak_bad_options %opts;
1794
1795
my ($socket, undef, undef, $pid) =
1796
$self->open_ex({ stdinout_socket => 1,
1797
%opts }, @_) or return ();
1798
wantarray ? ($socket, $pid) : $socket;
1799
}
1800
1801
_sub_options open3 => qw(quote_args quote_args_extended remote_shell glob_quoting tty ssh_opts
1802
encoding argument_encoding forward_agent forward_X11 setpgrp);
1803
sub open3 {
1804
${^TAINT} and &_catch_tainted_args;
1805
my $self = shift;
1806
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1807
_croak_bad_options %opts;
1808
_croak_scalar_context;
1809
1810
my ($in, $out, $err, $pid) =
1811
$self->open_ex({ stdout_pipe => 1,
1812
stdin_pipe => 1,
1813
stderr_pipe => 1,
1814
%opts },
1815
@_) or return ();
1816
return ($in, $out, $err, $pid);
1817
}
1818
1819
_sub_options open3pty => qw(quote_args quote_args_extended remote_shell glob_quoting tty close_slave_pty ssh_opts
1820
encoding argument_encoding forward_agent forward_X11 setpgrp);
1821
sub open3pty {
1822
${^TAINT} and &_catch_tainted_args;
1823
my $self = shift;
1824
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1825
_croak_bad_options %opts;
1826
_croak_scalar_context;
1827
1828
my ($pty, undef, $err, $pid) =
1829
$self->open_ex({ stdout_pty => 1,
1830
stdin_pty => 1,
1831
tty => 1,
1832
stderr_pipe => 1,
1833
%opts },
1834
@_) or return ();
1835
return ($pty, $err, $pid);
1836
}
1837
1838
_sub_options open3socket => qw(quote_args quote_args_extended remote_shell glob_quoting tty ssh_opts encoding
1839
argument_encoding forward_agent
1840
forward_X11 setpgrp);
1841
sub open3socket {
1842
${^TAINT} and &_catch_tainted_args;
1843
my $self = shift;
1844
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1845
_croak_bad_options %opts;
1846
_croak_scalar_context;
1847
1848
my ($socket, undef, $err, $pid) =
1849
$self->open_ex({ stdinout_socket => 1,
1850
stderr_pipe => 1,
1851
%opts }, @_) or return ();
1852
return ($socket, $err, $pid);
1853
}
1854
1855
_sub_options system => qw(stdout_discard stdout_fh stdin_discard stdout_file stdin_fh stdin_file
1856
quote_args quote_args_extended remote_shell glob_quoting
1857
stderr_to_stdout stderr_discard stderr_fh stderr_file
1858
stdinout_dpipe stdinout_dpipe_make_parent tty ssh_opts tunnel encoding
1859
argument_encoding forward_agent forward_X11 setpgrp);
1860
sub system {
1861
${^TAINT} and &_catch_tainted_args;
1862
my $self = shift;
1863
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1864
my $stdin_data = delete $opts{stdin_data};
1865
my $timeout = delete $opts{timeout};
1866
my $async = delete $opts{async};
1867
_croak_bad_options %opts;
1868
1869
local $SIG{INT} = 'IGNORE';
1870
local $SIG{QUIT} = 'IGNORE';
1871
local $SIG{CHLD};
1872
1873
my $stream_encoding;
1874
if (defined $stdin_data) {
1875
$opts{stdin_pipe} = 1;
1876
$stream_encoding = $self->_delete_stream_encoding(\%opts);
1877
}
1878
my ($in, undef, undef, $pid) = $self->open_ex(\%opts, @_) or return undef;
1879
1880
$self->_io3(undef, undef, $in, $stdin_data, $timeout, $stream_encoding) if defined $stdin_data;
1881
return $pid if $async;
1882
$self->_waitpid($pid, $timeout);
1883
}
1884
1885
_sub_options test => qw(stdout_discard stdout_fh stdin_discard stdout_file stdin_fh stdin_file
1886
quote_args quote_args_extended remote_shell glob_quoting
1887
stderr_to_stdout stderr_discard stderr_fh stderr_file
1888
stdinout_dpipe stdinout_dpipe_make_parent tty ssh_opts timeout stdin_data
1889
encoding stream_encoding argument_encoding forward_agent forward_X11 setpgrp);
1890
sub test {
1891
${^TAINT} and &_catch_tainted_args;
1892
my $self = shift;
1893
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1894
$opts{stdout_discard} = 1 unless grep defined($opts{$_}), qw(stdout_discard stdout_fh
1895
stdout_file stdinout_dpipe);
1896
$opts{stderr_discard} = 1 unless grep defined($opts{$_}), qw(stderr_discard stderr_fh
1897
stderr_file stderr_to_stdout);
1898
_croak_bad_options %opts;
1899
1900
$self->system(\%opts, @_);
1901
my $error = $self->error;
1902
unless ($error) {
1903
return 1;
1904
}
1905
if ($error == OSSH_SLAVE_CMD_FAILED) {
1906
$self->_set_error(0);
1907
return 0;
1908
}
1909
return undef;
1910
}
1911
1912
_sub_options capture => qw(stderr_to_stdout stderr_discard stderr_fh stderr_file
1913
stdin_discard stdin_fh stdin_file quote_args quote_args_extended
1914
remote_shell glob_quoting tty ssh_opts tunnel
1915
encoding argument_encoding forward_agent forward_X11 setpgrp);
1916
sub capture {
1917
${^TAINT} and &_catch_tainted_args;
1918
my $self = shift;
1919
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1920
my $stdin_data = delete $opts{stdin_data};
1921
my $timeout = delete $opts{timeout};
1922
_croak_bad_options %opts;
1923
1924
my $stream_encoding = $self->_delete_stream_encoding(\%opts);
1925
$opts{stdout_pipe} = 1;
1926
$opts{stdin_pipe} = 1 if defined $stdin_data;
1927
1928
local $SIG{INT} = 'IGNORE';
1929
local $SIG{QUIT} = 'IGNORE';
1930
local $SIG{CHLD};
1931
1932
my ($in, $out, undef, $pid) = $self->open_ex(\%opts, @_) or return ();
1933
my ($output) = $self->_io3($out, undef, $in, $stdin_data, $timeout, $stream_encoding);
1934
$self->_waitpid($pid, $timeout);
1935
if (wantarray) {
1936
my $pattern = quotemeta $/;
1937
return split /(?<=$pattern)/, $output;
1938
}
1939
$output
1940
}
1941
1942
_sub_options capture2 => qw(stdin_discard stdin_fh stdin_file
1943
quote_args quote_args_extended remote_shell glob_quoting
1944
tty ssh_opts encoding stream_encoding
1945
argument_encoding forward_agent forward_X11 setpgrp);
1946
sub capture2 {
1947
${^TAINT} and &_catch_tainted_args;
1948
my $self = shift;
1949
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1950
my $stdin_data = delete $opts{stdin_data};
1951
my $timeout = delete $opts{timeout};
1952
_croak_bad_options %opts;
1953
1954
my $stream_encoding = $self->_delete_stream_encoding(\%opts);
1955
$opts{stdout_pipe} = 1;
1956
$opts{stderr_pipe} = 1;
1957
$opts{stdin_pipe} = 1 if defined $stdin_data;
1958
1959
local $SIG{INT} = 'IGNORE';
1960
local $SIG{QUIT} = 'IGNORE';
1961
local $SIG{CHLD};
1962
1963
my ($in, $out, $err, $pid) = $self->open_ex( \%opts, @_) or return ();
1964
my @capture = $self->_io3($out, $err, $in, $stdin_data, $timeout, $stream_encoding);
1965
$self->_waitpid($pid, $timeout);
1966
wantarray ? @capture : $capture[0];
1967
}
1968
1969
_sub_options open_tunnel => qw(ssh_opts stderr_discard stderr_fh stderr_file
1970
encoding argument_encoding forward_agent setpgrp);
1971
sub open_tunnel {
1972
${^TAINT} and &_catch_tainted_args;
1973
my $self = shift;
1974
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1975
$opts{stderr_discard} = 1 unless grep defined $opts{$_}, qw(stderr_discard stderr_fh stderr_file);
1976
_croak_bad_options %opts;
1977
@_ == 2 or croak 'Usage: $ssh->open_tunnel(\%opts, $host, $port)';
1978
$opts{tunnel} = 1;
1979
$self->open2socket(\%opts, @_);
1980
}
1981
1982
_sub_options capture_tunnel => qw(ssh_opts stderr_discard stderr_fh stderr_file stdin_discard
1983
stdin_fh stdin_file stdin_data timeout encoding stream_encoding
1984
argument_encoding forward_agent setpgrp);
1985
sub capture_tunnel {
1986
${^TAINT} and &_catch_tainted_args;
1987
my $self = shift;
1988
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
1989
$opts{stderr_discard} = 1 unless grep defined $opts{$_}, qw(stderr_discard stderr_fh stderr_file);
1990
_croak_bad_options %opts;
1991
@_ == 2 or croak 'Usage: $ssh->capture_tunnel(\%opts, $host, $port)';
1992
$opts{tunnel} = 1;
1993
$self->capture(\%opts, @_);
1994
}
1995
1996
sub _calling_method {
1997
my $method = (caller 2)[3];
1998
$method =~ s/.*:://;
1999
$method;
2000
}
2001
2002
sub _scp_get_args {
2003
my $self = shift;
2004
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
2005
2006
@_ > 0 or croak
2007
'Usage: $ssh->' . _calling_method . '(\%opts, $remote_fn1, $remote_fn2, ..., $local_fn_or_dir)';
2008
2009
my $glob = delete $opts{glob};
2010
2011
my $target = (@_ > 1 ? pop @_ : '.');
2012
$target =~ m|^[^/]*:| and $target = "./$target";
2013
2014
my $prefix = $self->{_host_squared};
2015
$prefix = "$self->{_user}\@$prefix" if defined $self->{_user};
2016
2017
my $src = "$prefix:". join(" ", $self->_quote_args({quote_args => 1,
2018
glob_quoting => $glob},
2019
@_));
2020
($self, \%opts, $target, $src);
2021
}
2022
2023
sub scp_get {
2024
${^TAINT} and &_catch_tainted_args;
2025
my ($self, $opts, $target, @src) = _scp_get_args @_;
2026
$self->_scp($opts, @src, $target);
2027
}
2028
2029
sub rsync_get {
2030
${^TAINT} and &_catch_tainted_args;
2031
my ($self, $opts, $target, @src) = _scp_get_args @_;
2032
$self->_rsync($opts, @src, $target);
2033
}
2034
2035
sub _scp_put_args {
2036
my $self = shift;
2037
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
2038
2039
@_ > 0 or croak
2040
'Usage: $ssh->' . _calling_method . '(\%opts, $local_fn1, $local_fn2, ..., $remote_dir_or_fn)';
2041
2042
my $glob = delete $opts{glob};
2043
my $glob_flags = ($glob ? delete $opts{glob_flags} || 0 : undef);
2044
2045
my $prefix = $self->{_host_squared};
2046
$prefix = "$self->{_user}\@$prefix" if defined $self->{_user};
2047
2048
my $remote_shell = delete $opts{remote_shell};
2049
my $target = $prefix . ':' . ( @_ > 1
2050
? $self->_quote_args({quote_args => 1, remote_shell => $remote_shell}, pop(@_))
2051
: '');
2052
2053
my @src = @_;
2054
if ($glob) {
2055
require File::Glob;
2056
@src = map File::Glob::bsd_glob($_, $glob_flags), @src;
2057
unless (@src) {
2058
$self->_set_error(OSSH_SLAVE_FAILED,
2059
"given file name patterns did not match any file");
2060
return undef;
2061
}
2062
}
2063
$_ = "./$_" for grep m|^[^/]*:|, @src;
2064
2065
($self, \%opts, $target, @src);
2066
}
2067
2068
sub scp_put {
2069
${^TAINT} and &_catch_tainted_args;
2070
my ($self, $opts, $target, @src) = _scp_put_args @_;
2071
return unless $self;
2072
$self->_scp($opts, @src, $target);
2073
}
2074
2075
sub rsync_put {
2076
${^TAINT} and &_catch_tainted_args;
2077
my ($self, $opts, $target, @src) = _scp_put_args @_;
2078
return unless $self;
2079
$self->_rsync($opts, @src, $target);
2080
}
2081
2082
_sub_options _scp => qw(stderr_to_stdout stderr_discard stderr_fh
2083
stderr_file stdout_discard stdout_fh
2084
stdout_file encoding argument_encoding
2085
forward_agent setpgrp);
2086
sub _scp {
2087
my $self = shift;
2088
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
2089
my $quiet = delete $opts{quiet};
2090
$quiet = 1 unless defined $quiet;
2091
my $recursive = delete $opts{recursive};
2092
my $copy_attrs = delete $opts{copy_attrs};
2093
my $bwlimit = delete $opts{bwlimit};
2094
my $async = delete $opts{async};
2095
my $ssh_opts = delete $opts{ssh_opts};
2096
my $timeout = delete $opts{timeout};
2097
my $verbose = delete $opts{verbose};
2098
_croak_bad_options %opts;
2099
2100
my @opts;
2101
@opts = @$ssh_opts if $ssh_opts;
2102
push @opts, '-q' if $quiet;
2103
push @opts, '-v' if $verbose;
2104
push @opts, '-r' if $recursive;
2105
push @opts, '-p' if $copy_attrs;
2106
push @opts, '-l', $bwlimit if $bwlimit;
2107
2108
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, 'scp failed'];
2109
2110
my $pid = $self->open_ex({ %opts,
2111
_cmd => 'scp',
2112
ssh_opts => \@opts,
2113
quote_args => 0 },
2114
@_);
2115
2116
return $pid if $async;
2117
$self->_waitpid($pid, $timeout);
2118
}
2119
2120
my %rsync_opt_with_arg = map { $_ => 1 } qw(chmod suffix backup-dir rsync-path max-delete max-size min-size partial-dir
2121
timeout modify-window temp-dir compare-dest copy-dest link-dest compress-level
2122
skip-compress filter exclude exclude-from include include-from
2123
out-format log-file log-file-format bwlimit protocol iconv checksum-seed);
2124
2125
my %rsync_opt_forbiden = map { $_ => 1 } qw(rsh address port sockopts blocking-io password-file write-batch
2126
only-write-batch read-batch ipv4 ipv6 version help daemon config detach
2127
files-from from0 blocking-io protect-args list-only);
2128
2129
$rsync_opt_forbiden{"no-$_"} = 1 for (keys %rsync_opt_with_arg, keys %rsync_opt_forbiden);
2130
2131
my %rsync_error = (1, 'syntax or usage error',
2132
2, 'protocol incompatibility',
2133
3, 'errors selecting input/output files, dirs',
2134
4, 'requested action not supported: an attempt was made to manipulate 64-bit files on a platform '.
2135
'that cannot support them; or an option was specified that is supported by the client and not '.
2136
'by the server.',
2137
5, 'error starting client-server protocol',
2138
6, 'daemon unable to append to log-file',
2139
10, 'error in socket I/O',
2140
11, 'error in file I/O',
2141
12, 'error in rsync protocol data stream',
2142
13, 'errors with program diagnostics',
2143
14, 'error in IPC code',
2144
20, 'received SIGUSR1 or SIGINT',
2145
21, 'some error returned by waitpid()',
2146
22, 'error allocating core memory buffers',
2147
23, 'partial transfer due to error',
2148
24, 'partial transfer due to vanished source files',
2149
25, 'the --max-delete limit stopped deletions',
2150
30, 'timeout in data send/receive',
2151
35, 'timeout waiting for daemon connection');
2152
2153
my %rsync_opt_open_ex = map { $_ => 1 } qw(stderr_to_stdout
2154
stderr_discard stderr_fh
2155
stderr_file stdout_discard
2156
stdout_fh stdout_file encoding
2157
argument_encoding);
2158
sub _rsync {
2159
my $self = shift;
2160
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
2161
my $async = delete $opts{async};
2162
my $verbose = delete $opts{verbose};
2163
my $quiet = delete $opts{quiet};
2164
my $copy_attrs = delete $opts{copy_attrs};
2165
my $timeout = delete $opts{timeout};
2166
$quiet = 1 unless (defined $quiet or $verbose);
2167
2168
my @opts = qw(--blocking-io) ;
2169
push @opts, '-q' if $quiet;
2170
push @opts, '-pt' if $copy_attrs;
2171
push @opts, '-' . ($verbose =~ /^\d+$/ ? 'v' x $verbose : 'v') if $verbose;
2172
2173
my %opts_open_ex = ( _cmd => 'rsync',
2174
quote_args => 0 );
2175
2176
for my $opt (keys %opts) {
2177
my $value = $opts{$opt};
2178
if (defined $value) {
2179
if ($rsync_opt_open_ex{$opt}) {
2180
$opts_open_ex{$opt} = $value;
2181
}
2182
else {
2183
my $opt1 = $opt;
2184
$opt1 =~ tr/_/-/;
2185
$rsync_opt_forbiden{$opt1} and croak "forbiden rsync option '$opt' used";
2186
if ($rsync_opt_with_arg{$opt1}) {
2187
push @opts, "--$opt1=$_" for _array_or_scalar_to_list($value)
2188
}
2189
else {
2190
$value = !$value if $opt1 =~ s/^no-//;
2191
push @opts, ($value ? "--$opt1" : "--no-$opt1");
2192
}
2193
}
2194
}
2195
}
2196
2197
local $self->{_error_prefix} = [@{$self->{_error_prefix}}, 'rsync failed'];
2198
2199
my $pid = $self->open_ex(\%opts_open_ex, @opts, '--', @_);
2200
return $pid if $async;
2201
$self->_waitpid($pid, $timeout) and return 1;
2202
2203
if ($self->error == OSSH_SLAVE_CMD_FAILED and $?) {
2204
my $err = ($? >> 8);
2205
my $errstr = $rsync_error{$err};
2206
$errstr = 'Unknown rsync error' unless defined $errstr;
2207
my $signal = $? & 255;
2208
my $signalstr = ($signal ? " (signal $signal)" : '');
2209
$self->_set_error(OSSH_SLAVE_CMD_FAILED,
2210
"command exited with code $err$signalstr: $errstr");
2211
}
2212
return undef
2213
}
2214
2215
_sub_options sftp => qw(autoflush timeout argument_encoding encoding block_size
2216
queue_size late_set_perm forward_agent setpgrp);
2217
2218
sub sftp {
2219
${^TAINT} and &_catch_tainted_args;
2220
@_ & 1 or croak 'Usage: $ssh->sftp(%sftp_opts)';
2221
_load_module('Net::SFTP::Foreign', '1.47');
2222
my ($self, %opts) = @_;
2223
my $stderr_fh = delete $opts{stderr_fh};
2224
my $stderr_discard = delete $opts{stderr_discard};
2225
my $fs_encoding = _first_defined(delete $opts{fs_encoding},
2226
$opts{argument_encoding},
2227
$opts{encoding},
2228
$self->{_default_argument_encoding});
2229
undef $fs_encoding if (defined $fs_encoding and $fs_encoding eq 'bytes');
2230
_croak_bad_options %opts;
2231
$opts{timeout} = $self->{_timeout} unless defined $opts{timeout};
2232
$self->wait_for_master or return undef;
2233
my ($in, $out, $pid) = $self->open2( { ssh_opts => '-s',
2234
stderr_fh => $stderr_fh,
2235
stderr_discard => $stderr_discard },
2236
'sftp' )
2237
or return undef;
2238
2239
my $sftp = Net::SFTP::Foreign->new(transport => [$out, $in, $pid],
2240
dirty_cleanup => 0,
2241
fs_encoding => $fs_encoding,
2242
%opts);
2243
if ($sftp->error) {
2244
$self->_or_set_error(OSSH_SLAVE_SFTP_FAILED, "unable to create SFTP client", $sftp->error);
2245
return undef;
2246
}
2247
$sftp
2248
}
2249
2250
_sub_options sshfs_import => qw(stderr_discard stderr_fh stderr_file
2251
ssh_opts argument_encoding sshfs_opts setpgrp);
2252
sub sshfs_import {
2253
${^TAINT} and &_catch_tainted_args;
2254
my $self = shift;
2255
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
2256
@_ == 2 or croak 'Usage: $ssh->sshfs_import(\%opts, $remote, $local)';
2257
my ($from, $to) = @_;
2258
my @sshfs_opts = ( -o => 'slave',
2259
_array_or_scalar_to_list delete $opts{sshfs_opts} );
2260
_croak_bad_options %opts;
2261
2262
$opts{ssh_opts} = ['-s', _array_or_scalar_to_list delete $opts{ssh_opts}];
2263
$opts{stdinout_dpipe} = [$self->{_sshfs_cmd}, "$self->{_host_squared}:$from", $to, @sshfs_opts];
2264
$opts{stdinout_dpipe_make_parent} = 1;
2265
$self->spawn(\%opts, 'sftp');
2266
}
2267
2268
_sub_options sshfs_export => qw(stderr_discard stderr_fh stderr_file
2269
ssh_opts argument_encoding sshfs_opts setpgrp);
2270
sub sshfs_export {
2271
${^TAINT} and &_catch_tainted_args;
2272
my $self = shift;
2273
my %opts = (ref $_[0] eq 'HASH' ? %{shift()} : ());
2274
@_ == 2 or croak 'Usage: $ssh->sshfs_export(\%opts, $local, $remote)';
2275
my ($from, $to) = @_;
2276
my @sshfs_opts = ( -o => 'slave',
2277
_array_or_scalar_to_list delete $opts{sshfs_opts} );
2278
_croak_bad_options %opts;
2279
$opts{stdinout_dpipe} = $self->{_sftp_server_cmd};
2280
2281
my $hostname = do {
2282
local ($@, $SIG{__DIE__});
2283
eval {
2284
require Sys::Hostname;
2285
Sys::Hostname::hostname();
2286
};
2287
};
2288
$hostname = 'remote' if (not defined $hostname or
2289
not length $hostname or
2290
$hostname=~/^localhost\b/);
2291
$self->spawn(\%opts, $self->{_sshfs_cmd}, "$hostname:$from", $to, @sshfs_opts);
2292
}
2293
2294
sub DESTROY {
2295
my $self = shift;
2296
my $pid = $self->{_pid};
2297
local ($@, $SIG{__DIE__});
2298
$debug and $debug & 2 and _debug("DESTROY($self, pid: ", $pid, ")");
2299
if ($pid and $self->{_perl_pid} == $$ and $self->{_thread_generation} == $thread_generation) {
2300
$debug and $debug & 32 and _debug("killing master");
2301
local ($?, $!);
2302
unless ($self->{_wfm_state}) {
2303
# we have successfully created the master connection so we
2304
# can send control commands:
2305
$debug and $debug & 32 and _debug("sending exit control to master");
2306
$self->_master_ctl('exit');
2307
}
2308
$self->_kill_master;
2309
}
2310
}
2311
2312
1;
2313
__END__
2314
2315
=head1 NAME
2316
2317
Net::OpenSSH - Perl SSH client package implemented on top of OpenSSH
2318
2319
=head1 SYNOPSIS
2320
2321
use Net::OpenSSH;
2322
2323
my $ssh = Net::OpenSSH->new($host);
2324
$ssh->error and
2325
die "Couldn't establish SSH connection: ". $ssh->error;
2326
2327
$ssh->system("ls /tmp") or
2328
die "remote command failed: " . $ssh->error;
2329
2330
my @ls = $ssh->capture("ls");
2331
$ssh->error and
2332
die "remote ls command failed: " . $ssh->error;
2333
2334
my ($out, $err) = $ssh->capture2("find /root");
2335
$ssh->error and
2336
die "remote find command failed: " . $ssh->error;
2337
2338
my ($rin, $pid) = $ssh->pipe_in("cat >/tmp/foo") or
2339
die "pipe_in method failed: " . $ssh->error;
2340
2341
print $rin, "hello\n";
2342
close $rin;
2343
2344
my ($rout, $pid) = $ssh->pipe_out("cat /tmp/foo") or
2345
die "pipe_out method failed: " . $ssh->error;
2346
2347
while (<$rout>) { print }
2348
close $rout;
2349
2350
my ($in, $out ,$pid) = $ssh->open2("foo");
2351
my ($pty, $pid) = $ssh->open2pty("foo");
2352
my ($in, $out, $err, $pid) = $ssh->open3("foo");
2353
my ($pty, $err, $pid) = $ssh->open3pty("login");
2354
2355
my $sftp = $ssh->sftp();
2356
$sftp->error and die "SFTP failed: " . $sftp->error;
2357
2358
2359
=head1 DESCRIPTION
2360
2361
Net::OpenSSH is a secure shell client package implemented on top of
2362
OpenSSH binary client (C<ssh>).
2363
2364
=head2 Under the hood
2365
2366
This package is implemented around the multiplexing feature found in
2367
later versions of OpenSSH. That feature allows one to run several
2368
commands over a single SSH connection (IIRC, OpenSSH 4.1 is the first
2369
one to provide all the required functionality).
2370
2371
When a new Net::OpenSSH object is created, the OpenSSH C<ssh> client
2372
is run in master mode, establishing a persistent (for the lifetime of
2373
the object) connection to the server.
2374
2375
Then, every time a new operation is requested a new C<ssh> process is
2376
started in slave mode, effectively reusing the master SSH connection
2377
to send the request to the remote side.
2378
2379
=head2 Net::OpenSSH Vs. Net::SSH::.* modules
2380
2381
Why should you use Net::OpenSSH instead of any of the other Perl SSH
2382
clients available?
2383
2384
Well, this is my (biased) opinion:
2385
2386
L<Net::SSH::Perl|Net::SSH::Perl> is not well maintained nowadays
2387
(update: a new maintainer has stepped in so this situation could
2388
change!!!), requires a bunch of modules (some of them very difficult
2389
to install) to be acceptably efficient and has an API that is limited
2390
in some ways.
2391
2392
L<Net::SSH2|Net::SSH2> is much better than Net::SSH::Perl, but not
2393
completely stable yet. It can be very difficult to install on some
2394
specific operative systems and its API is also limited, in the same
2395
way as L<Net::SSH::Perl|Net::SSH::Perl>.
2396
2397
Using L<Net::SSH::Expect|Net::SSH::Expect>, in general, is a bad
2398
idea. Handling interaction with a shell via Expect in a generic way
2399
just can not be reliably done.
2400
2401
Net::SSH is just a wrapper around any SSH binary commands available on
2402
the machine. It can be very slow as they establish a new SSH
2403
connection for every operation performed.
2404
2405
In comparison, Net::OpenSSH is a pure perl module that does not have
2406
any mandatory dependencies (obviously, besides requiring OpenSSH
2407
binaries).
2408
2409
Net::OpenSSH has a very perlish interface. Most operations are
2410
performed in a fashion very similar to that of the Perl builtins and
2411
common modules (e.g. L<IPC::Open2|IPC::Open2>).
2412
2413
It is also very fast. The overhead introduced by launching a new ssh
2414
process for every operation is not appreciable (at least on my Linux
2415
box). The bottleneck is the latency intrinsic to the protocol, so
2416
Net::OpenSSH is probably as fast as an SSH client can be.
2417
2418
Being based on OpenSSH is also an advantage: a proved, stable, secure
2419
(to paranoid levels), inseparably and well maintained implementation
2420
of the SSH protocol is used.
2421
2422
On the other hand, Net::OpenSSH does not work on Windows, not even
2423
under Cygwin.
2424
2425
Net::OpenSSH specifically requires the OpenSSH SSH client (AFAIK, the
2426
multiplexing feature is not available from any other SSH
2427
client). However, note that it will interact with any server software,
2428
not just servers running OpenSSH C<sshd>.
2429
2430
For password authentication, L<IO::Pty|IO::Pty> has to be
2431
installed. Other modules and binaries are also required to implement
2432
specific functionality (for instance
2433
L<Net::SFTP::Foreign|Net::SFTP::Foreign>, L<Expect|Expect> or
2434
L<rsync(1)|rsync(1)|>).
2435
2436
Net::OpenSSH and Net::SSH2 do not support version 1 of the SSH
2437
protocol.
2438
2439
=head1 API
2440
2441
=head2 Optional arguments
2442
2443
Almost all methods in this package accept as first argument an
2444
optional reference to a hash containing parameters (C<\%opts>). For
2445
instance, these two method calls are equivalent:
2446
2447
my $out1 = $ssh->capture(@cmd);
2448
my $out2 = $ssh->capture({}, @cmd);
2449
2450
=head2 Error handling
2451
2452
Most methods return undef (or an empty list) to indicate failure.
2453
2454
The L</error> method can always be used to explicitly check for
2455
errors. For instance:
2456
2457
my ($output, $errput) = $ssh->capture2({timeout => 1}, "find /");
2458
$ssh->error and die "ssh failed: " . $ssh->error;
2459
2460
=head2 Net::OpenSSH methods
2461
2462
These are the methods provided by the package:
2463
2464
=over 4
2465
2466
=item Net::OpenSSH->new($host, %opts)
2467
2468
Creates a new SSH master connection
2469
2470
C<$host> can be a hostname or an IP address. It may also
2471
contain the name of the user, her password and the TCP port
2472
number where the server is listening:
2473
2474
my $ssh1 = Net::OpenSSH->new('jack@foo.bar.com');
2475
my $ssh2 = Net::OpenSSH->new('jack:secret@foo.bar.com:10022');
2476
my $ssh3 = Net::OpenSSH->new('jsmith@2001:db8::1428:57ab'); # IPv6
2477
2478
IPv6 addresses may optionally be enclosed in brackets:
2479
2480
my $ssh4 = Net::OpenSSH->new('jsmith@[::1]:1022');
2481
2482
This method always succeeds in returning a new object. Error checking
2483
has to be performed explicitly afterwards:
2484
2485
my $ssh = Net::OpenSSH->new($host, %opts);
2486
$ssh->error and die "Can't ssh to $host: " . $ssh->error;
2487
2488
If you have problems getting Net::OpenSSH to connect to the remote
2489
host read the troubleshooting chapter near the end of this document.
2490
2491
Accepted options:
2492
2493
=over 4
2494
2495
=item user => $user_name
2496
2497
Login name
2498
2499
=item port => $port
2500
2501
TCP port number where the server is running
2502
2503
=item password => $password
2504
2505
User given password for authentication.
2506
2507
Note that using password authentication in automated scripts is a very
2508
bad idea. When possible, you should use public key authentication
2509
instead.
2510
2511
=item passphrase => $passphrase
2512
2513
X<passphrase>Uses given passphrase to open private key.
2514
2515
=item key_path => $private_key_path
2516
2517
Uses the key stored on the given file path for authentication.
2518
2519
=item gateway => $gateway
2520
2521
If the given argument is a gateway object as returned by
2522
L<Net::OpenSSH::Gateway/find_gateway> method, use it to connect to
2523
the remote host.
2524
2525
If it is a hash reference, call the C<find_gateway> method first.
2526
2527
For instance, the following code fragments are equivalent:
2528
2529
my $gateway = Net::OpenSSH::Gateway->find_gateway(
2530
proxy => 'http://proxy.corporate.com');
2531
$ssh = Net::OpenSSH->new($host, gateway => $gateway);
2532
2533
and
2534
2535
$ssh = Net::OpenSSH->new($host,
2536
gateway => { proxy => 'http://proxy.corporate.com'});
2537
2538
=item proxy_command => $proxy_command
2539
2540
Use the given command to establish the connection to the remote host
2541
(see C<ProxyCommand> on L<ssh_config(5)>).
2542
2543
=item batch_mode => 1
2544
2545
Disables querying the user for password and passphrases.
2546
2547
=item ctl_dir => $path
2548
2549
Directory where the SSH master control socket will be created.
2550
2551
This directory and its parents must be writable only by the current
2552
effective user or root, otherwise the connection will be aborted to
2553
avoid insecure operation.
2554
2555
By default C<~/.libnet-openssh-perl> is used.
2556
2557
=item ssh_cmd => $cmd
2558
2559
Name or full path to OpenSSH C<ssh> binary. For instance:
2560
2561
my $ssh = Net::OpenSSH->new($host, ssh_cmd => '/opt/OpenSSH/bin/ssh');
2562
2563
=item scp_cmd => $cmd
2564
2565
Name or full path to OpenSSH C<scp> binary.
2566
2567
By default it is inferred from the C<ssh> one.
2568
2569
=item rsync_cmd => $cmd
2570
2571
Name or full path to C<rsync> binary. Defaults to C<rsync>.
2572
2573
=item remote_shell => $name
2574
2575
Name of the remote shell. Used to select the argument quoter backend.
2576
2577
=item timeout => $timeout
2578
2579
Maximum acceptable time that can elapse without network traffic or any
2580
other event happening on methods that are not immediate (for instance,
2581
when establishing the master SSH connection or inside methods
2582
C<capture>, C<system>, C<scp_get>, etc.).
2583
2584
See also L</Timeouts>.
2585
2586
=item kill_ssh_on_timeout => 1
2587
2588
This option tells Net::OpenSSH to kill the local slave SSH process
2589
when some operation times out.
2590
2591
See also L</Timeouts>.
2592
2593
=item strict_mode => 0
2594
2595
By default, the connection will be aborted if the path to the socket
2596
used for multiplexing is found to be non-secure (for instance, when
2597
any of the parent directories is writable by other users).
2598
2599
This option can be used to disable that feature. Use with care!!!
2600
2601
=item async => 1
2602
2603
By default, the constructor waits until the multiplexing socket is
2604
available. That option can be used to defer the waiting until the
2605
socket is actually used.
2606
2607
For instance, the following code connects to several remote machines
2608
in parallel:
2609
2610
my (%ssh, %ls);
2611
# multiple connections are established in parallel:
2612
for my $host (@hosts) {
2613
$ssh{$host} = Net::OpenSSH->new($host, async => 1);
2614
}
2615
# then to run some command in all the hosts (sequentially):
2616
for my $host (@hosts) {
2617
$ssh{$host}->system('ls /');
2618
}
2619
2620
=item master_opts => [...]
2621
2622
Additional options to pass to the C<ssh> command when establishing the
2623
master connection. For instance:
2624
2625
my $ssh = Net::OpenSSH->new($host,
2626
master_opts => [-o => "ProxyCommand corkscrew httpproxy 8080 $host"]);
2627
2628
=item default_ssh_opts => [...]
2629
2630
Default slave SSH command line options for L</open_ex> and derived
2631
methods.
2632
2633
For instance:
2634
2635
my $ssh = Net::OpenSSH->new($host,
2636
default_ssh_opts => [-o => "ConnectionAttempts=0"]);
2637
2638
=item forward_agent => 1
2639
2640
Enables forwarding of the authentication agent.
2641
2642
This option can not be used when passing a passphrase (via
2643
L</passphrase>) to unlock the login private key.
2644
2645
Note that Net::OpenSSH will not run C<ssh-agent> for you. This has to
2646
be done ahead of time and the environment variable C<SSH_AUTH_SOCK>
2647
set pointing to the proper place.
2648
2649
=item forward_X11 => 1
2650
2651
Enables forwarding of the X11 protocol
2652
2653
=item default_stdin_fh => $fh
2654
2655
=item default_stdout_fh => $fh
2656
2657
=item default_stderr_fh => $fh
2658
2659
Default I/O streams for L</open_ex> and derived methods (currently, that
2660
means any method but L</pipe_in> and L</pipe_out> and I plan to remove
2661
those exceptions soon!).
2662
2663
For instance:
2664
2665
open my $stderr_fh, '>>', '/tmp/$host.err' or die ...;
2666
open my $stdout_fh, '>>', '/tmp/$host.log' or die ...;
2667
2668
my $ssh = Net::OpenSSH->new($host, default_stderr_fh => $stderr_fh,
2669
default_stdout_fh => $stdout_fh);
2670
$ssh->error and die "SSH connection failed: " . $ssh->error;
2671
2672
$ssh->scp_put("/foo/bar*", "/tmp")
2673
or die "scp failed: " . $ssh->error;
2674
2675
=item default_stdin_file = $fn
2676
2677
=item default_stdout_file = $fn
2678
2679
=item default_stderr_file = $fn
2680
2681
Opens the given file names and use them as the defaults.
2682
2683
=item master_stdout_fh => $fh
2684
2685
=item master_stderr_fh => $fh
2686
2687
Redirect corresponding stdio streams of the master SSH process to
2688
given filehandles.
2689
2690
=item master_stdout_discard => $bool
2691
2692
=item master_stderr_discard => $bool
2693
2694
Discard corresponding stdio streams.
2695
2696
=item expand_vars => $bool
2697
2698
Activates variable expansion inside command arguments and file paths.
2699
2700
See L</"Variable expansion"> below.
2701
2702
=item vars => \%vars
2703
2704
Initial set of variables.
2705
2706
=item external_master => 1
2707
2708
Instead of launching a new OpenSSH client in master mode, the module
2709
tries to reuse an already existent one. C<ctl_path> must also be
2710
passed when this option is set. See also L</get_ctl_path>.
2711
2712
Example:
2713
2714
$ssh = Net::OpenSSH->new('foo', external_master => 1, ctl_path = $path);
2715
2716
When C<external_master> is set, the hostname argument becomes optional
2717
(C<0.0.0.0> is passed to OpenSSH which does not use it at all).
2718
2719
=item default_encoding => $encoding
2720
2721
=item default_stream_encoding => $encoding
2722
2723
=item default_argument_encoding => $encoding
2724
2725
Set default encodings. See L</Data encoding>.
2726
2727
=item password_prompt => $string
2728
2729
=item password_prompt => $re
2730
2731
By default, when using password authentication, the module expects the
2732
remote side to send a password prompt matching C</[?:]/>.
2733
2734
This option can be used to override that default for the rare cases
2735
when a different prompt is used.
2736
2737
Examples:
2738
2739
password_prompt => ']'; # no need to escape ']'
2740
password_prompt => qr/[:?>]/;
2741
2742
=item login_handler => \&custom_login_handler
2743
2744
Some remote SSH server may require a custom login/authentication
2745
interaction not natively supported by Net::OpenSSH. In that cases, you
2746
can use this option to replace the default login logic.
2747
2748
The callback will be invoked repeatedly as C<custom_login_handler($ssh,
2749
$pty, $data)> where C<$ssh> is the current Net::OpenSSH object, C<pty>
2750
a L<IO::Pty> object attached to the slave C<ssh> process tty and
2751
C<$data> a reference to an scalar you can use at will.
2752
2753
The login handler must return 1 after the login process has completed
2754
successfully or 0 in case it still needs to do something else. If some
2755
error happens, it must die.
2756
2757
Note, that blocking operations should not be performed inside the
2758
login handler (at least if you want the C<async> and C<timeout>
2759
features to work).
2760
2761
See also the sample script C<login_handler.pl> in the C<samples>
2762
directory.
2763
2764
Usage of this option is incompatible with the C<password> and
2765
C<passphrase> options, you will have to handle password or passphrases
2766
from the custom handler yourself.
2767
2768
=item master_setpgrp => 1
2769
2770
When this option is set, the master process is run as a different
2771
process group. As a consequence it will not die when the user presses
2772
Ctrl-C at the terminal.
2773
2774
In order to allow the master SSH process to request any information
2775
from the user, the module may set it as the terminal controlling
2776
process while the connection is established (using
2777
L<POSIX/tcsetpgrp>). Afterwards, the terminal controlling process is
2778
reset.
2779
2780
This feature is highly experimental. Report any problems you may find,
2781
please.
2782
2783
=back
2784
2785
=item $ssh->error
2786
2787
Returns the error condition for the last performed operation.
2788
2789
The returned value is a dualvar as $! (see L<perlvar/"$!">) that
2790
renders an informative message when used in string context or an error
2791
number in numeric context (error codes appear in
2792
L<Net::OpenSSH::Constants|Net::OpenSSH::Constants>).
2793
2794
=item $ssh->get_user
2795
2796
=item $ssh->get_host
2797
2798
=item $ssh->get_port
2799
2800
Return the corresponding SSH login parameters.
2801
2802
=item $ssh->get_ctl_path
2803
2804
X<get_ctl_path>Returns the path to the socket where the OpenSSH master
2805
process listens for new multiplexed connections.
2806
2807
=item ($in, $out, $err, $pid) = $ssh->open_ex(\%opts, @cmd)
2808
2809
X<open_ex>I<Note: this is a low level method which, probably, you do
2810
not need to use!>
2811
2812
That method starts the command C<@cmd> on the remote machine creating
2813
new pipes for the IO channels as specified on the C<%opts> hash.
2814
2815
If C<@cmd> is omitted, the remote user shell is run.
2816
2817
Returns four values, the first three (C<$in>, C<$out> and C<$err>)
2818
correspond to the local side of the pipes created (they can be undef)
2819
and the fourth (C<$pid>) to the PID of the new SSH slave process. An
2820
empty list is returned on failure.
2821
2822
Note that C<waitpid> has to be used afterwards to reap the
2823
slave SSH process.
2824
2825
Accepted options:
2826
2827
=over 4
2828
2829
=item stdin_pipe => 1
2830
2831
Creates a new pipe and connects the reading side to the stdin stream
2832
of the remote process. The writing side is returned as the first
2833
value (C<$in>).
2834
2835
=item stdin_pty => 1
2836
2837
Similar to C<stdin_pipe>, but instead of a regular pipe it uses a
2838
pseudo-tty (pty).
2839
2840
Note that on some operating systems (e.g. HP-UX, AIX), ttys are not
2841
reliable. They can overflow when large chunks are written or when data
2842
is written faster than it is read.
2843
2844
=item stdin_fh => $fh
2845
2846
Duplicates C<$fh> and uses it as the stdin stream of the remote process.
2847
2848
=item stdin_file => $filename
2849
2850
=item stdin_file => \@open_args
2851
2852
Opens the file of the given name for reading and uses it as the remote
2853
process stdin stream.
2854
2855
If an array reference is passed its contents are used as the arguments
2856
for the underlying open call. For instance:
2857
2858
$ssh->system({stdin_file => ['-|', 'gzip -c -d file.gz']}, $rcmd);
2859
2860
=item stdin_discard => 1
2861
2862
Uses /dev/null as the remote process stdin stream.
2863
2864
=item stdout_pipe => 1
2865
2866
Creates a new pipe and connects the writing side to the stdout stream
2867
of the remote process. The reading side is returned as the second
2868
value (C<$out>).
2869
2870
=item stdout_pty => 1
2871
2872
Connects the stdout stream of the remote process to the
2873
pseudo-pty. This option requires C<stdin_pty> to be also set.
2874
2875
=item stdout_fh => $fh
2876
2877
Duplicates C<$fh> and uses it as the stdout stream of the remote
2878
process.
2879
2880
=item stdout_file => $filename
2881
2882
=item stdout_file => \@open_args
2883
2884
Opens the file of the given filename and redirect stdout there.
2885
2886
=item stdout_discard => 1
2887
2888
Uses /dev/null as the remote process stdout stream.
2889
2890
=item stdinout_socket => 1
2891
2892
Creates a new socketpair, attaches the stdin an stdout streams of the
2893
slave SSH process to one end and returns the other as the first value
2894
(C<$in>) and undef for the second (C<$out>).
2895
2896
Example:
2897
2898
my ($socket, undef, undef, $pid) = $ssh->open_ex({stdinout_socket => 1},
2899
'/bin/netcat $dest');
2900
2901
See also L</open2socket>.
2902
2903
=item stdinout_dpipe => $cmd
2904
2905
=item stdinout_dpipe => \@cmd
2906
2907
Runs the given command locally attaching its stdio streams to those of
2908
the remote SSH command. Conceptually it is equivalent to the
2909
L<dpipe(1)> shell command.
2910
2911
=item stderr_pipe => 1
2912
2913
Creates a new pipe and connects the writing side to the stderr stream
2914
of the remote process. The reading side is returned as the third
2915
value (C<$err>).
2916
2917
Example:
2918
2919
my $pid = $ssh->open_ex({stdinout_dpipe => 'vncviewer -stdio'},
2920
x11vnc => '-inetd');
2921
2922
=item stderr_fh => $fh
2923
2924
Duplicates C<$fh> and uses it as the stderr stream of the remote process.
2925
2926
=item stderr_file => $filename
2927
2928
Opens the file of the given name and redirects stderr there.
2929
2930
=item stderr_to_stdout => 1
2931
2932
Makes stderr point to stdout.
2933
2934
=item tty => $bool
2935
2936
Tells C<ssh> to allocate a pseudo-tty for the remote process. By
2937
default, a tty is allocated if remote command stdin stream is attached
2938
to a tty.
2939
2940
When this flag is set and stdin is not attached to a tty, the ssh
2941
master and slave processes may generate spurious warnings about failed
2942
tty operations. This is caused by a bug present in older versions of
2943
OpenSSH.
2944
2945
=item close_slave_pty => 0
2946
2947
When a pseudo pty is used for the stdin stream, the slave side is
2948
automatically closed on the parent process after forking the ssh
2949
command.
2950
2951
This option disables that feature, so that the slave pty can be
2952
accessed on the parent process as C<$pty-E<gt>slave>. It will have to
2953
be explicitly closed (see L<IO::Pty|IO::Pty>)
2954
2955
=item quote_args => $bool
2956
2957
See L</"Shell quoting"> below.
2958
2959
=item remote_shell => $shell
2960
2961
Sets the remote shell. Allows to change the argument quoting mechanism
2962
in a per-command fashion.
2963
2964
This may be useful when interacting with a Windows machine where
2965
argument parsing may be done at the command level in custom ways.
2966
2967
Example:
2968
2969
$ssh->system({remote_shell => 'MSWin'}, echo => $line);
2970
$ssh->system({remote_shell => 'MSCmd,MSWin'}, type => $file);
2971
2972
=item forward_agent => $bool
2973
2974
Enables/disables forwarding of the authentication agent.
2975
2976
This option can only be used when agent forwarding has been previously
2977
requested on the constructor.
2978
2979
=item forward_X11 => $bool
2980
2981
Enables/disables forwarding of the X11 protocol.
2982
2983
This option can only be used when X11 forwarding has been previously
2984
requested on the constructor.
2985
2986
=item ssh_opts => \@opts
2987
2988
List of extra options for the C<ssh> command.
2989
2990
This feature should be used with care, as the given options are not
2991
checked in any way by the module, and they could interfere with it.
2992
2993
=item tunnel => $bool
2994
2995
Instead of executing a command in the remote host, this option
2996
instruct Net::OpenSSH to create a TCP tunnel. The arguments become the
2997
target IP and port.
2998
2999
Example:
3000
3001
my ($in, $out, undef, $pid) = $ssh->open_ex({tunnel => 1}, $IP, $port);
3002
3003
See also L</Tunnels>.
3004
3005
=item encoding => $encoding
3006
3007
=item argument_encoding => $encoding
3008
3009
Set encodings. See L</Data encoding>.
3010
3011
=back
3012
3013
Usage example:
3014
3015
# similar to IPC::Open2 open2 function:
3016
my ($in_pipe, $out_pipe, undef, $pid) =
3017
$ssh->open_ex( { stdin_pipe => 1,
3018
stdout_pipe => 1 },
3019
@cmd )
3020
or die "open_ex failed: " . $ssh->error;
3021
# do some IO through $in/$out
3022
# ...
3023
waitpid($pid);
3024
3025
=item setpgrp => 1
3026
3027
Calls C<setpgrp> after forking the child process. As a result it will
3028
not die when the user presses Ctrl+C at the console. See also
3029
L<perlfunc/setpgrp>.
3030
3031
Using this option without also setting C<master_setpgrp> on the
3032
constructor call is mostly useless as the signal will be delivered to
3033
the master process and all the remote commands aborted.
3034
3035
This feature is experimental.
3036
3037
=item $ssh->system(\%opts, @cmd)
3038
3039
Runs the command C<@cmd> on the remote machine.
3040
3041
Returns true on success, undef otherwise.
3042
3043
The error status is set to C<OSSH_SLAVE_CMD_FAILED> when the remote
3044
command exits with a non zero code (the code is available from C<$?>,
3045
see L<perlvar/"$?">).
3046
3047
Example:
3048
3049
$ssh->system('ls -R /')
3050
or die "ls failed: " . $ssh->error";
3051
3052
As for C<system> builtin, C<SIGINT> and C<SIGQUIT> signals are
3053
blocked. (see L<perlfunc/system>). Also, setting C<$SIG{CHLD}> to
3054
C<IGNORE> or to a custom signal handler will interfere with this
3055
method.
3056
3057
Accepted options:
3058
3059
=over 4
3060
3061
=item stdin_data => $input
3062
3063
=item stdin_data => \@input
3064
3065
Sends the given data through the stdin stream to the remote
3066
process.
3067
3068
For example, the following code creates a file on the remote side:
3069
3070
$ssh->system({stdin_data => \@data}, "cat >/tmp/foo")
3071
or die "unable to write file: " . $ssh->error;
3072
3073
=item timeout => $timeout
3074
3075
The operation is aborted after C<$timeout> seconds elapsed without
3076
network activity.
3077
3078
See also L</Timeouts>.
3079
3080
=item async => 1
3081
3082
Does not wait for the child process to exit. The PID of the new
3083
process is returned.
3084
3085
Note that when this option is combined with C<stdin_data>, the given
3086
data will be transferred to the remote side before returning control
3087
to the caller.
3088
3089
See also the L</spawn> method documentation below.
3090
3091
=item stdin_fh => $fh
3092
3093
=item stdin_discard => $bool
3094
3095
=item stdout_fh => $fh
3096
3097
=item stdout_discard => $bool
3098
3099
=item stderr_fh => $fh
3100
3101
=item stderr_discard => $bool
3102
3103
=item stderr_to_stdout => $bool
3104
3105
=item stdinout_dpipe => $cmd
3106
3107
=item tty => $bool
3108
3109
See the L</open_ex> method documentation for an explanation of these
3110
options.
3111
3112
=back
3113
3114
=item $ok = $ssh->test(\%opts, @cmd);
3115
3116
Runs the given command and returns its success/failure exit status as
3117
1 or 0 respectively. Returns undef when something goes wrong in the
3118
SSH layer.
3119
3120
Error status is not set to OSSH_SLAVE_CMD_FAILED when the remote
3121
command exits with a non-zero code.
3122
3123
By default this method discards the remote command C<stdout> and
3124
C<sterr> streams.
3125
3126
Usage example:
3127
3128
if ($ssh->test(ps => -C => $executable)) {
3129
say "$executable is running on remote machine"
3130
}
3131
else {
3132
die "something got wrong: ". $ssh->error if $ssh->error;
3133
3134
say "$executable is not running on remote machine"
3135
}
3136
3137
This method support the same set of options as C<system>, except
3138
C<async> and C<tunnel>.
3139
3140
=item $output = $ssh->capture(\%opts, @cmd);
3141
3142
=item @output = $ssh->capture(\%opts, @cmd);
3143
3144
This method is conceptually equivalent to the perl backquote operator
3145
(e.g. C<`ls`>): it runs the command on the remote machine and captures
3146
its output.
3147
3148
In scalar context returns the output as a scalar. In list context
3149
returns the output broken into lines (it honors C<$/>, see
3150
L<perlvar/"$/">).
3151
3152
The exit status of the remote command is returned in C<$?>.
3153
3154
When an error happens while capturing (for instance, the operation
3155
times out), the partial captured output will be returned. Error
3156
conditions have to be explicitly checked using the L</error>
3157
method. For instance:
3158
3159
my $output = $ssh->capture({ timeout => 10 },
3160
"echo hello; sleep 20; echo bye");
3161
$ssh->error and
3162
warn "operation didn't complete successfully: ". $ssh->error;
3163
print $output;
3164
3165
Setting C<$SIG{CHLD}> to a custom signal handler or to C<IGNORE> will
3166
interfere with this method.
3167
3168
Accepted options:
3169
3170
=over 4
3171
3172
=item stdin_data => $input
3173
3174
=item stdin_data => \@input
3175
3176
=item timeout => $timeout
3177
3178
See L</Timeouts>.
3179
3180
=item stdin_fh => $fh
3181
3182
=item stdin_discard => $bool
3183
3184
=item stderr_fh => $fh
3185
3186
=item stderr_discard => $bool
3187
3188
=item stderr_to_stdout => $bool
3189
3190
=item tty => $bool
3191
3192
See the L</open_ex> method documentation for an explanation of these
3193
options.
3194
3195
=back
3196
3197
=item ($output, $errput) = $ssh->capture2(\%opts, @cmd)
3198
3199
captures the output sent to both stdout and stderr by C<@cmd> on the
3200
remote machine.
3201
3202
Setting C<$SIG{CHLD}> to a custom signal handler or to C<IGNORE> will
3203
also interfere with this method.
3204
3205
The accepted options are:
3206
3207
=over 4
3208
3209
=item stdin_data => $input
3210
3211
=item stdin_data => \@input
3212
3213
See the L</system> method documentation for an explanation of these
3214
options.
3215
3216
=item timeout => $timeout
3217
3218
See L</Timeouts>.
3219
3220
=item stdin_fh => $fh
3221
3222
=item stdin_discard => $bool
3223
3224
=item tty => $bool
3225
3226
See the L</open_ex> method documentation for an explanation of these
3227
options.
3228
3229
=back
3230
3231
=item ($in, $pid) = $ssh->pipe_in(\%opts, @cmd)
3232
3233
X<pipe_in>This method is similar to the following Perl C<open> call
3234
3235
$pid = open $in, '|-', @cmd
3236
3237
but running @cmd on the remote machine (see L<perlfunc/open>).
3238
3239
No options are currently accepted.
3240
3241
There is no need to perform a waitpid on the returned PID as it will
3242
be done automatically by perl when C<$in> is closed.
3243
3244
Example:
3245
3246
my ($in, $pid) = $ssh->pipe_in('cat >/tmp/fpp')
3247
or die "pipe_in failed: " . $ssh->error;
3248
print $in $_ for @data;
3249
close $in or die "close failed";
3250
3251
=item ($out, $pid) = $ssh->pipe_out(\%opts, @cmd)
3252
3253
X<pipe_out>Reciprocal to previous method, it is equivalent to
3254
3255
$pid = open $out, '-|', @cmd
3256
3257
running @cmd on the remote machine.
3258
3259
No options are currently accepted.
3260
3261
=item ($in, $out, $pid) = $ssh->open2(\%opts, @cmd)
3262
3263
=item ($pty, $pid) = $ssh->open2pty(\%opts, @cmd)
3264
3265
=item ($socket, $pid) = $ssh->open2socket(\%opts, @cmd)
3266
3267
=item ($in, $out, $err, $pid) = $ssh->open3(\%opts, @cmd)
3268
3269
=item ($pty, $err, $pid) = $ssh->open3pty(\%opts, @cmd)
3270
3271
Shortcuts around L</open_ex> method.
3272
3273
=item $pid = $ssh->spawn(\%opts, @_)
3274
3275
X<spawn>Another L</open_ex> shortcut, it launches a new remote process
3276
in the background and returns the PID of the local slave SSH process.
3277
3278
At some later point in your script, C<waitpid> should be called on the
3279
returned PID in order to reap the slave SSH process.
3280
3281
For instance, you can run some command on several hosts in parallel
3282
with the following code:
3283
3284
my %conn = map { $_ => Net::OpenSSH->new($_, async => 1) } @hosts;
3285
my @pid;
3286
for my $host (@hosts) {
3287
open my($fh), '>', "/tmp/out-$host.txt"
3288
or die "unable to create file: $!";
3289
push @pid, $conn{$host}->spawn({stdout_fh => $fh}, $cmd);
3290
}
3291
3292
waitpid($_, 0) for @pid;
3293
3294
Note that C<spawn> should not be used to start detached remote
3295
processes that may survive the local program (see also the L</FAQ>
3296
about running remote processes detached).
3297
3298
=item ($socket, $pid) = $ssh->open_tunnel(\%opts, $dest_host, $port)
3299
3300
X<open_tunnel>Similar to L</open2socket>, but instead of running a
3301
command, it opens a TCP tunnel to the given address. See also
3302
L</Tunnels>.
3303
3304
=item $out = $ssh->capture_tunnel(\%opts, $dest_host, $port)
3305
3306
=item @out = $ssh->capture_tunnel(\%opts, $dest_host, $port)
3307
3308
X<capture_tunnel>Similar to L</capture>, but instead of running a command, it opens a
3309
TCP tunnel.
3310
3311
Example:
3312
3313
$out = $ssh->capture_tunnel({stdin_data => join("\r\n",
3314
"GET / HTTP/1.0",
3315
"Host: www.perl.org",
3316
"", "") },
3317
'www.perl.org', 80)
3318
3319
See also L</Tunnels>.
3320
3321
=item $ssh->scp_get(\%opts, $remote1, $remote2,..., $local_dir_or_file)
3322
3323
=item $ssh->scp_put(\%opts, $local, $local2,..., $remote_dir_or_file)
3324
3325
These two methods are wrappers around the C<scp> command that allow
3326
transfers of files to/from the remote host using the existing SSH
3327
master connection.
3328
3329
When transferring several files, the target argument must point to an
3330
existing directory. If only one file is to be transferred, the target
3331
argument can be a directory or a file name or can be omitted. For
3332
instance:
3333
3334
$ssh->scp_get({glob => 1}, '/var/tmp/foo*', '/var/tmp/bar*', '/tmp');
3335
$ssh->scp_put('/etc/passwd');
3336
3337
Both L</scp_get> and L</scp_put> methods return a true value when all
3338
the files are transferred correctly, otherwise they return undef.
3339
3340
Accepted options:
3341
3342
=over 4
3343
3344
=item quiet => 0
3345
3346
By default, C<scp> is called with the quiet flag C<-q> enabled in
3347
order to suppress progress information. This option allows one to
3348
re-enable the progress indication bar.
3349
3350
=item verbose => 1
3351
3352
Calls C<scp> with the C<-v> flag.
3353
3354
=item recursive => 1
3355
3356
Copy files and directories recursively.
3357
3358
=item glob => 1
3359
3360
Allow expansion of shell metacharacters in the sources list so that
3361
wildcards can be used to select files.
3362
3363
=item glob_flags => $flags
3364
3365
Second argument passed to L<File::Glob::bsd_glob|File::Glob/bsd_glob>
3366
function. Only available for L</scp_put> method.
3367
3368
=item copy_attrs => 1
3369
3370
Copies modification and access times and modes from the original
3371
files.
3372
3373
=item bwlimit => $Kbits
3374
3375
Limits the used bandwidth, specified in Kbit/s.
3376
3377
=item timeout => $secs
3378
3379
The transfer is aborted if the connection does not finish before the
3380
given timeout elapses. See also L</Timeouts>.
3381
3382
=item async => 1
3383
3384
Does not wait for the C<scp> command to finish. When this option is
3385
used, the method returns the PID of the child C<scp> process.
3386
3387
For instance, it is possible to transfer files to several hosts in
3388
parallel as follows:
3389
3390
use Errno;
3391
my (%pid, %ssh);
3392
for my $host (@hosts) {
3393
$ssh{$host} = Net::OpenSSH->new($host, async => 1);
3394
}
3395
for my $host (@hosts) {
3396
$pid{$host} = $ssh{$host}->scp_put({async => 1}, $local_fn, $remote_fn)
3397
or warn "scp_put to $host failed: " . $ssh{$host}->error . "\n";
3398
}
3399
for my $host (@hosts) {
3400
if (my $pid = $pid{$host}) {
3401
if (waitpid($pid, 0) > 0) {
3402
my $exit = ($? >> 8);
3403
$exit and warn "transfer of file to $host failed ($exit)\n";
3404
}
3405
else {
3406
redo if ($! == EINTR);
3407
warn "waitpid($pid) failed: $!\n";
3408
}
3409
}
3410
}
3411
3412
=item stdout_fh => $fh
3413
3414
=item stderr_fh => $fh
3415
3416
=item stderr_to_stdout => 1
3417
3418
These options are passed unchanged to method L</open_ex>, allowing
3419
capture of the output of the C<scp> program.
3420
3421
Note that C<scp> will not generate progress reports unless its stdout
3422
stream is attached to a tty.
3423
3424
=item ssh_opts => \@opts
3425
3426
List of extra options for the C<ssh> command.
3427
3428
This feature should be used with care, as the given options are not
3429
checked in any way by the module, and they could interfere with it.
3430
3431
=back
3432
3433
=item $ssh->rsync_get(\%opts, $remote1, $remote2,..., $local_dir_or_file)
3434
3435
=item $ssh->rsync_put(\%opts, $local1, $local2,..., $remote_dir_or_file)
3436
3437
These methods use C<rsync> over SSH to transfer files from/to the remote
3438
machine.
3439
3440
They accept the same set of options as the C<scp> ones.
3441
3442
Any unrecognized option will be passed as an argument to the C<rsync>
3443
command (see L<rsync(1)>). Underscores can be used instead of dashes
3444
in C<rsync> option names.
3445
3446
For instance:
3447
3448
$ssh->rsync_get({exclude => '*~',
3449
verbose => 1,
3450
safe_links => 1},
3451
'/remote/dir', '/local/dir');
3452
3453
=item $sftp = $ssh->sftp(%sftp_opts)
3454
3455
Creates a new L<Net::SFTP::Foreign|Net::SFTP::Foreign> object for SFTP
3456
interaction that runs through the ssh master connection.
3457
3458
=item @call = $ssh->make_remote_command(\%opts, @cmd)
3459
3460
=item $call = $ssh->make_remote_command(\%opts, @cmd)
3461
3462
This method returns the arguments required to execute a command on the
3463
remote machine via SSH. For instance:
3464
3465
my @call = $ssh->make_remote_command(ls => "/var/log");
3466
system @call;
3467
3468
In scalar context, returns the arguments quoted and joined into one
3469
string:
3470
3471
my $remote = $ssh->make_remote_comand("cd /tmp/ && tar xf -");
3472
system "tar cf - . | $remote";
3473
3474
The options accepted are as follows:
3475
3476
=over 4
3477
3478
=item tty => $bool
3479
3480
Enables/disables allocation of a tty on the remote side.
3481
3482
=item forward_agent => $bool
3483
3484
Enables/disables forwarding of authentication agent.
3485
3486
This option can only be used when agent forwarding has been previously
3487
requested on the constructor.
3488
3489
=item tunnel => 1
3490
3491
Return a command to create a connection to some TCP server reachable
3492
from the remote host. In that case the arguments are the destination
3493
address and port. For instance:
3494
3495
$cmd = $ssh->make_remote_command({tunnel => 1}, $host, $port);
3496
3497
=back
3498
3499
=item $ssh->wait_for_master($async)
3500
3501
When the connection has been established by calling the constructor
3502
with the C<async> option, this call allows one to advance the process.
3503
3504
If C<$async> is true, it will perform any work that can be done
3505
immediately without waiting (for instance, entering the password or
3506
checking for the existence of the multiplexing socket) and then
3507
return. If a false value is given, it will finalize the connection
3508
process and wait until the multiplexing socket is available.
3509
3510
It returns a true value after the connection has been successfully
3511
established. False is returned if the connection process fails or if
3512
it has not yet completed (then, the L</error> method can be used to
3513
distinguish between both cases).
3514
3515
=item $ssh->check_master
3516
3517
This method runs several checks to ensure that the master connection
3518
is still alive.
3519
3520
=item $ssh->shell_quote(@args)
3521
3522
Returns the list of arguments quoted so that they will be restored to
3523
their original form when parsed by the remote shell.
3524
3525
In scalar context returns the list of arguments quoted and joined.
3526
3527
Usually this task is done automatically by the module. See L</"Shell
3528
quoting"> below.
3529
3530
This method can also be used as a class method.
3531
3532
Example:
3533
3534
my $quoted_args = Net::OpenSSH->shell_quote(@args);
3535
system('ssh', '--', $host, $quoted_args);
3536
3537
=item $ssh->shell_quote_glob(@args)
3538
3539
This method is like the previous C<shell_quote> but leaves wildcard
3540
characters unquoted.
3541
3542
It can be used as a class method also.
3543
3544
=item $ssh->set_expand_vars($bool)
3545
3546
Enables/disables variable expansion feature (see L</"Variable
3547
expansion">).
3548
3549
=item $ssh->get_expand_vars
3550
3551
Returns current state of variable expansion feature.
3552
3553
=item $ssh->set_var($name, $value)
3554
3555
=item $ssh->get_var($name, $value)
3556
3557
These methods allow to change and to retrieve the value of the logical
3558
value of the given name.
3559
3560
=item $ssh->get_master_pid
3561
3562
Returns the PID of the master SSH process
3563
3564
=item $ssh->master_exited
3565
3566
This methods allows one to tell the module that the master process has
3567
exited when we get its PID from some external wait or waitpid
3568
call. For instance:
3569
3570
my $ssh = Net::OpenSSH->new('foo', async => 1);
3571
3572
# create new processes
3573
# ...
3574
3575
# rip them...
3576
my $master_pid = $ssh->master_pid;
3577
while ((my $pid = wait) > 0) {
3578
if ($pid == $master_pid) {
3579
$ssh->master_exited;
3580
}
3581
}
3582
3583
If your program rips the master process and this method is not called,
3584
the OS could reassign the PID to a new unrelated process and the
3585
module would try to kill it at object destruction time.
3586
3587
=item $pid = $ssh->sshfs_import(\%opts, $remote_fs, $local_mnt_point)
3588
3589
=item $pid = $ssh->sshfs_export(\%opts, $local_fs, $remote_mnt_point)
3590
3591
These methods use L<sshfs(1)> to import or export a file system
3592
through the SSH connection.
3593
3594
They return the C<$pid> of the C<sshfs> process or of the slave C<ssh>
3595
process used to proxy it. Killing that process unmounts the file
3596
system, though, it may be probably better to use L<fusermount(1)>.
3597
3598
The options accepted are as follows:
3599
3600
=over
3601
3602
=item ssh_opts => \@ssh_opts
3603
3604
Options passed to the slave C<ssh> process.
3605
3606
=item sshfs_opts => \@sshfs_opts
3607
3608
Options passed to the C<sshfs> command. For instance, to mount the file
3609
system in read-only mode:
3610
3611
my $pid = $ssh->sshfs_export({sshfs_opts => [-o => 'ro']},
3612
"/", "/mnt/foo");
3613
3614
=back
3615
3616
Note that this command requires a recent version of C<sshfs> to work (at
3617
the time of writing, it requires the yet unreleased version available
3618
from the FUSE git repository!).
3619
3620
See also the L<sshfs(1)> man page and the C<sshfs> and FUSE web sites
3621
at L<http://fuse.sourceforge.net/sshfs.html> and
3622
L<http://fuse.sourceforge.net/> respectively.
3623
3624
=back
3625
3626
=head2 Shell quoting
3627
3628
By default, when invoking remote commands, this module tries to mimic
3629
perl C<system> builtin in regard to argument processing. Quoting
3630
L<perlfunc/system>:
3631
3632
Argument processing varies depending on the number of arguments. If
3633
there is more than one argument in LIST, or if LIST is an array with
3634
more than one value, starts the program given by the first element
3635
of the list with arguments given by the rest of the list. If there
3636
is only one scalar argument, the argument is checked for shell
3637
metacharacters, and if there are any, the entire argument is passed
3638
to the system's command shell for parsing (this is "/bin/sh -c" on
3639
Unix platforms, but varies on other platforms).
3640
3641
Take for example Net::OpenSSH L</system> method:
3642
3643
$ssh->system("ls -l *");
3644
$ssh->system('ls', '-l', '/');
3645
3646
The first call passes the argument unchanged to ssh and it is executed
3647
in the remote side through the shell which interprets metacharacters.
3648
3649
The second call escapes any shell metacharacters so that, effectively,
3650
it is equivalent to calling the command directly and not through the
3651
shell.
3652
3653
Under the hood, as the Secure Shell protocol does not provide for this
3654
mode of operation and always spawns a new shell where it runs the
3655
given command, Net::OpenSSH quotes any shell metacharacters in the
3656
command list.
3657
3658
All the methods that invoke a remote command (system, open_ex, etc.)
3659
accept the option C<quote_args> that allows one to force/disable shell
3660
quoting.
3661
3662
For instance:
3663
3664
$ssh->system({quote_args => 1}, "/path with spaces/bin/foo");
3665
3666
will correctly handle the spaces in the program path.
3667
3668
The shell quoting mechanism implements some extensions (for instance,
3669
performing redirections to /dev/null on the remote side) that can be
3670
disabled with the option C<quote_args_extended>:
3671
3672
$ssh->system({ stderr_discard => 1,
3673
quote_args => 1, quote_args_extended => 0 },
3674
@cmd);
3675
3676
The option C<quote_args> can also be used to disable quoting when more
3677
than one argument is passed. For instance, to get some pattern
3678
expanded by the remote shell:
3679
3680
$ssh->system({quote_args => 0}, 'ls', '-l', "/tmp/files_*.dat");
3681
3682
The method C<shell_quote> can be used to selectively quote some
3683
arguments and leave others untouched:
3684
3685
$ssh->system({quote_args => 0},
3686
$ssh->shell_quote('ls', '-l'),
3687
"/tmp/files_*.dat");
3688
3689
When the glob option is set in C<scp> and C<rsync> file transfer
3690
methods, an alternative quoting method which knows about file
3691
wildcards and passes them unquoted is used. The set of wildcards
3692
recognized currently is the one supported by L<bash(1)>.
3693
3694
Another way to selectively use quote globing or fully disable quoting
3695
for some specific arguments is to pass them as scalar references or
3696
double scalar references respectively. In practice, that means
3697
prepending them with one or two backslashes. For instance:
3698
3699
# quote the last argument for globing:
3700
$ssh->system('ls', '-l', \'/tmp/my files/filed_*dat');
3701
3702
# append a redirection to the remote command
3703
$ssh->system('ls', '-lR', \\'>/tmp/ls-lR.txt');
3704
3705
# expand remote shell variables and glob in the same command:
3706
$ssh->system('tar', 'czf', \\'$HOME/out.tgz', \'/var/log/server.*.log');
3707
3708
As shell quoting is a tricky matter, I expect bugs to appear in this
3709
area. You can see how C<ssh> is called, and the quoting used setting
3710
the following debug flag:
3711
3712
$Net::OpenSSH::debug |= 16;
3713
3714
By default, the module assumes the remote shell is some variant of a
3715
POSIX or Bourne shell (C<bash>, C<dash>, C<ksh>, etc.). If this is not
3716
the case, the construction option C<remote_shell> can be used to
3717
select an alternative quoting mechanism.
3718
3719
For instance:
3720
3721
$ssh = Net::OpenSSH->new($host, remote_shell => 'csh');
3722
$ssh->system(echo => "hard\n to\n quote\n argument!");
3723
3724
Currently there are quoters available for POSIX (Bourne) compatible
3725
shells, C<csh> and the two Windows variants C<MSWin> (for servers
3726
using L<Win32::CreateProcess>, see
3727
L<Net::OpenSSH::ShellQuoter::MSWin>) and C<MSCmd> (for servers using
3728
C<cmd.exe>, see L<Net::OpenSSH::ShellQuoter::MSCmd>).
3729
3730
In any case, you can always do the quoting yourself and pass the
3731
quoted remote command as a single string:
3732
3733
# for VMS
3734
$ssh->system('DIR/SIZE NFOO::USERS:[JSMITH.DOCS]*.TXT;0');
3735
3736
Note that the current quoting mechanism does not handle possible
3737
aliases defined by the remote shell. In that case, to force execution
3738
of the command instead of the alias, the full path to the command must
3739
be used.
3740
3741
=head2 Timeouts
3742
3743
In order to stop remote processes when they timeout, the ideal approach
3744
would be to send them signals through the SSH connection as specified
3745
by the protocol standard.
3746
3747
Unfortunately OpenSSH does not implement that feature so Net::OpenSSH
3748
has to use other imperfect approaches:
3749
3750
=over 4
3751
3752
=item * close slave I/O streams
3753
3754
Closing the STDIN and STDOUT streams of the unresponsive remote
3755
process will effectively deliver a SIGPIPE when it tries to access any
3756
of them.
3757
3758
Remote processes may not access STDIN or STDOUT and even them,
3759
Net::OpenSSH can only close these channels when it is capturing them,
3760
so this approach does not always work.
3761
3762
=item * killing the local SSH slave process
3763
3764
This action may leave the remote process running, creating a remote
3765
orphan so Net::OpenSSH does not use it unless the construction option
3766
C<kill_ssh_on_timeout> is set.
3767
3768
=back
3769
3770
Luckily, future versions of OpenSSH will support signaling remote
3771
processes via the mux channel.
3772
3773
=head2 Variable expansion
3774
3775
The variable expansion feature allows one to define variables that are
3776
expanded automatically inside command arguments and file paths.
3777
3778
This feature is disabled by default. It is intended to be used with
3779
L<Net::OpenSSH::Parallel|Net::OpenSSH::Parallel> and other similar
3780
modules.
3781
3782
Variables are delimited by a pair of percent signs (C<%>), for
3783
instance C<%HOST%>. Also, two consecutive percent signs are replaced
3784
by a single one.
3785
3786
The special variables C<HOST>, C<USER> and C<PORT> are maintained
3787
internally by the module and take the obvious values.
3788
3789
Variable expansion is performed before shell quoting (see L</"Shell
3790
quoting">).
3791
3792
Some usage example:
3793
3794
my $ssh = Net::OpenSSH->new('server.foo.com', expand_vars => 1);
3795
$ssh->set_var(ID => 42);
3796
$ssh->system("ls >/tmp/ls.out-%HOST%-%ID%");
3797
3798
will redirect the output of the C<ls> command to
3799
C</tmp/ls.out-server.foo.com-42> on the remote host.
3800
3801
=head2 Tunnels
3802
3803
Besides running commands on the remote host, Net::OpenSSH also allows
3804
one to tunnel TCP connections to remote machines reachable from the
3805
SSH server.
3806
3807
That feature is made available through the C<tunnel> option of the
3808
L</open_ex> method, and also through wrapper methods L</open_tunnel>
3809
and L</capture_tunnel> and most others where it makes sense.
3810
3811
Example:
3812
3813
$ssh->system({tunnel => 1,
3814
stdin_data => "GET / HTTP/1.0\r\n\r\n",
3815
stdout_file => "/tmp/$server.res"},
3816
$server, 80)
3817
or die "unable to retrieve page: " . $ssh->error;
3818
3819
or capturing the output of several requests in parallel:
3820
3821
my @pids;
3822
for (@servers) {
3823
my $pid = $ssh->spawn({tunnel => 1,
3824
stdin_file => "/tmp/request.req",
3825
stdout_file => "/tmp/$_.res"},
3826
$_, 80);
3827
if ($pid) {
3828
push @pids, $pid;
3829
}
3830
else {
3831
warn "unable to spawn tunnel process to $_: " . $ssh->error;
3832
}
3833
}
3834
waitpid ($_, 0) for (@pids);
3835
3836
Under the hood, in order to create a tunnel, a new C<ssh> process is
3837
spawned with the option C<-W${address}:${port}> (available from
3838
OpenSSH 5.4 and upwards) making it redirect its stdio streams to the
3839
remote given address. Unlike when C<ssh> C<-L> options is used to
3840
create tunnels, no TCP port is opened on the local machine at any time
3841
so this is a perfectly secure operation.
3842
3843
The PID of the new process is returned by the named methods. It must
3844
be reaped once the pipe or socket handlers for the local side of the
3845
tunnel have been closed.
3846
3847
OpenSSH 5.4 or later is required for the tunnels functionality to
3848
work. Also, note that tunnel forwarding may be administratively
3849
forbidden at the server side (see L<sshd(8)> and L<sshd_config(5)> or
3850
the documentation provided by your SSH server vendor).
3851
3852
=head2 Data encoding
3853
3854
Net::OpenSSH has some support for transparently converting the data send
3855
or received from the remote server to Perl internal unicode
3856
representation.
3857
3858
The methods supporting that feature are those that move data from/to
3859
Perl data structures (e.g. C<capture>, C<capture2>, C<capture_tunnel>
3860
and methods supporting the C<stdin_data> option). Data accessed through
3861
pipes, sockets or redirections is not affected by the encoding options.
3862
3863
It is also possible to set the encoding of the command and arguments
3864
passed to the remote server on the command line.
3865
3866
By default, if no encoding option is given on the constructor or on the
3867
method calls, Net::OpenSSH will not perform any encoding transformation,
3868
effectively processing the data as C<latin1>.
3869
3870
When data can not be converted between the Perl internal
3871
representation and the selected encoding inside some Net::OpenSSH
3872
method, it will fail with an C<OSSH_ENCODING_ERROR> error.
3873
3874
The supported encoding options are as follows:
3875
3876
=over 4
3877
3878
=item stream_encoding => $encoding
3879
3880
sets the encoding of the data send and received on capture methods.
3881
3882
=item argument_encoding => $encoding
3883
3884
sets the encoding of the command line arguments
3885
3886
=item encoding => $encoding
3887
3888
sets both C<argument_encoding> and C<stream_encoding>.
3889
3890
=back
3891
3892
The constructor also accepts C<default_encoding>,
3893
C<default_stream_encoding> and C<default_argument_encoding> that set the
3894
defaults.
3895
3896
=head2 Diverting C<new>
3897
3898
When a code ref is installed at C<$Net::OpenSSH::FACTORY>, calls to new
3899
will be diverted through it.
3900
3901
That feature can be used to transparently implement connection
3902
caching, for instance:
3903
3904
my $old_factory = $Net::OpenSSH::FACTORY;
3905
my %cache;
3906
3907
sub factory {
3908
my ($class, %opts) = @_;
3909
my $signature = join("\0", $class, map { $_ => $opts{$_} }, sort keys %opts);
3910
my $old = $cache{signature};
3911
return $old if ($old and $old->error != OSSH_MASTER_FAILED);
3912
local $Net::OpenSSH::FACTORY = $old_factory;
3913
$cache{$signature} = $class->new(%opts);
3914
}
3915
3916
$Net::OpenSSH::FACTORY = \&factory;
3917
3918
... and I am sure it can be abused in several other ways!
3919
3920
3921
=head1 3rd PARTY MODULE INTEGRATION
3922
3923
=head2 Expect
3924
3925
Sometimes you would like to use L<Expect> to control some program
3926
running in the remote host. You can do it as follows:
3927
3928
my ($pty, $pid) = $ssh->open2pty(@cmd)
3929
or die "unable to run remote command @cmd";
3930
my $expect = Expect->init($pty);
3931
3932
Then, you will be able to use the new Expect object in C<$expect> as
3933
usual.
3934
3935
=head2 Net::Telnet
3936
3937
This example is adapted from L<Net::Telnet> documentation:
3938
3939
my ($pty, $pid) = $ssh->open2pty({stderr_to_stdout => 1})
3940
or die "unable to start remote shell: " . $ssh->error;
3941
my $telnet = Net::Telnet->new(-fhopen => $pty,
3942
-prompt => '/.*\$ $/',
3943
-telnetmode => 0,
3944
-cmd_remove_mode => 1,
3945
-output_record_separator => "\r");
3946
3947
$telnet->waitfor(-match => $telnet->prompt,
3948
-errmode => "return")
3949
or die "login failed: " . $telnet->lastline;
3950
3951
my @lines = $telnet->cmd("who");
3952
3953
...
3954
3955
$telnet->close;
3956
waitpid($pid, 0);
3957
3958
=head2 mod_perl and mod_perl2
3959
3960
L<mod_perl> and L<mod_perl2> tie STDIN and STDOUT to objects that are
3961
not backed up by real file descriptors at the operative system
3962
level. Net::OpenSSH will fail if any of these handles is used
3963
explicitly or implicitly when calling some remote command.
3964
3965
The work-around is to redirect them to C</dev/null> or to some file:
3966
3967
open my $def_in, '<', '/dev/null' or die "unable to open /dev/null";
3968
my $ssh = Net::OpenSSH->new($host,
3969
default_stdin_fh => $def_in);
3970
3971
my $out = $ssh->capture($cmd1);
3972
$ssh->system({stdout_discard => 1}, $cmd2);
3973
$ssh->system({stdout_to_file => '/tmp/output'}, $cmd3);
3974
3975
Also, note that from a security stand point, running C<ssh> from
3976
inside the web server process is not a great idea. An attacker
3977
exploiting some Apache bug would be able to access the SSH keys and
3978
passwords and gain unlimited access to the remote systems.
3979
3980
If you can, use a queue (as L<TheSchwartz|TheSchwartz>) or any other
3981
mechanism to execute the ssh commands from another process running
3982
under a different user account.
3983
3984
At a minimum, ensure that C<~www-data/.ssh> (or similar) is not
3985
accessible through the web server!
3986
3987
=head2 Other modules
3988
3989
CPAN contains several modules that rely on SSH to perform their duties
3990
as for example L<IPC::PerlSSH|IPC::PerlSSH> or
3991
L<GRID::Machine|GRID::Machine>.
3992
3993
Often, it is possible to instruct them to go through a Net::OpenSSH
3994
multiplexed connection employing some available constructor
3995
option. For instance:
3996
3997
use Net::OpenSSH;
3998
use IPC::PerlIPC;
3999
my $ssh = Net::OpenSSH->new(...);
4000
$ssh->error and die "unable to connect to remote host: " . $ssh->error;
4001
my @cmd = $ssh->make_remote_command('/usr/bin/perl');
4002
my $ipc = IPC::PerlSSH->new(Command => \@cmd);
4003
my @r = $ipc->eval('...');
4004
4005
or...
4006
4007
use GRID::Machine;
4008
...
4009
my @cmd = $ssh->make_remote_command('/usr/bin/perl');
4010
my $grid = GRID::Machine->new(command => \@cmd);
4011
my $r = $grid->eval('print "hello world!\n"');
4012
4013
In other cases, some kind of plugin mechanism is provided by the 3rd
4014
party modules to allow for different transports. The method C<open2>
4015
may be used to create a pair of pipes for transport in these cases.
4016
4017
=head1 TROUBLESHOOTING
4018
4019
Usually, Net::OpenSSH works out of the box, but when it fails, some
4020
users have a hard time finding the cause of the problem. This mini
4021
troubleshooting guide should help you to find and solve it.
4022
4023
=over 4
4024
4025
=item 1 - check the error message
4026
4027
Add in your script, after the Net::OpenSSH constructor call, an error
4028
check:
4029
4030
$ssh = Net::OpenSSH->new(...);
4031
$ssh->error and die "SSH connection failed: " . $ssh->error;
4032
4033
The error message will tell what has gone wrong.
4034
4035
=item 2 - OpenSSH version
4036
4037
Ensure that you have a version of C<ssh> recent enough:
4038
4039
$ ssh -V
4040
OpenSSH_5.1p1 Debian-5, OpenSSL 0.9.8g 19 Oct 2007
4041
4042
OpenSSH version 4.1 was the first to support the multiplexing feature
4043
and is the minimal required by the module to work. I advise you to use
4044
the latest OpenSSH (currently 5.8) or at least a more recent
4045
version.
4046
4047
The C<ssh_cmd> constructor option lets you select the C<ssh> binary to
4048
use. For instance:
4049
4050
$ssh = Net::OpenSSH->new($host,
4051
ssh_cmd => "/opt/OpenSSH/5.8/bin/ssh")
4052
4053
Some hardware vendors (e.g. Sun, err... Oracle) include custom
4054
versions of OpenSSH bundled with the operative system. In principle,
4055
Net::OpenSSH should work with these SSH clients as long as they are
4056
derived from some version of OpenSSH recent enough. Anyway, my advise
4057
is to use the real OpenSSH software if you can!
4058
4059
=item 3 - run ssh from the command line
4060
4061
Check you can connect to the remote host using the same parameters you
4062
are passing to Net::OpenSSH. In particular, ensure that you are
4063
running C<ssh> as the same local user.
4064
4065
If you are running your script from a web server, the user
4066
would probably be C<www>, C<apache> or something alike.
4067
4068
Common problems are:
4069
4070
=over 4
4071
4072
=item *
4073
4074
Remote host public key not present in known_hosts file.
4075
4076
The SSH protocol uses public keys to identify the remote hosts so that
4077
they can not be supplanted by some malicious third parties.
4078
4079
For OpenSSH, usually the server public key is stored in
4080
C</etc/ssh/ssh_host_dsa_key.pub> or in
4081
C</etc/ssh/ssh_host_rsa_key.pub> and that key should be copied into the
4082
C<~/.ssh/known_hosts> file in the local machine (other SSH
4083
implementations may use other file locations).
4084
4085
Maintaining the server keys when several hosts and clients are
4086
involved may be somewhat inconvenient, so most SSH clients, by
4087
default, when a new connection is established to a host whose key is
4088
not in the C<known_hosts> file, show the key and ask the user if he
4089
wants the key copied there.
4090
4091
=item *
4092
4093
Wrong remote host public key in known_hosts file.
4094
4095
This is another common problem that happens when some server is
4096
replaced or reinstalled from scratch and its public key changes
4097
becoming different to that installed on the C<known_hosts> file.
4098
4099
The easiest way to solve that problem is to remove the old key from
4100
the C<known_hosts> file by hand using any editor and then to connect
4101
to the server replying C<yes> when asked to save the new key.
4102
4103
=item *
4104
4105
Wrong permissions for the C<~/.ssh> directory or its contents.
4106
4107
OpenSSH client performs several checks on the access permissions of
4108
the C<~/.ssh> directory and its contents and refuses to use them when
4109
misconfigured. See the FILES section from the L<ssh(1)> man page.
4110
4111
=item *
4112
4113
Incorrect settings for password or public key authentication.
4114
4115
Check that you are using the right password or that the user public
4116
key is correctly installed on the server.
4117
4118
=back
4119
4120
=item 4 - security checks on the multiplexing socket
4121
4122
Net::OpenSSH performs some security checks on the directory where the
4123
multiplexing socket is going to be placed to ensure that it can not be
4124
accessed by other users.
4125
4126
The default location for the multiplexing socket is under
4127
C<~/.libnet-openssh-perl>. It can be changed using the C<ctl_dir> and
4128
C<ctl_path> constructor arguments.
4129
4130
The requirements for that directory and all its parents are:
4131
4132
=over 4
4133
4134
=item *
4135
4136
They have to be owned by the user executing the script or by root
4137
4138
=item *
4139
4140
Their permission masks must be 0755 or more restrictive, so nobody
4141
else has permissions to perform write operations on them.
4142
4143
=back
4144
4145
The constructor option C<strict_mode> disables these security checks,
4146
but you should not use it unless you understand its implications.
4147
4148
=item 5 - file system must support sockets
4149
4150
Some file systems (as for instance FAT or AFS) do not support placing
4151
sockets inside them.
4152
4153
Ensure that the C<ctl_dir> path does not lay into one of those file
4154
systems.
4155
4156
=back
4157
4158
=head1 DEBUGGING
4159
4160
Debugging of Net::OpenSSH internals is controlled through the variable
4161
C<$Net::OpenSSH::debug>. Every bit of this variable activates
4162
debugging of some subsystem as follows:
4163
4164
=over 4
4165
4166
=item bit 1 - errors
4167
4168
Dumps changes on the internal object attribute where errors are stored.
4169
4170
=item bit 2 - ctl_path
4171
4172
Dumps information about ctl_path calculation and the tests performed
4173
on that directory in order to decide if it is secure to place the
4174
multiplexing socket inside.
4175
4176
=item bit 4 - connecting
4177
4178
Dumps information about the establishment of new master connections.
4179
4180
=item bit 8 - commands and arguments
4181
4182
Dumps the command and arguments for every system/exec call.
4183
4184
=item bit 16 - command execution
4185
4186
Dumps information about the progress of command execution.
4187
4188
=item bit 32 - destruction
4189
4190
Dumps information about the destruction of Net::OpenSSH objects and
4191
the termination of the SSH master processes.
4192
4193
=item bit 64 - IO loop
4194
4195
Dumps information about the progress of the IO loop on capture
4196
operations.
4197
4198
=item bit 128 - IO hexdumps
4199
4200
Generates hexdumps of the information that travels through the SSH
4201
streams inside capture operations.
4202
4203
=item bit 512 - OS tracing of the master process
4204
4205
Use the module L<Net::OpenSSH::OSTracer> to trace the SSH master
4206
process at the OS level.
4207
4208
=back
4209
4210
For instance, in order to activate all the debugging flags, you can
4211
use:
4212
4213
$Net::OpenSSH::debug = ~0;
4214
4215
Note that the meaning of the flags and the information generated is
4216
only intended for debugging of the module and may change without
4217
notice between releases.
4218
4219
=head1 FAQ
4220
4221
Frequent questions about the module:
4222
4223
=over
4224
4225
=item Connecting to switches, routers, etc.
4226
4227
B<Q>: I can not get the method C<system>, C<capture>, etc., to work
4228
when connecting to some router, switch, etc. What I am doing wrong?
4229
4230
B<A>: Roughly, the SSH protocol allows for two modes of operation:
4231
command mode and interactive mode.
4232
4233
Command mode is designed to run single commands on the remote host. It
4234
opens an SSH channel between both hosts, ask the remote computer to
4235
run some given command and when it finish the channel is closed. It
4236
is what you get, for instance, when you run something as...
4237
4238
$ ssh my.unix.box cat foo.txt
4239
4240
... and it is also the way Net::OpenSSH runs commands on the remote
4241
host.
4242
4243
Interactive mode launches a shell on the remote hosts with its stdio
4244
streams redirected to the local ones so that the user can
4245
transparently interact with it.
4246
4247
Some devices (as probably the one you are using) do not run an
4248
standard, general purpose shell (e.g. C<bash>, C<csh> or C<ksh>) but
4249
some custom program specially targeted and limited to the task of
4250
configuring the device.
4251
4252
Usually, the SSH server running on these devices does not support
4253
command mode. It unconditionally attaches the restricted shell to any
4254
incoming SSH connection and waits for the user to enter commands
4255
through the redirected stdin stream.
4256
4257
The only way to work-around this limitation is to make your script talk
4258
to the restricted shell (1-open a new SSH session, 2-wait for the
4259
shell prompt, 3-send a command, 4-read the output until you get to the
4260
shell prompt again, repeat from 3). The best tool for this task is
4261
probably L<Expect>, used alone, as wrapped by L<Net::SSH::Expect> or
4262
combined with Net::OpenSSH (see L</Expect>).
4263
4264
There are some devices that support command mode but that only accept
4265
one command per connection. In that cases, using L<Expect> is also
4266
probably the best option.
4267
4268
=item Connection fails
4269
4270
B<Q>: I am unable to make the module connect to the remote host...
4271
4272
B<A>: Have you read the troubleshooting section? (see
4273
L</TROUBLESHOOTING>).
4274
4275
=item Disable StrictHostKeyChecking
4276
4277
B<Q>: Why is C<ssh> not run with C<StrictHostKeyChecking=no>?
4278
4279
B<A>: Using C<StrictHostKeyChecking=no> relaxes the default security
4280
level of SSH and it will be relatively easy to end with a
4281
misconfigured SSH (for instance, when C<known_hosts> is unwritable)
4282
that could be forged to connect to a bad host in order to perform
4283
man-in-the-middle attacks, etc.
4284
4285
I advice you to do not use that option unless you fully understand its
4286
implications from a security point of view.
4287
4288
If you want to use it anyway, past it to the constructor:
4289
4290
$ssh = Net::OpenSSH->new($host,
4291
master_opts => [-o => "StrictHostKeyChecking=no"],
4292
...);
4293
4294
4295
=item child process 14947 does not exist: No child processes
4296
4297
B<Q>: Calls to C<system>, C<capture> or C<capture2> fail with the
4298
previous error, what I am doing wrong?
4299
4300
B<A>: That usually happens when C<$SIG{CHLD}> is set to C<IGNORE> or
4301
to some custom handler reaping child processes by itself. In order to
4302
solve the problem just disable the handler during the method call:
4303
4304
local $SIG{CHLD};
4305
$ssh->system($cmd);
4306
4307
=item child process STDIN/STDOUT/STDERR is not a real system file
4308
handle
4309
4310
B<Q>: Calls to C<system>, C<capture>, etc. fail with the previous
4311
error, what's happening?
4312
4313
B<A>: The reported stdio stream is closed or is not attached to a real
4314
file handle (e.g. it is a tied handle). Redirect it to C</dev/null> or
4315
to a real file:
4316
4317
my $out = $ssh->capture({stdin_discard => 1, stderr_to_stdout => 1},
4318
$cmd);
4319
4320
See also the L<mod_perl> entry above.
4321
4322
=item Solaris (and AIX and probably others)
4323
4324
B<Q>: I was trying Net::OpenSSH on Solaris and seem to be running into
4325
an issue...
4326
4327
B<A>: The SSH client bundled with Solaris is an early fork of OpenSSH
4328
that does not provide the multiplexing functionality required by
4329
Net::OpenSSH. You will have to install the OpenSSH client.
4330
4331
Precompiled packages are available from Sun Freeware
4332
(L<http://www.sunfreeware.com>). There, select your OS version an CPU
4333
architecture, download the OpenSSH package and its dependencies and
4334
install them. Note that you do B<not> need to configure Solaris to use
4335
the OpenSSH server C<sshd>.
4336
4337
Ensure that OpenSSH client is in your path before the system C<ssh> or
4338
alternatively, you can hardcode the full path into your scripts
4339
as follows:
4340
4341
$ssh = Net::OpenSSH->new($host,
4342
ssh_cmd => '/usr/local/bin/ssh');
4343
4344
AIX and probably some other unixen, also bundle SSH clients lacking
4345
the multiplexing functionality and require installation of the real
4346
OpenSSH.
4347
4348
=item Can not change working directory
4349
4350
B<Q>: I want to run some command inside a given remote directory but I
4351
am unable to change the working directory. For instance:
4352
4353
$ssh->system('cd /home/foo/bin');
4354
$ssh->systen('ls');
4355
4356
does not list the contents of C</home/foo/bin>.
4357
4358
What am I doing wrong?
4359
4360
B<A>: Net::OpenSSH (and, for that matter, all the SSH modules
4361
available from CPAN but L<Net::SSH::Expect>) runs every command in a
4362
new session so most shell builtins that are run for its side effects
4363
become useless (e.g. C<cd>, C<export>, C<ulimit>, C<umask>, etc.,
4364
usually, you can list them running help from the shell).
4365
4366
A work around is to combine several commands in one, for instance:
4367
4368
$ssh->system('cd /home/foo/bin && ls');
4369
4370
Note the use of the shell C<&&> operator instead of C<;> in order to
4371
abort the command as soon as any of the subcommands fail.
4372
4373
Also, several commands can be combined into one while still using the
4374
multi-argument quoting feature as follows:
4375
4376
$ssh->system(@cmd1, \\'&&', @cmd2, \\'&&', @cmd3, ...);
4377
4378
=item Running detached remote processes
4379
4380
B<Q>: I need to be able to ssh into several machines from my script,
4381
launch a process to run in the background there, and then return
4382
immediately while the remote programs keep running...
4383
4384
B<A>: If the remote systems run some Unix/Linux variant, the right
4385
approach is to use L<nohup(1)> that will disconnect the remote process
4386
from the stdio streams and to ask the shell to run the command on the
4387
background. For instance:
4388
4389
$ssh->system("nohup $long_running_command &");
4390
4391
Also, it may be possible to demonize the remote program. If it is
4392
written in Perl you can use L<App::Daemon> for that (actually, there
4393
are several CPAN modules that provided that kind of functionality).
4394
4395
In any case, note that you should not use L</spawn> for that.
4396
4397
=item MaxSessions server limit reached
4398
4399
B<Q>: I created an C<$ssh> object and then fork a lot children
4400
processes which use this object. When the children number is bigger
4401
than C<MaxSessions> as defined in sshd configuration (defaults to 10),
4402
trying to fork new remote commands will prompt the user for the
4403
password.
4404
4405
B<A>: When the slave SSH client gets a response from the remote
4406
servers saying that the maximum number of sessions for the current
4407
connection has been reached, it fall backs to open a new direct
4408
connection without going through the multiplexing socket.
4409
4410
To stop that for happening, the following hack can be used:
4411
4412
$ssh = Net::OpenSSH->new(host,
4413
default_ssh_opts => ['-oConnectionAttempts=0'],
4414
...);
4415
4416
=item Running remote commands with sudo
4417
4418
B<Q>: How can I run remote commands using C<sudo> to become root first?
4419
4420
B<A>: The simplest way is to tell C<sudo> to read the password from
4421
stdin with the C<-S> flag and to do not use cached credentials
4422
with the C<-k> flag. You may also like to use the C<-p> flag to tell
4423
C<sudo> to print an empty prompt. For instance:
4424
4425
my @out = $ssh->capture({stdin_data => "$sudo_passwd\n"},
4426
'sudo', '-Sk',
4427
'-p', '',
4428
'--',
4429
@cmd);
4430
4431
If the version of sudo installed on the remote host does not support
4432
the C<-S> flag (it tells sudo to read the password from its STDIN
4433
stream), you can do it as follows:
4434
4435
my @out = $ssh->capture({tty => 1,
4436
stdin_data => "$sudo_passwd\n"},
4437
'sudo', '-k',
4438
'-p', '',
4439
'--',
4440
@cmd);
4441
4442
This may generate an spurious and harmless warning from the SSH master
4443
connection (because we are requesting allocation of a tty on the
4444
remote side and locally we are attaching it to a regular pair of
4445
pipes).
4446
4447
If for whatever reason the methods described above fail, you can
4448
always revert to using Expect to talk to the remote C<sudo>. See the
4449
C<sample/expect.pl> script from this module distribution.
4450
4451
=back
4452
4453
=head1 SEE ALSO
4454
4455
OpenSSH client documentation L<ssh(1)>, L<ssh_config(5)>, the project
4456
web L<http://www.openssh.org> and its FAQ
4457
L<http://www.openbsd.org/openssh/faq.html>. L<scp(1)> and
4458
L<rsync(1)>. The OpenSSH Wikibook
4459
L<http://en.wikibooks.org/wiki/OpenSSH>.
4460
4461
L<Net::OpenSSH::Gateway> for detailed instruction about how to get
4462
this module to connect to hosts through proxies and other SSH gateway
4463
servers.
4464
4465
Core perl documentation L<perlipc>, L<perlfunc/open>,
4466
L<perlfunc/waitpid>.
4467
4468
L<IO::Pty|IO::Pty> to known how to use the pseudo tty objects returned
4469
by several methods on this package.
4470
4471
L<Net::SFTP::Foreign|Net::SFTP::Foreign> provides a compatible SFTP
4472
implementation.
4473
4474
L<Expect|Expect> can be used to interact with commands run through
4475
this module on the remote machine (see also the C<expect.pl> and
4476
<autosudo.pl> scripts in the sample directory).
4477
4478
L<SSH::OpenSSH::Parallel> is an advanced scheduler that allows one to run
4479
commands in remote hosts in parallel. It is obviously based on
4480
Net::OpenSSH.
4481
4482
L<SSH::Batch|SSH::Batch> allows one to run remote commands in parallel in
4483
a cluster. It is build on top on C<Net::OpenSSH> also.
4484
4485
Other Perl SSH clients: L<Net::SSH::Perl|Net::SSH::Perl>,
4486
L<Net::SSH2|Net::SSH2>, L<Net::SSH|Net::SSH>,
4487
L<Net::SSH::Expect|Net::SSH::Expect>, L<Net::SCP|Net::SCP>,
4488
L<Net::SSH::Mechanize|Net::SSH::Mechanize>.
4489
4490
L<Net::OpenSSH::Compat> is a package offering a set of compatibility
4491
layers for other SSH modules on top of Net::OpenSSH.
4492
4493
L<IPC::PerlSSH|IPC::PerlSSH>, L<GRID::Machine|GRID::Machine> allow
4494
execution of Perl code in remote machines through SSH.
4495
4496
L<SSH::RPC|SSH::RPC> implements an RPC mechanism on top of SSH using
4497
Net::OpenSSH to handle the connections.
4498
4499
=head1 BUGS AND SUPPORT
4500
4501
=head2 Experimental features
4502
4503
Support for the setpgrp feature is highly experimental.
4504
4505
Support for the gateway feature is highly experimental and mostly stalled.
4506
4507
Support for data encoding is experimental.
4508
4509
Support for taint mode is experimental.
4510
4511
=head2 Known issues
4512
4513
Net::OpenSSH does not work on Windows. OpenSSH multiplexing feature
4514
requires passing file handles through sockets, something that is not
4515
supported by any version of Windows.
4516
4517
It does not work on VMS either... well, probably, it does not work on
4518
anything not resembling a modern Linux/Unix OS.
4519
4520
Old versions of OpenSSH C<ssh> may leave stdio streams in non-blocking
4521
mode. That can result on failures when writing to C<STDOUT> or
4522
C<STDERR> after using the module. In order to work-around this issue,
4523
Perl L<perlfunc/fcntl> can be used to unset the non-blocking flag:
4524
4525
use Fcntl qw(F_GETFL F_SETFL O_NONBLOCK);
4526
my $flags = fcntl(STDOUT, F_GETFL, 0);
4527
fcntl(STDOUT, F_SETFL, $flags & ~O_NONBLOCK);
4528
4529
=head2 Git repository
4530
4531
The source code of this module is hosted at GitHub:
4532
L<http://github.com/salva/p5-Net-OpenSSH>.
4533
4534
=head2 Reporting bugs and asking for help
4535
4536
To report bugs send an email to the address that appear below or use
4537
the CPAN bug tracking system at L<http://rt.cpan.org>.
4538
4539
B<Post questions related to how to use the module in PerlMonks>
4540
L<http://perlmonks.org/>, you will probably get faster responses than
4541
if you address me directly and I visit PerlMonks quite often, so I
4542
will see your question anyway.
4543
4544
=head2 Commercial support
4545
4546
Commercial support, professional services and custom software
4547
development around this module are available through my current
4548
company. Drop me an email with a rough description of your
4549
requirements and we will get back to you ASAP.
4550
4551
=head2 My wishlist
4552
4553
If you like this module and you are feeling generous, take a look at
4554
my Amazon Wish List: L<http://amzn.com/w/1WU1P6IR5QZ42>.
4555
4556
Also consider contributing to the OpenSSH project this module builds
4557
upon: L<http://www.openssh.org/donations.html>.
4558
4559
=head1 TODO
4560
4561
- *** add tests for C<scp_*>, C<rsync_*> and C<sftp> methods
4562
4563
- *** add support for more target operating systems (quoting, OpenVMS,
4564
Windows & others)
4565
4566
- better timeout handling in system and capture methods
4567
4568
- make L</pipe_in> and L</pipe_out> methods L</open_ex> based
4569
4570
- add C<scp_cat> and similar methods
4571
4572
- async disconnect
4573
4574
- currently wait_for_master does not honor timeout
4575
4576
- auto_discard_streams feature for mod_perl2 and similar environments
4577
4578
- add proper shell quoting for Windows (see
4579
L<http://blogs.msdn.com/b/twistylittlepassagesallalike/archive/2011/04/23/everyone-quotes-arguments-the-wrong-way.aspx>).
4580
4581
- refactor open_ex support for multiple commands, maybe just keeping tunnel, ssh and raw
4582
4583
Send your feature requests, ideas or any feedback, please!
4584
4585
=head1 COPYRIGHT AND LICENSE
4586
4587
Copyright (C) 2008-2014 by Salvador FandiE<ntilde>o
4588
(sfandino@yahoo.com)
4589
4590
This library is free software; you can redistribute it and/or modify
4591
it under the same terms as Perl itself, either Perl version 5.10.0 or,
4592
at your option, any later version of Perl 5 you may have available.
4593
4594
=cut
Loggerhead is a web-based interface for Breezy
Version: 2.0.1