[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.6 and 1.12

version 1.6, 2006/06/28 23:00:15 version 1.12, 2006/08/31 22:29:53
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
 # $RedRiver: Trango.pm,v 1.5 2006/01/03 00:22:19 andrew Exp $  # $RedRiver: Trango.pm,v 1.11 2006/08/23 00:37:20 andrew Exp $
 use strict;  use strict;
 use warnings;  use warnings;
 use base 'Net::Telnet';  use base 'Net::Telnet';
Line 49 
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 67 
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 243 
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 255 
Line 286 
   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 },
   sudb_save   => { String => "sudb save", expect => $success },    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 433 
Line 470 
                     );                      );
 }  }
   
   =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  =pod
   
 =item sudb_view  =item sudb_view
Line 456 
Line 524 
   
   return undef unless @lines;    return undef unless @lines;
   
     unless ($PRIVATE{'Decode'}) {
       return @lines;
     }
   
   my @sus;    my @sus;
   foreach (@lines) {    foreach (@lines) {
       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 = (
         suid => $1,          suid => $1,
Line 491 
Line 564 
   
 and returns true on success or undef otherwise.  and returns true on success or undef otherwise.
   
 You should sudb_save() after calling this, or your changes  will be lost  You should save_sudb() after calling this, or your changes  will be lost
 when the AP is rebooted.  when the AP is rebooted.
   
 =cut  =cut
Line 550 
Line 623 
 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.
   
 You should sudb_save() after calling this, or your changes  will be lost  You should save_sudb() after calling this, or your changes  will be lost
 when the AP is rebooted.  when the AP is rebooted.
   
 =cut  =cut
Line 560 
Line 633 
         my $self = shift;          my $self = shift;
         my $suid = shift;          my $suid = shift;
   
         if ($suid =~ /\D/) {          if (lc($suid) ne 'all' || $suid =~ /\D/) {
                 return undef;                  return undef;
         }          }
   
         return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );          return $self->cmd( String => 'sudb delete ' . $suid, expect => $success );
 }  }
   
   
 =pod  =pod
   
 =item sudb_modify  =item sudb_modify
Line 580 
Line 652 
   
 su2su takes a group id parameter that is in hex.  su2su takes a group id parameter that is in hex.
   
 You should sudb_save() after calling this, or your changes  will be lost  You should save_sudb() after calling this, or your changes  will be lost
 when the AP is rebooted.  when the AP is rebooted.
   
 =cut  =cut
Line 697 
Line 769 
   );    );
   
   my %cfg;    my %cfg;
   if (@_ == 2) {    if (@_ == 1) {
     $cfg{'String'} = shift;      $cfg{'String'} = shift;
   } elsif (@_ > 2) {    } elsif (@_ > 1) {
     %cfg = @_;      %cfg = @_;
   }    }
   
Line 744 
Line 816 
   $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);
     }      }
Line 766 
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 884 
Line 958 
     }      }
   }    }
   return \@decoded;    return \@decoded;
   }
   
   #=item _decode_maclist
   
   sub _decode_maclist
   {
           my @lines = @_;
           my @decoded;
           my $total_entries = 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,
                           };
                   } elsif ($line =~ /(\d+)\s+entries/) {
                           $total_entries = $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.6  
changed lines
  Added in v.1.12
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>