=================================================================== RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v retrieving revision 1.5 retrieving revision 1.11 diff -u -r1.5 -r1.11 --- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2006/01/03 00:22:19 1.5 +++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2006/08/23 01:37:20 1.11 @@ -1,5 +1,5 @@ package Net::Telnet::Trango; -# $RedRiver: Trango.pm,v 1.4 2005/12/30 20:26:41 andrew Exp $ +# $RedRiver: Trango.pm,v 1.10 2006/07/31 22:16:52 andrew Exp $ use strict; use warnings; use base 'Net::Telnet'; @@ -15,11 +15,7 @@ use Net::Telnet::Trango; my $t = new Net::Telnet::Trango ( Timeout => 5 ); - my ($type, $version) = $t->open( Host => $fox ); - - unless (defined $type && defined $version) { - die "Error connecting: $!"; - } + $t->open( Host => $fox ) or die "Error connecting: $!"; $t->login('password') or die "Couldn't log in: $!"; @@ -53,6 +49,11 @@ Same as new from L 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 sub new @@ -71,6 +72,8 @@ foreach my $key (keys %args) { $PRIVATE{$key} = $args{$key}; } + $PRIVATE{'Decode'} = 1 unless defined $PRIVATE{'Decode'}; + delete $args{'Decode'}; my $self = $class->SUPER::new(%args); bless $self if ref $self; @@ -247,6 +250,30 @@ 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 @@ -259,6 +286,13 @@ sulog => { decode => 'sulog', expect => $success }, 'exit' => { no_prompt => 1, 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??? #_bootloader #temp @@ -436,7 +470,6 @@ ); } - =pod =item sudb_view @@ -459,9 +492,14 @@ return undef unless @lines; + unless ($PRIVATE{'Decode'}) { + return @lines; + } + my @sus; foreach (@lines) { - if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9a-fA-F]+)/) { + next unless $_; + if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) { my %s = ( suid => $1, type => $2, @@ -469,6 +507,10 @@ mir => $4, mac => $5, ); + + $s{'mac'} =~ s/\s//g; + $s{'mac'} = uc($s{'mac'}); + push @sus, \%s; } } @@ -478,6 +520,141 @@ =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 runs C 'on')> and makes sure that Tftpd is now 'listen'ing @@ -560,9 +737,9 @@ ); my %cfg; - if (@_ == 2) { + if (@_ == 1) { $cfg{'String'} = shift; - } elsif (@_ > 2) { + } elsif (@_ > 1) { %cfg = @_; } @@ -607,11 +784,13 @@ $self->last_lines(\@lines); my $vals = 1; - if ($cfg{'decode'}) { + if ($PRIVATE{'Decode'} && $cfg{'decode'}) { if ($cfg{'decode'} eq 'each') { $vals = _decode_each_line(@lines); } elsif ($cfg{'decode'} eq 'sulog') { $vals = _decode_sulog(@lines); + } elsif ($cfg{'decode'} eq 'maclist') { + $vals = _decode_maclist(@lines); } else { $vals = _decode_lines(@lines); } @@ -629,7 +808,7 @@ $self->is_connected(0); } - if ($cfg{'decode'}) { + if ($PRIVATE{'Decode'} && $cfg{'decode'}) { return $vals; } else { return @lines; @@ -747,6 +926,51 @@ } } 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;