Net::SSH::Perl not support single-channel

[briandfoy]

This ticket was imported from rt.cpan.org 79378

• Requestor: konopada@mail.ru
• Date:
• Original subject: Net::SSH::Perl not support single-channel
• Original link: rt.cpan.org 79378

  ---

I apologize for my English module package Net::SSH::Perl v1.34 does not support single-channel

to eliminate the need to replace it:

1)----------------------------------

package Net::SSH::Perl::ChannelMgr;

sub input_open_failure {
    my $cmgr = shift;
    my($packet) = @_;
    my $id = $packet->get_int32;
    my $c = $cmgr->{channels}->[$id];
    croak "Received open failure for non-opening channel $id"
        unless $c && $c->{type} == SSH_CHANNEL_OPENING;
    my $reason = $packet->get_int32;
    my $msg = $packet->get_str;
    my $lang = $packet->get_str;
    $cmgr->{ssh}->debug("Channel open failure: $id: reason $reason: 
$msg");
    #$cmgr->remove($id);

    # Single Chennel - not multi chennel
    my $c0;
    my $type_run;
    if($id == 1 && $cmgr->{channels}->[$id-1]->{type} == 
SSH_CHANNEL_OPEN ) {
        $c0 = $cmgr->{channels}->[$id-1];
        my $id0=$c0->{id};
        my $ssh = $cmgr->{ssh};
        $c0->{rfd}=$ssh->_dup2('STDIN', '<');
        $c0->{wfd}=$ssh->_dup2('STDOUT', '>');
        $c0->{efd}=$ssh->_dup2('STDERR', '>');

        foreach my $type (keys %{$c->{handlers}}) {
             $c0->{handlers}{$type} = { code => $c->{handlers}->{$type}-
>{code}, extra => $c->{handlers}->{$type}->{extra} };
             if($type =~ /^\d+/ && $type == 
SSH2_MSG_CHANNEL_OPEN_CONFIRMATION ) {
             $type_run= $type;
             }
        }
        if($c0->{type} == SSH_CHANNEL_OPEN ) {
            $c0->drop_handler(SSH2_MSG_CHANNEL_OPEN_FAILURE);
            $c0->drop_handler(SSH2_MSG_CHANNEL_WINDOW_ADJUST);
        }
        $cmgr->{multichennel}=0;
        $cmgr->{ssh}->debug("Return to channel: $id0");
    }
    $cmgr->remove($id);
    if($c0 && $type_run) {
        if (my $sub = $c0->{handlers}->{$type_run}->{code}) {
            $sub->($c0, $packet);
        }
    }
} 

2)----------------------------

package Net::SSH::Perl::SSH2;

sub client_loop {
    my $ssh = shift;
    my $cmgr = $ssh->channel_mgr;
    $cmgr->{multichennel}=1;

    my $h = $cmgr->handlers;
    my $select_class = $ssh->select_class;

    CLOOP:
    $ssh->{_cl_quit_pending} = 0;
    while (!$ssh->_quit_pending) {
        while (my $packet = Net::SSH::Perl::Packet->read_poll($ssh)) {
            if (my $code = $h->{ $packet->type }) {
                $code->($cmgr, $packet);
            }
            else {
                $ssh->debug("Warning: ignore packet type " . $packet-
>type);
            }
        }
        last if $ssh->_quit_pending;

        $cmgr->process_output_packets;

        my $rb = $select_class->new;
        my $wb = $select_class->new;
        $rb->add($ssh->sock);
        $cmgr->prepare_channels($rb, $wb);

        #last unless $cmgr->any_open_channels;
        #my $oc = grep { defined } @{ $cmgr->{channels} };
        #last unless $oc > 1;
    my $next_loop;
        unless($cmgr->{multichennel})
             {
             $next_loop= $cmgr->any_open_channels;
             }
        else {
             my $oc = grep { defined } @{ $cmgr->{channels} };
             $next_loop = $oc > 1 ? 1 : 0 ;
             }
        last unless ($next_loop); 

        my($rready, $wready) = $select_class->select($rb, $wb);
        $cmgr->process_input_packets($rready, $wready);

        for my $ab (@$rready) {
            if ($ab == $ssh->{session}{sock}) {
                my $buf;
                my $len = sysread $ab, $buf, 8192;
                if (! defined $len) {
                    croak "Connection failed: $!\n";
                }
                $ssh->break_client_loop if $len == 0;
                ($buf) = $buf =~ /(.*)/s;  ## Untaint data. Anything 
allowed.
                $ssh->incoming_data->append($buf);
            }
        }
    }
}

and add: 3)----------------------------

package Net::SSH::Perl::SSH2;

sub _dup2 {
    my $ssh = shift;
    my($fh, $mode) = @_;
    my $dup = Symbol::gensym;
    my $str = "${mode}&$fh";
    open ($dup, $str) or die "Could not dupe: $!\n"; ## no critic
    $dup;
}

if the creation of the 2nd channel(id=0) error then is a return run to the 1nd сhannel(id=0) Thank you for your attention

[briandfoy]

from konopada@mail.ru

---

if the creation of the 2nd channel(id=0) error then is a return run

to

the 1nd сhannel(id=0)

error must be read as: if the creation of the 2nd channel(id=1) error then is a return run to the 1nd сhannel(id=0)