[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.15 and 1.25

version 1.15, 2006/09/07 03:59:03 version 1.25, 2007/01/17 20:48:46
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
 # $RedRiver: Trango.pm,v 1.14 2006/09/07 02:49:34 andrew Exp $  # $RedRiver: Trango.pm,v 1.24 2007/01/17 19:00:51 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 14 
Line 14 
   
   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 => $fox ) or die "Error connecting: $!";
   
   $t->login('password') or die "Couldn't log in: $!";    $t->login('password') or die "Couldn't log in: $!";
   
   # Do whatever    # Do whatever
   
   $t->exit;    $t->exit;
   $t->close;    $t->close;
   
Line 28 
Line 28 
   
 Perl access to the telnet interface on Trango Foxes, SUs and APs.  Perl access to the telnet interface on Trango Foxes, SUs and APs.
   
 Another handy feature is that it will parse the output from certain commands that is in the format "[key1] value1 [key2] value2" and put those in a hashref that is returned.  This makes using the output from things like sysinfo very easy to do.  Another handy feature is that it will parse the output from certain
   commands that is in the format "[key1] value1 [key2] value2" and put
   those in a hashref that is returned.  This makes using the output from
   things like sysinfo very easy to do.
   
 =head2 EXPORT  =head2 EXPORT
   
 None  None
   
   =head1 METHODS
   
   =over
   
 =cut  =cut
   
 our $VERSION = '0.01';  our $VERSION = '0.01';
Line 157 
Line 164 
   
 =pod  =pod
   
 =head1 METHODS  =back
   
 =head2 ACCESSORS  =head2 ACCESSORS
   
Line 192 
Line 199 
   
 =item login_banner  =item login_banner
   
 returns the banner that is displayed when first connected at login.  Only set after a successful open()  returns the banner that is displayed when first connected at login.
   Only set after a successful open()
   
 This is usually only set internally  This is usually only set internally
   
Line 201 
Line 209 
 returns the output from the last cmd() that was run as an array ref  returns the output from the last cmd() that was run as an array ref
 This is usually only set internally  This is usually only set internally
   
   =item last_error
   
   returns the last error reported.  Should contain the the last entry in
   last_lines
   
 =back  =back
   
 =head2 ALIASES  =head2 ALIASES
Line 219 
Line 232 
   
 =head2 COMMANDS  =head2 COMMANDS
   
 Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>, as such they accept the same options as C<cmd()>.  Specifically they take a named paramater "args", for example:  Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>,
   as such they accept the same options as C<cmd()>.
   Specifically they take a named paramater "args", for example:
 C<tftpd(args =E<gt> 'on')> would enable tftpd  C<tftpd(args =E<gt> 'on')> would enable tftpd
   
 =over  =over
Line 246 
Line 261 
   
 reboots the trango and closes the connection  reboots the trango and closes the connection
   
   =item remarks
   
   Takes an optional argument, which sets the remarks.
   If there is no argument, returns the current remarks.
   
 =item sulog  =item sulog
   
 returns an array ref of hashes containing each log line.  returns an array ref of hashes containing each log line.
Line 274 
Line 294 
   
 returns the output from the eth list command  returns the output from the eth list command
   
   =item su_info
   
   You need to pass in args => <suid> and it will return the info for that suid.
   
   =item save_ss
   
   saves the config.  Returns 1 on success, undef on failure.
   
 =cut  =cut
   
   
Line 286 
Line 314 
   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 },
   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     => { String => 'su info', decode => 'all', expect => $success },
     save_ss     => { String => 'save ss', expect => $success },
     opmode      => { decode => 'all',   expect => $success },
   # eth r, w and reset???    # eth r, w and reset???
   #su password???    #su password???
   #_bootloader    #_bootloader
Line 314 
Line 346 
   Timeout    Timeout
   last_lines    last_lines
   last_vals    last_vals
     last_error
 );  );
   
 sub AUTOLOAD  sub AUTOLOAD
Line 329 
Line 362 
   }    }
   
   if (exists $COMMANDS{$method}) {    if (exists $COMMANDS{$method}) {
     $method = shift if (@_ == 1);  
     $COMMANDS{$method}{'String'} ||= $method;      $COMMANDS{$method}{'String'} ||= $method;
       $COMMANDS{$method}{'args'} .= ' ' . shift if (@_ == 1);
     return $self->cmd(%{ $COMMANDS{$method} }, @_);      return $self->cmd(%{ $COMMANDS{$method} }, @_);
   }    }
   
Line 348 
Line 381 
   
 =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()  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
   
Line 357 
Line 392 
   my $self = shift;    my $self = shift;
   
   unless ( $self->SUPER::open(@_) ) {    unless ( $self->SUPER::open(@_) ) {
     #$! = "Couldn't connect to " . $self->Host . ":  $!";      $self->last_error("Couldn't connect to " . $self->Host . ":  $!");
     return undef;      return undef;
   }    }
   
Line 366 
Line 401 
       -match => '/password: ?$/i',        -match => '/password: ?$/i',
       -errmode => "return",        -errmode => "return",
     ) ) {      ) ) {
     #$! = "problem connecting to host (" . $self->Host . "): " .      $self->last_error("problem connecting to host (" . $self->Host . "): " .
     #    $self->lastline;          $self->lastline);
     return undef;      return undef;
   }    }
   
Line 382 
Line 417 
   
 =item login  =item login
   
 Calls open() if not already connected, then sends the password and sets logged_in() if successful  Calls open() if not already connected, then sends the password and sets
   logged_in() if successful
   
 =cut  =cut
   
Line 401 
Line 437 
     -match => $self->prompt,      -match => $self->prompt,
     -errmode => "return",      -errmode => "return",
   ) ) {    ) ) {
     #$! = "login ($self->Host) failed: " . $self->lastline;      $self->last_error("login ($self->Host) failed: " . $self->lastline);
     return undef;      return undef;
   }    }
   
Line 414 
Line 450 
   
 =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()  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
   
Line 442 
Line 480 
   
 =item su_password  =item su_password
   
 C<su_password('all'|suid, 'new_password')>  C<su_password('new_password'[, 'suid'])> If no suid is specified,
   the default is "all".
   
 =cut  =cut
   
 sub su_password  sub su_password
 {  {
   my $self     = shift;    my $self     = shift;
   my $su       = shift || '!';  
   my $new_pass = shift || '';    my $new_pass = shift || '';
     my $su       = shift || 'all';
   
   unless (defined $su) {  
     warn "No su passed!"  
     #return undef;  
   }  
   
   unless (defined $new_pass) {    unless (defined $new_pass) {
     warn "No new password!"      $self->last_error("No new password");
     #return undef;      #return undef;
   }    }
   
Line 487 
Line 521 
         my $new_subnet  = shift;          my $new_subnet  = shift;
         my $new_gateway = shift;          my $new_gateway = shift;
   
         return undef unless $suid =~ /^\d+$/;          if ($suid =~ /\D/) {
         return undef unless $new_ip;                  $self->last_error("Invalid suid '$suid'");
         return undef unless $new_subnet;                  return undef;
         return undef unless $new_gateway;          }
           unless ($new_ip) {
                   $self->last_error("no new_ip passed");
                   return undef;
           }
           unless ($new_subnet) {
                   $self->last_error("no new_subnet passed");
                   return undef;
           }
           unless ($new_gateway) {
                   $self->last_error("no new_gateway passed");
                   return undef;
           }
   
         # su ipconfig <suid> <new ip> <new subnet> <new gateway>          # su ipconfig <suid> <new ip> <new subnet> <new gateway>
         return $self->cmd(String => 'su ipconfig ' .          return $self->cmd(String => 'su ipconfig ' .
Line 579 
Line 625 
         my $mac  = shift;          my $mac  = shift;
   
         if ($suid =~ /\D/) {          if ($suid =~ /\D/) {
                   $self->last_error("Invalid suid '$suid'");
                 return undef;                  return undef;
         }          }
   
         unless (lc($type) eq 'reg' || lc($type) eq 'pr') {          unless (lc($type) eq 'reg' || lc($type) eq 'pr') {
                 warn "Invalid type '$type'!";                  $self->last_error("Invalid type '$type'");
                 return undef;                  return undef;
         }          }
   
         if ($cir =~ /\D/) {          if ($cir =~ /\D/) {
                 warn "Invalid CIR '$cir'!";                  $self->last_error("Invalid CIR '$cir'");
                 return undef;                  return undef;
         }          }
   
         if ($mir =~ /\D/) {          if ($mir =~ /\D/) {
                 warn "Invalid MIR '$mir'!";                  $self->last_error("Invalid MIR '$mir'");
                 return undef;                  return undef;
         }          }
   
         my $new_mac = $mac;          my $new_mac = $mac;
         $new_mac =~ s/[^0-9A-Fa-f]//;          $new_mac =~ s/[^0-9A-Fa-f]//;
         unless (length $new_mac == 12) {          unless (length $new_mac == 12) {
                 warn "Invalid MAC '$mac'!";                  $self->last_error("Invalid MAC '$mac'");
                 return undef;                  return undef;
         }          }
         $new_mac = join ' ', $new_mac =~ /../g;          $new_mac = join ' ', $new_mac =~ /../g;
Line 633 
Line 680 
         my $self = shift;          my $self = shift;
         my $suid = shift;          my $suid = shift;
   
         if (lc($suid) ne 'all' || $suid =~ /\D/) {          #if (lc($suid) ne 'all' || $suid =~ /\D/) {
           if ($suid =~ /\D/) {
                   $self->last_error("Invalid suid '$suid'");
                 return undef;                  return undef;
         }          }
   
Line 665 
Line 714 
         my $value = shift;          my $value = shift;
   
         if ($suid =~ /\D/) {          if ($suid =~ /\D/) {
                   $self->last_error("Invalid suid '$suid'");
                 return undef;                  return undef;
         }          }
   
         if (lc($opt) eq 'cir' or lc($opt) eq 'mir') {          if (lc($opt) eq 'cir' or lc($opt) eq 'mir') {
                 if ($value =~ /\D/) {                  if ($value =~ /\D/) {
                           $self->last_error("Invalid $opt '$value'");
                         return undef;                          return undef;
                 }                  }
         } elsif (lc($opt) eq 'su2su') {          } elsif (lc($opt) eq 'su2su') {
                 if ($value =~ /[^0-9A-Za-f]/) {                  if ($value =~ /[^0-9A-Za-f]/) {
                           $self->last_error("Invalid MAC '$value'");
                         return undef;                          return undef;
                 }                  }
         } else {          } else {
                   $self->last_error("Invalid option '$opt'");
                 return undef;                  return undef;
         }          }
   
Line 731 
Line 784 
   
 =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.  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  Normally returns the last lines from from the command
   
 Also accepts these options:  Also accepts these options:
   
 I<decode>  I<decode>
 - if this is true, then it will send the output lines to _decode_lines() and then returns the decoded output  - if this is true, then it will send the output lines to _decode_lines()
   and then returns the decoded output
   
 I<cmd_disconnects>  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  - 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>  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  - 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>  I<args>
 - a string containing the command line options that are passed to the command  - a string containing the command line options that are passed to the
   command
   
 =cut  =cut
   
Line 778 
Line 837 
   $cfg{'Timeout'} ||= $self->Timeout;    $cfg{'Timeout'} ||= $self->Timeout;
   
   unless ($cfg{'String'}) {    unless ($cfg{'String'}) {
     #$! = "No command passed";      $self->last_error("No command passed");
     #warn "No command passed\n";  
     return undef;      return undef;
   }    }
   
   unless ($self->is_connected) {    unless ($self->is_connected) {
     #$! = "Not connected";      $self->last_error("Not connected");
     #warn "Not connected\n";  
     return undef;      return undef;
   }    }
   
   unless ($self->logged_in) {    unless ($self->logged_in) {
     #$! = "Not logged in";      $self->last_error("Not logged in");
     #warn "Not logged in\n";  
     return undef;      return undef;
   }    }
   
Line 846 
Line 902 
       return @lines;        return @lines;
     }      }
   } else {    } else {
     #$! = "Error with command ($cfg{'string'}): $last";      $self->last_error("Error with command ($cfg{'String'}): $last");
     return undef;      return undef;
   }    }
 }  }
Line 860 
Line 916 
   my %conf;    my %conf;
   
   my $key = '';    my $key = '';
   my $val = '';    my $val = undef;
   my $in_key = 0;    my $in_key = 0;
   my $in_val = 0;    my $in_val = 1;
   
   foreach my $line (@lines) {    foreach my $line (@lines) {
     next if $line =~ /$success$/;      next if $line =~ /$success$/;
Line 878 
Line 934 
           $in_val = 0;            $in_val = 0;
         } else {          } else {
           $in_key = 0;            $in_key = 0;
           $in_val = 0;            $in_val = 1;
         }          }
   
         if ($key) {          if ($key) {
           $key =~ s/^\s+//;            $key =~ s/^\s+//;
           $key =~ s/\s+$//;            $key =~ s/\s+$//;
   
           $val =~ s/^\s+//;            if (defined $val) {
           $val =~ s/\s+$//;              $val =~ s/^\s+//;
               $val =~ s/\s+$//;
             }
   
           if ($key eq 'Checksum' && $last_key) {            if ($key eq 'Checksum' && $last_key) {
             # Special case for these bastids.              # Special case for these bastids.
Line 918 
Line 976 
   if (%conf) {    if (%conf) {
     return \%conf;      return \%conf;
   } else {    } else {
     return undef;      return $val;
   }    }
 }  }
   
Line 1018 
Line 1076 
   
 =head1 SEE ALSO  =head1 SEE ALSO
   
 Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm  Trango Documentation -
   http://www.trangobroadband.com/support/product_docs.htm
   
 L<Net::Telnet>  L<Net::Telnet>
   
 =head1 TODO  =head1 TODO
   
 There are still a lot of commands that are not accessed directly.  If you call them (as cmd("command + args") or whatever) and it works, please send me examples that work and I will try to get it incorporated into the next version of the script.  There are still a lot of commands that are not accessed directly.  If
   you call them (as cmd("command + args") or whatever) and it works,
   please send me examples that work and I will try to get it incorporated
   into the next version of the script.
   
 I also want to be able to parse the different types of output from commands like su, sudb all and anything else that would be better available as a perl datastructure.  I also want to be able to parse the different types of output from
   commands like su, sudb all and anything else that would be better
   available as a perl datastructure.
   
 =head1 AUTHOR  =head1 AUTHOR
   
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.25
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>