[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.41 and 1.58

version 1.41, 2007/02/07 20:08:32 version 1.58, 2009/07/13 17:33:45
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.40 2007/02/06 21:15:28 andrew Exp $  # $RedRiver: Trango.pm,v 1.57 2009/07/09 21:50:03 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.04';
   
 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 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 = (
     tftpd       => { decode    => 'all',       expect          => $success },      _clear      => { String    => "\n" },
       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' },
 );  );
   
 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 419 
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 458 
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 488 
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 504 
Line 506 
   
 =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 525 
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 567 
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 579 
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 597 
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+
               (\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 666 
Line 728 
     }      }
   
     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 845 
Line 915 
     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 892 
Line 962 
         $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 974 
   
     $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 994 
         }          }
         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' ) {
               $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 942 
Line 1026 
     }      }
     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 {  
             $self->last_error("Error with command ($cfg{'String'}): $last");  
         }          }
           else {
               $self->last_error("Error with command ($cmd{'String'}): $last");
           }
         return;          return;
     }      }
 }  }
Line 968 
Line 1053 
     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 1064 
Line 1194 
     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 1117 
Line 1283 
             }              }
   
             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.41  
changed lines
  Added in v.1.58
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>