version 1.34, 2007/02/05 21:02:07 |
version 1.39, 2007/02/06 20:41:42 |
|
|
package Net::Telnet::Trango;
|
package Net::Telnet::Trango;
|
|
|
# $RedRiver: Trango.pm,v 1.33 2007/02/02 21:26:56 andrew Exp $
|
# $RedRiver: Trango.pm,v 1.38 2007/02/06 16:22:46 andrew Exp $
|
use strict;
|
use strict;
|
use warnings;
|
use warnings;
|
use base 'Net::Telnet';
|
use base 'Net::Telnet';
|
|
|
|
|
our $VERSION = '0.01';
|
our $VERSION = '0.01';
|
|
|
|
my $EMPTY = q{};
|
|
my $SPACE = q{ };
|
|
|
my %PRIVATE = (
|
my %PRIVATE = (
|
is_connected => 0,
|
is_connected => 0,
|
logged_in => 0,
|
logged_in => 0,
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<new>
|
=head2 B<new> - Creates a new Net::Telnet::Trango object.
|
- Creates a new Net::Telnet::Trango object.
|
|
|
|
new([Options from Net::Telnet,]
|
new([Options from Net::Telnet,]
|
[Decode => 0,]);
|
[Decode => 0,]);
|
|
|
Same as new from L<Net::Telnet> but sets the default Trango Prompt:
|
Same as new from L<Net::Telnet> but sets the default Trango Prompt:
|
'/#> *$/'
|
'/#> *$/'
|
|
|
|
|
These are usually only set internally.
|
These are usually only set internally.
|
|
|
=head2 B<firmware_version>
|
=head2 B<firmware_version> - returns the firmware version
|
- returns the firmware version
|
|
|
|
Returns the firmware version if available, otherwise undef.
|
Returns the firmware version if available, otherwise undef.
|
|
|
It should be available after a successful open().
|
It should be available after a successful open().
|
|
|
=head2 B<host_type>
|
=head2 B<host_type> - return the type of host you are connected to.
|
- return the type of host you are connected to.
|
|
|
|
returns the type of host from the login banner for example M5830S or M5300S.
|
returns the type of host from the login banner for example M5830S or M5300S.
|
|
|
Should be available after a successful open().
|
Should be available after a successful open().
|
|
|
=head2 B<is_connected>
|
=head2 B<is_connected> - Status of the connection to host.
|
- Status of the connection to host.
|
|
|
|
returns 1 when connected, undef otherwise.
|
returns 1 when connected, undef otherwise.
|
|
|
=head2 B<logged_in>
|
=head2 B<logged_in> - Status of being logged in to the host.
|
- Status of being logged in to the host.
|
|
|
|
returns 1 after a successful login(), 0 if it failed and undef if
|
returns 1 after a successful login(), 0 if it failed and undef if
|
login() was never called.
|
login() was never called.
|
|
|
=head2 B<login_banner>
|
=head2 B<login_banner> - The banner when first connecting to the host.
|
- The banner when first connecting to the host.
|
|
|
|
returns the banner that is displayed when first connected at login.
|
returns the banner that is displayed when first connected at login.
|
Only set after a successful open().
|
Only set after a successful open().
|
|
|
=head2 B<last_lines>
|
=head2 B<last_lines> - The last lines of output from the last cmd().
|
- The last lines of output from the last cmd().
|
|
|
|
returns, as an array ref, the output from the last cmd() that was run.
|
returns, as an array ref, the output from the last cmd() that was run.
|
|
|
=head2 B<last_error>
|
=head2 B<last_error> - A text output of the last error that was encountered.
|
- A text output of the last error that was encountered.
|
|
|
|
returns the last error reported. Probably contains the last entry in
|
returns the last error reported. Probably contains the last entry in
|
last_lines.
|
last_lines.
|
|
|
=head1 ALIASES
|
=head1 ALIASES
|
|
|
=head2 B<bye>
|
=head2 B<bye> - alias of exit()
|
- alias of exit()
|
|
|
|
Does the same as exit()
|
Does the same as exit()
|
|
|
=head2 B<restart>
|
=head2 B<restart> - alias of reboot()
|
- alias of reboot()
|
|
|
|
Does the same as reboot()
|
Does the same as reboot()
|
|
|
|
=head2 B<save_systemsetting> - alias of save_ss()
|
|
|
|
Does the same as save_ss()
|
|
|
=head1 COMMANDS
|
=head1 COMMANDS
|
|
|
Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>,
|
Most of these are just shortcuts to C<cmd(String =E<gt> METHOD)>,
|
|
|
Specifically they take a named paramater "args", for example:
|
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
|
|
|
=head2 B<tftpd>
|
=head2 B<tftpd> - The output from the tftpd command
|
- The output from the tftpd command
|
|
|
|
Returns a hash ref of the decoded output from the
|
Returns a hash ref of the decoded output from the
|
command.
|
command.
|
|
|
Also see enable_tftpd() and disable_tftpd() as those check that it was
|
Also see enable_tftpd() and disable_tftpd() as those check that it was
|
successfully changed.
|
successfully changed.
|
|
|
=head2 B<ver>
|
=head2 B<ver> - The output from the ver command
|
- The output from the ver command
|
|
|
|
Returns a hash ref of the decoded output from the
|
Returns a hash ref of the decoded output from the
|
command.
|
command.
|
|
|
=head2 B<sysinfo>
|
=head2 B<sysinfo> - The output from the sysinfo command
|
- The output from the sysinfo command
|
|
|
|
Returns a hash ref of the decoded output from the
|
Returns a hash ref of the decoded output from the
|
command.
|
command.
|
|
|
=head2 B<exit>
|
=head2 B<exit> - Exits the connection
|
- Exits the connection
|
|
|
|
exits the command session with the Trango and closes
|
exits the command session with the Trango and closes
|
the connection
|
the connection
|
|
|
=head2 B<reboot>
|
=head2 B<reboot> - Sends a reboot command
|
- Sends a reboot command
|
|
|
|
reboots the Trango and closes the connection
|
reboots the Trango and closes the connection
|
|
|
=head2 B<remarks>
|
=head2 B<remarks> - Set or retrieve the remarks.
|
- Set or retrieve the remarks.
|
|
|
|
Takes an optional argument, which sets the remarks.
|
Takes an optional argument, which sets the remarks.
|
If there is no argument, returns the current remarks.
|
If there is no argument, returns the current remarks.
|
|
|
my $old_remarks = $t->remarks();
|
my $old_remarks = $t->remarks();
|
$t->remarks($new_remarks);
|
$t->remarks($new_remarks);
|
|
|
=head2 B<sulog>
|
=head2 B<sulog> - The output from the sulog command
|
- The output from the sulog command
|
|
|
|
Returns an array ref of hashes containing each log
|
Returns an array ref of hashes containing each log
|
line.
|
line.
|
|
|
=head2 B<save_sudb>
|
=head2 B<save_sudb> - saves the sudb
|
- saves the sudb
|
|
|
|
Returns true on success, undef on failure
|
Returns true on success, undef on failure
|
|
|
=head2 B<syslog>
|
=head2 B<syslog> - The output from the sulog command
|
- The output from the sulog command
|
|
|
|
Returns a hashref of the output from the syslog command
|
Returns a hashref of the output from the syslog command
|
|
|
=head2 B<pipe>
|
=head2 B<pipe> - the pipe command
|
- the pipe command
|
|
|
|
Returns the output from the pipe command
|
Returns the output from the pipe command
|
|
|
=head2 B<maclist>
|
=head2 B<maclist> - retrieves the maclist
|
- retrieves the maclist
|
|
|
|
Returns the output from the maclist command
|
Returns the output from the maclist command
|
|
|
=head2 B<maclist_reset>
|
=head2 B<maclist_reset> - resets the maclist.
|
- resets the maclist.
|
|
|
|
No useful output.
|
No useful output.
|
|
|
=head2 B<eth_list>
|
=head2 B<eth_link> - eth link command
|
- eth list command
|
|
|
|
Returns the output from the eth list command
|
Returns the output from the eth link command
|
|
|
|
This command seems to cause some weird issues. It often will cause the
|
|
command after it to appear to fail. I am not sure why.
|
|
|
=head2 B<su_info>
|
=head2 B<su_info> - gets the su info
|
- gets the su info
|
|
|
|
Returns information about the SU.
|
Returns information about the SU.
|
|
|
|
|
|
|
$t->su_info($suid);
|
$t->su_info($suid);
|
|
|
=head2 B<su_testrflink>
|
=head2 B<su_testrflink> - tests the RF Link to an su
|
- tests the RF Link to an su
|
|
|
|
$t->su_testrflink($suid|'all');
|
$t->su_testrflink($suid|'all');
|
|
|
=head2 B<save_ss>
|
=head2 B<save_ss> - saves the config.
|
- saves the config.
|
|
|
|
Returns 1 on success, undef on failure.
|
Returns 1 on success, undef on failure.
|
|
|
|
=head2 B<opmode> - sets opmode ap y or returns the opmode
|
|
|
|
$t->opmode([ap y]);
|
|
|
=cut
|
=cut
|
|
|
my $success = 'Success\\.';
|
my $success = 'Success\\.';
|
|
|
remarks => { decode => 'all', expect => $success },
|
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 },
|
su_info =>
|
|
{ String => 'su info', decode => 'all', expect => $success },
|
su_testrflink =>
|
su_testrflink =>
|
{ String => 'su testrflink', decode => 'each', expect => $success },
|
{ String => 'su testrflink', decode => 'each', expect => $success },
|
save_ss => { String => 'save ss', expect => $success },
|
save_ss => { String => 'save ss', expect => $success },
|
opmode => { decode => 'all', expect => $success },
|
opmode => { decode => 'all', expect => $success },
|
|
|
# eth r, w and reset???
|
|
#su password???
|
|
#_bootloader
|
|
#temp
|
|
#heater
|
|
);
|
);
|
|
|
my %ALIASES = (
|
my %ALIASES = (
|
bye => 'exit',
|
bye => 'exit',
|
restart => 'reboot',
|
restart => 'reboot',
|
Host => 'host',
|
Host => 'host',
|
|
save_systemseting => 'save_ss',
|
);
|
);
|
|
|
my %ACCESS = map { $_ => 1 } qw(
|
my %ACCESS = map { $_ => 1 } qw(
|
|
|
$cmd{$k} = $COMMANDS{$method}{$k};
|
$cmd{$k} = $COMMANDS{$method}{$k};
|
}
|
}
|
$cmd{'String'} ||= $method;
|
$cmd{'String'} ||= $method;
|
$cmd{'args'} .= ' ' . shift if ( @_ == 1 );
|
$cmd{'args'} .= $SPACE . shift if ( @_ == 1 );
|
return $self->cmd( %cmd, @_ );
|
return $self->cmd( %cmd, @_ );
|
}
|
}
|
|
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<open>
|
=head2 B<open> - Open a connection to a Trango AP.
|
- Open a connection to a Trango AP.
|
|
|
|
Calls Net::Telnet::open() then makes sure you get a password prompt so
|
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
|
you are ready to login() and parses the login banner so you can get
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<login>
|
=head2 B<login> - Login to the AP.
|
- Login to the AP.
|
|
|
|
Calls open() if not already connected, then sends the password and sets
|
Calls open() if not already connected, then sends the password and sets
|
logged_in() if successful
|
logged_in() if successful
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<parse_login_banner>
|
=head2 B<parse_login_banner> - Converts the login_banner to something useful.
|
- Converts the login_banner to some useful
|
|
variables.
|
|
|
|
Takes a login banner (what you get when you first connect to the Trango)
|
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
|
or reads what is already in login_banner() then parses it and sets
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<su_password>
|
=head2 B<su_password> - Set the password on SUs connected to the AP.
|
- Set the password on SUs connected to the AP.
|
|
|
|
su_password('new_password'[, 'suid']) If no suid is specified,
|
su_password('new_password'[, 'suid']) If no suid is specified,
|
the default is "all".
|
the default is "all".
|
|
|
|
|
sub su_password {
|
sub su_password {
|
my $self = shift;
|
my $self = shift;
|
my $new_pass = shift || '';
|
my $new_pass = shift || $EMPTY;
|
my $su = shift || 'all';
|
my $su = shift || 'all';
|
|
|
unless ( defined $new_pass ) {
|
unless ( defined $new_pass ) {
|
|
|
}
|
}
|
|
|
return $self->cmd(
|
return $self->cmd(
|
String => 'su password ' . $su . ' ' . $new_pass . ' ' . $new_pass,
|
String => 'su password ' . $su . $SPACE . $new_pass . $SPACE . $new_pass,
|
expect => $success,
|
expect => $success,
|
);
|
);
|
}
|
}
|
|
|
=pod
|
=pod
|
|
|
=head2 B<su_ipconfig>
|
=head2 B<su_ipconfig> - Change IP configuration on SUs connected to the AP.
|
- Change IP configuration on SUs connected to
|
|
the AP.
|
|
|
|
su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )
|
su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' )
|
|
|
|
|
|
|
# su ipconfig <suid> <new ip> <new subnet> <new gateway>
|
# su ipconfig <suid> <new ip> <new subnet> <new gateway>
|
return $self->cmd(
|
return $self->cmd(
|
String => 'su ipconfig ' . $suid . ' ' . $new_ip . ' '
|
String => 'su ipconfig ' . $suid . $SPACE . $new_ip . $SPACE
|
. $new_subnet . ' '
|
. $new_subnet . $SPACE
|
. $new_gateway,
|
. $new_gateway,
|
expect => $success,
|
expect => $success,
|
);
|
);
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<sudb_view>
|
=head2 B<sudb_view> - Returns the output from the sudb view command
|
- Returns the output from the sudb view command
|
|
|
|
returns a reference to an array of hashes each containing these keys
|
returns a reference to an array of hashes each containing these keys
|
'suid', 'type', 'cir', 'mir' and 'mac'
|
'suid', 'type', 'cir', 'mir' and 'mac'
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<sudb_add>
|
=head2 B<sudb_add> - Adds an su to the sudb
|
|
|
Takes the following paramaters
|
Takes the following paramaters
|
|
|
suid : numeric,
|
suid : numeric,
|
type : (reg|pr)
|
type : (reg|pr)
|
cir : numeric,
|
cir : numeric,
|
mir : numeric,
|
mir : numeric,
|
mac : Almost any format, it will be reformatted,
|
mac : Almost any format, it will be reformatted,
|
|
|
and returns true on success or undef otherwise.
|
and returns true on success or undef otherwise.
|
|
|
|
|
$self->last_error("Invalid MAC '$mac'");
|
$self->last_error("Invalid MAC '$mac'");
|
return;
|
return;
|
}
|
}
|
$new_mac = join ' ', $new_mac =~ /../g;
|
$new_mac = join $SPACE, $new_mac =~ /../g;
|
|
|
my $string =
|
my $string =
|
'sudb add ' . $suid . ' ' . $type . ' ' . $cir . ' ' . $mir . ' '
|
'sudb add ' . $suid . $SPACE . $type . $SPACE . $cir . $SPACE . $mir . $SPACE
|
. $new_mac;
|
. $new_mac;
|
|
|
return $self->cmd( String => $string, expect => $success );
|
return $self->cmd( String => $string, expect => $success );
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<sudb_delete>
|
=head2 B<sudb_delete> - removes an su from the sudb
|
|
|
Takes either 'all' or the suid of the su to delete
|
Takes either 'all' or the suid of the su to delete
|
and returns true on success or undef otherwise.
|
and returns true on success or undef otherwise.
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<sudb_modify>
|
=head2 B<sudb_modify> - changes the su information in the sudb
|
|
|
Takes either the suid of the su to change
|
Takes either the suid of the su to change
|
as well as what you are changing, either "cir, mir or su2su"
|
as well as what you are changing, either "cir, mir or su2su"
|
|
|
return;
|
return;
|
}
|
}
|
|
|
my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value;
|
my $string = 'sudb modify ' . $suid . $SPACE . $opt . $SPACE . $value;
|
|
|
return $self->cmd( String => $string, expect => $success );
|
return $self->cmd( String => $string, expect => $success );
|
}
|
}
|
|
|
=pod
|
=pod
|
|
|
=head2 B<enable_tftpd>
|
=head2 B<enable_tftpd> - enable the TFTP server
|
- enable the TFTP server
|
|
|
|
runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
|
runs C<tftpd(args =E<gt> 'on')> and makes sure that Tftpd is now 'listen'ing
|
|
|
|
|
|
|
=pod
|
=pod
|
|
|
=head2 B<disable_tftpd>
|
=head2 B<disable_tftpd> - disable the TFTP server
|
- disable the TFTP server
|
|
|
|
runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
|
runs C<tftpd(args =E<gt> 'off')> and makes sure that Tftpd is now 'disabled'
|
|
|
|
|
- a string containing the command line options that are passed to the
|
- a string containing the command line options that are passed to the
|
command
|
command
|
|
|
$t->cmd( String => 'exit', no_prompt => 1, cmd_disconnects => 1 );
|
$t->cmd( String => 'exit', no_prompt => 1, cmd_disconnects => 1 );
|
|
|
=cut
|
=cut
|
|
|
|
|
}
|
}
|
}
|
}
|
if ( $cfg{'args'} ) {
|
if ( $cfg{'args'} ) {
|
$cmd{'String'} .= ' ' . $cfg{'args'};
|
$cmd{'String'} .= $SPACE . $cfg{'args'};
|
}
|
}
|
|
|
my @lines;
|
my @lines;
|
|
|
}
|
}
|
}
|
}
|
else {
|
else {
|
$self->last_error("Error with command ($cfg{'String'}): $last");
|
my $err;
|
|
if (grep { /\[ERR\]/ } @lines) {
|
|
$err = _decode_lines(@lines);
|
|
}
|
|
|
|
if (ref $err eq 'HASH' && $err ->{ERR}) {
|
|
$self->last_error($err->{ERR} );
|
|
} else {
|
|
$self->last_error("Error with command ($cfg{'String'}): $last");
|
|
}
|
return;
|
return;
|
}
|
}
|
}
|
}
|
|
|
|
|
my %conf;
|
my %conf;
|
|
|
my $key = '';
|
my $key = $EMPTY;
|
my $val = undef;
|
my $val = undef;
|
my @vals;
|
my @vals;
|
my $in_key = 0;
|
my $in_key = 0;
|
|
|
|
|
my @chars = split //, $line;
|
my @chars = split //, $line;
|
|
|
my $last_key = '';
|
my $last_key = $EMPTY;
|
foreach my $c (@chars) {
|
foreach my $c (@chars) {
|
|
|
if ( $c eq '[' || $c eq "\r" || $c eq "\n" ) {
|
if ( $c eq '[' || $c eq "\r" || $c eq "\n" ) {
|
|
|
# Special case for these bastids.
|
# Special case for these bastids.
|
my $new = $last_key;
|
my $new = $last_key;
|
$new =~ s/\s+\S+$//;
|
$new =~ s/\s+\S+$//;
|
$key = $new . " " . $key;
|
$key = $new . $SPACE . $key;
|
}
|
}
|
|
|
$conf{$key} = $val;
|
$conf{$key} = $val;
|
$last_key = $key;
|
$last_key = $key;
|
$key = '';
|
$key = $EMPTY;
|
}
|
}
|
elsif ($val) {
|
elsif ($val) {
|
push @vals, $val;
|
push @vals, $val;
|
}
|
}
|
$val = '';
|
$val = $EMPTY;
|
|
|
}
|
}
|
elsif ( $c eq ']' ) {
|
elsif ( $c eq ']' ) {
|
|
|
foreach my $line (@lines) {
|
foreach my $line (@lines) {
|
$line =~ s/\r?\n$//;
|
$line =~ s/\r?\n$//;
|
my ( $mac, $loc, $tm ) = $line =~ /
|
my ( $mac, $loc, $tm ) = $line =~ /
|
([0-9a-fA-F ]{17})\s+
|
([0-9a-fA-F ]{17})\s+
|
(.*)\s+
|
(.*)\s+
|
tm\s+
|
tm\s+
|
(\d+)
|
(\d+)
|
/x;
|
/x;
|
|
|
if ($mac) {
|
if ($mac) {
|
$mac =~ s/\s+//g;
|
$mac =~ s/\s+//g;
|