Initial Commit
This commit is contained in:
563
database/perl/vendor/lib/Net/SSH2/Channel.pm
vendored
Normal file
563
database/perl/vendor/lib/Net/SSH2/Channel.pm
vendored
Normal file
@@ -0,0 +1,563 @@
|
||||
package Net::SSH2::Channel;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
use Carp;
|
||||
|
||||
# methods
|
||||
|
||||
sub shell {
|
||||
$_[0]->process('shell')
|
||||
}
|
||||
|
||||
sub exec {
|
||||
$_[0]->process(exec => $_[1])
|
||||
}
|
||||
|
||||
sub subsystem {
|
||||
$_[0]->process(subsystem => $_[1])
|
||||
}
|
||||
|
||||
sub error {
|
||||
shift->session->error(@_)
|
||||
}
|
||||
|
||||
sub blocking {
|
||||
shift->session->blocking(@_)
|
||||
}
|
||||
|
||||
sub setenv {
|
||||
my ($self, %env) = @_;
|
||||
my $rc = 1;
|
||||
while (my ($k, $v) = each %env) {
|
||||
$self->_setenv($k, $v)
|
||||
or undef $rc;
|
||||
}
|
||||
$rc
|
||||
}
|
||||
|
||||
sub read1 {
|
||||
my $self = shift;
|
||||
my $buffer;
|
||||
my $rc = $self->read($buffer, @_);
|
||||
return (defined $rc ? $buffer : undef);
|
||||
}
|
||||
|
||||
sub read2 {
|
||||
my ($self, $max_size) = @_;
|
||||
$max_size = 32678 unless defined $max_size;
|
||||
my $ssh2 = $self->session;
|
||||
my $old_blocking = $ssh2->blocking;
|
||||
my $timeout = $ssh2->timeout;
|
||||
my $delay = (($timeout and $timeout < 2000) ? 0.0005 * $timeout : 1);
|
||||
my $deadline;
|
||||
$deadline = time + 1 + 0.001 * $timeout if $timeout;
|
||||
$ssh2->blocking(0);
|
||||
while (1) {
|
||||
my @out;
|
||||
my $bytes;
|
||||
my $fail;
|
||||
my $zero;
|
||||
for (0, 1) {
|
||||
my $rc = $self->read($out[$_], $max_size, $_);
|
||||
if (defined $rc) {
|
||||
$rc or $zero++;
|
||||
$bytes += $rc;
|
||||
$deadline = time + 1 + 0.001 * $timeout if $timeout;
|
||||
}
|
||||
else {
|
||||
$out[$_] = '';
|
||||
if ($ssh2->error != Net::SSH2::LIBSSH2_ERROR_EAGAIN()) {
|
||||
$fail++;
|
||||
last;
|
||||
}
|
||||
}
|
||||
}
|
||||
if ($bytes) {
|
||||
$ssh2->blocking($old_blocking);
|
||||
return (wantarray ? @out : $out[0])
|
||||
}
|
||||
my $eof = $self->eof;
|
||||
if ($fail or $eof) {
|
||||
$ssh2->_set_error if $eof;
|
||||
$ssh2->blocking($old_blocking);
|
||||
return;
|
||||
}
|
||||
unless ($zero) {
|
||||
return unless $old_blocking;
|
||||
if ($deadline and time > $deadline) {
|
||||
$ssh2->_set_error(Net::SSH2::LIBSSH2_ERROR_TIMEOUT(), "Time out waiting for data");
|
||||
return;
|
||||
}
|
||||
my $sock = $ssh2->sock;
|
||||
my $fn = fileno($sock);
|
||||
my ($rbm, $wbm) = ('', '');
|
||||
my $bd = $ssh2->block_directions;
|
||||
vec($rbm, $fn, 1) = 1 if $bd & Net::SSH2::LIBSSH2_SESSION_BLOCK_INBOUND();
|
||||
vec($wbm, $fn, 1) = 1 if $bd & Net::SSH2::LIBSSH2_SESSION_BLOCK_OUTBOUND();
|
||||
select $rbm, $wbm, undef, $delay;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
my $readline_non_blocking_warned;
|
||||
sub readline {
|
||||
my ($self, $ext, $eol) = @_;
|
||||
return if $self->eof;
|
||||
$ext ||= 0;
|
||||
$eol = $/ unless @_ >= 3;
|
||||
|
||||
$self->blocking or $readline_non_blocking_warned++ or
|
||||
warnings::warnif('Net::SSH2',
|
||||
"Calling Net::SSH2::Channel::readline in non-blocking mode is usually a programming error");
|
||||
|
||||
if (wantarray or not defined $eol) {
|
||||
my $data = '';
|
||||
my $buffer;
|
||||
while (1) {
|
||||
my $bytes = $self->read($buffer, 32768, $ext);
|
||||
last unless defined $bytes;
|
||||
if (!$bytes and $self->eof) {
|
||||
$self->session->_set_error(Net::SSH2::LIBSSH2_ERROR_NONE());
|
||||
last;
|
||||
}
|
||||
$data .= $buffer;
|
||||
}
|
||||
defined $eol and return split /(?<=\Q$eol\E)/s, $data;
|
||||
wantarray and not length $data and return ();
|
||||
return $data;
|
||||
}
|
||||
else {
|
||||
my $c;
|
||||
my $data = '';
|
||||
while (1) {
|
||||
$c = $self->getc($ext);
|
||||
last unless defined $c;
|
||||
$data .= $c;
|
||||
if ( (!length($c) and $self->eof) or
|
||||
$data =~ /\Q$eol\E\z/) {
|
||||
$self->session->_set_error(Net::SSH2::LIBSSH2_ERROR_NONE());
|
||||
last;
|
||||
}
|
||||
}
|
||||
return (length $data ? $data : undef);
|
||||
}
|
||||
}
|
||||
|
||||
sub wait_closed {
|
||||
my $self = shift;
|
||||
if ($self->wait_eof) {
|
||||
$self->flush('all');
|
||||
return $self->_wait_closed;
|
||||
}
|
||||
undef;
|
||||
}
|
||||
|
||||
sub exit_status {
|
||||
my $self = shift;
|
||||
return unless $self->wait_closed;
|
||||
return $self->_exit_status;
|
||||
}
|
||||
|
||||
sub exit_signal {
|
||||
my $self = shift;
|
||||
return unless $self->wait_closed;
|
||||
return $self->_exit_signal;
|
||||
}
|
||||
|
||||
my %signal_number;
|
||||
sub exit_signal_number {
|
||||
my $self = shift;
|
||||
my $signal = $self->exit_signal;
|
||||
return unless defined $signal;
|
||||
return 0 unless $signal;
|
||||
unless (%signal_number) {
|
||||
require Config;
|
||||
my @names = split /\s+/, $Config::Config{sig_name};
|
||||
@signal_number{@names} = 0..$#names;
|
||||
}
|
||||
$signal =~ s/\@\.[^\.]+\.config\.guess$//;
|
||||
my $number = $signal_number{$signal};
|
||||
$number = 255 unless defined $number;
|
||||
return $number;
|
||||
}
|
||||
|
||||
my %pty_modes = (TTY_OP_END => 0, VINTR => 1, VQUIT => 2, VERASE => 3, VKILL => 4, VEOF => 5,
|
||||
VEOL => 6, VEOL2 => 7, VSTART => 8, VSTOP => 9, VSUSP => 10, VDSUSP => 11,
|
||||
VREPRINT => 12, VWERASE => 13, VLNEXT => 14, VFLUSH => 15, VSWTCH => 16, VSTATUS => 17,
|
||||
VDISCARD => 18, IGNPAR => 30, PARMRK => 31, INPCK => 32, ISTRIP => 33, INLCR => 34,
|
||||
IGNCR => 35, ICRNL => 36, IUCLC => 37, IXON => 38, IXANY => 39, IXOFF => 40,
|
||||
IMAXBEL => 41, ISIG => 50, ICANON => 51, XCASE => 52, ECHO => 53, ECHOE => 54,
|
||||
ECHOK => 55, ECHONL => 56, NOFLSH => 57, TOSTOP => 58, IEXTEN => 59, ECHOCTL => 60,
|
||||
ECHOKE => 61, PENDIN => 62, OPOST => 70, OLCUC => 71, ONLCR => 72, OCRNL => 73,
|
||||
ONOCR => 74, ONLRET => 75, CS7 => 90, CS8 => 91, PARENB => 92, PARODD => 93,
|
||||
TTY_OP_ISPEED => 128, TTY_OP_OSPEED => 129);
|
||||
|
||||
sub pty {
|
||||
my $self = shift;
|
||||
if (defined $_[1] and ref $_[1] eq 'HASH') {
|
||||
my $term = shift;
|
||||
my $modes = shift;
|
||||
my $packed = '';
|
||||
while (my ($k, $v) = each %$modes) {
|
||||
unless ($k =~ /^\d+$/) {
|
||||
my $k1 = $pty_modes{uc $k};
|
||||
defined $k1 or croak "Invalid pty mode key '$k'";
|
||||
$k = $k1;
|
||||
}
|
||||
next if $k == 0; # ignore the TTY_OP_END marker
|
||||
$k > 159 and croak "Invalid pty mode key '$k'";
|
||||
$packed .= pack CN => $k, $v;
|
||||
}
|
||||
$self->_pty($term, "$packed\x00", @_);
|
||||
}
|
||||
else {
|
||||
$self->_pty(@_);
|
||||
}
|
||||
}
|
||||
|
||||
# tie interface
|
||||
|
||||
sub PRINT {
|
||||
my $self = shift;
|
||||
my $sep = defined($,) ? $, : '';
|
||||
$self->write(join $sep, @_)
|
||||
}
|
||||
|
||||
sub PRINTF {
|
||||
my $self = shift;
|
||||
my $template = shift;
|
||||
$self->write(sprintf $template, @_);
|
||||
}
|
||||
|
||||
sub WRITE {
|
||||
my ($self, $buf, $len, $offset) = @_;
|
||||
$self->write(substr($buf, $offset || 0, $len))
|
||||
}
|
||||
|
||||
sub READLINE { shift->readline(0, $/) }
|
||||
|
||||
sub READ {
|
||||
my ($self, undef, $len, $offset) = @_;
|
||||
my $bytes = $self->read(my($buffer), $len);
|
||||
substr($_[1], $offset || 0) = $buffer
|
||||
if defined $bytes;
|
||||
return $bytes;
|
||||
}
|
||||
|
||||
sub BINMODE { 1 }
|
||||
|
||||
sub CLOSE {
|
||||
my $self = shift;
|
||||
my $ob = $self->blocking;
|
||||
$self->blocking(1);
|
||||
my $rc = undef;
|
||||
if ($self->close and
|
||||
$self->wait_closed) {
|
||||
my $status = $self->exit_status;
|
||||
my $signal = $self->exit_signal_number;
|
||||
$self->session->_set_error;
|
||||
$? = ($status << 8) | $signal;
|
||||
$rc = 1 if $? == 0;
|
||||
}
|
||||
$self->blocking($ob);
|
||||
$rc;
|
||||
}
|
||||
|
||||
sub EOF {
|
||||
my $self = shift;
|
||||
$self->eof;
|
||||
}
|
||||
|
||||
*GETC = \&getc;
|
||||
|
||||
1;
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Net::SSH2::Channel - SSH2 channel object
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
my $chan = $ssh2->channel()
|
||||
or $ssh2->die_with_error;
|
||||
|
||||
$chan->exec("ls -ld /usr/local/libssh2*")
|
||||
or $ssh2->die_with_error;
|
||||
|
||||
$chan->send_eof;
|
||||
|
||||
while (<$chan>) {
|
||||
print "line read: $_";
|
||||
}
|
||||
|
||||
print "exit status: " . $chan->exit_status . "\n";
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
A channel object is created by the L<Net::SSH2> C<channel> method. As well
|
||||
as being an object, it is also a tied filehandle.
|
||||
|
||||
=head2 setenv ( key, value ... )
|
||||
|
||||
Sets remote environment variables. Note that most servers do not allow
|
||||
environment variables to be freely set.
|
||||
|
||||
Pass in a list of keys and values with the values to set.
|
||||
|
||||
It returns a true value if all the given environment variables were
|
||||
correctly set.
|
||||
|
||||
=head2 blocking ( flag )
|
||||
|
||||
Enable or disable blocking.
|
||||
|
||||
Note that this is currently implemented in libssh2 by setting a
|
||||
per-session flag. It's equivalent to L<Net::SSH2::blocking>.
|
||||
|
||||
=head2 eof
|
||||
|
||||
Returns true if the remote server sent an EOF.
|
||||
|
||||
=head2 send_eof
|
||||
|
||||
Sends an EOF to the remote side.
|
||||
|
||||
After an EOF has been sent, no more data may be
|
||||
sent to the remote process C<STDIN> channel.
|
||||
|
||||
Note that if a PTY was requested for the channel, the EOF may be
|
||||
ignored by the remote server. See L</pty>.
|
||||
|
||||
=head2 close
|
||||
|
||||
Close the channel (happens automatically on object destruction).
|
||||
|
||||
=head2 wait_closed
|
||||
|
||||
Wait for a remote close event.
|
||||
|
||||
In order to avoid a bug in libssh2 this method discards any unread
|
||||
data queued in the channel.
|
||||
|
||||
=head2 exit_status
|
||||
|
||||
Returns the channel's program exit status.
|
||||
|
||||
This method blocks until the remote side closes the channel.
|
||||
|
||||
=head2 pty ( terminal [, modes [, width [, height ]]] )
|
||||
|
||||
Request a terminal on a channel.
|
||||
|
||||
C<terminal> is the type of emulation (e.g. vt102, ansi,
|
||||
etc...).
|
||||
|
||||
C<modes> are the terminal mode modifiers, for instance:
|
||||
|
||||
$c->pty('vt100', { echo => 0, vintr => ord('k') });
|
||||
|
||||
The list of acceptable mode modifiers is available from the SSH Connection
|
||||
Protocol RFC (L<RFC4254|https://tools.ietf.org/html/rfc4254#section-8>).
|
||||
|
||||
If provided, C<width> and C<height> are the width and height in
|
||||
characters (defaults to 80x24); if negative their absolute values
|
||||
specify width and height in pixels.
|
||||
|
||||
=head2 pty_size ( width, height )
|
||||
|
||||
Request a terminal size change on a channel. C<width> and C<height> are the
|
||||
width and height in characters; if negative their absolute values specify
|
||||
width and height in pixels.
|
||||
|
||||
=head2 ext_data ( mode )
|
||||
|
||||
Set extended data handling mode:
|
||||
|
||||
=over 4
|
||||
|
||||
=item normal (default)
|
||||
|
||||
Keep data in separate channels; C<STDERR> is read separately.
|
||||
|
||||
=item ignore
|
||||
|
||||
Ignore all extended data.
|
||||
|
||||
=item merge
|
||||
|
||||
Merge into the regular channel.
|
||||
|
||||
=back
|
||||
|
||||
=head2 process ( request, message )
|
||||
|
||||
Start a process on the channel. See also L<shell>, L<exec>, L<subsystem>.
|
||||
|
||||
Note that only one invocation of C<process> or any of the shortcuts
|
||||
C<shell>, C<exec> or C<subsystem> is allowed per channel. In order to
|
||||
run several commands, shells or/and subsystems, a new C<Channel>
|
||||
instance must be used for every one.
|
||||
|
||||
Alternatively, it is also possible to launch a remote shell (using
|
||||
L<shell>) and simulate the user interaction printing commands to its
|
||||
C<stdin> stream and reading data back from its C<stdout> and
|
||||
C<stderr>. But this approach should be avoided if possible; talking to
|
||||
a shell is difficult and, in general, unreliable.
|
||||
|
||||
=head2 shell
|
||||
|
||||
Start a shell on the remote host (calls C<process("shell")>).
|
||||
|
||||
=head2 exec ( command )
|
||||
|
||||
Execute the command on the remote host (calls C<process("exec", command)>).
|
||||
|
||||
Note that the given command is parsed by the remote shell; it should
|
||||
be properly quoted, specially when passing data from untrusted sources.
|
||||
|
||||
=head2 subsystem ( name )
|
||||
|
||||
Run subsystem on the remote host (calls C<process("subsystem", name)>).
|
||||
|
||||
=head2 read ( buffer, max_size [, ext ] )
|
||||
|
||||
Attempts to read up to C<max_size> bytes from the channel into C<buffer>. If
|
||||
C<ext> is true, reads from the extended data channel (C<STDERR>).
|
||||
|
||||
The method returns as soon as some data is available, even if the
|
||||
given size has not been reached.
|
||||
|
||||
Returns number of bytes read or C<undef> on failure. Note that 0 is a
|
||||
valid return code.
|
||||
|
||||
=head2 read2 ( [max_size] )
|
||||
|
||||
Attempts to read from both the ordinary (stdout) and the extended
|
||||
(stderr) channel streams.
|
||||
|
||||
Returns two scalars with the data read both from stdout and stderr. It
|
||||
returns as soon as some data is available and any of the returned
|
||||
values may be an empty string.
|
||||
|
||||
When some error happens it returns the empty list.
|
||||
|
||||
Example:
|
||||
|
||||
my ($out, $err) = ('', '');
|
||||
while (!$channel->eof) {
|
||||
if (my ($o, $e) = $channel->read2) {
|
||||
$out .= $o;
|
||||
$err .= $e;
|
||||
}
|
||||
else {
|
||||
$ssh2->die_with_error;
|
||||
}
|
||||
}
|
||||
print "STDOUT:\n$out\nSTDERR:\n$err\n";
|
||||
|
||||
=head2 readline ( [ext [, eol ] ] )
|
||||
|
||||
Reads the next line from the selected stream (C<ext> defaults to 0:
|
||||
stdout).
|
||||
|
||||
C<$/> is used as the end of line marker when C<eol> is C<undef>.
|
||||
|
||||
In list context reads and returns all the remaining lines until some
|
||||
read error happens or the remote side sends an eof.
|
||||
|
||||
Note that this method is only safe when the complementary stream
|
||||
(e.g. C<!ext>) is guaranteed to not generate data or when L</ext_data>
|
||||
has been used to discard or merge it; otherwise it may hang. This is a
|
||||
limitation of libssh2 that hopefully would be removed in a future
|
||||
release, in the meantime you are advised to use L<read2> instead.
|
||||
|
||||
=head2 getc( [ext] )
|
||||
|
||||
Reads and returns the next character from the selected stream.
|
||||
|
||||
Returns C<undef> on error.
|
||||
|
||||
Note that due to some libssh2 quirks, the return value can be the
|
||||
empty string which may indicate an EOF condition (but not
|
||||
always!). See L</eof>.
|
||||
|
||||
=head2 write ( buffer )
|
||||
|
||||
Send the data in C<buffer> through the channel. Returns number of
|
||||
bytes written, undef on failure.
|
||||
|
||||
In versions of this module prior to 0.57, when working in non-blocking
|
||||
mode, the would-block condition was signaled by returning
|
||||
C<LIBSSH2_ERROR_EAGAIN> (a negative number) while leaving the session
|
||||
error status unset. From version 0.59, C<undef> is returned and the
|
||||
session error status is set to C<LIBSSH2_ERROR_EAGAIN> as for any
|
||||
other error.
|
||||
|
||||
In non-blocking mode, if C<write> fails with a C<LIBSSH2_ERROR_EAGAIN>
|
||||
error, no other operation must be invoked over any object in the same
|
||||
SSH session besides L</sock> and L<blocking_directions>.
|
||||
|
||||
Once the socket becomes ready again, the exact same former C<write>
|
||||
call, with exactly the same arguments must be invoked.
|
||||
|
||||
Failing to do that would result in a corrupted SSH session. This is a
|
||||
limitation in libssh2.
|
||||
|
||||
=head2 flush ( [ ext ] )
|
||||
|
||||
Discards the received but still unread data on the channel; if C<ext>
|
||||
is present and set, discards data on the extended channel. Returns
|
||||
number of bytes discarded, C<undef> on error.
|
||||
|
||||
=head2 exit_signal
|
||||
|
||||
Returns the name of exit signal from the remote command.
|
||||
|
||||
In list context returns also the error message and a language tag,
|
||||
though as of libssh2 1.7.0, those values are always undef.
|
||||
|
||||
This method blocks until the remote side closes the channel.
|
||||
|
||||
=head2 exit_signal_number
|
||||
|
||||
Converts the signal name to a signal number using the local mapping
|
||||
(which may be different to the remote one if the operating systems
|
||||
differ).
|
||||
|
||||
=head2 window_read
|
||||
|
||||
Returns the number of bytes which the remote end may send without
|
||||
overflowing the window limit.
|
||||
|
||||
In list context it also returns the number of bytes that are
|
||||
immediately available for read and the size of the initial window.
|
||||
|
||||
=head2 window_write
|
||||
|
||||
Returns the number of bytes which may be safely written to the channel
|
||||
without blocking at the SSH level. In list context it also returns the
|
||||
size of the initial window.
|
||||
|
||||
Note that this method doesn't take into account the TCP connection
|
||||
being used under the hood. Getting a positive integer back from this
|
||||
method does not guarantee that such number of bytes could be written
|
||||
to the channel without blocking the TCP connection.
|
||||
|
||||
=head2 receive_window_adjust (adjustment [, force])
|
||||
|
||||
Adjust the channel receive window by the given C<adjustment> bytes.
|
||||
|
||||
If the amount to be adjusted is less than C<LIBSSH2_CHANNEL_MINADJUST>
|
||||
and force is false the adjustment amount will be queued for a later
|
||||
packet.
|
||||
|
||||
On success returns the new size of the receive window. On failure it
|
||||
returns C<undef>.
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
L<Net::SSH2>.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user