[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.26 and 1.32

version 1.26, 2007/01/17 23:15:13 version 1.32, 2007/02/02 18:59:50
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
 # $RedRiver: Trango.pm,v 1.25 2007/01/17 20:48:46 andrew Exp $  # $RedRiver: Trango.pm,v 1.31 2007/02/02 18:54:22 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 65 
Line 65 
   
 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
 instead return an array of the lines that were returned from the  instead return a reference to an array of the lines that were returned
 command.  from the command.
   
 =cut  =cut
   
Line 179 
Line 179 
   
 =over  =over
   
 =item B<Host>  
   
 - returns the name of the host that you are accessing  
   
 =item B<firmware_version>  =item B<firmware_version>
   
 - returns the firmware version  - returns the firmware version
Line 333 
Line 329 
   
   $t->su_info($suid);    $t->su_info($suid);
   
   =item B<su_testrflink>
   
   - tests the RF Link to an su
   
     $t->su_testrflink($suid|'all');
   
 =item B<save_ss>  =item B<save_ss>
   
 - saves the config.  - saves the config.
Line 342 
Line 344 
 =cut  =cut
   
   
 my $success = 'Success.';  my $success = 'Success\\.';
 my %COMMANDS = (  my %COMMANDS = (
   tftpd       => { decode => 'all',   expect => $success },    tftpd       => { decode => 'all',   expect => $success },
   ver         => { decode => 'all' },    ver         => { decode => 'all' },
Line 359 
Line 361 
   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 },    su_info     => { String => 'su info', decode => 'all', expect => $success },
     su_testrflink => { 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 },
   # eth r, w and reset???    # eth r, w and reset???
Line 371 
Line 374 
 my %ALIASES = (  my %ALIASES = (
   bye     => 'exit',    bye     => 'exit',
   restart => 'reboot',    restart => 'reboot',
     Host    => 'host',
 );  );
   
 my %ACCESS = map { $_ => 1 } qw(  my %ACCESS = map { $_ => 1 } qw(
   firmware_version    firmware_version
   host_type    host_type
   Host  
   is_connected    is_connected
   logged_in    logged_in
   login_banner    login_banner
Line 384 
Line 387 
   last_lines    last_lines
   last_vals    last_vals
   last_error    last_error
     Decode
 );  );
   
 sub AUTOLOAD  sub AUTOLOAD
Line 399 
Line 403 
   }    }
   
   if (exists $COMMANDS{$method}) {    if (exists $COMMANDS{$method}) {
     $COMMANDS{$method}{'String'} ||= $method;      my %cmd;
     $COMMANDS{$method}{'args'} .= ' ' . shift if (@_ == 1);      foreach my $k (keys %{ $COMMANDS{$method} }) {
     return $self->cmd(%{ $COMMANDS{$method} }, @_);        $cmd{$k} = $COMMANDS{$method}{$k};
       }
       $cmd{'String'} ||= $method;
       $cmd{'args'}   .= ' ' . shift if (@_ == 1);
       return $self->cmd(%cmd, @_);
   }    }
   
   if (exists $ACCESS{$method}) {    if (exists $ACCESS{$method}) {
Line 431 
Line 439 
   my $self = shift;    my $self = shift;
   
   unless ( $self->SUPER::open(@_) ) {    unless ( $self->SUPER::open(@_) ) {
     $self->last_error("Couldn't connect to " . $self->Host . ":  $!");      $self->last_error("Couldn't connect to " . $self->host . ":  $!");
     return undef;      return;
   }    }
   
   ## Get to login prompt    ## Get to login prompt
Line 440 
Line 448 
       -match => '/password: ?$/i',        -match => '/password: ?$/i',
       -errmode => "return",        -errmode => "return",
     ) ) {      ) ) {
     $self->last_error("problem connecting to host (" . $self->Host . "): " .      $self->last_error("problem connecting to host (" . $self->host . "): " .
         $self->lastline);          $self->lastline);
     return undef;      return;
   }    }
   
   $self->parse_login_banner($self->lastline);    $self->parse_login_banner($self->lastline);
Line 468 
Line 476 
   my $self = shift;    my $self = shift;
   
   unless ($self->is_connected) {    unless ($self->is_connected) {
     $self->open or return undef;      $self->open or return;
   }    }
   
   my $password = shift;    my $password = shift;
Line 478 
Line 486 
     -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 undef;      return;
   }    }
   
   $self->logged_in(1);    $self->logged_in(1);
Line 510 
Line 518 
   
   my $banner = $self->login_banner;    my $banner = $self->login_banner;
   
   my ($type, $ver) = $banner =~    my ($type, $sep1, $subtype, $sep2, $ver) = $banner =~
     /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i;      /Welcome to Trango Broadband Wireless (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i;
   
     $type .= $sep1 . $subtype;
     $ver = $subtype . $sep2 . $ver;
   
   $self->login_banner($banner);    $self->login_banner($banner);
   $self->host_type($type);    $self->host_type($type);
   $self->firmware_version($ver);    $self->firmware_version($ver);
Line 541 
Line 552 
   
   unless (defined $new_pass) {    unless (defined $new_pass) {
     $self->last_error("No new password");      $self->last_error("No new password");
     #return undef;      #return;
   }    }
   
   return $self->cmd(String => 'su password ' .    return $self->cmd(String => 'su password ' .
Line 576 
Line 587 
   
         if ($suid =~ /\D/) {          if ($suid =~ /\D/) {
                 $self->last_error("Invalid suid '$suid'");                  $self->last_error("Invalid suid '$suid'");
                 return undef;                  return;
         }          }
         unless ($new_ip) {          unless ($new_ip) {
                 $self->last_error("no new_ip passed");                  $self->last_error("no new_ip passed");
                 return undef;                  return;
         }          }
         unless ($new_subnet) {          unless ($new_subnet) {
                 $self->last_error("no new_subnet passed");                  $self->last_error("no new_subnet passed");
                 return undef;                  return;
         }          }
         unless ($new_gateway) {          unless ($new_gateway) {
                 $self->last_error("no new_gateway passed");                  $self->last_error("no new_gateway passed");
                 return undef;                  return;
         }          }
   
         # su ipconfig <suid> <new ip> <new subnet> <new gateway>          # su ipconfig <suid> <new ip> <new subnet> <new gateway>
Line 616 
Line 627 
 {  {
   my $self = shift;    my $self = shift;
   
   my @lines = $self->cmd( String => 'sudb view', expect => $success );    my $lines = $self->cmd( String => 'sudb view', expect => $success ) || [];
   
   return undef unless @lines;    return unless @{ $lines };
   
   unless ($PRIVATE{'Decode'}) {    unless ($PRIVATE{'Decode'}) {
     return @lines;      return $lines;
   }    }
   
   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+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {
       my %s = (        my %s = (
Line 678 
Line 689 
   
         if ($suid =~ /\D/) {          if ($suid =~ /\D/) {
                 $self->last_error("Invalid suid '$suid'");                  $self->last_error("Invalid suid '$suid'");
                 return undef;                  return;
         }          }
   
         unless (lc($type) eq 'reg' || lc($type) eq 'pr') {          unless (lc($type) eq 'reg' || lc($type) eq 'pr') {
                 $self->last_error("Invalid type '$type'");                  $self->last_error("Invalid type '$type'");
                 return undef;                  return;
         }          }
   
         if ($cir =~ /\D/) {          if ($cir =~ /\D/) {
                 $self->last_error("Invalid CIR '$cir'");                  $self->last_error("Invalid CIR '$cir'");
                 return undef;                  return;
         }          }
   
         if ($mir =~ /\D/) {          if ($mir =~ /\D/) {
                 $self->last_error("Invalid MIR '$mir'");                  $self->last_error("Invalid MIR '$mir'");
                 return undef;                  return;
         }          }
   
         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) {
                 $self->last_error("Invalid MAC '$mac'");                  $self->last_error("Invalid MAC '$mac'");
                 return undef;                  return;
         }          }
         $new_mac = join ' ', $new_mac =~ /../g;          $new_mac = join ' ', $new_mac =~ /../g;
   
Line 737 
Line 748 
         #if (lc($suid) ne 'all' || $suid =~ /\D/) {          #if (lc($suid) ne 'all' || $suid =~ /\D/) {
         if ($suid =~ /\D/) {          if ($suid =~ /\D/) {
                 $self->last_error("Invalid suid '$suid'");                  $self->last_error("Invalid suid '$suid'");
                 return undef;                  return;
         }          }
   
         return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );          return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );
Line 771 
Line 782 
   
         if ($suid =~ /\D/) {          if ($suid =~ /\D/) {
                 $self->last_error("Invalid suid '$suid'");                  $self->last_error("Invalid suid '$suid'");
                 return undef;                  return;
         }          }
   
         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'");                          $self->last_error("Invalid $opt '$value'");
                         return undef;                          return;
                 }                  }
         } 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'");                          $self->last_error("Invalid MAC '$value'");
                         return undef;                          return;
                 }                  }
         } else {          } else {
                 $self->last_error("Invalid option '$opt'");                  $self->last_error("Invalid option '$opt'");
                 return undef;                  return;
         }          }
   
         my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value;          my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value;
Line 813 
Line 824 
   if ($vals->{'Tftpd'} eq 'listen') {    if ($vals->{'Tftpd'} eq 'listen') {
     return $vals;      return $vals;
   } else {    } else {
     return undef;      return;
   }    }
 }  }
   
Line 836 
Line 847 
   if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') {    if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') {
     return $vals;      return $vals;
   } else {    } else {
     return undef;      return;
   }    }
 }  }
   
Line 915 
Line 926 
   
   unless ($cfg{'String'}) {    unless ($cfg{'String'}) {
     $self->last_error("No command passed");      $self->last_error("No command passed");
     return undef;      return;
   }    }
   
   unless ($self->is_connected) {    unless ($self->is_connected) {
     $self->last_error("Not connected");      $self->last_error("Not connected");
     return undef;      return;
   }    }
   
   unless ($self->logged_in) {    unless ($self->logged_in) {
     $self->last_error("Not logged in");      $self->last_error("Not logged in");
     return undef;      return;
   }    }
   
   
Line 938 
Line 949 
   if ($cfg{'args'}) {    if ($cfg{'args'}) {
     $cmd{'String'} .= ' ' . $cfg{'args'};      $cmd{'String'} .= ' ' . $cfg{'args'};
   }    }
   
   my @lines;    my @lines;
   unless ($cfg{'no_prompt'}) {    if ($cfg{'no_prompt'}) {
     @lines = $self->SUPER::cmd(%cmd);  
   } else {  
     $self->print($cmd{'String'});      $self->print($cmd{'String'});
     @lines = $self->lastline;      @lines = $self->lastline;
     } else {
       @lines = $self->SUPER::cmd(%cmd);
   }    }
   
   $self->last_lines(\@lines);    $self->last_lines(\@lines);
Line 976 
Line 988 
     if ($PRIVATE{'Decode'} && $cfg{'decode'}) {      if ($PRIVATE{'Decode'} && $cfg{'decode'}) {
       return $vals;        return $vals;
     } else {      } else {
       return @lines;        return \@lines;
     }      }
   } else {    } else {
     $self->last_error("Error with command ($cfg{'String'}): $last");      $self->last_error("Error with command ($cfg{'String'}): $last");
     return undef;      return;
   }    }
 }  }
   
Line 994 
Line 1006 
   
   my $key = '';    my $key = '';
   my $val = undef;    my $val = undef;
     my @vals;
   my $in_key = 0;    my $in_key = 0;
   my $in_val = 1;    my $in_val = 1;
   
Line 1018 
Line 1031 
           $key =~ s/^\s+//;            $key =~ s/^\s+//;
           $key =~ s/\s+$//;            $key =~ s/\s+$//;
   
           if (defined $val) {            if ($val) {
             $val =~ s/^\s+//;              $val =~ s/^\s+//;
             $val =~ s/\s+$//;              $val =~ s/\s+$//;
           }            }
Line 1030 
Line 1043 
             $key = $new . " " . $key;              $key = $new . " " . $key;
           }            }
   
           $last_key = $key;  
           $conf{$key} = $val;            $conf{$key} = $val;
             $last_key = $key;
           $key = '';            $key = '';
           $val = '';          } elsif ($val) {
         }                          push @vals, $val;
                   }
           $val = '';
   
       } elsif ($c eq ']') {        } elsif ($c eq ']') {
         $in_val = 1;          $in_val = 1;
Line 1050 
Line 1065 
     }      }
   }    }
   
     unless ($key) {
       push @vals, $val;
     }
   
     if (@vals == 1) {
       $val = $vals[0];
     } elsif (@vals) {
       $val= \@vals;
     } else {
       $val = undef;
     }
   
   if (%conf) {    if (%conf) {
       $conf{_pre} = $val if $val;
     return \%conf;      return \%conf;
   } else {    } else {
     return $val;      return $val;
Line 1142 
Line 1170 
                 return \@decoded;                  return \@decoded;
         } else {          } else {
                 # XXX we should have a way to set last error, not sure why we don't                  # XXX we should have a way to set last error, not sure why we don't
                 return undef;                  return;
         }          }
 }  }
   
Legend:
Removed from v.1.26  
changed lines
  Added in v.1.32
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>