=================================================================== RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v retrieving revision 1.13 retrieving revision 1.14 diff -u -r1.13 -r1.14 --- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2006/09/07 03:39:36 1.13 +++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2006/09/07 03:49:34 1.14 @@ -1,1042 +1,1042 @@ -package Net::Telnet::Trango; -# $RedRiver: Trango.pm,v 1.12 2006/08/31 21:29:53 andrew Exp $ -use strict; -use warnings; -use base 'Net::Telnet'; - -=pod - -=head1 NAME - -Net::Telnet::Trango - Perl extension for accessing the Trango telnet interface - -=head1 SYNOPSIS - - use Net::Telnet::Trango; - my $t = new Net::Telnet::Trango ( Timeout => 5 ); - - $t->open( Host => $fox ) or die "Error connecting: $!"; - - $t->login('password') or die "Couldn't log in: $!"; - - # Do whatever - - $t->exit; - $t->close; - -=head1 DESCRIPTION - -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. - -=head2 EXPORT - -None - -=cut - -our $VERSION = '0.01'; - -my %PRIVATE = ( - is_connected => 0, - logged_in => 0, -); - -=pod - -=item new - -Same as new from L 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 - -sub new -{ - my $class = shift; - - my %args; - if (@_ == 1) { - $args{'Host'} = shift; - } else { - %args = @_; - } - - $args{'Prompt'} ||= '/#> *$/'; - - foreach my $key (keys %args) { - $PRIVATE{$key} = $args{$key}; - } - $PRIVATE{'Decode'} = 1 unless defined $PRIVATE{'Decode'}; - delete $args{'Decode'}; - - my $self = $class->SUPER::new(%args); - bless $self if ref $self; - - return $self; -} - -# _password -# ? [command] -# apsearch [ ]... -# arp -bcast -# bcastscant [ ... -# bye -# cf2cf ap [default|] -# date -# date -# freq scantable -# freq channeltable -# freq writescan [ ] -# freq writechannel [ ] ... -# freq -# help [command] -# heater [ ] -# ipconfig [ ] -# log [<# of entries, 1..179>] -# log <# of entries, 1..179> -# logout -# opmode [ap [y]] -# password -# ping -# polar -# power > -# reboot -# restart -# remarks [] -# rfrxthreshold [ <-90|-85|-80|-75|-70|-65>] -# rfrxth [ <-90|-85|-80|-75|-70|-65>] -# sysinfo -# set suid -# set apid -# set baseid -# set defaultopmode [ ] -# set defaultopmode off -# set snmpcomm [ ] -# set mir [on|off] -# set mir threshold -# set rssitarget [ ] -# set serviceradius [ ] -# ssrssi -# su [|all] -# su changechannel -# su ipconfig -# su [live|poweroff|priority] -# su -# su powerleveling -# su reboot -# su restart -# su testrflink [r] -# su testrflink [64..1600] -# su testrflink [20..100] -# su sw -# sudb [dload | view] -# sudb add pr -# sudb add reg -# sudb delete > -# sudb modify -# sudb modify -# sudb view -# sulog [lastmins | sampleperiod <1..60>] -# sulog [<# of entry,1..18>] -# survey -# sw [ ] -# temp -# tftpd [on|off] -# time -# time -# save -# save -# updateflash -# updateflash - -=pod - -=head1 METHODS - -=head2 ACCESSORS - -=over - -=item Host - -returns the name of the host that you are accessing - -=item firmware_version - -returns the firmware version on the trango if available otherwise undef. -Available after a successful open() -This is usually only set internally - -=item host_type - -returns the type of host from the login banner for example M5830S or M5300S. -Available after a successful open() -This is usually only set internally - -=item is_connected - -returns 1 after a successful open() otherwise undef -This is usually only set internally - -=item logged_in - -returns 1 after a successful login() 0 if it failed and undef if -login() was never called -This is usually only set internally - -=item login_banner - -returns the banner that is displayed when first connected at login. Only set after a successful open() - -This is usually only set internally - -=item last_lines - -returns the output from the last cmd() that was run as an array ref -This is usually only set internally - -=back - -=head2 ALIASES - -=over - -=item bye - -alias of exit() - -=item restart - -alias of reboot() - -=back - -=head2 COMMANDS - -Most of these are just shortcuts to C METHOD)>, as such they accept the same options as C. Specifically they take a named paramater "args", for example: -C 'on')> would enable tftpd - -=over - -=item tftpd - -Returns a hash ref of the decoded output from the command. - -Also see enable_tftpd() and disable_tftpd() as those check for correct output - -=item ver - -Returns a hash ref of the decoded output from the command. - -=item sysinfo - -Returns a hash ref of the decoded output from the command. - -=item exit - -exits the command session with the trango and closes the connection - -=item reboot - -reboots the trango and closes the connection - -=item sulog - -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 maclist_reset - -resets the maclist. No useful output. - -=item eth_list - -returns the output from the eth list command - -=cut - - -my $success = 'Success.'; -my %COMMANDS = ( - tftpd => { decode => 'all', expect => $success }, - ver => { decode => 'all' }, - sysinfo => { decode => 'all', expect => $success }, - updateflash => { decode => 'all', expect => $success }, - sulog => { decode => 'sulog', expect => $success }, - 'exit' => { 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 => { decode => 'maclist' }, - maclist_reset => { String => 'maclist reset', expect => 'done' }, - eth_link => { String => 'eth link', expect => $success }, - # eth r, w and reset??? - #su password??? - #_bootloader - #temp - #heater -); - -my %ALIASES = ( - bye => 'exit', - restart => 'reboot', -); - -my %ACCESS = map { $_ => 1 } qw( - firmware_version - host_type - Host - is_connected - logged_in - login_banner - Timeout - last_lines - last_vals -); - -sub AUTOLOAD -{ - my $self = shift; - - my ($method) = (our $AUTOLOAD) =~ /^.*::(\w+)$/ - or die "Weird: $AUTOLOAD"; - - if (exists $ALIASES{$method}) { - $method = $ALIASES{$method}; - return $self->$method(@_); - } - - if (exists $COMMANDS{$method}) { - $method = shift if (@_ == 1); - $COMMANDS{$method}{'String'} ||= $method; - return $self->cmd(%{ $COMMANDS{$method} }, @_); - } - - if (exists $ACCESS{$method}) { - my $prev = $PRIVATE{$method}; - ($PRIVATE{$method}) = @_ if @_; - return $prev; - } - - $method = "SUPER::$method"; - return $self->$method(@_); -} - -=pod - -=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() - -=cut - -sub open -{ - my $self = shift; - - unless ( $self->SUPER::open(@_) ) { - #$! = "Couldn't connect to " . $self->Host . ": $!"; - return undef; - } - - ## Get to login prompt - unless ($self->waitfor( - -match => '/password: ?$/i', - -errmode => "return", - ) ) { - #$! = "problem connecting to host (" . $self->Host . "): " . - # $self->lastline; - return undef; - } - - $self->parse_login_banner($self->lastline); - - $self->is_connected(1); - - return $self->is_connected; -} - -=pod - -=item login - -Calls open() if not already connected, then sends the password and sets logged_in() if successful - -=cut - -sub login -{ - my $self = shift; - - unless ($self->is_connected) { - $self->open or return undef; - } - - my $password = shift; - - $self->print($password); - unless ($self->waitfor( - -match => $self->prompt, - -errmode => "return", - ) ) { - #$! = "login ($self->Host) failed: " . $self->lastline; - return undef; - } - - $self->logged_in(1); - - return $self->logged_in; -} - -=pod - -=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() - -=cut - -sub parse_login_banner -{ - my $self = shift; - - if (@_) { - $self->login_banner(@_); - } - - my $banner = $self->login_banner; - - my ($type, $ver) = $banner =~ - /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i; - - $self->login_banner($banner); - $self->host_type($type); - $self->firmware_version($ver); - - return 1; -} - -=pod - -=item su_password - -C - -=cut - -sub su_password -{ - my $self = shift; - my $su = shift || '!'; - my $new_pass = shift || ''; - - unless (defined $su) { - warn "No su passed!" - #return undef; - } - - unless (defined $new_pass) { - warn "No new password!" - #return undef; - } - - return $self->cmd(String => 'su password ' . - $su . ' ' . - $new_pass . ' ' . - $new_pass, - expect => $success, - ); -} - -=pod - -=item su_ipconfig - -C - -=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 - return $self->cmd(String => 'su ipconfig ' . - $suid . ' ' . - $new_ip . ' ' . - $new_subnet . ' ' . - $new_gateway, - expect => $success, - ); -} - -=pod - -=item sudb_view - -returns a reference to an array of hashes each containing: - - suid - type - cir - mir - mac - -=cut - -sub sudb_view -{ - my $self = shift; - - my @lines = $self->cmd( String => 'sudb view', expect => $success ); - - return undef unless @lines; - - unless ($PRIVATE{'Decode'}) { - return @lines; - } - - my @sus; - foreach (@lines) { - next unless $_; - if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) { - my %s = ( - suid => $1, - type => $2, - cir => $3, - mir => $4, - mac => $5, - ); - - $s{'mac'} =~ s/\s//g; - $s{'mac'} = uc($s{'mac'}); - - push @sus, \%s; - } - } - - return \@sus; -} - -=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 - -runs C 'on')> and makes sure that Tftpd is now 'listen'ing - -=cut - -sub enable_tftpd -{ - my $self = shift; - - my $vals = $self->tftpd( args => 'on' ); - - if ($vals->{'Tftpd'} eq 'listen') { - return $vals; - } else { - return undef; - } -} - -=pod - -=item disable_tftpd - -runs C 'off')> and makes sure that Tftpd is now 'disabled' - -=cut - -sub disable_tftpd -{ - my $self = shift; - - my $vals = $self->tftpd( args => 'off' ); - - if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') { - return $vals; - } else { - return undef; - } -} - -=pod - -=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. - -Normally returns the last lines from from the command - -Also accepts these options: - -I -- if this is true, then it will send the output lines to _decode_lines() and then returns the decoded output - -I -- 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 -- 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 -- a string containing the command line options that are passed to the command - -=cut - -sub cmd -{ - my $self = shift; - - my @valid_net_telnet_opts = qw( - String - Output - Cmd_remove_mode - Errmode - Input_record_separator - Ors - Output_record_separator - Prompt - Rs - Timeout - ); - - my %cfg; - if (@_ == 1) { - $cfg{'String'} = shift; - } elsif (@_ > 1) { - %cfg = @_; - } - - $cfg{'Timeout'} ||= $self->Timeout; - - unless ($cfg{'String'}) { - #$! = "No command passed"; - #warn "No command passed\n"; - return undef; - } - - unless ($self->is_connected) { - #$! = "Not connected"; - #warn "Not connected\n"; - return undef; - } - - unless ($self->logged_in) { - #$! = "Not logged in"; - #warn "Not logged in\n"; - return undef; - } - - - my %cmd; - foreach (@valid_net_telnet_opts) { - if (exists $cfg{$_}) { - $cmd{$_} = $cfg{$_}; - } - } - if ($cfg{'args'}) { - $cmd{'String'} .= ' ' . $cfg{'args'}; - } - my @lines; - unless ($cfg{'no_prompt'}) { - @lines = $self->SUPER::cmd(%cmd); - } else { - $self->print($cmd{'String'}); - @lines = $self->lastline; - } - - $self->last_lines(\@lines); - - my $vals = 1; - if ($PRIVATE{'Decode'} && $cfg{'decode'}) { - if ($cfg{'decode'} eq 'each') { - $vals = _decode_each_line(@lines); - } elsif ($cfg{'decode'} eq 'sulog') { - $vals = _decode_sulog(@lines); - } elsif ($cfg{'decode'} eq 'maclist') { - $vals = _decode_maclist(@lines); - } else { - $vals = _decode_lines(@lines); - } - } - - $self->last_vals($vals); - - - my $last = $self->lastline; - - if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) { - if ($cfg{'cmd_disconnects'}) { - $self->logged_in(0); - $self->close; - $self->is_connected(0); - } - - if ($PRIVATE{'Decode'} && $cfg{'decode'}) { - return $vals; - } else { - return @lines; - } - } else { - #$! = "Error with command ($cfg{'string'}): $last"; - return undef; - } -} - -#=item _decode_lines - -sub _decode_lines -{ - my @lines = @_; - - my %conf; - - my $key = ''; - my $val = ''; - my $in_key = 0; - my $in_val = 0; - - foreach my $line (@lines) { - next if $line =~ /$success$/; - - my @chars = split //, $line; - - my $last_key = ''; - foreach my $c (@chars) { - - if ($c eq '[' || $c eq "\r" || $c eq "\n") { - if ($c eq '[') { - $in_key = 1; - $in_val = 0; - } else { - $in_key = 0; - $in_val = 0; - } - - if ($key) { - $key =~ s/^\s+//; - $key =~ s/\s+$//; - - $val =~ s/^\s+//; - $val =~ s/\s+$//; - - if ($key eq 'Checksum' && $last_key) { - # Special case for these bastids. - my $new = $last_key; - $new =~ s/\s+\S+$//; - $key = $new . " " . $key; - } - - $last_key = $key; - $conf{$key} = $val; - $key = ''; - $val = ''; - } - - } elsif ($c eq ']') { - $in_val = 1; - $in_key = 0; - $c = shift @chars; - - } elsif ($in_key) { - $key .= $c; - - } elsif ($in_val) { - $val .= $c; - } - } - } - - if (%conf) { - return \%conf; - } else { - return undef; - } -} - -#=item _decode_each_line - -sub _decode_each_line -{ - my @lines = @_; - my @decoded; - foreach my $line (@lines) { - my $decoded = _decode_lines($line); - push @decoded, $decoded if defined $decoded; - } - return \@decoded; -} - -#=item _decode_sulog - -sub _decode_sulog -{ - my @lines = @_; - my @decoded; - my $last_tm; - foreach my $line (@lines) { - my $decoded = _decode_lines($line); - - if (defined $decoded) { - if ($decoded->{'tm'}) { - $last_tm = $decoded->{'tm'}; - next; - } else { - $decoded->{'tm'} = $last_tm; - } - next unless $last_tm; - - push @decoded, $decoded if defined $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; -__END__ - -=back - -=head1 SEE ALSO - -Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm - -L - -=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. - -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 - -Andrew Fresh Eandrew@rraz.netE - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2005 by Andrew Fresh - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself, either Perl version 5.8.7 or, -at your option, any later version of Perl 5 you may have available. - - -=cut +package Net::Telnet::Trango; +# $RedRiver: Trango.pm,v 1.13 2006/09/07 02:39:36 andrew Exp $ +use strict; +use warnings; +use base 'Net::Telnet'; + +=pod + +=head1 NAME + +Net::Telnet::Trango - Perl extension for accessing the Trango telnet interface + +=head1 SYNOPSIS + + use Net::Telnet::Trango; + my $t = new Net::Telnet::Trango ( Timeout => 5 ); + + $t->open( Host => $fox ) or die "Error connecting: $!"; + + $t->login('password') or die "Couldn't log in: $!"; + + # Do whatever + + $t->exit; + $t->close; + +=head1 DESCRIPTION + +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. + +=head2 EXPORT + +None + +=cut + +our $VERSION = '0.01'; + +my %PRIVATE = ( + is_connected => 0, + logged_in => 0, +); + +=pod + +=item new + +Same as new from L 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 + +sub new +{ + my $class = shift; + + my %args; + if (@_ == 1) { + $args{'Host'} = shift; + } else { + %args = @_; + } + + $args{'Prompt'} ||= '/#> *$/'; + + foreach my $key (keys %args) { + $PRIVATE{$key} = $args{$key}; + } + $PRIVATE{'Decode'} = 1 unless defined $PRIVATE{'Decode'}; + delete $args{'Decode'}; + + my $self = $class->SUPER::new(%args); + bless $self if ref $self; + + return $self; +} + +# _password +# ? [command] +# apsearch [ ]... +# arp -bcast +# bcastscant [ ... +# bye +# cf2cf ap [default|] +# date +# date +# freq scantable +# freq channeltable +# freq writescan [ ] +# freq writechannel [ ] ... +# freq +# help [command] +# heater [ ] +# ipconfig [ ] +# log [<# of entries, 1..179>] +# log <# of entries, 1..179> +# logout +# opmode [ap [y]] +# password +# ping +# polar +# power > +# reboot +# restart +# remarks [] +# rfrxthreshold [ <-90|-85|-80|-75|-70|-65>] +# rfrxth [ <-90|-85|-80|-75|-70|-65>] +# sysinfo +# set suid +# set apid +# set baseid +# set defaultopmode [ ] +# set defaultopmode off +# set snmpcomm [ ] +# set mir [on|off] +# set mir threshold +# set rssitarget [ ] +# set serviceradius [ ] +# ssrssi +# su [|all] +# su changechannel +# su ipconfig +# su [live|poweroff|priority] +# su +# su powerleveling +# su reboot +# su restart +# su testrflink [r] +# su testrflink [64..1600] +# su testrflink [20..100] +# su sw +# sudb [dload | view] +# sudb add pr +# sudb add reg +# sudb delete > +# sudb modify +# sudb modify +# sudb view +# sulog [lastmins | sampleperiod <1..60>] +# sulog [<# of entry,1..18>] +# survey +# sw [ ] +# temp +# tftpd [on|off] +# time +# time +# save +# save +# updateflash +# updateflash + +=pod + +=head1 METHODS + +=head2 ACCESSORS + +=over + +=item Host + +returns the name of the host that you are accessing + +=item firmware_version + +returns the firmware version on the trango if available otherwise undef. +Available after a successful open() +This is usually only set internally + +=item host_type + +returns the type of host from the login banner for example M5830S or M5300S. +Available after a successful open() +This is usually only set internally + +=item is_connected + +returns 1 after a successful open() otherwise undef +This is usually only set internally + +=item logged_in + +returns 1 after a successful login() 0 if it failed and undef if +login() was never called +This is usually only set internally + +=item login_banner + +returns the banner that is displayed when first connected at login. Only set after a successful open() + +This is usually only set internally + +=item last_lines + +returns the output from the last cmd() that was run as an array ref +This is usually only set internally + +=back + +=head2 ALIASES + +=over + +=item bye + +alias of exit() + +=item restart + +alias of reboot() + +=back + +=head2 COMMANDS + +Most of these are just shortcuts to C METHOD)>, as such they accept the same options as C. Specifically they take a named paramater "args", for example: +C 'on')> would enable tftpd + +=over + +=item tftpd + +Returns a hash ref of the decoded output from the command. + +Also see enable_tftpd() and disable_tftpd() as those check for correct output + +=item ver + +Returns a hash ref of the decoded output from the command. + +=item sysinfo + +Returns a hash ref of the decoded output from the command. + +=item exit + +exits the command session with the trango and closes the connection + +=item reboot + +reboots the trango and closes the connection + +=item sulog + +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 maclist_reset + +resets the maclist. No useful output. + +=item eth_list + +returns the output from the eth list command + +=cut + + +my $success = 'Success.'; +my %COMMANDS = ( + tftpd => { decode => 'all', expect => $success }, + ver => { decode => 'all' }, + sysinfo => { decode => 'all', expect => $success }, + updateflash => { decode => 'all', expect => $success }, + sulog => { decode => 'sulog', expect => $success }, + 'exit' => { 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 => { decode => 'maclist' }, + maclist_reset => { String => 'maclist reset', expect => 'done' }, + eth_link => { String => 'eth link', expect => $success }, + # eth r, w and reset??? + #su password??? + #_bootloader + #temp + #heater +); + +my %ALIASES = ( + bye => 'exit', + restart => 'reboot', +); + +my %ACCESS = map { $_ => 1 } qw( + firmware_version + host_type + Host + is_connected + logged_in + login_banner + Timeout + last_lines + last_vals +); + +sub AUTOLOAD +{ + my $self = shift; + + my ($method) = (our $AUTOLOAD) =~ /^.*::(\w+)$/ + or die "Weird: $AUTOLOAD"; + + if (exists $ALIASES{$method}) { + $method = $ALIASES{$method}; + return $self->$method(@_); + } + + if (exists $COMMANDS{$method}) { + $method = shift if (@_ == 1); + $COMMANDS{$method}{'String'} ||= $method; + return $self->cmd(%{ $COMMANDS{$method} }, @_); + } + + if (exists $ACCESS{$method}) { + my $prev = $PRIVATE{$method}; + ($PRIVATE{$method}) = @_ if @_; + return $prev; + } + + $method = "SUPER::$method"; + return $self->$method(@_); +} + +=pod + +=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() + +=cut + +sub open +{ + my $self = shift; + + unless ( $self->SUPER::open(@_) ) { + #$! = "Couldn't connect to " . $self->Host . ": $!"; + return undef; + } + + ## Get to login prompt + unless ($self->waitfor( + -match => '/password: ?$/i', + -errmode => "return", + ) ) { + #$! = "problem connecting to host (" . $self->Host . "): " . + # $self->lastline; + return undef; + } + + $self->parse_login_banner($self->lastline); + + $self->is_connected(1); + + return $self->is_connected; +} + +=pod + +=item login + +Calls open() if not already connected, then sends the password and sets logged_in() if successful + +=cut + +sub login +{ + my $self = shift; + + unless ($self->is_connected) { + $self->open or return undef; + } + + my $password = shift; + + $self->print($password); + unless ($self->waitfor( + -match => $self->prompt, + -errmode => "return", + ) ) { + #$! = "login ($self->Host) failed: " . $self->lastline; + return undef; + } + + $self->logged_in(1); + + return $self->logged_in; +} + +=pod + +=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() + +=cut + +sub parse_login_banner +{ + my $self = shift; + + if (@_) { + $self->login_banner(@_); + } + + my $banner = $self->login_banner; + + my ($type, $ver) = $banner =~ + /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i; + + $self->login_banner($banner); + $self->host_type($type); + $self->firmware_version($ver); + + return 1; +} + +=pod + +=item su_password + +C + +=cut + +sub su_password +{ + my $self = shift; + my $su = shift || '!'; + my $new_pass = shift || ''; + + unless (defined $su) { + warn "No su passed!" + #return undef; + } + + unless (defined $new_pass) { + warn "No new password!" + #return undef; + } + + return $self->cmd(String => 'su password ' . + $su . ' ' . + $new_pass . ' ' . + $new_pass, + expect => $success, + ); +} + +=pod + +=item su_ipconfig + +C + +=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 + return $self->cmd(String => 'su ipconfig ' . + $suid . ' ' . + $new_ip . ' ' . + $new_subnet . ' ' . + $new_gateway, + expect => $success, + ); +} + +=pod + +=item sudb_view + +returns a reference to an array of hashes each containing: + + suid + type + cir + mir + mac + +=cut + +sub sudb_view +{ + my $self = shift; + + my @lines = $self->cmd( String => 'sudb view', expect => $success ); + + return undef unless @lines; + + unless ($PRIVATE{'Decode'}) { + return @lines; + } + + my @sus; + foreach (@lines) { + next unless $_; + if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) { + my %s = ( + suid => $1, + type => $2, + cir => $3, + mir => $4, + mac => $5, + ); + + $s{'mac'} =~ s/\s//g; + $s{'mac'} = uc($s{'mac'}); + + push @sus, \%s; + } + } + + return \@sus; +} + +=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 + +runs C 'on')> and makes sure that Tftpd is now 'listen'ing + +=cut + +sub enable_tftpd +{ + my $self = shift; + + my $vals = $self->tftpd( args => 'on' ); + + if ($vals->{'Tftpd'} eq 'listen') { + return $vals; + } else { + return undef; + } +} + +=pod + +=item disable_tftpd + +runs C 'off')> and makes sure that Tftpd is now 'disabled' + +=cut + +sub disable_tftpd +{ + my $self = shift; + + my $vals = $self->tftpd( args => 'off' ); + + if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') { + return $vals; + } else { + return undef; + } +} + +=pod + +=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. + +Normally returns the last lines from from the command + +Also accepts these options: + +I +- if this is true, then it will send the output lines to _decode_lines() and then returns the decoded output + +I +- 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 +- 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 +- a string containing the command line options that are passed to the command + +=cut + +sub cmd +{ + my $self = shift; + + my @valid_net_telnet_opts = qw( + String + Output + Cmd_remove_mode + Errmode + Input_record_separator + Ors + Output_record_separator + Prompt + Rs + Timeout + ); + + my %cfg; + if (@_ == 1) { + $cfg{'String'} = shift; + } elsif (@_ > 1) { + %cfg = @_; + } + + $cfg{'Timeout'} ||= $self->Timeout; + + unless ($cfg{'String'}) { + #$! = "No command passed"; + #warn "No command passed\n"; + return undef; + } + + unless ($self->is_connected) { + #$! = "Not connected"; + #warn "Not connected\n"; + return undef; + } + + unless ($self->logged_in) { + #$! = "Not logged in"; + #warn "Not logged in\n"; + return undef; + } + + + my %cmd; + foreach (@valid_net_telnet_opts) { + if (exists $cfg{$_}) { + $cmd{$_} = $cfg{$_}; + } + } + if ($cfg{'args'}) { + $cmd{'String'} .= ' ' . $cfg{'args'}; + } + my @lines; + unless ($cfg{'no_prompt'}) { + @lines = $self->SUPER::cmd(%cmd); + } else { + $self->print($cmd{'String'}); + @lines = $self->lastline; + } + + $self->last_lines(\@lines); + + my $vals = 1; + if ($PRIVATE{'Decode'} && $cfg{'decode'}) { + if ($cfg{'decode'} eq 'each') { + $vals = _decode_each_line(@lines); + } elsif ($cfg{'decode'} eq 'sulog') { + $vals = _decode_sulog(@lines); + } elsif ($cfg{'decode'} eq 'maclist') { + $vals = _decode_maclist(@lines); + } else { + $vals = _decode_lines(@lines); + } + } + + $self->last_vals($vals); + + + my $last = $self->lastline; + + if ((not $cfg{'expect'}) || $last =~ /$cfg{'expect'}$/) { + if ($cfg{'cmd_disconnects'}) { + $self->logged_in(0); + $self->close; + $self->is_connected(0); + } + + if ($PRIVATE{'Decode'} && $cfg{'decode'}) { + return $vals; + } else { + return @lines; + } + } else { + #$! = "Error with command ($cfg{'string'}): $last"; + return undef; + } +} + +#=item _decode_lines + +sub _decode_lines +{ + my @lines = @_; + + my %conf; + + my $key = ''; + my $val = ''; + my $in_key = 0; + my $in_val = 0; + + foreach my $line (@lines) { + next if $line =~ /$success$/; + + my @chars = split //, $line; + + my $last_key = ''; + foreach my $c (@chars) { + + if ($c eq '[' || $c eq "\r" || $c eq "\n") { + if ($c eq '[') { + $in_key = 1; + $in_val = 0; + } else { + $in_key = 0; + $in_val = 0; + } + + if ($key) { + $key =~ s/^\s+//; + $key =~ s/\s+$//; + + $val =~ s/^\s+//; + $val =~ s/\s+$//; + + if ($key eq 'Checksum' && $last_key) { + # Special case for these bastids. + my $new = $last_key; + $new =~ s/\s+\S+$//; + $key = $new . " " . $key; + } + + $last_key = $key; + $conf{$key} = $val; + $key = ''; + $val = ''; + } + + } elsif ($c eq ']') { + $in_val = 1; + $in_key = 0; + $c = shift @chars; + + } elsif ($in_key) { + $key .= $c; + + } elsif ($in_val) { + $val .= $c; + } + } + } + + if (%conf) { + return \%conf; + } else { + return undef; + } +} + +#=item _decode_each_line + +sub _decode_each_line +{ + my @lines = @_; + my @decoded; + foreach my $line (@lines) { + my $decoded = _decode_lines($line); + push @decoded, $decoded if defined $decoded; + } + return \@decoded; +} + +#=item _decode_sulog + +sub _decode_sulog +{ + my @lines = @_; + my @decoded; + my $last_tm; + foreach my $line (@lines) { + my $decoded = _decode_lines($line); + + if (defined $decoded) { + if ($decoded->{'tm'}) { + $last_tm = $decoded->{'tm'}; + next; + } else { + $decoded->{'tm'} = $last_tm; + } + next unless $last_tm; + + push @decoded, $decoded if defined $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; +__END__ + +=back + +=head1 SEE ALSO + +Trango Documentation - http://www.trangobroadband.com/support/product_docs.htm + +L + +=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. + +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 + +Andrew Fresh Eandrew@rraz.netE + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2005 by Andrew Fresh + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself, either Perl version 5.8.7 or, +at your option, any later version of Perl 5 you may have available. + + +=cut