[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.5 and 1.8

version 1.5, 2006/01/03 00:22:19 version 1.8, 2006/06/29 01:39:52
Line 1 
Line 1 
 package Net::Telnet::Trango;  package Net::Telnet::Trango;
 # $RedRiver: Trango.pm,v 1.4 2005/12/30 20:26:41 andrew Exp $  # $RedRiver: Trango.pm,v 1.7 2006/06/28 22:33:18 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 247 
Line 243 
   
 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
   
 =cut  =cut
   
   
Line 259 
Line 259 
   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 },
     save_sudb   => { String => "save sudb", expect => $success },
   #su password???    #su password???
   #_bootloader    #_bootloader
   #temp    #temp
Line 461 
Line 462 
   
   my @sus;    my @sus;
   foreach (@lines) {    foreach (@lines) {
     if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9a-fA-F]+)/) {      if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {
       my %s = (        my %s = (
         suid => $1,          suid => $1,
         type => $2,          type => $2,
Line 469 
Line 470 
         mir  => $4,          mir  => $4,
         mac  => $5,          mac  => $5,
       );        );
   
             $s{'mac'} =~ s/\s//g;
             $s{'mac'} = uc($s{'mac'});
   
       push @sus, \%s;        push @sus, \%s;
     }      }
   }    }
   
   return \@sus;    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  =pod
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.8
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>