[BACK]Return to Trango.pm CVS log [TXT][DIR] Up to [local] / trango / Net-Telnet-Trango / lib / Net / Telnet

Diff for /trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm between version 1.40 and 1.52

version 1.40, 2007/02/06 21:15:28 version 1.52, 2008/02/18 19:13:32
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.39 2007/02/06 20:41:42 andrew Exp $  # $RedRiver: Trango.pm,v 1.51 2008/02/18 16:37:35 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 17 
Line 17 
   use Net::Telnet::Trango;    use Net::Telnet::Trango;
   my $t = new Net::Telnet::Trango ( Timeout => 5 );    my $t = new Net::Telnet::Trango ( Timeout => 5 );
   
   $t->open( Host => $fox ) or die "Error connecting: $!";    $t->open( Host => $ap ) or die "Error connecting: $!";
   
   $t->login('password') or die "Couldn't log in: $!";    $t->login('password') or die "Couldn't log in: $!";
   
Line 28 
Line 28 
   
 =head1 DESCRIPTION  =head1 DESCRIPTION
   
 Perl access to the telnet interface on Trango Foxes, SUs and APs.  Perl access to the telnet interface on Trango APs and SUs.
   
 Another handy feature is that it will parse the output from certain  A handy feature is that it will parse the output from certain commands that is
 commands that is in the format "[key1] value1 [key2] value2" and put  in the format "[key1] value1 [key2] value2" and put those in a hashref that is
 those in a hashref that is returned.  This makes using the output from  returned.  This makes using the output from things like sysinfo very easy to
 things like sysinfo very easy to do.  do.
   
 =head2 EXPORT  =head2 EXPORT
   
Line 61 
Line 61 
         [Decode => 0,]);          [Decode => 0,]);
   
 Same as new from L<Net::Telnet> but sets the default Trango Prompt:  Same as new from L<Net::Telnet> but sets the default Trango Prompt:
 '/#> *$/'  '/#>\s*\Z/'
   
 It also takes an optional parameter 'Decode'.  If not defined it  It also takes an optional parameter 'Decode'.  If not defined it
 defaults to 1, if it is set to 0, it will not decode the output and  defaults to 1, if it is set to 0, it will not decode the output and
Line 81 
Line 81 
         %args = @_;          %args = @_;
     }      }
   
     $args{'Prompt'} ||= '/#> *$/';      $args{'Prompt'} ||= '/#>\s*\r?\n?$/';
   
     foreach my $key ( keys %args ) {      foreach my $key ( keys %args ) {
         $PRIVATE{$key} = $args{$key};          $PRIVATE{$key} = $args{$key};
Line 112 
Line 112 
 #  help [command]  #  help [command]
 #  heater [<on temp> <off temp>]  #  heater [<on temp> <off temp>]
 #  ipconfig [<new ip> <new subnet mask> <new gateway>]  #  ipconfig [<new ip> <new subnet mask> <new gateway>]
   #  linktest <suid> [<pkt len, bytes> [<# of pkts> [<# of cycle>]]]
 #  log [<# of entries, 1..179>]  #  log [<# of entries, 1..179>]
 #  log <sum> <# of entries, 1..179>  #  log <sum> <# of entries, 1..179>
 #  logout  #  logout
Line 322 
Line 323 
   
 my $success  = 'Success\\.';  my $success  = 'Success\\.';
 my %COMMANDS = (  my %COMMANDS = (
       _clear      => { String => "\n" },
     tftpd       => { decode    => 'all',       expect          => $success },      tftpd       => { decode    => 'all',       expect          => $success },
     ver         => { decode    => 'all' },      ver         => { decode    => 'all' },
     sysinfo     => { decode    => 'all',       expect          => $success },      sysinfo     => { decode    => 'all',       expect          => $success },
Line 342 
Line 344 
       { String => 'su testrflink', decode => 'each', expect    => $success },        { String => 'su testrflink', decode => 'each', expect    => $success },
     save_ss     => { String => 'save ss',      expect          => $success },      save_ss     => { String => 'save ss',      expect          => $success },
     opmode      => { decode => 'all',          expect          => $success },      opmode      => { decode => 'all',          expect          => $success },
       arq         => { decode => 'all' },
 );  );
   
 my %ALIASES = (  my %ALIASES = (
Line 490 
Line 493 
   
     my ( $type, $sep1, $subtype, $sep2, $ver ) =      my ( $type, $sep1, $subtype, $sep2, $ver ) =
       $banner =~        $banner =~
       /Welcome to Trango Broadband Wireless (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;        /Welcome to Trango Broadband Wireless,? (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;
   
     $type .= $sep1 . $subtype;      $type .= $sep1 . $subtype;
     $ver = $subtype . $sep2 . $ver;      $ver = $subtype . $sep2 . $ver;
Line 504 
Line 507 
   
 =pod  =pod
   
   =head2 B<linktest> - Link test to SU
   
   linktest('suid'[, 'pkt len, bytes'[, '# of pkts'[, '# of cycles']]]);
   
   Returns a hash reference to the results of the test
   
   =cut
   
   sub linktest
   {
       my $self    = shift;
       my $suid    = shift;
       # These numbers are what I found as defaults when running the command
       my $pkt_len = shift || 1600;
       my $pkt_cnt = shift || 500;
       my $cycles  = shift || 10;
   
       my %config  = @_;
   
       # * 2, one for the FromAP, one FromSU.  Then / 1000 to get to ms.
       # XXX This might need to be changed, this makes the default timeout the
       # same as $pkt_len, and that might not be enough at slower speeds.
       $config{Timeout} ||= int(($pkt_len * $pkt_cnt * $cycles * 2 ) / 1000);
   
       my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;
       return $self->cmd(
           %config,
           String => $string,
           decode => 'linktest',
       );
   
   }
   
   =pod
   
 =head2 B<su_password> - Set the password on SUs connected to the AP.  =head2 B<su_password> - Set the password on SUs connected to the AP.
   
 su_password('new_password'[, 'suid']) If no suid is specified,  su_password('new_password'[, 'suid']) If no suid is specified,
Line 892 
Line 930 
         $cmd{'String'} .= $SPACE . $cfg{'args'};          $cmd{'String'} .= $SPACE . $cfg{'args'};
     }      }
   
       #print "Running cmd $cmd{String}\n";
     my @lines;      my @lines;
     if ( $cfg{'no_prompt'} ) {      if ( $cfg{'no_prompt'} ) {
         $self->print( $cmd{'String'} );          $self->print( $cmd{'String'} );
Line 903 
Line 942 
   
     $self->last_lines( \@lines );      $self->last_lines( \@lines );
   
       my $last = $self->lastline;
       my $prompt = $self->prompt;
       $prompt =~ s{^/}{}xms;
       $prompt =~ s{/[gixms]*$}{}xms;
       while (@lines && $last =~ qr($prompt)) {
           pop @lines;
           $last = $lines[-1];
       }
       $self->last_error($EMPTY);
   
     my $vals = 1;      my $vals = 1;
     if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) {      if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) {
         if ( $cfg{'decode'} eq 'each' ) {          if ( $cfg{'decode'} eq 'each' ) {
Line 913 
Line 962 
         }          }
         elsif ( $cfg{'decode'} eq 'maclist' ) {          elsif ( $cfg{'decode'} eq 'maclist' ) {
             $vals = _decode_maclist(@lines);              $vals = _decode_maclist(@lines);
               if (! $vals) {
                   $self->last_error("Error decoding maclist");
               }
         }          }
           elsif ( $cfg{'decode'} eq 'linktest' ) {
               $vals = _decode_linktest(@lines);
               if (! $vals) {
                   $self->last_error("Error decoding linktest");
               }
           }
         else {          else {
             $vals = _decode_lines(@lines);              $vals = _decode_lines(@lines);
         }          }
     }      }
   
     $self->last_vals($vals);      $self->last_vals($vals);
   
     my $last = $self->lastline;  
   
     if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {      if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) {
         if ( $cfg{'cmd_disconnects'} ) {          if ( $cfg{'cmd_disconnects'} ) {
             $self->logged_in(0);              $self->logged_in(0);
Line 941 
Line 996 
         my $err;          my $err;
         if (grep { /\[ERR\]/ } @lines) {          if (grep { /\[ERR\]/ } @lines) {
             $err = _decode_lines(@lines);              $err = _decode_lines(@lines);
         }          }
   
         if (ref $err eq 'HASH' && $err ->{ERR}) {          if (ref $err eq 'HASH' && $err->{ERR}) {
             $self->last_error($err->{ERR} );              $self->last_error($err->{ERR} );
         } else {          } else {
             $self->last_error("Error with command ($cfg{'String'}): $last");              $self->last_error("Error with command ($cmd{'String'}): $last");
         }          }
         return;          return;
     }      }
Line 965 
Line 1020 
     my $in_key = 0;      my $in_key = 0;
     my $in_val = 1;      my $in_val = 1;
   
     foreach my $line (@lines) {      LINE: while (my $line = shift @lines) {
         next if $line =~ /$success$/;          next LINE if $line =~ /$success\Z/;
           next LINE if $line =~ /^ \*+ \s+ \d+ \s+ \*+ \Z/xms;
   
           # Special decode for sysinfo on a TrangoLink 45
           if ($line =~ /^(.* Channel \s+ Table):\s*(.*)\Z/xms) {
               my $key  = $1;
               my $note = $2;
   
               my %vals;
               while ($line = shift @lines) {
                   if ($line =~ /^\Z/) {
                       $conf{$key} = \%vals;
                       $conf{$key}{note} = $note;
                       next LINE;
                   }
   
                   my $decoded = _decode_lines($line);
                   if ($decoded) {
                       %vals = (%vals, %{ $decoded });
                   }
               }
           }
           # Another special decode for the TrangoLink
           elsif ($line =~ /^
               RF \s Band \s \#
               (\d+) \s+
               \( ([^\)]+) \) \s*
               (.*)$
           /xms) {
               my $num   = $1;
               my $band  = $2;
               my $extra = $3;
   
               if ($extra =~ /\[/) {
                   my $decoded = _decode_lines($extra);
                   $conf{'RF Band'}{$num} = $decoded;
               }
               else {
                   $conf{'RF Band'}{$num}{$extra} = 1;
               }
               next LINE;
           }
   
         my @chars = split //, $line;          my @chars = split //, $line;
   
         my $last_key = $EMPTY;          my $last_key = $EMPTY;
Line 1061 
Line 1157 
     return \@decoded;      return \@decoded;
 }  }
   
   #=item _decode_linktest
   
   sub _decode_linktest {
       my @lines = @_;
       my %decoded;
       foreach my $line (@lines) {
   
           if ($line =~ s/^(\d+) \s+ //xms) {
               my $line_id = $1;
                           my ($tm, $rt);
                           if ($line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms) {
                                   $rt = $1;
                           }
                           if ($line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms) {
                                   $tm = $1;
                           }
   
               my $d = _decode_lines($line. "\n");
               $decoded{tests}[$line_id] = $d;
               $decoded{tests}[$line_id]{'time'} = $tm;
               $decoded{tests}[$line_id]{rate}   = $rt;
           }
   
           else {
               my $d = _decode_lines($line . "\n");
               if ($d) {
                   while (my ($k, $v) = each %{ $d }) {
                       $decoded{$k} = $v;
                   }
              }
           }
   
       }
       return \%decoded;
   }
   
 #=item _decode_sulog  #=item _decode_sulog
   
 sub _decode_sulog {  sub _decode_sulog {
Line 1135 
Line 1267 
         return \@decoded;          return \@decoded;
     }      }
     else {      else {
   
         # XXX we should have a way to set last error, not sure why we don't  
         return;          return;
     }      }
 }  }
Legend:
Removed from v.1.40  
changed lines
  Added in v.1.52
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>