[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.36 and 1.38

version 1.36, 2007/02/05 21:09:26 version 1.38, 2007/02/06 16:22:46
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
   
 # $RedRiver: Trango.pm,v 1.35 2007/02/05 21:03:40 andrew Exp $  # $RedRiver: Trango.pm,v 1.37 2007/02/05 23:09:59 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 45 
Line 45 
   
 our $VERSION = '0.01';  our $VERSION = '0.01';
   
   my $EMPTY = q{};
   my $SPACE = q{ };
   
 my %PRIVATE = (  my %PRIVATE = (
     is_connected => 0,      is_connected => 0,
     logged_in    => 0,      logged_in    => 0,
Line 52 
Line 55 
   
 =pod  =pod
   
 =head2 B<new>  =head2 B<new> - Creates a new Net::Telnet::Trango object.
 - Creates a new Net::Telnet::Trango object.  
   
     new([Options from Net::Telnet,]      new([Options from Net::Telnet,]
         [Decode => 0,]);          [Decode => 0,]);
Line 173 
Line 175 
   
 These are usually only set internally.  These are usually only set internally.
   
 =head2 B<firmware_version>  =head2 B<firmware_version> - returns the firmware version
 - returns the firmware version  
   
 Returns the firmware version if available, otherwise undef.  Returns the firmware version if available, otherwise undef.
   
 It should be available after a successful open().  It should be available after a successful open().
   
 =head2 B<host_type>  =head2 B<host_type> - return the type of host you are connected to.
 - return the type of host you are connected to.  
   
 returns the type of host from the login banner for example M5830S or M5300S.    returns the type of host from the login banner for example M5830S or M5300S.  
   
 Should be available after a successful open().  Should be available after a successful open().
   
 =head2 B<is_connected>  =head2 B<is_connected> - Status of the connection to host.
 - Status of the connection to host.  
   
 returns 1 when connected, undef otherwise.  returns 1 when connected, undef otherwise.
   
 =head2 B<logged_in>  =head2 B<logged_in> - Status of being logged in to the host.
 - Status of being logged in to the host.  
   
 returns 1 after a successful login(), 0 if it failed and undef if  returns 1 after a successful login(), 0 if it failed and undef if
 login() was never called.  login() was never called.
   
 =head2 B<login_banner>  =head2 B<login_banner> - The banner when first connecting to the host.
 - The banner when first connecting to the host.  
   
 returns the banner that is displayed when first connected at login.    returns the banner that is displayed when first connected at login.  
 Only set after a successful open().  Only set after a successful open().
   
 =head2 B<last_lines>  =head2 B<last_lines> - The last lines of output from the last cmd().
 - The last lines of output from the last cmd().  
   
 returns, as an array ref, the output from the last cmd() that was run.  returns, as an array ref, the output from the last cmd() that was run.
   
 =head2 B<last_error>  =head2 B<last_error> - A text output of the last error that was encountered.
 - A text output of the last error that was encountered.  
   
 returns the last error reported.  Probably contains the last entry in  returns the last error reported.  Probably contains the last entry in
 last_lines.  last_lines.
   
 =head1 ALIASES  =head1 ALIASES
   
 =head2 B<bye>  =head2 B<bye> - alias of exit()
 - alias of exit()  
   
 Does the same as exit()  Does the same as exit()
   
 =head2 B<restart>  =head2 B<restart> - alias of reboot()
 - alias of reboot()  
   
 Does the same as reboot()  Does the same as reboot()
   
   =head2 B<save_systemsetting> - alias of save_ss()
   
   Does the same as save_ss()
   
 =head1 COMMANDS  =head1 COMMANDS
   
 Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>,  Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>,
Line 234 
Line 231 
 Specifically they take a named paramater "args", for example:  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
   
 =head2 B<tftpd>  =head2 B<tftpd> - The output from the tftpd command
 - The output from the tftpd command  
   
 Returns a hash ref of the decoded output from the  Returns a hash ref of the decoded output from the
 command.  command.
Line 243 
Line 239 
 Also see enable_tftpd() and disable_tftpd() as those check that it was  Also see enable_tftpd() and disable_tftpd() as those check that it was
 successfully changed.  successfully changed.
   
 =head2 B<ver>  =head2 B<ver> - The output from the ver command
 - The output from the ver command  
   
 Returns a hash ref of the decoded output from the  Returns a hash ref of the decoded output from the
 command.  command.
   
 =head2 B<sysinfo>  =head2 B<sysinfo> - The output from the sysinfo command
 - The output from the sysinfo command  
   
 Returns a hash ref of the decoded output from the  Returns a hash ref of the decoded output from the
 command.  command.
   
 =head2 B<exit>  =head2 B<exit> - Exits the connection
 - Exits the connection  
   
 exits the command session with the Trango and closes  exits the command session with the Trango and closes
 the connection  the connection
   
 =head2 B<reboot>  =head2 B<reboot> - Sends a reboot command
 - Sends a reboot command  
   
 reboots the Trango and closes the connection  reboots the Trango and closes the connection
   
 =head2 B<remarks>  =head2 B<remarks> - Set or retrieve the remarks.
 - Set or retrieve the remarks.  
   
 Takes an optional argument, which sets the remarks.    Takes an optional argument, which sets the remarks.  
 If there is no argument, returns the current remarks.  If there is no argument, returns the current remarks.
Line 275 
Line 266 
   my $old_remarks = $t->remarks();    my $old_remarks = $t->remarks();
   $t->remarks($new_remarks);    $t->remarks($new_remarks);
   
 =head2 B<sulog>  =head2 B<sulog> - The output from the sulog command
 - The output from the sulog command  
   
 Returns an array ref of hashes containing each log  Returns an array ref of hashes containing each log
 line.  line.
   
 =head2 B<save_sudb>  =head2 B<save_sudb> - saves the sudb
 - saves the sudb  
   
 Returns true on success, undef on failure  Returns true on success, undef on failure
   
 =head2 B<syslog>  =head2 B<syslog> - The output from the sulog command
 - The output from the sulog command  
   
 Returns a hashref of the output from the syslog command  Returns a hashref of the output from the syslog command
   
 =head2 B<pipe>  =head2 B<pipe> - the pipe command
 - the pipe command  
   
 Returns the output from the pipe command  Returns the output from the pipe command
   
 =head2 B<maclist>  =head2 B<maclist> - retrieves the maclist
 - retrieves the maclist  
   
 Returns the output from the maclist command  Returns the output from the maclist command
   
 =head2 B<maclist_reset>  =head2 B<maclist_reset> - resets the maclist.  
 - resets the maclist.    
   
 No useful output.  No useful output.
   
 =head2 B<eth_list>  =head2 B<eth_list> - eth list command
 - eth list command  
   
 Returns the output from the eth list command  Returns the output from the eth list command
   
   
 =head2 B<su_info>  =head2 B<su_info> - gets the su info
 - gets the su info  
   
 Returns information about the SU.  Returns information about the SU.
   
Line 321 
Line 304 
   
   $t->su_info($suid);    $t->su_info($suid);
   
 =head2 B<su_testrflink>  =head2 B<su_testrflink> - tests the RF Link to an su
 - tests the RF Link to an su  
   
   $t->su_testrflink($suid|'all');    $t->su_testrflink($suid|'all');
   
 =head2 B<save_ss>  =head2 B<save_ss> - saves the config.  
 - saves the config.    
   
 Returns 1 on success, undef on failure.  Returns 1 on success, undef on failure.
   
   =head2 B<opmode> - sets opmode ap y or returns the opmode
   
       $t->opmode([ap y]);
   
 =cut  =cut
   
 my $success  = 'Success\\.';  my $success  = 'Success\\.';
Line 361 
Line 346 
     bye     => 'exit',      bye     => 'exit',
     restart => 'reboot',      restart => 'reboot',
     Host    => 'host',      Host    => 'host',
       save_systemseting => 'save_ss',
 );  );
   
 my %ACCESS = map { $_ => 1 } qw(  my %ACCESS = map { $_ => 1 } qw(
Line 393 
Line 379 
             $cmd{$k} = $COMMANDS{$method}{$k};              $cmd{$k} = $COMMANDS{$method}{$k};
         }          }
         $cmd{'String'} ||= $method;          $cmd{'String'} ||= $method;
         $cmd{'args'} .= ' ' . shift if ( @_ == 1 );          $cmd{'args'} .= $SPACE . shift if ( @_ == 1 );
         return $self->cmd( %cmd, @_ );          return $self->cmd( %cmd, @_ );
     }      }
   
Line 409 
Line 395 
   
 =pod  =pod
   
 =head2 B<open>  =head2 B<open> - Open a connection to a Trango AP.
 - Open a connection to a Trango AP.  
   
 Calls Net::Telnet::open() then makes sure you get a password prompt so  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  you are ready to login() and parses the login banner so you can get
Line 449 
Line 434 
   
 =pod  =pod
   
 =head2 B<login>  =head2 B<login> - Login to the AP.
 - Login to the AP.  
   
 Calls open() if not already connected, then sends the password and sets  Calls open() if not already connected, then sends the password and sets
 logged_in() if successful  logged_in() if successful
Line 485 
Line 469 
   
 =pod  =pod
   
 =head2 B<parse_login_banner>  =head2 B<parse_login_banner> - Converts the login_banner to something useful.
 - Converts the login_banner to some useful  
 variables.  
   
 Takes a login banner (what you get when you first connect to the Trango)  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  or reads what is already in login_banner() then parses it and sets
Line 520 
Line 502 
   
 =pod  =pod
   
 =head2 B<su_password>  =head2 B<su_password> - Set the password on SUs connected to the AP.
 - 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,
 the default is "all".  the default is "all".
Line 532 
Line 513 
   
 sub su_password {  sub su_password {
     my $self     = shift;      my $self     = shift;
     my $new_pass = shift || '';      my $new_pass = shift || $EMPTY;
     my $su       = shift || 'all';      my $su       = shift || 'all';
   
     unless ( defined $new_pass ) {      unless ( defined $new_pass ) {
Line 542 
Line 523 
     }      }
   
     return $self->cmd(      return $self->cmd(
         String => 'su password ' . $su . ' ' . $new_pass . ' ' . $new_pass,          String => 'su password ' . $su . $SPACE . $new_pass . $SPACE . $new_pass,
         expect => $success,          expect => $success,
     );      );
 }  }
   
 =pod  =pod
   
 =head2 B<su_ipconfig>  =head2 B<su_ipconfig> - Change IP configuration on SUs connected to the AP.
 - Change IP configuration on SUs connected to  
 the AP.  
   
 su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )  su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )
   
Line 586 
Line 565 
   
     # 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 . ' ' . $new_ip . ' '          String => 'su ipconfig ' . $suid . $SPACE . $new_ip . $SPACE
           . $new_subnet . ' '            . $new_subnet . $SPACE
           . $new_gateway,            . $new_gateway,
         expect => $success,          expect => $success,
     );      );
Line 595 
Line 574 
   
 =pod  =pod
   
 =head2 B<sudb_view>  =head2 B<sudb_view> - Returns the output from the sudb view command
 - 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', 'type', 'cir', 'mir' and 'mac'
Line 638 
Line 616 
   
 =pod  =pod
   
 =head2 B<sudb_add>  =head2 B<sudb_add> - Adds an su to the sudb
   
 Takes the following paramaters  Takes the following paramaters
   
Line 691 
Line 669 
         $self->last_error("Invalid MAC '$mac'");          $self->last_error("Invalid MAC '$mac'");
         return;          return;
     }      }
     $new_mac = join ' ', $new_mac =~ /../g;      $new_mac = join $SPACE, $new_mac =~ /../g;
   
     my $string =      my $string =
       'sudb add ' . $suid . ' ' . $type . ' ' . $cir . ' ' . $mir . ' '        'sudb add ' . $suid . $SPACE . $type . $SPACE . $cir . $SPACE . $mir . $SPACE
       . $new_mac;        . $new_mac;
   
     return $self->cmd( String => $string, expect => $success );      return $self->cmd( String => $string, expect => $success );
Line 702 
Line 680 
   
 =pod  =pod
   
 =head2 B<sudb_delete>  =head2 B<sudb_delete> - removes an su from the sudb
   
 Takes either 'all' or the  suid of the su to delete  Takes either 'all' or the  suid of the su to delete
 and returns true on success or undef otherwise.  and returns true on success or undef otherwise.
Line 729 
Line 707 
   
 =pod  =pod
   
 =head2 B<sudb_modify>  =head2 B<sudb_modify> - changes the su information in the sudb
   
 Takes either the  suid of the su to change  Takes either the  suid of the su to change
 as well as what you are changing, either "cir, mir or su2su"  as well as what you are changing, either "cir, mir or su2su"
Line 774 
Line 752 
         return;          return;
     }      }
   
     my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value;      my $string = 'sudb modify ' . $suid . $SPACE . $opt . $SPACE . $value;
   
     return $self->cmd( String => $string, expect => $success );      return $self->cmd( String => $string, expect => $success );
 }  }
   
 =pod  =pod
   
 =head2 B<enable_tftpd>  =head2 B<enable_tftpd> - enable the TFTP server
 - enable the TFTP server  
   
 runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing  runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
   
Line 803 
Line 780 
   
 =pod  =pod
   
 =head2 B<disable_tftpd>  =head2 B<disable_tftpd> - disable the TFTP server
 - disable the TFTP server  
   
 runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'  runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
   
Line 911 
Line 887 
         }          }
     }      }
     if ( $cfg{'args'} ) {      if ( $cfg{'args'} ) {
         $cmd{'String'} .= ' ' . $cfg{'args'};          $cmd{'String'} .= $SPACE . $cfg{'args'};
     }      }
   
     my @lines;      my @lines;
Line 960 
Line 936 
         }          }
     }      }
     else {      else {
         $self->last_error("Error with command ($cfg{'String'}): $last");          my $err;
           if (grep { /\[ERR\]/ } @lines) {
               $err = _decode_lines(@lines);
           }
   
           if (ref $err eq 'HASH' && $err ->{ERR}) {
               $self->last_error($err->{ERR} );
           } else {
               $self->last_error("Error with command ($cfg{'String'}): $last");
           }
         return;          return;
     }      }
 }  }
Line 972 
Line 957 
   
     my %conf;      my %conf;
   
     my $key = '';      my $key = $EMPTY;
     my $val = undef;      my $val = undef;
     my @vals;      my @vals;
     my $in_key = 0;      my $in_key = 0;
Line 983 
Line 968 
   
         my @chars = split //, $line;          my @chars = split //, $line;
   
         my $last_key = '';          my $last_key = $EMPTY;
         foreach my $c (@chars) {          foreach my $c (@chars) {
   
             if ( $c eq '[' || $c eq "\r" || $c eq "\n" ) {              if ( $c eq '[' || $c eq "\r" || $c eq "\n" ) {
Line 1010 
Line 995 
                         # Special case for these bastids.                          # Special case for these bastids.
                         my $new = $last_key;                          my $new = $last_key;
                         $new =~ s/\s+\S+$//;                          $new =~ s/\s+\S+$//;
                         $key = $new . " " . $key;                          $key = $new . $SPACE . $key;
                     }                      }
   
                     $conf{$key} = $val;                      $conf{$key} = $val;
                     $last_key   = $key;                      $last_key   = $key;
                     $key        = '';                      $key        = $EMPTY;
                 }                  }
                 elsif ($val) {                  elsif ($val) {
                     push @vals, $val;                      push @vals, $val;
                 }                  }
                 $val = '';                  $val = $EMPTY;
   
             }              }
             elsif ( $c eq ']' ) {              elsif ( $c eq ']' ) {
Legend:
Removed from v.1.36  
changed lines
  Added in v.1.38
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>