version 1.14, 2006/09/07 03:49:34 |
version 1.25, 2007/01/17 20:48:46 |
|
|
package Net::Telnet::Trango; |
package Net::Telnet::Trango; |
# $RedRiver: Trango.pm,v 1.13 2006/09/07 02:39:36 andrew Exp $ |
# $RedRiver: Trango.pm,v 1.24 2007/01/17 19:00:51 andrew Exp $ |
use strict; |
use strict; |
use warnings; |
use warnings; |
use base 'Net::Telnet'; |
use base 'Net::Telnet'; |
|
|
|
|
use Net::Telnet::Trango; |
use Net::Telnet::Trango; |
my $t = new Net::Telnet::Trango ( Timeout => 5 ); |
my $t = new Net::Telnet::Trango ( Timeout => 5 ); |
|
|
$t->open( Host => $fox ) or die "Error connecting: $!"; |
$t->open( Host => $fox ) or die "Error connecting: $!"; |
|
|
$t->login('password') or die "Couldn't log in: $!"; |
$t->login('password') or die "Couldn't log in: $!"; |
|
|
# Do whatever |
# Do whatever |
|
|
$t->exit; |
$t->exit; |
$t->close; |
$t->close; |
|
|
|
|
|
|
Perl access to the telnet interface on Trango Foxes, SUs and APs. |
Perl access to the telnet interface on Trango Foxes, SUs and APs. |
|
|
Another handy feature is that it will parse the output from certain commands that is in the format "[key1] value1 [key2] value2" and put those in a hashref that is returned. This makes using the output from things like sysinfo very easy to do. |
Another handy feature is that it will parse the output from certain |
|
commands that is in the format "[key1] value1 [key2] value2" and put |
|
those in a hashref that is returned. This makes using the output from |
|
things like sysinfo very easy to do. |
|
|
=head2 EXPORT |
=head2 EXPORT |
|
|
None |
None |
|
|
|
=head1 METHODS |
|
|
|
=over |
|
|
=cut |
=cut |
|
|
our $VERSION = '0.01'; |
our $VERSION = '0.01'; |
|
|
|
|
=pod |
=pod |
|
|
=head1 METHODS |
=back |
|
|
=head2 ACCESSORS |
=head2 ACCESSORS |
|
|
|
|
|
|
=item login_banner |
=item login_banner |
|
|
returns the banner that is displayed when first connected at login. Only set after a successful open() |
returns the banner that is displayed when first connected at login. |
|
Only set after a successful open() |
|
|
This is usually only set internally |
This is usually only set internally |
|
|
|
|
returns the output from the last cmd() that was run as an array ref |
returns the output from the last cmd() that was run as an array ref |
This is usually only set internally |
This is usually only set internally |
|
|
|
=item last_error |
|
|
|
returns the last error reported. Should contain the the last entry in |
|
last_lines |
|
|
=back |
=back |
|
|
=head2 ALIASES |
=head2 ALIASES |
|
|
|
|
=head2 COMMANDS |
=head2 COMMANDS |
|
|
Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>, as such they accept the same options as C<cmd()>. Specifically they take a named paramater "args", for example: |
Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>, |
|
as such they accept the same options as C<cmd()>. |
|
Specifically they take a named paramater "args", for example: |
C<tftpd(args =E<gt> 'on')> would enable tftpd |
C<tftpd(args =E<gt> 'on')> would enable tftpd |
|
|
=over |
=over |
|
|
|
|
reboots the trango and closes the connection |
reboots the trango and closes the connection |
|
|
|
=item remarks |
|
|
|
Takes an optional argument, which sets the remarks. |
|
If there is no argument, returns the current remarks. |
|
|
=item sulog |
=item sulog |
|
|
returns an array ref of hashes containing each log line. |
returns an array ref of hashes containing each log line. |
|
|
|
|
returns the output from the eth list command |
returns the output from the eth list command |
|
|
|
=item su_info |
|
|
|
You need to pass in args => <suid> and it will return the info for that suid. |
|
|
|
=item save_ss |
|
|
|
saves the config. Returns 1 on success, undef on failure. |
|
|
=cut |
=cut |
|
|
|
|
|
|
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 }, |
|
remarks => { decode => 'all', expect => $success }, |
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 => { decode => 'maclist' }, |
maclist => { decode => 'maclist' }, |
maclist_reset => { String => 'maclist reset', expect => 'done' }, |
maclist_reset => { String => 'maclist reset', expect => 'done' }, |
eth_link => { String => 'eth link', expect => $success }, |
eth_link => { String => 'eth link', expect => $success }, |
|
su_info => { String => 'su info', decode => 'all', expect => $success }, |
|
save_ss => { String => 'save ss', expect => $success }, |
|
opmode => { decode => 'all', expect => $success }, |
# eth r, w and reset??? |
# eth r, w and reset??? |
#su password??? |
#su password??? |
#_bootloader |
#_bootloader |
|
|
Timeout |
Timeout |
last_lines |
last_lines |
last_vals |
last_vals |
|
last_error |
); |
); |
|
|
sub AUTOLOAD |
sub AUTOLOAD |
|
|
} |
} |
|
|
if (exists $COMMANDS{$method}) { |
if (exists $COMMANDS{$method}) { |
$method = shift if (@_ == 1); |
|
$COMMANDS{$method}{'String'} ||= $method; |
$COMMANDS{$method}{'String'} ||= $method; |
|
$COMMANDS{$method}{'args'} .= ' ' . shift if (@_ == 1); |
return $self->cmd(%{ $COMMANDS{$method} }, @_); |
return $self->cmd(%{ $COMMANDS{$method} }, @_); |
} |
} |
|
|
|
|
|
|
=item open |
=item open |
|
|
Calls Net::Telnet::open() then makes sure you get a password prompt so you are ready to login() and parses the login banner so you can get host_type() and firmware_version() |
Calls Net::Telnet::open() then makes sure you get a password prompt so |
|
you are ready to login() and parses the login banner so you can get |
|
host_type() and firmware_version() |
|
|
=cut |
=cut |
|
|
|
|
my $self = shift; |
my $self = shift; |
|
|
unless ( $self->SUPER::open(@_) ) { |
unless ( $self->SUPER::open(@_) ) { |
#$! = "Couldn't connect to " . $self->Host . ": $!"; |
$self->last_error("Couldn't connect to " . $self->Host . ": $!"); |
return undef; |
return undef; |
} |
} |
|
|
|
|
-match => '/password: ?$/i', |
-match => '/password: ?$/i', |
-errmode => "return", |
-errmode => "return", |
) ) { |
) ) { |
#$! = "problem connecting to host (" . $self->Host . "): " . |
$self->last_error("problem connecting to host (" . $self->Host . "): " . |
# $self->lastline; |
$self->lastline); |
return undef; |
return undef; |
} |
} |
|
|
|
|
|
|
=item login |
=item login |
|
|
Calls open() if not already connected, then sends the password and sets logged_in() if successful |
Calls open() if not already connected, then sends the password and sets |
|
logged_in() if successful |
|
|
=cut |
=cut |
|
|
|
|
-match => $self->prompt, |
-match => $self->prompt, |
-errmode => "return", |
-errmode => "return", |
) ) { |
) ) { |
#$! = "login ($self->Host) failed: " . $self->lastline; |
$self->last_error("login ($self->Host) failed: " . $self->lastline); |
return undef; |
return undef; |
} |
} |
|
|
|
|
|
|
=item parse_login_banner |
=item parse_login_banner |
|
|
Takes a login banner (what you get when you first connect to the Trango) or reads what is already in login_banner() then parses it and sets host_type() and firmware_version() as well as login_banner() |
Takes a login banner (what you get when you first connect to the Trango) |
|
or reads what is already in login_banner() then parses it and sets |
|
host_type() and firmware_version() as well as login_banner() |
|
|
=cut |
=cut |
|
|
|
|
|
|
=item su_password |
=item su_password |
|
|
C<su_password('all'|suid, 'new_password')> |
C<su_password('new_password'[, 'suid'])> If no suid is specified, |
|
the default is "all". |
|
|
=cut |
=cut |
|
|
sub su_password |
sub su_password |
{ |
{ |
my $self = shift; |
my $self = shift; |
my $su = shift || '!'; |
|
my $new_pass = shift || ''; |
my $new_pass = shift || ''; |
|
my $su = shift || 'all'; |
|
|
unless (defined $su) { |
|
warn "No su passed!" |
|
#return undef; |
|
} |
|
|
|
unless (defined $new_pass) { |
unless (defined $new_pass) { |
warn "No new password!" |
$self->last_error("No new password"); |
#return undef; |
#return undef; |
} |
} |
|
|
|
|
my $new_subnet = shift; |
my $new_subnet = shift; |
my $new_gateway = shift; |
my $new_gateway = shift; |
|
|
return undef unless $suid =~ /^\d+$/; |
if ($suid =~ /\D/) { |
return undef unless $new_ip; |
$self->last_error("Invalid suid '$suid'"); |
return undef unless $new_subnet; |
return undef; |
return undef unless $new_gateway; |
} |
|
unless ($new_ip) { |
|
$self->last_error("no new_ip passed"); |
|
return undef; |
|
} |
|
unless ($new_subnet) { |
|
$self->last_error("no new_subnet passed"); |
|
return undef; |
|
} |
|
unless ($new_gateway) { |
|
$self->last_error("no new_gateway passed"); |
|
return undef; |
|
} |
|
|
# su ipconfig <suid> <new ip> <new subnet> <new gateway> |
# su ipconfig <suid> <new ip> <new subnet> <new gateway> |
return $self->cmd(String => 'su ipconfig ' . |
return $self->cmd(String => 'su ipconfig ' . |
|
|
my $mac = shift; |
my $mac = shift; |
|
|
if ($suid =~ /\D/) { |
if ($suid =~ /\D/) { |
|
$self->last_error("Invalid suid '$suid'"); |
return undef; |
return undef; |
} |
} |
|
|
unless (lc($type) eq 'reg' || lc($type) eq 'pr') { |
unless (lc($type) eq 'reg' || lc($type) eq 'pr') { |
warn "Invalid type '$type'!"; |
$self->last_error("Invalid type '$type'"); |
return undef; |
return undef; |
} |
} |
|
|
if ($cir =~ /\D/) { |
if ($cir =~ /\D/) { |
warn "Invalid CIR '$cir'!"; |
$self->last_error("Invalid CIR '$cir'"); |
return undef; |
return undef; |
} |
} |
|
|
if ($mir =~ /\D/) { |
if ($mir =~ /\D/) { |
warn "Invalid MIR '$mir'!"; |
$self->last_error("Invalid MIR '$mir'"); |
return undef; |
return undef; |
} |
} |
|
|
my $new_mac = $mac; |
my $new_mac = $mac; |
$new_mac =~ s/[^0-9A-Fa-f]//; |
$new_mac =~ s/[^0-9A-Fa-f]//; |
unless (length $new_mac == 12) { |
unless (length $new_mac == 12) { |
warn "Invalid MAC '$mac'!"; |
$self->last_error("Invalid MAC '$mac'"); |
return undef; |
return undef; |
} |
} |
$new_mac = join ' ', $new_mac =~ /../g; |
$new_mac = join ' ', $new_mac =~ /../g; |
|
|
my $self = shift; |
my $self = shift; |
my $suid = shift; |
my $suid = shift; |
|
|
if (lc($suid) ne 'all' || $suid =~ /\D/) { |
#if (lc($suid) ne 'all' || $suid =~ /\D/) { |
|
if ($suid =~ /\D/) { |
|
$self->last_error("Invalid suid '$suid'"); |
return undef; |
return undef; |
} |
} |
|
|
|
|
my $value = shift; |
my $value = shift; |
|
|
if ($suid =~ /\D/) { |
if ($suid =~ /\D/) { |
|
$self->last_error("Invalid suid '$suid'"); |
return undef; |
return undef; |
} |
} |
|
|
if (lc($opt) eq 'cir' or lc($opt) eq 'mir') { |
if (lc($opt) eq 'cir' or lc($opt) eq 'mir') { |
if ($value =~ /\D/) { |
if ($value =~ /\D/) { |
|
$self->last_error("Invalid $opt '$value'"); |
return undef; |
return undef; |
} |
} |
} elsif (lc($opt) eq 'su2su') { |
} elsif (lc($opt) eq 'su2su') { |
if ($value =~ /[^0-9A-Za-f]/) { |
if ($value =~ /[^0-9A-Za-f]/) { |
|
$self->last_error("Invalid MAC '$value'"); |
return undef; |
return undef; |
} |
} |
} else { |
} else { |
|
$self->last_error("Invalid option '$opt'"); |
return undef; |
return undef; |
} |
} |
|
|
|
|
|
|
=item cmd |
=item cmd |
|
|
This does most of the work. At the heart, it calls Net::Telnet::cmd() but it also does some special stuff for Trango. |
This does most of the work. At the heart, it calls Net::Telnet::cmd() |
|
but it also does some special stuff for Trango. |
|
|
Normally returns the last lines from from the command |
Normally returns the last lines from from the command |
|
|
Also accepts these options: |
Also accepts these options: |
|
|
I<decode> |
I<decode> |
- if this is true, then it will send the output lines to _decode_lines() and then returns the decoded output |
- if this is true, then it will send the output lines to _decode_lines() |
|
and then returns the decoded output |
|
|
I<cmd_disconnects> |
I<cmd_disconnects> |
- if this is true, it then sets logged_in() to false, then it will close() the connection and then sets is_connected() to false |
- if this is true, it then sets logged_in() to false, then it will |
|
close() the connection and then sets is_connected() to false |
|
|
I<expect> |
I<expect> |
- if this is set (usually to 'Success.') it will check for that in the last line of output and if it does not, will return undef because the command probably failed |
- if this is set (usually to 'Success.') it will check for that in the |
|
last line of output and if it does not, will return undef because the |
|
command probably failed |
|
|
I<args> |
I<args> |
- a string containing the command line options that are passed to the command |
- a string containing the command line options that are passed to the |
|
command |
|
|
=cut |
=cut |
|
|
|
|
$cfg{'Timeout'} ||= $self->Timeout; |
$cfg{'Timeout'} ||= $self->Timeout; |
|
|
unless ($cfg{'String'}) { |
unless ($cfg{'String'}) { |
#$! = "No command passed"; |
$self->last_error("No command passed"); |
#warn "No command passed\n"; |
|
return undef; |
return undef; |
} |
} |
|
|
unless ($self->is_connected) { |
unless ($self->is_connected) { |
#$! = "Not connected"; |
$self->last_error("Not connected"); |
#warn "Not connected\n"; |
|
return undef; |
return undef; |
} |
} |
|
|
unless ($self->logged_in) { |
unless ($self->logged_in) { |
#$! = "Not logged in"; |
$self->last_error("Not logged in"); |
#warn "Not logged in\n"; |
|
return undef; |
return undef; |
} |
} |
|
|
|
|
return @lines; |
return @lines; |
} |
} |
} else { |
} else { |
#$! = "Error with command ($cfg{'string'}): $last"; |
$self->last_error("Error with command ($cfg{'String'}): $last"); |
return undef; |
return undef; |
} |
} |
} |
} |
|
|
my %conf; |
my %conf; |
|
|
my $key = ''; |
my $key = ''; |
my $val = ''; |
my $val = undef; |
my $in_key = 0; |
my $in_key = 0; |
my $in_val = 0; |
my $in_val = 1; |
|
|
foreach my $line (@lines) { |
foreach my $line (@lines) { |
next if $line =~ /$success$/; |
next if $line =~ /$success$/; |
|
|
$in_val = 0; |
$in_val = 0; |
} else { |
} else { |
$in_key = 0; |
$in_key = 0; |
$in_val = 0; |
$in_val = 1; |
} |
} |
|
|
if ($key) { |
if ($key) { |
$key =~ s/^\s+//; |
$key =~ s/^\s+//; |
$key =~ s/\s+$//; |
$key =~ s/\s+$//; |
|
|
$val =~ s/^\s+//; |
if (defined $val) { |
$val =~ s/\s+$//; |
$val =~ s/^\s+//; |
|
$val =~ s/\s+$//; |
|
} |
|
|
if ($key eq 'Checksum' && $last_key) { |
if ($key eq 'Checksum' && $last_key) { |
# Special case for these bastids. |
# Special case for these bastids. |
|
|
if (%conf) { |
if (%conf) { |
return \%conf; |
return \%conf; |
} else { |
} else { |
return undef; |
return $val; |
} |
} |
} |
} |
|
|
|
|
loc => $loc, |
loc => $loc, |
tm => $tm, |
tm => $tm, |
suid => $suid, |
suid => $suid, |
cur_tm => \$current_tm, |
|
}; |
}; |
} elsif ($line =~ /(\d+)\s+entries/) { |
} elsif ($line =~ /(\d+)\s+entries/) { |
$total_entries = $1; |
$total_entries = $1; |
|
|
$current_tm = $1 |
$current_tm = $1 |
} |
} |
} |
} |
|
|
|
map { $_->{'cur_tm'} = $current_tm } @decoded; |
|
|
if (scalar @decoded == $total_entries) { |
if (scalar @decoded == $total_entries) { |
return \@decoded; |
return \@decoded; |
} else { |
} else { |
|
|
|
|
=head1 SEE ALSO |
=head1 SEE ALSO |
|
|
Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm |
Trango Documentation - |
|
http://www.trangobroadband.com/support/product_docs.htm |
|
|
L<Net::Telnet> |
L<Net::Telnet> |
|
|
=head1 TODO |
=head1 TODO |
|
|
There are still a lot of commands that are not accessed directly. If you call them (as cmd("command + args") or whatever) and it works, please send me examples that work and I will try to get it incorporated into the next version of the script. |
There are still a lot of commands that are not accessed directly. If |
|
you call them (as cmd("command + args") or whatever) and it works, |
|
please send me examples that work and I will try to get it incorporated |
|
into the next version of the script. |
|
|
I also want to be able to parse the different types of output from commands like su, sudb all and anything else that would be better available as a perl datastructure. |
I also want to be able to parse the different types of output from |
|
commands like su, sudb all and anything else that would be better |
|
available as a perl datastructure. |
|
|
=head1 AUTHOR |
=head1 AUTHOR |
|
|