home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / ChannelMgr.pm < prev    next >
Encoding:
Perl POD Document  |  2003-12-03  |  5.9 KB  |  231 lines
  1. # $Id: ChannelMgr.pm,v 1.9 2003/12/03 15:35:21 autarch Exp $
  2.  
  3. package Net::SSH::Perl::ChannelMgr;
  4. use strict;
  5.  
  6. use Net::SSH::Perl::Channel;
  7. use Net::SSH::Perl::Packet;
  8. use Net::SSH::Perl::Constants qw( :msg2 :channels );
  9.  
  10. use Carp qw( croak );
  11. use Scalar::Util qw(weaken);
  12.  
  13. sub new {
  14.     my $class = shift;
  15.     my $ssh = shift;
  16.     my $cmgr = bless { ssh => $ssh, @_ }, $class;
  17.     weaken $cmgr->{ssh};
  18.     $cmgr->init;
  19.     $cmgr;
  20. }
  21.  
  22. sub init {
  23.     my $cmgr = shift;
  24.     $cmgr->{channels} = [];
  25.     $cmgr->{handlers} = {
  26.         SSH2_MSG_CHANNEL_CLOSE() => \&input_oclose,
  27.         SSH2_MSG_CHANNEL_DATA() => \&input_data,
  28.         SSH2_MSG_CHANNEL_EOF() => \&input_eof,
  29.         SSH2_MSG_CHANNEL_EXTENDED_DATA() => \&input_extended_data,
  30.         SSH2_MSG_CHANNEL_OPEN_CONFIRMATION() => \&input_open_confirmation,
  31.         SSH2_MSG_CHANNEL_OPEN_FAILURE() => \&input_open_failure,
  32.         SSH2_MSG_CHANNEL_REQUEST() => \&input_channel_request,
  33.         SSH2_MSG_CHANNEL_WINDOW_ADJUST() => \&input_window_adjust,
  34.     };
  35. }
  36.  
  37. sub new_channel {
  38.     my $cmgr = shift;
  39.     my $c = Net::SSH::Perl::Channel->new($cmgr->{ssh}, $cmgr, @_);
  40.     push @{ $cmgr->{channels} }, $c;
  41.     $c;
  42. }
  43.  
  44. sub remove {
  45.     my $cmgr = shift;
  46.     my($id) = @_;
  47.     $cmgr->{channels}->[$id] = undef;
  48. }
  49.  
  50. sub new_channel_id {
  51.     my $cmgr = shift;
  52.     $cmgr->{_channel_id} ||= 0;
  53.     $cmgr->{_channel_id}++;
  54. }
  55.  
  56. sub any_open_channels {
  57.     my $cmgr = shift;
  58.     for my $c (@{ $cmgr->{channels} }) {
  59.         next unless defined $c;
  60.         return 1 if
  61.             $c->{type} == SSH_CHANNEL_OPENING        ||
  62.             $c->{type} == SSH_CHANNEL_OPEN           ||
  63.             $c->{type} == SSH_CHANNEL_INPUT_DRAINING ||
  64.             $c->{type} == SSH_CHANNEL_OUTPUT_DRAINING;
  65.     }
  66. }
  67.  
  68. sub prepare_channels {
  69.     my $cmgr = shift;
  70.     for my $c (@{ $cmgr->{channels} }) {
  71.         next unless defined $c;
  72.         $c->prepare_for_select(@_);
  73.         if ($c->delete_if_full_closed) {
  74.             $cmgr->remove($c->{id});
  75.         }
  76.     }
  77. }
  78.  
  79. sub process_input_packets {
  80.     my $cmgr = shift;
  81.     for my $c (@{ $cmgr->{channels} }) {
  82.         next unless defined $c;
  83.         $c->process_buffers(@_);
  84.         $c->check_window;
  85.         if ($c->delete_if_full_closed) {
  86.             $cmgr->remove($c->{id});
  87.         }
  88.     }
  89. }
  90.  
  91. sub process_output_packets {
  92.     my $cmgr = shift;
  93.     for my $c (@{ $cmgr->{channels} }) {
  94.         next unless defined $c;
  95.         $c->process_outgoing;
  96.     }
  97. }
  98.  
  99. sub _get_channel_from_packet {
  100.     my($cmgr, $packet, $what) = @_;
  101.     my $id = $packet->get_int32;
  102.     my $c = $cmgr->{channels}->[$id];
  103.     croak "Received $what for nonexistent channel $id"
  104.         unless $c;
  105.     $c;
  106. }
  107.  
  108. sub input_oclose {
  109.     my $cmgr = shift;
  110.     my($packet) = @_;
  111.     my $c = $cmgr->_get_channel_from_packet($packet, 'oclose');
  112.     $c->rcvd_oclose;
  113. }
  114.  
  115. sub input_data {
  116.     my $cmgr = shift;
  117.     my($packet) = @_;
  118.     my $c = $cmgr->_get_channel_from_packet($packet, 'data');
  119.     return unless $c->{type} == SSH_CHANNEL_OPEN;
  120.     my $data = $packet->get_str;
  121.     $c->{local_window} -= length $data;
  122.     $c->{output}->append($data);
  123. }
  124.  
  125. sub input_eof {
  126.     my $cmgr = shift;
  127.     my($packet) = @_;
  128.     my $c = $cmgr->_get_channel_from_packet($packet, 'ieof');
  129.     $c->rcvd_ieof;
  130. }
  131.  
  132. sub input_extended_data {
  133.     my $cmgr = shift;
  134.     my($packet) = @_;
  135.     my $c = $cmgr->_get_channel_from_packet($packet, 'extended_data');
  136.     return unless $c->{type} == SSH_CHANNEL_OPEN;
  137.     my $code = $packet->get_int32;
  138.     my $data = $packet->get_str;
  139.     $c->{extended}->append($data);
  140. }
  141.  
  142. sub input_open_confirmation {
  143.     my $cmgr = shift;
  144.     my($packet) = @_;
  145.     my $id = $packet->get_int32;
  146.     my $c = $cmgr->{channels}->[$id];
  147.     croak "Received open confirmation for non-opening channel $id"
  148.         unless $c && $c->{type} == SSH_CHANNEL_OPENING;
  149.     $c->{remote_id} = $packet->get_int32;
  150.     $c->{type} = SSH_CHANNEL_OPEN;
  151.     $c->{remote_window} = $packet->get_int32;
  152.     $c->{remote_maxpacket} = $packet->get_int32;
  153.     if (my $sub = $c->{handlers}{$packet->type}{code}) {
  154.         $sub->($c, $packet);
  155.     }
  156.     $cmgr->{ssh}->debug("channel $id: open confirm rwindow $c->{remote_window} rmax $c->{remote_maxpacket}");
  157. }
  158.  
  159. sub input_open_failure {
  160.     my $cmgr = shift;
  161.     my($packet) = @_;
  162.     my $id = $packet->get_int32;
  163.     my $c = $cmgr->{channels}->[$id];
  164.     croak "Received open failure for non-opening channel $id"
  165.         unless $c && $c->{type} == SSH_CHANNEL_OPENING;
  166.     my $reason = $packet->get_int32;
  167.     my $msg = $packet->get_str;
  168.     my $lang = $packet->get_str;
  169.     $cmgr->{ssh}->debug("Channel open failure: $id: reason $reason: $msg");
  170.     $cmgr->remove($id);
  171. }
  172.  
  173. sub input_channel_request {
  174.     my $cmgr = shift;
  175.     my($packet) = @_;
  176.     my $id = $packet->get_int32;
  177.     my $c = $cmgr->{channels}->[$id];
  178.     croak "Received request for non-open channel $id"
  179.         unless $c && $c->{type} == SSH_CHANNEL_OPEN ||
  180.                      $c->{type} == SSH_CHANNEL_LARVAL;
  181.     if (my $sub = $c->{handlers}{$packet->type}{code}) {
  182.         $sub->($c, $packet);
  183.     }
  184. }
  185.  
  186. sub input_window_adjust {
  187.     my $cmgr = shift;
  188.     my($packet) = @_;
  189.     my $id = $packet->get_int32;
  190.     my $c = $cmgr->{channels}->[$id];
  191.     croak "Received window adjust for non-open channel $id"
  192.         unless $c && $c->{type} == SSH_CHANNEL_OPEN;
  193.     $c->{remote_window} += $packet->get_int32;
  194.     if (my $sub = $c->{handlers}{$packet->type}{code}) {
  195.         $sub->($c, $packet);
  196.     }
  197. }
  198.  
  199. sub register_handler {
  200.     my $cmgr = shift;
  201.     my($type, $code) = @_;
  202.     $cmgr->{handlers}->{ $type } = $code;
  203. }
  204.  
  205. sub handlers { $_[0]->{handlers} }
  206.  
  207. 1;
  208. __END__
  209.  
  210. =head1 NAME
  211.  
  212. Net::SSH::Perl::ChannelMgr - Manages a list of open channels
  213.  
  214. =head1 SYNOPSIS
  215.  
  216.     use Net::SSH::Perl::ChannelMgr;
  217.     my $cmgr = Net::SSH::Perl::ChannelMgr->new;
  218.     my $channel = $cmgr->new_channel(@args);
  219.  
  220. =head1 DESCRIPTION
  221.  
  222. I<Net::SSH::Perl::ChannelMgr> manages the creation and maintenance
  223. of a list of open channels for the SSH2 protocol.
  224.  
  225. =head1 AUTHOR & COPYRIGHTS
  226.  
  227. Please see the Net::SSH::Perl manpage for author, copyright,
  228. and license information.
  229.  
  230. =cut
  231.