| version 1.26, 2007/01/17 23:15:13 |
version 1.29, 2007/02/01 17:58:33 |
|
|
| package Net::Telnet::Trango; |
package Net::Telnet::Trango; |
| # $RedRiver: Trango.pm,v 1.25 2007/01/17 20:48:46 andrew Exp $ |
# $RedRiver: Trango.pm,v 1.28 2007/02/01 17:10:07 mike Exp $ |
| use strict; |
use strict; |
| use warnings; |
use warnings; |
| use base 'Net::Telnet'; |
use base 'Net::Telnet'; |
|
|
| |
|
| It also takes an optional parameter 'Decode'. If not defined it |
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 |
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 |
instead return a reference to an array of the lines that were returned |
| command. |
from the command. |
| |
|
| =cut |
=cut |
| |
|
|
|
| |
|
| =over |
=over |
| |
|
| =item B<Host> |
|
| |
|
| - returns the name of the host that you are accessing |
|
| |
|
| =item B<firmware_version> |
=item B<firmware_version> |
| |
|
| - returns the firmware version |
- returns the firmware version |
|
|
| =cut |
=cut |
| |
|
| |
|
| my $success = 'Success.'; |
my $success = 'Success\\.'; |
| my %COMMANDS = ( |
my %COMMANDS = ( |
| tftpd => { decode => 'all', expect => $success }, |
tftpd => { decode => 'all', expect => $success }, |
| ver => { decode => 'all' }, |
ver => { decode => 'all' }, |
|
|
| my %ALIASES = ( |
my %ALIASES = ( |
| bye => 'exit', |
bye => 'exit', |
| restart => 'reboot', |
restart => 'reboot', |
| |
Host => 'host', |
| ); |
); |
| |
|
| my %ACCESS = map { $_ => 1 } qw( |
my %ACCESS = map { $_ => 1 } qw( |
| firmware_version |
firmware_version |
| host_type |
host_type |
| Host |
|
| is_connected |
is_connected |
| logged_in |
logged_in |
| login_banner |
login_banner |
|
|
| last_lines |
last_lines |
| last_vals |
last_vals |
| last_error |
last_error |
| |
Decode |
| ); |
); |
| |
|
| sub AUTOLOAD |
sub AUTOLOAD |
|
|
| my $self = shift; |
my $self = shift; |
| |
|
| unless ( $self->SUPER::open(@_) ) { |
unless ( $self->SUPER::open(@_) ) { |
| $self->last_error("Couldn't connect to " . $self->Host . ": $!"); |
$self->last_error("Couldn't connect to " . $self->host . ": $!"); |
| return undef; |
return; |
| } |
} |
| |
|
| ## Get to login prompt |
## Get to login prompt |
|
|
| -match => '/password: ?$/i', |
-match => '/password: ?$/i', |
| -errmode => "return", |
-errmode => "return", |
| ) ) { |
) ) { |
| $self->last_error("problem connecting to host (" . $self->Host . "): " . |
$self->last_error("problem connecting to host (" . $self->host . "): " . |
| $self->lastline); |
$self->lastline); |
| return undef; |
return; |
| } |
} |
| |
|
| $self->parse_login_banner($self->lastline); |
$self->parse_login_banner($self->lastline); |
|
|
| my $self = shift; |
my $self = shift; |
| |
|
| unless ($self->is_connected) { |
unless ($self->is_connected) { |
| $self->open or return undef; |
$self->open or return; |
| } |
} |
| |
|
| my $password = shift; |
my $password = shift; |
|
|
| -match => $self->prompt, |
-match => $self->prompt, |
| -errmode => "return", |
-errmode => "return", |
| ) ) { |
) ) { |
| $self->last_error("login ($self->Host) failed: " . $self->lastline); |
$self->last_error("login ($self->host) failed: " . $self->lastline); |
| return undef; |
return; |
| } |
} |
| |
|
| $self->logged_in(1); |
$self->logged_in(1); |
|
|
| |
|
| my $banner = $self->login_banner; |
my $banner = $self->login_banner; |
| |
|
| my ($type, $ver) = $banner =~ |
my ($type, $sep1, $subtype, $sep2, $ver) = $banner =~ |
| /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i; |
/Welcome to Trango Broadband Wireless (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i; |
| |
|
| |
$type .= $sep1 . $subtype; |
| |
$ver = $subtype . $sep2 . $ver; |
| |
|
| $self->login_banner($banner); |
$self->login_banner($banner); |
| $self->host_type($type); |
$self->host_type($type); |
| $self->firmware_version($ver); |
$self->firmware_version($ver); |
|
|
| |
|
| unless (defined $new_pass) { |
unless (defined $new_pass) { |
| $self->last_error("No new password"); |
$self->last_error("No new password"); |
| #return undef; |
#return; |
| } |
} |
| |
|
| return $self->cmd(String => 'su password ' . |
return $self->cmd(String => 'su password ' . |
|
|
| |
|
| if ($suid =~ /\D/) { |
if ($suid =~ /\D/) { |
| $self->last_error("Invalid suid '$suid'"); |
$self->last_error("Invalid suid '$suid'"); |
| return undef; |
return; |
| } |
} |
| unless ($new_ip) { |
unless ($new_ip) { |
| $self->last_error("no new_ip passed"); |
$self->last_error("no new_ip passed"); |
| return undef; |
return; |
| } |
} |
| unless ($new_subnet) { |
unless ($new_subnet) { |
| $self->last_error("no new_subnet passed"); |
$self->last_error("no new_subnet passed"); |
| return undef; |
return; |
| } |
} |
| unless ($new_gateway) { |
unless ($new_gateway) { |
| $self->last_error("no new_gateway passed"); |
$self->last_error("no new_gateway passed"); |
| return undef; |
return; |
| } |
} |
| |
|
| # su ipconfig <suid> <new ip> <new subnet> <new gateway> |
# su ipconfig <suid> <new ip> <new subnet> <new gateway> |
|
|
| { |
{ |
| my $self = shift; |
my $self = shift; |
| |
|
| my @lines = $self->cmd( String => 'sudb view', expect => $success ); |
my $lines = $self->cmd( String => 'sudb view', expect => $success ) || []; |
| |
|
| return undef unless @lines; |
return unless @{ $lines }; |
| |
|
| unless ($PRIVATE{'Decode'}) { |
unless ($PRIVATE{'Decode'}) { |
| return @lines; |
return $lines; |
| } |
} |
| |
|
| my @sus; |
my @sus; |
| foreach (@lines) { |
foreach (@{ $lines }) { |
| next unless $_; |
next unless $_; |
| if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) { |
if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) { |
| my %s = ( |
my %s = ( |
|
|
| |
|
| if ($suid =~ /\D/) { |
if ($suid =~ /\D/) { |
| $self->last_error("Invalid suid '$suid'"); |
$self->last_error("Invalid suid '$suid'"); |
| return undef; |
return; |
| } |
} |
| |
|
| unless (lc($type) eq 'reg' || lc($type) eq 'pr') { |
unless (lc($type) eq 'reg' || lc($type) eq 'pr') { |
| $self->last_error("Invalid type '$type'"); |
$self->last_error("Invalid type '$type'"); |
| return undef; |
return; |
| } |
} |
| |
|
| if ($cir =~ /\D/) { |
if ($cir =~ /\D/) { |
| $self->last_error("Invalid CIR '$cir'"); |
$self->last_error("Invalid CIR '$cir'"); |
| return undef; |
return; |
| } |
} |
| |
|
| if ($mir =~ /\D/) { |
if ($mir =~ /\D/) { |
| $self->last_error("Invalid MIR '$mir'"); |
$self->last_error("Invalid MIR '$mir'"); |
| return undef; |
return; |
| } |
} |
| |
|
| 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) { |
| $self->last_error("Invalid MAC '$mac'"); |
$self->last_error("Invalid MAC '$mac'"); |
| return undef; |
return; |
| } |
} |
| $new_mac = join ' ', $new_mac =~ /../g; |
$new_mac = join ' ', $new_mac =~ /../g; |
| |
|
|
|
| #if (lc($suid) ne 'all' || $suid =~ /\D/) { |
#if (lc($suid) ne 'all' || $suid =~ /\D/) { |
| if ($suid =~ /\D/) { |
if ($suid =~ /\D/) { |
| $self->last_error("Invalid suid '$suid'"); |
$self->last_error("Invalid suid '$suid'"); |
| return undef; |
return; |
| } |
} |
| |
|
| return $self->cmd( String => 'sudb delete ' . $suid, expect => $success ); |
return $self->cmd( String => 'sudb delete ' . $suid, expect => $success ); |
|
|
| |
|
| if ($suid =~ /\D/) { |
if ($suid =~ /\D/) { |
| $self->last_error("Invalid suid '$suid'"); |
$self->last_error("Invalid suid '$suid'"); |
| return undef; |
return; |
| } |
} |
| |
|
| 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'"); |
$self->last_error("Invalid $opt '$value'"); |
| return undef; |
return; |
| } |
} |
| } 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'"); |
$self->last_error("Invalid MAC '$value'"); |
| return undef; |
return; |
| } |
} |
| } else { |
} else { |
| $self->last_error("Invalid option '$opt'"); |
$self->last_error("Invalid option '$opt'"); |
| return undef; |
return; |
| } |
} |
| |
|
| my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value; |
my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value; |
|
|
| if ($vals->{'Tftpd'} eq 'listen') { |
if ($vals->{'Tftpd'} eq 'listen') { |
| return $vals; |
return $vals; |
| } else { |
} else { |
| return undef; |
return; |
| } |
} |
| } |
} |
| |
|
|
|
| if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') { |
if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') { |
| return $vals; |
return $vals; |
| } else { |
} else { |
| return undef; |
return; |
| } |
} |
| } |
} |
| |
|
|
|
| |
|
| unless ($cfg{'String'}) { |
unless ($cfg{'String'}) { |
| $self->last_error("No command passed"); |
$self->last_error("No command passed"); |
| return undef; |
return; |
| } |
} |
| |
|
| unless ($self->is_connected) { |
unless ($self->is_connected) { |
| $self->last_error("Not connected"); |
$self->last_error("Not connected"); |
| return undef; |
return; |
| } |
} |
| |
|
| unless ($self->logged_in) { |
unless ($self->logged_in) { |
| $self->last_error("Not logged in"); |
$self->last_error("Not logged in"); |
| return undef; |
return; |
| } |
} |
| |
|
| |
|
|
|
| if ($PRIVATE{'Decode'} && $cfg{'decode'}) { |
if ($PRIVATE{'Decode'} && $cfg{'decode'}) { |
| return $vals; |
return $vals; |
| } else { |
} else { |
| return @lines; |
return \@lines; |
| } |
} |
| } else { |
} else { |
| $self->last_error("Error with command ($cfg{'String'}): $last"); |
$self->last_error("Error with command ($cfg{'String'}): $last"); |
| return undef; |
return; |
| } |
} |
| } |
} |
| |
|
|
|
| |
|
| my $key = ''; |
my $key = ''; |
| my $val = undef; |
my $val = undef; |
| |
my @vals; |
| my $in_key = 0; |
my $in_key = 0; |
| my $in_val = 1; |
my $in_val = 1; |
| |
|
|
|
| $key =~ s/^\s+//; |
$key =~ s/^\s+//; |
| $key =~ s/\s+$//; |
$key =~ s/\s+$//; |
| |
|
| if (defined $val) { |
if ($val) { |
| $val =~ s/^\s+//; |
$val =~ s/^\s+//; |
| $val =~ s/\s+$//; |
$val =~ s/\s+$//; |
| } |
} |
|
|
| $key = $new . " " . $key; |
$key = $new . " " . $key; |
| } |
} |
| |
|
| $last_key = $key; |
|
| $conf{$key} = $val; |
$conf{$key} = $val; |
| |
$last_key = $key; |
| $key = ''; |
$key = ''; |
| $val = ''; |
} elsif ($val) { |
| } |
push @vals, $val; |
| |
} |
| |
$val = ''; |
| |
|
| } elsif ($c eq ']') { |
} elsif ($c eq ']') { |
| $in_val = 1; |
$in_val = 1; |
|
|
| } |
} |
| } |
} |
| |
|
| |
unless ($key) { |
| |
push @vals, $val; |
| |
} |
| |
|
| |
if (@vals == 1) { |
| |
$val = $vals[0]; |
| |
} elsif (@vals) { |
| |
$val= \@vals; |
| |
} else { |
| |
$val = undef; |
| |
} |
| |
|
| if (%conf) { |
if (%conf) { |
| |
$conf{_pre} = $val if $val; |
| return \%conf; |
return \%conf; |
| } else { |
} else { |
| return $val; |
return $val; |
|
|
| return \@decoded; |
return \@decoded; |
| } else { |
} else { |
| # XXX we should have a way to set last error, not sure why we don't |
# XXX we should have a way to set last error, not sure why we don't |
| return undef; |
return; |
| } |
} |
| } |
} |
| |
|