[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.49 and 1.57

version 1.49, 2008/02/08 19:29:05 version 1.57, 2009/07/09 22:50:03
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.48 2008/02/08 18:49:41 andrew Exp $  # $RedRiver: Trango.pm,v 1.56 2009/07/08 17:16:41 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 43 
Line 43 
   
 =cut  =cut
   
 our $VERSION = '0.01';  our $VERSION = '0.03';
   
 my $EMPTY = q{};  my $EMPTY = q{};
 my $SPACE = q{ };  my $SPACE = q{ };
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 323 
Line 323 
   
 my $success  = 'Success\\.';  my $success  = 'Success\\.';
 my %COMMANDS = (  my %COMMANDS = (
     _clear      => { String => "\n" },      _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 },
     updateflash => { decode    => 'all',       expect          => $success },      updateflash => { decode    => 'all', expect => $success },
     sulog       => { decode    => 'sulog',     expect          => $success },      sulog       => { decode    => 'sulog', expect => $success },
     'exit'      => { no_prompt => 1,           cmd_disconnects => 1 },      'exit'      => { no_prompt => 1, cmd_disconnects => 1 },
     reboot      => { no_prompt => 1,           cmd_disconnects => 1 },      reboot      => { no_prompt => 1, cmd_disconnects => 1 },
     remarks     => { decode    => 'all',       expect          => $success },      remarks     => { decode    => 'all', expect => $success },
     save_sudb   => { String    => 'save sudb', expect          => $success },      save_sudb   => { String    => 'save sudb', expect => $success },
     syslog      => { expect    => $success },      syslog      => { expect    => $success },
     'pipe'      => {},                        # XXX needs a special decode      'pipe'  => {},                        # XXX needs a special decode
     maclist     => { decode => 'maclist' },      maclist => { decode => 'maclist' },
     maclist_reset => { String => 'maclist reset', expect       => 'done' },      maclist_reset => { String => 'maclist reset', expect => 'done' },
     eth_link    => { String => 'eth link',     expect          => $success },      eth_link => { String => 'eth link', expect => $success },
     su_info     =>      su_info  => { String => 'su info',  decode => 'all', expect => $success },
       { String => 'su info',  decode => 'all', expect          => $success },  
     su_testrflink =>      su_testrflink =>
       { 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' },      arq     => { decode => 'all' },
 );  );
   
 my %ALIASES = (  my %ALIASES = (
     bye     => 'exit',      bye               => 'exit',
     restart => 'reboot',      restart           => 'reboot',
     Host    => 'host',      Host              => 'host',
     save_systemseting => 'save_ss',      save_systemseting => 'save_ss',
 );  );
   
 my %ACCESS = map { $_ => 1 } qw(  my %ACCESS = map { $_ => 1 } qw(
   firmware_version      firmware_version
   host_type      host_type
   is_connected      is_connected
   logged_in      logged_in
   login_banner      login_banner
   Timeout      Timeout
   last_lines      last_lines
   last_vals      last_vals
   last_error      last_error
   Decode      Decode
 );  );
   
 sub AUTOLOAD {  sub AUTOLOAD {
     my $self = shift;      my $self = shift;
   
     my ($method) = ( our $AUTOLOAD ) =~ /^.*::(\w+)$/      my ($method) = ( our $AUTOLOAD ) =~ /^.*::(\w+)$/
       or die "Weird: $AUTOLOAD";          or die "Weird: $AUTOLOAD";
   
     if ( exists $ALIASES{$method} ) {      if ( exists $ALIASES{$method} ) {
         $method = $ALIASES{$method};          $method = $ALIASES{$method};
Line 422 
Line 421 
             -match   => '/password: ?$/i',              -match   => '/password: ?$/i',
             -errmode => "return",              -errmode => "return",
         )          )
       )          )
     {      {
         $self->last_error( "problem connecting to host ("          $self->last_error( "problem connecting to host ("
               . $self->host . "): "                  . $self->host . "): "
               . $self->lastline );                  . $self->lastline );
         return;          return;
     }      }
   
Line 461 
Line 460 
             -match   => $self->prompt,              -match   => $self->prompt,
             -errmode => "return",              -errmode => "return",
         )          )
       )          )
     {      {
         $self->last_error( "login ($self->host) failed: " . $self->lastline );          $self->last_error( "login ($self->host) failed: " . $self->lastline );
         return;          return;
Line 491 
Line 490 
   
     my $banner = $self->login_banner;      my $banner = $self->login_banner;
   
     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 515 
Line 514 
   
 =cut  =cut
   
 sub linktest  sub linktest {
 {      my $self = shift;
     my $self    = shift;      my $suid = shift;
     my $suid    = shift;  
     # These numbers are what I found as defaults when running the command      # These numbers are what I found as defaults when running the command
     my $pkt_len = shift || 1600;      my $pkt_len = shift || 1600;
     my $pkt_cnt = shift || 500;      my $pkt_cnt = shift || 500;
     my $cycles  = shift || 10;      my $cycles  = shift || 10;
   
     my %config  = @_;      my %config = @_;
   
     # * 2, one for the FromAP, one FromSU.  Then / 1000 to get to ms.      # * 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      # 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.      # same as $pkt_len, and that might not be enough at slower speeds.
     $config{Timeout} ||= int(($pkt_len * $pkt_cnt * $cycles * 2 ) / 1000);      $config{Timeout} ||= int( ( $pkt_len * $pkt_cnt * $cycles * 2 ) / 1000 );
   
     my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;      my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles;
     return $self->cmd(      return $self->cmd(
Line 563 
Line 562 
     }      }
   
     return $self->cmd(      return $self->cmd(
         String => 'su password ' . $su . $SPACE . $new_pass . $SPACE . $new_pass,          String => 'su password '
               . $su
               . $SPACE
               . $new_pass
               . $SPACE
               . $new_pass,
         expect => $success,          expect => $success,
     );      );
 }  }
Line 605 
Line 609 
   
     # su ipconfig <suid> <new ip> <new subnet> <new gateway>      # su ipconfig <suid> <new ip> <new subnet> <new gateway>
     return $self->cmd(      return $self->cmd(
         String => 'su ipconfig ' . $suid . $SPACE . $new_ip . $SPACE          String => 'su ipconfig '
           . $new_subnet . $SPACE              . $suid
           . $new_gateway,              . $SPACE
               . $new_ip
               . $SPACE
               . $new_subnet
               . $SPACE
               . $new_gateway,
         expect => $success,          expect => $success,
     );      );
 }  }
Line 617 
Line 626 
 =head2 B<sudb_view> - Returns the output from the sudb view command  =head2 B<sudb_view> - Returns the output from the sudb view command
   
 returns a reference to an array of hashes each containing these keys  returns a reference to an array of hashes each containing these keys
 'suid', 'type', 'cir', 'mir' and 'mac'  'suid', 'su2su', 'type', 'cir', 'mir' and 'mac'
   
 =cut  =cut
   
Line 635 
Line 644 
     my @sus;      my @sus;
     foreach ( @{$lines} ) {      foreach ( @{$lines} ) {
         next unless $_;          next unless $_;
         if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {          if (/^
               \[(\d+)\]
               \s+
               [[:xdigit:]]{2}
               ([[:xdigit:]])
               ([[:xdigit:]])
               \s+
               (\d+)
               \s+
               ([[:xdigit:]\s]+)
           $/ixms
               )
           {
             my %s = (              my %s = (
                 suid => $1,                  suid  => $1,
                 type => $2,                  su2su => $2 ? $2 : undef,
                 cir  => $3,                  type  => $3 == 1 ? 'reg' : $3 == 5 ? 'pri' : $3,
                 mir  => $4,                  cir   => $4,
                 mac  => $5,                  mir   => $5,
                   mac   => $6,
             );              );
   
             $s{'mac'} =~ s/\s//g;              $s{'mac'} =~ s/\s//gxms;
             $s{'mac'} = uc( $s{'mac'} );              $s{'mac'} = uc( $s{'mac'} );
   
             push @sus, \%s;              push @sus, \%s;
Line 704 
Line 726 
     }      }
   
     my $new_mac = $mac;      my $new_mac = $mac;
     $new_mac =~ s/[^0-9A-Fa-f]//;      $new_mac =~ s/[^0-9A-Fa-f]//g;
     unless ( length $new_mac == 12 ) {      unless ( length $new_mac == 12 ) {
         $self->last_error("Invalid MAC '$mac'");          $self->last_error("Invalid MAC '$mac'");
         return;          return;
     }      }
     $new_mac = join $SPACE, $new_mac =~ /../g;      $new_mac = join $SPACE, $new_mac =~ /../g;
   
     my $string =      my $string
       'sudb add ' . $suid . $SPACE . $type . $SPACE . $cir . $SPACE . $mir . $SPACE          = 'sudb add '
       . $new_mac;          . $suid
           . $SPACE
           . $type
           . $SPACE
           . $cir
           . $SPACE
           . $mir
           . $SPACE
           . $new_mac;
   
     return $self->cmd( String => $string, expect => $success );      return $self->cmd( String => $string, expect => $success );
 }  }
Line 883 
Line 913 
     my $self = shift;      my $self = shift;
   
     my @valid_net_telnet_opts = qw(      my @valid_net_telnet_opts = qw(
       String          String
       Output          Output
       Cmd_remove_mode          Cmd_remove_mode
       Errmode          Errmode
       Input_record_separator          Input_record_separator
       Ors          Ors
       Output_record_separator          Output_record_separator
       Prompt          Prompt
       Rs          Rs
       Timeout          Timeout
     );      );
   
     my %cfg;      my %cfg;
Line 942 
Line 972 
   
     $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 952 
Line 992 
         }          }
         elsif ( $cfg{'decode'} eq 'maclist' ) {          elsif ( $cfg{'decode'} eq 'maclist' ) {
             $vals = _decode_maclist(@lines);              $vals = _decode_maclist(@lines);
             if (! $vals) {              if ( !$vals ) {
                 $self->last_error("Error decoding maclist");                  $self->last_error("Error decoding maclist");
             }              }
         }          }
         elsif ( $cfg{'decode'} eq 'linktest' ) {          elsif ( $cfg{'decode'} eq 'linktest' ) {
             $vals = _decode_linktest(@lines);              $vals = _decode_linktest(@lines);
             if (! $vals) {              if ( !$vals ) {
                 $self->last_error("Error decoding linktest");                  $self->last_error("Error decoding linktest");
             }              }
         }          }
Line 966 
Line 1006 
             $vals = _decode_lines(@lines);              $vals = _decode_lines(@lines);
         }          }
     }      }
   
     $self->last_vals($vals);      $self->last_vals($vals);
   
     my $last = $self->lastline;  
     $self->last_error($EMPTY);  
   
     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 988 
Line 1024 
     }      }
     else {      else {
         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 ($cmd{'String'}): $last");              $self->last_error("Error with command ($cmd{'String'}): $last");
         }          }
         return;          return;
Line 1014 
Line 1051 
     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 1117 
Line 1199 
     my %decoded;      my %decoded;
     foreach my $line (@lines) {      foreach my $line (@lines) {
   
         if ($line =~ s/^(\d+) \s+ //xms) {          if ( $line =~ s/^(\d+) \s+ //xms ) {
             my $line_id = $1;              my $line_id = $1;
                         my ($tm, $rt);              my ( $tm, $rt );
                         if ($line =~ s/\s+ (\d+ \s+ \w+) $//xms) {              if ( $line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms ) {
                                 $rt = $1;                  $rt = $1;
                         }              }
                         if ($line =~ s/\s+ (\d+ \s+ \w+) $//xms) {              if ( $line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms ) {
                                 $tm = $1;                  $tm = $1;
                         }              }
   
             my $d = _decode_lines($line. "\n");              my $d = _decode_lines( $line . "\n" );
             $decoded{tests}[$line_id] = $d;              $decoded{tests}[$line_id]         = $d;
             $decoded{tests}[$line_id]{'time'} = $tm;              $decoded{tests}[$line_id]{'time'} = $tm;
             $decoded{tests}[$line_id]{rate}   = $rt;              $decoded{tests}[$line_id]{rate}   = $rt;
         }          }
   
         else {          else {
             my $d = _decode_lines($line . "\n");              my $d = _decode_lines( $line . "\n" );
             if ($d) {              if ($d) {
                 while (my ($k, $v) = each %{ $d }) {                  while ( my ( $k, $v ) = each %{$d} ) {
                     $decoded{$k} = $v;                      $decoded{$k} = $v;
                 }                  }
            }              }
         }          }
   
     }      }
Line 1199 
Line 1281 
             }              }
   
             push @decoded,              push @decoded,
               {                  {
                 mac  => $mac,                  mac  => $mac,
                 loc  => $loc,                  loc  => $loc,
                 tm   => $tm,                  tm   => $tm,
                 suid => $suid,                  suid => $suid,
               };                  };
         }          }
         elsif ( $line =~ /(\d+)\s+entries/ ) {          elsif ( $line =~ /(\d+)\s+entries/ ) {
             $total_entries = $1;              $total_entries = $1;
Legend:
Removed from v.1.49  
changed lines
  Added in v.1.57
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>