=================================================================== RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v retrieving revision 1.4 retrieving revision 1.9 diff -u -r1.4 -r1.9 --- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2005/12/30 20:26:41 1.4 +++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2006/07/14 02:17:29 1.9 @@ -1,5 +1,5 @@ package Net::Telnet::Trango; -# $RedRiver: Trango.pm,v 1.3 2005/12/30 19:26:06 andrew Exp $ +# $RedRiver: Trango.pm,v 1.8 2006/06/29 00:39: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,26 @@ 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 eth_list + +returns the output from the eth list command + =cut @@ -257,8 +280,14 @@ sysinfo => { decode => 'all', expect => $success }, updateflash => { decode => 'all', expect => $success }, sulog => { decode => 'sulog', expect => $success }, - 'exit' => { Prompt => '//', cmd_disconnects => 1 }, - reboot => { Prompt => '//', cmd_disconnects => 1 }, + '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 => { }, # XXX needs a special decode and a special expect + eth_link => { String => "eth link", expect => $success }, + # eth r, w and reset??? #su password??? #_bootloader #temp @@ -279,6 +308,7 @@ login_banner Timeout last_lines + last_vals ); sub AUTOLOAD @@ -405,6 +435,221 @@ =pod +=item su_password + +C + +=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 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 runs C 'on')> and makes sure that Tftpd is now 'listen'ing @@ -487,9 +732,9 @@ ); my %cfg; - if (@_ == 2) { + if (@_ == 1) { $cfg{'String'} = shift; - } elsif (@_ > 2) { + } elsif (@_ > 1) { %cfg = @_; } @@ -523,12 +768,18 @@ if ($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); 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') { @@ -538,7 +789,9 @@ } } + $self->last_vals($vals); + my $last = $self->lastline; if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) { @@ -548,7 +801,7 @@ $self->is_connected(0); } - if ($cfg{'decode'}) { + if ($PRIVATE{'Decode'} && $cfg{'decode'}) { return $vals; } else { return @lines;