| version 1.9, 2006/07/14 02:17:29 | version 1.13, 2006/09/07 03:39:36 | 
|  |  | 
| package Net::Telnet::Trango; | package Net::Telnet::Trango; | 
| # $RedRiver: Trango.pm,v 1.8 2006/06/29 00:39:52 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'; | 
|  |  | 
|  |  | 
| returns the output from the maclist command | returns the output from the maclist command | 
|  |  | 
|  | =item maclist_reset | 
|  |  | 
|  | resets the maclist.  No useful output. | 
|  |  | 
| =item eth_list | =item eth_list | 
|  |  | 
| returns the output from the eth list command | returns the output from the eth list command | 
|  |  | 
| 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 }, | save_sudb   => { String => 'save sudb', expect => $success }, | 
| syslog      => { expect => $success }, | syslog      => { expect => $success }, | 
| 'pipe'      => { }, # XXX needs a special decode | 'pipe'      => { }, # XXX needs a special decode | 
| maclist     => { }, # XXX needs a special decode and a special expect | maclist     => { decode => 'maclist' }, | 
| eth_link    => { String => "eth link", expect => $success }, | maclist_reset => { String => 'maclist reset', expect => 'done' }, | 
|  | eth_link    => { String => 'eth link', expect => $success }, | 
| # eth r, w and reset??? | # eth r, w and reset??? | 
| #su password??? | #su password??? | 
| #_bootloader | #_bootloader | 
|  |  | 
|  |  | 
| =pod | =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 | =item sudb_view | 
|  |  | 
| returns a reference to an array of hashes each containing: | returns a reference to an array of hashes each containing: | 
|  |  | 
| $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); | 
| } | } | 
|  |  | 
| } | } | 
| } | } | 
| 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; |