| version 1.5, 2006/01/03 00:22:19 |
version 1.9, 2006/07/14 02:17:29 |
|
|
| package Net::Telnet::Trango;
|
package Net::Telnet::Trango;
|
| # $RedRiver: Trango.pm,v 1.4 2005/12/30 20:26:41 andrew Exp $
|
# $RedRiver: Trango.pm,v 1.8 2006/06/29 00:39:52 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 );
|
|
|
|
| my ($type, $version) = $t->open( Host => $fox );
|
$t->open( Host => $fox ) or die "Error connecting: $!";
|
|
|
|
| unless (defined $type && defined $version) {
|
|
| die "Error connecting: $!";
|
|
| }
|
|
|
|
|
| $t->login('password') or die "Couldn't log in: $!";
|
$t->login('password') or die "Couldn't log in: $!";
|
|
|
|
|
|
|
|
|
| Same as new from L<Net::Telnet> but has defaults for the trango 'Prompt'
|
Same as new from L<Net::Telnet> 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
|
=cut
|
|
|
|
| sub new
|
sub new
|
|
|
| foreach my $key (keys %args) {
|
foreach my $key (keys %args) {
|
| $PRIVATE{$key} = $args{$key};
|
$PRIVATE{$key} = $args{$key};
|
| }
|
}
|
| |
$PRIVATE{'Decode'} = 1 unless defined $PRIVATE{'Decode'};
|
| |
delete $args{'Decode'};
|
|
|
|
| my $self = $class->SUPER::new(%args);
|
my $self = $class->SUPER::new(%args);
|
| bless $self if ref $self;
|
bless $self if ref $self;
|
|
|
|
|
|
| returns an array ref of hashes containing each log line.
|
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
|
=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 },
|
| |
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???
|
#su password???
|
| #_bootloader
|
#_bootloader
|
| #temp
|
#temp
|
|
|
| );
|
);
|
| }
|
}
|
|
|
|
|
|
|
| =pod
|
=pod
|
|
|
|
| =item sudb_view
|
=item sudb_view
|
|
|
|
|
|
| return undef unless @lines;
|
return undef unless @lines;
|
|
|
|
| |
unless ($PRIVATE{'Decode'}) {
|
| |
return @lines;
|
| |
}
|
| |
|
| my @sus;
|
my @sus;
|
| foreach (@lines) {
|
foreach (@lines) {
|
| if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9a-fA-F]+)/) {
|
next unless $_;
|
| |
if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) {
|
| my %s = (
|
my %s = (
|
| suid => $1,
|
suid => $1,
|
| type => $2,
|
type => $2,
|
|
|
| mir => $4,
|
mir => $4,
|
| mac => $5,
|
mac => $5,
|
| );
|
);
|
| |
|
| |
$s{'mac'} =~ s/\s//g;
|
| |
$s{'mac'} = uc($s{'mac'});
|
| |
|
| push @sus, \%s;
|
push @sus, \%s;
|
| }
|
}
|
| }
|
}
|
|
|
|
|
|
| =pod
|
=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
|
=item enable_tftpd
|
|
|
|
| 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
|
|
|
| );
|
);
|
|
|
|
| my %cfg;
|
my %cfg;
|
| if (@_ == 2) {
|
if (@_ == 1) {
|
| $cfg{'String'} = shift;
|
$cfg{'String'} = shift;
|
| } elsif (@_ > 2) {
|
} elsif (@_ > 1) {
|
| %cfg = @_;
|
%cfg = @_;
|
| }
|
}
|
|
|
|
|
|
| $self->last_lines(\@lines);
|
$self->last_lines(\@lines);
|
|
|
|
| my $vals = 1;
|
my $vals = 1;
|
| if ($cfg{'decode'}) {
|
if ($PRIVATE{'Decode'} && $cfg{'decode'}) {
|
| if ($cfg{'decode'} eq 'each') {
|
if ($cfg{'decode'} eq 'each') {
|
| $vals = _decode_each_line(@lines);
|
$vals = _decode_each_line(@lines);
|
| } elsif ($cfg{'decode'} eq 'sulog') {
|
} elsif ($cfg{'decode'} eq 'sulog') {
|
|
|
| $self->is_connected(0);
|
$self->is_connected(0);
|
| }
|
}
|
|
|
|
| if ($cfg{'decode'}) {
|
if ($PRIVATE{'Decode'} && $cfg{'decode'}) {
|
| return $vals;
|
return $vals;
|
| } else {
|
} else {
|
| return @lines;
|
return @lines;
|
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to Trango.pm CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / trango / Net-Telnet-Trango / lib / Net / Telnet