[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.4 and 1.13

version 1.4, 2005/12/30 20:26:41 version 1.13, 2006/09/07 03:39:36
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
 # $RedRiver: Trango.pm,v 1.3 2005/12/30 19:26:06 andrew Exp $  # $RedRiver: Trango.pm,v 1.12 2006/08/31 21:29:53 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 15 
Line 15 
   use Net::Telnet::Trango;    use Net::Telnet::Trango;
   my $t = new Net::Telnet::Trango ( Timeout => 5 );    my $t = new Net::Telnet::Trango ( Timeout => 5 );
       
   my ($type, $version) = $t->open( Host => $fox );    $t->open( Host => $fox ) or die "Error connecting: $!";
     
   unless (defined $type && defined $version) {  
     die "Error connecting: $!";  
   }  
   
   $t->login('password') or die "Couldn't log in: $!";    $t->login('password') or die "Couldn't log in: $!";
       
Line 53 
Line 49 
   
 Same as new from L<Net::Telnet> but has defaults for the trango 'Prompt'  Same as new from L<Net::Telnet> but has defaults for the trango 'Prompt'
   
   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
   instead return an array of the lines that were returned from the
   command.
   
 =cut  =cut
   
 sub new  sub new
Line 71 
Line 72 
   foreach my $key (keys %args) {    foreach my $key (keys %args) {
     $PRIVATE{$key} = $args{$key};      $PRIVATE{$key} = $args{$key};
   }    }
     $PRIVATE{'Decode'} = 1 unless defined $PRIVATE{'Decode'};
     delete $args{'Decode'};
   
   my $self = $class->SUPER::new(%args);    my $self = $class->SUPER::new(%args);
   bless $self if ref $self;    bless $self if ref $self;
Line 247 
Line 250 
   
 returns an array ref of hashes containing each log line.  returns an array ref of hashes containing each log line.
   
   =item save_sudb
   
   returns true on success, undef on failure
   
   =item syslog
   
   returns the output from the syslog command
   
   =item pipe
   
   returns the output from the pipe command
   
   =item maclist
   
   returns the output from the maclist command
   
   =item maclist_reset
   
   resets the maclist.  No useful output.
   
   =item eth_list
   
   returns the output from the eth list command
   
 =cut  =cut
   
   
Line 257 
Line 284 
   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'      => { Prompt => '//', cmd_disconnects => 1 },    'exit'      => { no_prompt => 1, cmd_disconnects => 1 },
   reboot      => { Prompt => '//', cmd_disconnects => 1 },    reboot      => { no_prompt => 1, cmd_disconnects => 1 },
     save_sudb   => { String => 'save sudb', expect => $success },
     syslog      => { expect => $success },
     'pipe'      => { }, # XXX needs a special decode
     maclist     => { decode => 'maclist' },
     maclist_reset => { String => 'maclist reset', expect => 'done' },
     eth_link    => { String => 'eth link', expect => $success },
     # eth r, w and reset???
   #su password???    #su password???
   #_bootloader    #_bootloader
   #temp    #temp
Line 279 
Line 313 
   login_banner    login_banner
   Timeout    Timeout
   last_lines    last_lines
     last_vals
 );  );
   
 sub AUTOLOAD  sub AUTOLOAD
Line 405 
Line 440 
   
 =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 su_ipconfig
   
   C<su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )>
   
   =cut
   
   sub su_ipconfig
   {
           my $self        = shift;
   
           my $suid        = shift;
           my $new_ip      = shift;
           my $new_subnet  = shift;
           my $new_gateway = shift;
   
           return undef unless $suid =~ /^\d+$/;
           return undef unless $new_ip;
           return undef unless $new_subnet;
           return undef unless $new_gateway;
                   
           # su ipconfig <suid> <new ip> <new subnet> <new gateway>
           return $self->cmd(String => 'su ipconfig ' .
                        $suid       . ' ' .
                        $new_ip     . ' ' .
                        $new_subnet . ' ' .
                        $new_gateway,
                        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;
   
     unless ($PRIVATE{'Decode'}) {
       return @lines;
     }
   
     my @sus;
     foreach (@lines) {
       next unless $_;
       if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {
         my %s = (
           suid => $1,
           type => $2,
           cir  => $3,
           mir  => $4,
           mac  => $5,
         );
   
             $s{'mac'} =~ s/\s//g;
             $s{'mac'} = uc($s{'mac'});
   
         push @sus, \%s;
       }
     }
   
     return \@sus;
   }
   
   =pod
   
   =item sudb_add
   
   Takes the following paramaters
   
           suid : numeric,
           type : (reg|pr)
           cir  : numeric,
           mir  : numeric,
           mac  : Almost any format, it will be reformatted,
   
   and returns true on success or undef otherwise.
   
   You should save_sudb() after calling this, or your changes  will be lost
   when the AP is rebooted.
   
   =cut
   
   sub sudb_add
   {
           my $self = shift;
           my $suid = shift;
           my $type = shift;
           my $cir  = shift;
           my $mir  = shift;
           my $mac  = shift;
   
           if ($suid =~ /\D/) {
                   return undef;
           }
   
           unless (lc($type) eq 'reg' || lc($type) eq 'pr') {
                   warn "Invalid type '$type'!";
                   return undef;
           }
   
           if ($cir =~ /\D/) {
                   warn "Invalid CIR '$cir'!";
                   return undef;
           }
   
           if ($mir =~ /\D/) {
                   warn "Invalid MIR '$mir'!";
                   return undef;
           }
   
           my $new_mac = $mac;
           $new_mac =~ s/[^0-9A-Fa-f]//;
           unless (length $new_mac == 12) {
                   warn "Invalid MAC '$mac'!";
                   return undef;
           }
           $new_mac = join ' ', $new_mac =~ /../g;
   
           my $string = 'sudb add ' .
                   $suid . ' ' .
                   $type . ' ' .
                   $cir  . ' ' .
                   $mir  . ' ' .
                   $new_mac;
   
   
           return $self->cmd( String => $string, expect => $success );
   }
   
   =pod
   
   =item sudb_delete
   
   Takes either 'all' or the  suid of the su to delete
   and returns true on success or undef otherwise.
   
   You should save_sudb() after calling this, or your changes  will be lost
   when the AP is rebooted.
   
   =cut
   
   sub sudb_delete
   {
           my $self = shift;
           my $suid = shift;
   
           if (lc($suid) ne 'all' || $suid =~ /\D/) {
                   return undef;
           }
   
           return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );
   }
   
   =pod
   
   =item sudb_modify
   
   Takes either the  suid of the su to delete
   as well as what you are changing, either "cir, mir or su2su"
   and returns true on success or undef otherwise.
   
   cir and mir also take a value to set the cir/mir to.
   
   su2su takes a group id parameter that is in hex.
   
   You should save_sudb() after calling this, or your changes  will be lost
   when the AP is rebooted.
   
   =cut
   
   sub sudb_modify
   {
           my $self  = shift;
           my $suid  = shift;
           my $opt   = shift;
           my $value = shift;
   
           if ($suid =~ /\D/) {
                   return undef;
           }
   
           if (lc($opt) eq 'cir' or lc($opt) eq 'mir') {
                   if ($value =~ /\D/) {
                           return undef;
                   }
           } elsif (lc($opt) eq 'su2su') {
                   if ($value =~ /[^0-9A-Za-f]/) {
                           return undef;
                   }
           } else {
                   return undef;
           }
   
           my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value;
   
           return $self->cmd( String => $string, expect => $success );
   }
   
   =pod
   
 =item enable_tftpd  =item enable_tftpd
   
 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 487 
Line 769 
   );    );
   
   my %cfg;    my %cfg;
   if (@_ == 2) {    if (@_ == 1) {
     $cfg{'String'} = shift;      $cfg{'String'} = shift;
   } elsif (@_ > 2) {    } elsif (@_ > 1) {
     %cfg = @_;      %cfg = @_;
   }    }
   
Line 523 
Line 805 
   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 ($PRIVATE{'Decode'} && $cfg{'decode'}) {
     if ($cfg{'decode'} eq 'each') {      if ($cfg{'decode'} eq 'each') {
       $vals = _decode_each_line(@lines);        $vals = _decode_each_line(@lines);
     } elsif ($cfg{'decode'} eq 'sulog') {      } elsif ($cfg{'decode'} eq 'sulog') {
       $vals = _decode_sulog(@lines);        $vals = _decode_sulog(@lines);
       } elsif ($cfg{'decode'} eq 'maclist') {
         $vals = _decode_maclist(@lines);
     } else {      } else {
       $vals = _decode_lines(@lines);        $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 548 
Line 840 
       $self->is_connected(0);        $self->is_connected(0);
     }      }
   
     if ($cfg{'decode'}) {      if ($PRIVATE{'Decode'} && $cfg{'decode'}) {
       return $vals;        return $vals;
     } else {      } else {
       return @lines;        return @lines;
Line 666 
Line 958 
     }      }
   }    }
   return \@decoded;    return \@decoded;
   }
   
   #=item _decode_maclist
   
   sub _decode_maclist
   {
           my @lines = @_;
           my @decoded;
           my $total_entries = 0;
           my $current_tm = 0;
           foreach my $line (@lines) {
                   $line =~ s/\r?\n$//;
                   my ($mac, $loc, $tm) = $line =~ /
                           ([0-9a-fA-F ]{17})\s+
                           (.*)\s+
                           tm\s+
                           (\d+)
                   /x;
   
                   if ($mac) {
                           $mac =~ s/\s+//g;
                           $loc =~ s/^\s+//;
                           $loc =~ s/\s+$//;
   
                           my $suid = undef;
                           if ($loc =~ /suid\s+=\s+(\d+)/) {
                                   $suid = $1;
                                   $loc = undef;
                           }
   
                           push @decoded, {
                                   mac  => $mac,
                                   loc  => $loc,
                                   tm   => $tm,
                                   suid => $suid,
                                   cur_tm => \$current_tm,
                           };
                   } elsif ($line =~ /(\d+)\s+entries/) {
                           $total_entries = $1;
                   } elsif ($line =~ /current tm = (\d+)\s+sec/) {
                           $current_tm = $1
                   }
           }
           if (scalar @decoded == $total_entries) {
                   return \@decoded;
           } else {
                   # XXX we should have a way to set last error, not sure why we don't
                   return undef;
           }
 }  }
   
 1;  1;
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.13
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>