[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.2 and 1.5

version 1.2, 2005/12/30 01:02:41 version 1.5, 2006/01/03 00:22:19
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
 # $RedRiver$  # $RedRiver: Trango.pm,v 1.4 2005/12/30 20:26:41 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 13 
Line 13 
 =head1 SYNOPSIS  =head1 SYNOPSIS
   
   use Net::Telnet::Trango;    use Net::Telnet::Trango;
   my $t = new Net::Telnet::Trango ({    my $t = new Net::Telnet::Trango ( Timeout => 5 );
     Host    => $fox,  
     Timeout => 5,  
   });  
       
   my ($type, $version) = $t->open;    my ($type, $version) = $t->open( Host => $fox );
       
   unless (defined $type && defined $version) {    unless (defined $type && defined $version) {
     die "Error connecting: $!";      die "Error connecting: $!";
Line 52 
Line 49 
   
 =pod  =pod
   
   =item new
   
   Same as new from L<Net::Telnet> but has defaults for the trango 'Prompt'
   
   =cut
   
   sub new
   {
     my $class = shift;
   
     my %args;
     if (@_ == 1) {
       $args{'Host'} = shift;
     } else {
       %args = @_;
     }
   
     $args{'Prompt'}  ||= '/#> *$/';
   
     foreach my $key (keys %args) {
       $PRIVATE{$key} = $args{$key};
     }
   
     my $self = $class->SUPER::new(%args);
     bless $self if ref $self;
   
     return $self;
   }
   
   #  _password <new password> <new password>
   #  ? [command]
   #  apsearch <secs> <ch#> <h|v> [<ch#> <h|v>]...
   #  arp -bcast <on|off>
   #  bcastscant <all|suid> <ch#> <h|v> [<ch#> <h|v> ...
   #  bye
   #  cf2cf ap [default|<size>]
   #  date
   #  date <month> <day> <year>
   #  freq scantable
   #  freq channeltable
   #  freq writescan [<ch#> <h|v>]
   #  freq writechannel [<ch#> <freq>] ...
   #  freq <ch #> <h|v>
   #  help [command]
   #  heater [<on temp> <off temp>]
   #  ipconfig [<new ip> <new subnet mask> <new gateway>]
   #  log [<# of entries, 1..179>]
   #  log <sum> <# of entries, 1..179>
   #  logout
   #  opmode [ap [y]]
   #  password
   #  ping <ip addr>
   #  polar <h|v>
   #  power <setism|setunii> <max|min|<dBm>>
   #  reboot
   #  restart
   #  remarks [<str>]
   #  rfrxthreshold [<ism|unii> <-90|-85|-80|-75|-70|-65>]
   #  rfrxth [<ism|unii> <-90|-85|-80|-75|-70|-65>]
   #  sysinfo
   #  set suid <id>
   #  set apid <id>
   #  set baseid <id>
   #  set defaultopmode [<ap|su> <min,0..10>]
   #  set defaultopmode off
   #  set snmpcomm [<read | write | trap (id or setall)> <str>]
   #  set mir [on|off]
   #  set mir threshold <kbps>
   #  set rssitarget [<ism|unii> <dBm>]
   #  set serviceradius [<ism | unii> <miles>]
   #  ssrssi <ch #> <h|v>
   #  su [<suid>|all]
   #  su changechannel <all|suid> <ch#> <h|v>
   #  su ipconfig <suid> <new ip> <new subnet> <new gateway>
   #  su [live|poweroff|priority]
   #  su <ping|info|status> <suid>
   #  su powerleveling <all|suid>
   #  su reboot <all|suid>
   #  su restart <all|suid>
   #  su testrflink <all|suid> [r]
   #  su testrflink <setlen> [64..1600]
   #  su testrflink <aptx> [20..100]
   #  su sw <suid|all> <sw #> <on|off>
   #  sudb [dload | view]
   #  sudb add <suid> pr <cir,kbps> <mir,kbps> <device id,hex>
   #  sudb add <suid> reg <cir,kbps> <mir,kbps> <device id,hex>
   #  sudb delete <all|<suid>>
   #  sudb modify <suid> <cir|mir> <kbps>
   #  sudb modify <suid> <su2su> <group id,hex>
   #  sudb view
   #  sulog [lastmins | sampleperiod <1..60>]
   #  sulog [<# of entry,1..18>]
   #  survey <ism|unii> <time, sec> <h|v>
   #  sw [<sw #> <on|off>]
   #  temp
   #  tftpd [on|off]
   #  time
   #  time <hour> <min> <sec>
   #  save <mainimage|fpgaimage> <current chksum> <new chksum>
   #  save <systemsetting|sudb>
   #  updateflash <mainimage|fpgaimage> <current chksum> <new chksum>
   #  updateflash <systemsetting|sudb>
   
   =pod
   
 =head1 METHODS  =head1 METHODS
   
 =head2 ACCESSORS  =head2 ACCESSORS
Line 106 
Line 208 
   
 alias of exit()  alias of exit()
   
 =item reboot  =item restart
   
 alias of restart()  alias of reboot()
   
 =back  =back
   
Line 141 
Line 243 
   
 reboots the trango and closes the connection  reboots the trango and closes the connection
   
 =cut  =item sulog
   
 #  _password <new password> <new password>  returns an array ref of hashes containing each log line.
 #  ? [command]  
 #  apsearch <secs> <ch#> <h|v> [<ch#> <h|v>]...  
 #  arp -bcast <on|off>  
 #  bcastscant <all|suid> <ch#> <h|v> [<ch#> <h|v> ...  
 #  bye  
 #  cf2cf ap [default|<size>]  
 #  date  
 #  date <month> <day> <year>  
 #  freq scantable  
 #  freq channeltable  
 #  freq writescan [<ch#> <h|v>]  
 #  freq writechannel [<ch#> <freq>] ...  
 #  freq <ch #> <h|v>  
 #  help [command]  
 #  heater [<on temp> <off temp>]  
 #  ipconfig [<new ip> <new subnet mask> <new gateway>]  
 #  log [<# of entries, 1..179>]  
 #  log <sum> <# of entries, 1..179>  
 #  logout  
 #  opmode [ap [y]]  
 #  password  
 #  ping <ip addr>  
 #  polar <h|v>  
 #  power <setism|setunii> <max|min|<dBm>>  
 #  reboot  
 #  restart  
 #  remarks [<str>]  
 #  rfrxthreshold [<ism|unii> <-90|-85|-80|-75|-70|-65>]  
 #  rfrxth [<ism|unii> <-90|-85|-80|-75|-70|-65>]  
 #  sysinfo  
 #  set suid <id>  
 #  set apid <id>  
 #  set baseid <id>  
 #  set defaultopmode [<ap|su> <min,0..10>]  
 #  set defaultopmode off  
 #  set snmpcomm [<read | write | trap (id or setall)> <str>]  
 #  set mir [on|off]  
 #  set mir threshold <kbps>  
 #  set rssitarget [<ism|unii> <dBm>]  
 #  set serviceradius [<ism | unii> <miles>]  
 #  ssrssi <ch #> <h|v>  
 #  su [<suid>|all]  
 #  su changechannel <all|suid> <ch#> <h|v>  
 #  su ipconfig <suid> <new ip> <new subnet> <new gateway>  
 #  su [live|poweroff|priority]  
 #  su <ping|info|status> <suid>  
 #  su powerleveling <all|suid>  
 #  su reboot <all|suid>  
 #  su restart <all|suid>  
 #  su testrflink <all|suid> [r]  
 #  su testrflink <setlen> [64..1600]  
 #  su testrflink <aptx> [20..100]  
 #  su sw <suid|all> <sw #> <on|off>  
 #  sudb [dload | view]  
 #  sudb add <suid> pr <cir,kbps> <mir,kbps> <device id,hex>  
 #  sudb add <suid> reg <cir,kbps> <mir,kbps> <device id,hex>  
 #  sudb delete <all|<suid>>  
 #  sudb modify <suid> <cir|mir> <kbps>  
 #  sudb modify <suid> <su2su> <group id,hex>  
 #  sudb view  
 #  sulog [lastmins | sampleperiod <1..60>]  
 #  sulog [<# of entry,1..18>]  
 #  survey <ism|unii> <time, sec> <h|v>  
 #  sw [<sw #> <on|off>]  
 #  temp  
 #  tftpd [on|off]  
 #  time  
 #  time <hour> <min> <sec>  
 #  save <mainimage|fpgaimage> <current chksum> <new chksum>  
 #  save <systemsetting|sudb>  
 #  updateflash <mainimage|fpgaimage> <current chksum> <new chksum>  
 #  updateflash <systemsetting|sudb>  
   
   =cut
   
   
 my $success = 'Success.';  my $success = 'Success.';
 my %COMMANDS = (  my %COMMANDS = (
   tftpd       => { decode => 1, expect => $success },    tftpd       => { decode => 'all',   expect => $success },
   ver         => { decode => 1 },    ver         => { decode => 'all' },
   sysinfo     => { decode => 1, expect => $success },    sysinfo     => { decode => 'all',   expect => $success },
   updateflash => { decode => 1, expect => $success },    updateflash => { decode => 'all',   expect => $success },
   'exit'      => { Prompt => '//', cmd_disconnects => 1 },    sulog       => { decode => 'sulog', expect => $success },
   reboot      => { Prompt => '//', cmd_disconnects => 1 },    'exit'      => { no_prompt => 1, cmd_disconnects => 1 },
     reboot      => { no_prompt => 1, cmd_disconnects => 1 },
     #su password???
     #_bootloader
     #temp
     #heater
 );  );
   
 my %ALIASES = (  my %ALIASES = (
Line 242 
Line 279 
   login_banner    login_banner
   Timeout    Timeout
   last_lines    last_lines
     last_vals
 );  );
   
 sub AUTOLOAD  sub AUTOLOAD
Line 257 
Line 295 
   }    }
   
   if (exists $COMMANDS{$method}) {    if (exists $COMMANDS{$method}) {
       $method = shift if (@_ == 1);
     $COMMANDS{$method}{'String'} ||= $method;      $COMMANDS{$method}{'String'} ||= $method;
     return $self->cmd(%{ $COMMANDS{$method} }, @_);      return $self->cmd(%{ $COMMANDS{$method} }, @_);
   }    }
Line 273 
Line 312 
   
 =pod  =pod
   
 =item new  
   
 =cut  
   
 sub new  
 {  
   my $class = shift;  
   my $args = shift || {};  
   
   $args->{'Timeout'} ||= 5;  
   $args->{'Prompt'}  ||= '/#> *$/';  
   
   foreach my $key (keys %{ $args }) {  
     $PRIVATE{$key} = $args->{$key};  
   }  
   
   my $self = $class->SUPER::new(%{ $args });  
   bless $self if ref $self;  
   
   return $self;  
 }  
   
 =pod  
   
 =item open  =item open
   
   Calls Net::Telnet::open() then makes sure you get a password prompt so you are ready to login() and parses the login banner so you can get host_type() and firmware_version()
   
 =cut  =cut
   
 sub open  sub open
 {  {
   my $self = shift;    my $self = shift;
   
   unless ( $self->SUPER::open(    unless ( $self->SUPER::open(@_) ) {
       #Host => $self->Host,  
       #Errmode => 'return',  
   ) ) {  
     #$! = "Couldn't connect to " . $self->Host . ":  $!";      #$! = "Couldn't connect to " . $self->Host . ":  $!";
     return undef;      return undef;
   }    }
   #$self->dump_log('dump.log');  
   
   ## Login to remote host.    ## Get to login prompt
   unless ($self->waitfor(    unless ($self->waitfor(
     -match => '/password: ?$/i',        -match => '/password: ?$/i',
     -errmode => "return",        -errmode => "return",
   ) ) {      ) ) {
   #$! = "problem connecting to host (" . $self->Host . "): " .      #$! = "problem connecting to host (" . $self->Host . "): " .
   #    $self->lastline;      #    $self->lastline;
     return undef;      return undef;
   }    }
   
Line 335 
Line 348 
   
 =item login  =item login
   
   Calls open() if not already connected, then sends the password and sets logged_in() if successful
   
 =cut  =cut
   
 sub login  sub login
Line 365 
Line 380 
   
 =item parse_login_banner  =item parse_login_banner
   
   Takes a login banner (what you get when you first connect to the Trango) or reads what is already in login_banner() then parses it and sets host_type() and firmware_version() as well as login_banner()
   
 =cut  =cut
   
 sub parse_login_banner  sub parse_login_banner
Line 389 
Line 406 
   
 =pod  =pod
   
   =item su_password
   
   C<su_password('all'|suid, 'new_password')>
   
   =cut
   
   sub su_password
   {
     my $self     = shift;
     my $su       = shift || '!';
     my $new_pass = shift || '';
   
     unless (defined $su) {
       warn "No su passed!"
       #return undef;
     }
   
     unless (defined $new_pass) {
       warn "No new password!"  
       #return undef;
     }
   
     return $self->cmd(String => 'su password ' .
                        $su . ' ' .
                        $new_pass . ' ' .
                        $new_pass,
                        expect => $success,
                       );
   }
   
   
   =pod
   
   =item sudb_view
   
   returns a reference to an array of hashes each containing:
   
     suid
     type
     cir
     mir
     mac
   
   =cut
   
   sub sudb_view
   {
     my $self = shift;
   
     my @lines = $self->cmd( String => 'sudb view', expect => $success );
   
     return undef unless @lines;
   
     my @sus;
     foreach (@lines) {
       if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9a-fA-F]+)/) {
         my %s = (
           suid => $1,
           type => $2,
           cir  => $3,
           mir  => $4,
           mac  => $5,
         );
         push @sus, \%s;
       }
     }
   
     return \@sus;
   }
   
   =pod
   
 =item enable_tftpd  =item enable_tftpd
   
   runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
   
 =cut  =cut
   
 sub enable_tftpd  sub enable_tftpd
Line 410 
Line 501 
   
 =item disable_tftpd  =item disable_tftpd
   
   runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
   
 =cut  =cut
   
 sub disable_tftpd  sub disable_tftpd
Line 429 
Line 522 
   
 =item cmd  =item cmd
   
   This does most of the work.  At the heart, it calls Net::Telnet::cmd() but it also does some special stuff for Trango.
   
   Normally returns the last lines from from the command
   
   Also accepts these options:
   
   I<decode>
   - if this is true, then it will send the output lines to _decode_lines() and then returns the decoded output
   
   I<cmd_disconnects>
   - if this is true, it then sets logged_in() to false, then it will close() the connection and then sets is_connected() to false
   
   I<expect>
   - if this is set (usually to 'Success.') it will check for that in the last line of output and if it does not, will return undef because the command probably failed
   
   I<args>
   - a string containing the command line options that are passed to the command
   
 =cut  =cut
   
 sub cmd  sub cmd
Line 459 
Line 570 
   
   unless ($cfg{'String'}) {    unless ($cfg{'String'}) {
     #$! = "No command passed";      #$! = "No command passed";
     warn "No command passed\n";      #warn "No command passed\n";
     return undef;      return undef;
   }    }
   
   unless ($self->is_connected) {    unless ($self->is_connected) {
     #$! = "Not connected";      #$! = "Not connected";
     warn "Not connected\n";      #warn "Not connected\n";
     return undef;      return undef;
   }    }
   
   unless ($self->logged_in) {    unless ($self->logged_in) {
     #$! = "Not logged in";      #$! = "Not logged in";
     warn "Not logged in\n";      #warn "Not logged in\n";
     return undef;      return undef;
   }    }
   
Line 485 
Line 596 
   if ($cfg{'args'}) {    if ($cfg{'args'}) {
     $cmd{'String'} .= ' ' . $cfg{'args'};      $cmd{'String'} .= ' ' . $cfg{'args'};
   }    }
   my @lines = $self->SUPER::cmd(%cmd);    my @lines;
     unless ($cfg{'no_prompt'}) {
       @lines = $self->SUPER::cmd(%cmd);
     } else {
       $self->print($cmd{'String'});
       @lines = $self->lastline;
     }
   
   $self->last_lines(\@lines);    $self->last_lines(\@lines);
   
   my $vals = 1;    my $vals = 1;
   if ($cfg{'decode'}) {    if ($cfg{'decode'}) {
     $vals = _decode_lines(@lines);      if ($cfg{'decode'} eq 'each') {
         $vals = _decode_each_line(@lines);
       } elsif ($cfg{'decode'} eq 'sulog') {
         $vals = _decode_sulog(@lines);
       } else {
         $vals = _decode_lines(@lines);
       }
   }    }
   
     $self->last_vals($vals);
   
   
   my $last = $self->lastline;    my $last = $self->lastline;
   
   if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) {    if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) {
Line 529 
Line 654 
   my $in_val = 0;    my $in_val = 0;
   
   foreach my $line (@lines) {    foreach my $line (@lines) {
       next if $line =~ /$success$/;
   
     my @chars = split //, $line;      my @chars = split //, $line;
   
     my $last_key = '';      my $last_key = '';
Line 580 
Line 707 
   if (%conf) {    if (%conf) {
     return \%conf;      return \%conf;
   } else {    } else {
     return \@lines;      return undef;
   }    }
 }  }
   
   #=item _decode_each_line
   
   sub _decode_each_line
   {
     my @lines = @_;
     my @decoded;
     foreach my $line (@lines) {
       my $decoded = _decode_lines($line);
       push @decoded, $decoded if defined $decoded;
     }
     return \@decoded;
   }
   
   #=item _decode_sulog
   
   sub _decode_sulog
   {
     my @lines = @_;
     my @decoded;
     my $last_tm;
     foreach my $line (@lines) {
       my $decoded = _decode_lines($line);
   
       if (defined $decoded) {
         if ($decoded->{'tm'}) {
           $last_tm = $decoded->{'tm'};
           next;
         } else {
           $decoded->{'tm'} = $last_tm;
         }
         next unless $last_tm;
   
         push @decoded, $decoded if defined $decoded;
       }
     }
     return \@decoded;
   }
   
 1;  1;
 __END__  __END__
   
 =back  =back
   
 =head1 SEE ALSO  =head1 SEE ALSO
   
 If you have a web site set up for your module, mention it here.  
   
 Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm  Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm
   
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>