=================================================================== RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v retrieving revision 1.16 retrieving revision 1.31 diff -u -r1.16 -r1.31 --- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2006/09/07 04:00:07 1.16 +++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2007/02/02 18:54:22 1.31 @@ -1,5 +1,5 @@ package Net::Telnet::Trango; -# $RedRiver: Trango.pm,v 1.14 2006/09/07 02:49:34 andrew Exp $ +# $RedRiver: Trango.pm,v 1.30 2007/02/02 17:51:52 andrew Exp $ use strict; use warnings; use base 'Net::Telnet'; @@ -8,19 +8,20 @@ =head1 NAME -Net::Telnet::Trango - Perl extension for accessing the Trango telnet interface +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; @@ -28,12 +29,19 @@ 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 None +=head1 METHODS + +=over + =cut our $VERSION = '0.01'; @@ -45,14 +53,20 @@ =pod -=item new +=item B -Same as new from L but has defaults for the trango 'Prompt' +- Creates a new Net::Telnet::Trango object. + new([Options from Net::Telnet,] + [Decode => 0,]); + +Same as new from L but sets the default 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. +instead return a reference to an array of the lines that were returned +from the command. =cut @@ -157,127 +171,180 @@ =pod -=head1 METHODS +=back =head2 ACCESSORS +These are usually only set internally. + =over -=item Host +=item B -returns the name of the host that you are accessing +- returns the firmware version -=item firmware_version +Returns the firmware version if available, otherwise undef. -returns the firmware version on the trango if available otherwise undef. -Available after a successful open() -This is usually only set internally +It should be available after a successful open(). -=item host_type +=item B +- return the type of host you are connected to. + 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 +Should be available after a successful open(). -returns 1 after a successful open() otherwise undef -This is usually only set internally +=item B -=item logged_in +- Status of the connection to host. -returns 1 after a successful login() 0 if it failed and undef if -login() was never called -This is usually only set internally +returns 1 when connected, undef otherwise. -=item login_banner +=item B -returns the banner that is displayed when first connected at login. Only set after a successful open() +- Status of being logged in to the host. -This is usually only set internally +returns 1 after a successful login(), 0 if it failed and undef if +login() was never called. -=item last_lines +=item B -returns the output from the last cmd() that was run as an array ref -This is usually only set internally +- The banner when first connecting to the host. +returns the banner that is displayed when first connected at login. +Only set after a successful open(). + +=item B + +- The last lines of output from the last cmd(). + +returns, as an array ref, the output from the last cmd() that was run. + +=item B + +- A text output of the last error that was encountered. + +returns the last error reported. Probably contains the last entry in +last_lines. + =back =head2 ALIASES =over -=item bye +=item B -alias of exit() +- alias of L. -=item restart +=item B -alias of reboot() +- alias of L. =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: +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 +=item B -Returns a hash ref of the decoded output from the command. +- Returns a hash ref of the decoded output from the +command. -Also see enable_tftpd() and disable_tftpd() as those check for correct output +Also see enable_tftpd() and disable_tftpd() as those check that it was +successfully changed. -=item ver +=item B -Returns a hash ref of the decoded output from the command. +- Returns a hash ref of the decoded output from the +command. -=item sysinfo +=item B -Returns a hash ref of the decoded output from the command. +- Returns a hash ref of the decoded output from the +command. -=item exit +=item B -exits the command session with the trango and closes the connection +- exits the command session with the Trango and closes +the connection -=item reboot +=item B -reboots the trango and closes the connection +- reboots the Trango and closes the connection -=item sulog +=item B -returns an array ref of hashes containing each log line. +- Set or retrieve the remarks. -=item save_sudb +Takes an optional argument, which sets the remarks. +If there is no argument, returns the current remarks. -returns true on success, undef on failure + my $old_remarks = $t->remarks(); + $t->remarks($new_remarks); -=item syslog +=item B -returns the output from the syslog command +- returns an array ref of hashes containing each log +line. -=item pipe +=item B -returns the output from the pipe command +- returns true on success, undef on failure -=item maclist +=item B -returns the output from the maclist command +- returns the output from the syslog command -=item maclist_reset +=item B -resets the maclist. No useful output. +- returns the output from the pipe command -=item eth_list +=item B -returns the output from the eth list command +- returns the output from the maclist command +=item B + +- resets the maclist. + +No useful output. + +=item B + +- returns the output from the eth list command + +=item B + +- returns information about the SU. + +You need to pass in the $suid and it will return the info for that suid. + + $t->su_info($suid); + +=item B + +- tests the RF Link to an su + + $t->su_testrflink($suid|'all'); + +=item B + +- saves the config. + +Returns 1 on success, undef on failure. + =cut -my $success = 'Success.'; +my $success = 'Success\\.'; my %COMMANDS = ( tftpd => { decode => 'all', expect => $success }, ver => { decode => 'all' }, @@ -286,12 +353,17 @@ sulog => { decode => 'sulog', expect => $success }, 'exit' => { 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 }, 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 }, + su_info => { String => 'su info', decode => 'all', expect => $success }, + su_testrflink => { String => 'su testrflink', decode => 'all', expect => $success }, + save_ss => { String => 'save ss', expect => $success }, + opmode => { decode => 'all', expect => $success }, # eth r, w and reset??? #su password??? #_bootloader @@ -302,18 +374,20 @@ my %ALIASES = ( bye => 'exit', restart => 'reboot', + Host => 'host', ); my %ACCESS = map { $_ => 1 } qw( firmware_version host_type - Host is_connected logged_in login_banner Timeout last_lines last_vals + last_error + Decode ); sub AUTOLOAD @@ -329,9 +403,13 @@ } if (exists $COMMANDS{$method}) { - $method = shift if (@_ == 1); - $COMMANDS{$method}{'String'} ||= $method; - return $self->cmd(%{ $COMMANDS{$method} }, @_); + my %cmd; + foreach my $k (keys %{ $COMMANDS{$method} }) { + $cmd{$k} = $COMMANDS{$method}{$k}; + } + $cmd{'String'} ||= $method; + $cmd{'args'} .= ' ' . shift if (@_ == 1); + return $self->cmd(%cmd, @_); } if (exists $ACCESS{$method}) { @@ -346,10 +424,14 @@ =pod -=item open +=item B -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() +- Open a connection to a Trango AP. +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 @@ -357,8 +439,8 @@ my $self = shift; unless ( $self->SUPER::open(@_) ) { - #$! = "Couldn't connect to " . $self->Host . ": $!"; - return undef; + $self->last_error("Couldn't connect to " . $self->host . ": $!"); + return; } ## Get to login prompt @@ -366,9 +448,9 @@ -match => '/password: ?$/i', -errmode => "return", ) ) { - #$! = "problem connecting to host (" . $self->Host . "): " . - # $self->lastline; - return undef; + $self->last_error("problem connecting to host (" . $self->host . "): " . + $self->lastline); + return; } $self->parse_login_banner($self->lastline); @@ -380,10 +462,13 @@ =pod -=item login +=item B -Calls open() if not already connected, then sends the password and sets logged_in() if successful +- Login to the AP. +Calls open() if not already connected, then sends the password and sets +logged_in() if successful + =cut sub login @@ -391,7 +476,7 @@ my $self = shift; unless ($self->is_connected) { - $self->open or return undef; + $self->open or return; } my $password = shift; @@ -401,8 +486,8 @@ -match => $self->prompt, -errmode => "return", ) ) { - #$! = "login ($self->Host) failed: " . $self->lastline; - return undef; + $self->last_error("login ($self->host) failed: " . $self->lastline); + return; } $self->logged_in(1); @@ -412,10 +497,15 @@ =pod -=item parse_login_banner +=item B -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() +- Converts the login_banner to some useful +variables. +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 @@ -428,9 +518,12 @@ my $banner = $self->login_banner; - my ($type, $ver) = $banner =~ - /Welcome to Trango Broadband Wireless (\S+)[\s-]+(.+)$/i; + my ($type, $sep1, $subtype, $sep2, $ver) = $banner =~ + /Welcome to Trango Broadband Wireless (\S+)([\s-]+)(\S+)([\s-]+)(.+)$/i; + $type .= $sep1 . $subtype; + $ver = $subtype . $sep2 . $ver; + $self->login_banner($banner); $self->host_type($type); $self->firmware_version($ver); @@ -440,26 +533,26 @@ =pod -=item su_password +=item B -C +- Set the password on SUs connected to the AP. +su_password('new_password'[, 'suid']) If no suid is specified, +the default is "all". + + $t->su_password('good_pass', 5); + =cut sub su_password { my $self = shift; - my $su = shift || '!'; my $new_pass = shift || ''; + my $su = shift || 'all'; - unless (defined $su) { - warn "No su passed!" - #return undef; - } - unless (defined $new_pass) { - warn "No new password!" - #return undef; + $self->last_error("No new password"); + #return; } return $self->cmd(String => 'su password ' . @@ -472,10 +565,15 @@ =pod -=item su_ipconfig +=item B -C +- Change IP configuration on SUs connected to +the AP. +su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' ) + + $t->su_ipconfig( 5, '10.0.1.5', '255.255.255.0', '10.0.1.1' ); + =cut sub su_ipconfig @@ -487,10 +585,22 @@ 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; + if ($suid =~ /\D/) { + $self->last_error("Invalid suid '$suid'"); + return; + } + unless ($new_ip) { + $self->last_error("no new_ip passed"); + return; + } + unless ($new_subnet) { + $self->last_error("no new_subnet passed"); + return; + } + unless ($new_gateway) { + $self->last_error("no new_gateway passed"); + return; + } # su ipconfig return $self->cmd(String => 'su ipconfig ' . @@ -504,15 +614,12 @@ =pod -=item sudb_view +=item B -returns a reference to an array of hashes each containing: +- Returns the output from the sudb view command - suid - type - cir - mir - mac +returns a reference to an array of hashes each containing these keys +'suid', 'type', 'cir', 'mir' and 'mac' =cut @@ -520,16 +627,16 @@ { 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'}) { - return @lines; + return $lines; } my @sus; - foreach (@lines) { + foreach (@{ $lines }) { next unless $_; if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) { my %s = ( @@ -552,7 +659,7 @@ =pod -=item sudb_add +=item B Takes the following paramaters @@ -564,6 +671,8 @@ and returns true on success or undef otherwise. + $t->sudb_add($suid, 'reg', $cir, $mir, $mac); + You should save_sudb() after calling this, or your changes will be lost when the AP is rebooted. @@ -579,29 +688,30 @@ my $mac = shift; if ($suid =~ /\D/) { - return undef; + $self->last_error("Invalid suid '$suid'"); + return; } unless (lc($type) eq 'reg' || lc($type) eq 'pr') { - warn "Invalid type '$type'!"; - return undef; + $self->last_error("Invalid type '$type'"); + return; } if ($cir =~ /\D/) { - warn "Invalid CIR '$cir'!"; - return undef; + $self->last_error("Invalid CIR '$cir'"); + return; } if ($mir =~ /\D/) { - warn "Invalid MIR '$mir'!"; - return undef; + $self->last_error("Invalid MIR '$mir'"); + return; } my $new_mac = $mac; $new_mac =~ s/[^0-9A-Fa-f]//; unless (length $new_mac == 12) { - warn "Invalid MAC '$mac'!"; - return undef; + $self->last_error("Invalid MAC '$mac'"); + return; } $new_mac = join ' ', $new_mac =~ /../g; @@ -618,11 +728,13 @@ =pod -=item sudb_delete +=item B Takes either 'all' or the suid of the su to delete and returns true on success or undef otherwise. + $t->sudb_delete($suid); + You should save_sudb() after calling this, or your changes will be lost when the AP is rebooted. @@ -633,8 +745,10 @@ my $self = shift; my $suid = shift; - if (lc($suid) ne 'all' || $suid =~ /\D/) { - return undef; + #if (lc($suid) ne 'all' || $suid =~ /\D/) { + if ($suid =~ /\D/) { + $self->last_error("Invalid suid '$suid'"); + return; } return $self->cmd( String => 'sudb delete ' . $suid, expect => $success ); @@ -642,9 +756,9 @@ =pod -=item sudb_modify +=item B -Takes either the suid of the su to delete +Takes either the suid of the su to change as well as what you are changing, either "cir, mir or su2su" and returns true on success or undef otherwise. @@ -652,6 +766,8 @@ su2su takes a group id parameter that is in hex. + $t->sudb_modify($suid, 'cir', 512); + You should save_sudb() after calling this, or your changes will be lost when the AP is rebooted. @@ -665,19 +781,23 @@ my $value = shift; if ($suid =~ /\D/) { - return undef; + $self->last_error("Invalid suid '$suid'"); + return; } if (lc($opt) eq 'cir' or lc($opt) eq 'mir') { if ($value =~ /\D/) { - return undef; + $self->last_error("Invalid $opt '$value'"); + return; } } elsif (lc($opt) eq 'su2su') { if ($value =~ /[^0-9A-Za-f]/) { - return undef; + $self->last_error("Invalid MAC '$value'"); + return; } } else { - return undef; + $self->last_error("Invalid option '$opt'"); + return; } my $string = 'sudb modify ' . $suid . ' ' . $opt . ' ' . $value; @@ -687,8 +807,10 @@ =pod -=item enable_tftpd +=item B +- enable the TFTP server + runs C 'on')> and makes sure that Tftpd is now 'listen'ing =cut @@ -702,14 +824,16 @@ if ($vals->{'Tftpd'} eq 'listen') { return $vals; } else { - return undef; + return; } } =pod -=item disable_tftpd +=item B +- disable the TFTP server + runs C 'off')> and makes sure that Tftpd is now 'disabled' =cut @@ -723,32 +847,55 @@ if (ref $vals eq 'HASH' && $vals->{'Tftpd'} eq 'disabled') { return $vals; } else { - return undef; + return; } } =pod -=item cmd +=item B -This does most of the work. At the heart, it calls Net::Telnet::cmd() but it also does some special stuff for Trango. +- runs a command on the AP. +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: +If you are using this, rather than one of the "easy" methods above, +you probably want to read through the source of this module to see how +some of the other commands are called. +In addition to the Net::Telnet::cmd() options, it also accepts these: + I -- 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 + +- if this is true, it does not wait for a prompt, so you are not stuck +waiting for something that will never happen. + 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 +- if this is true, it then sets logged_in() to false, then it will +close() the connection and set 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 +- 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 +- a string containing the command line options that are passed to the +command + + $t->cmd( String => 'exit', no_prompt => 1, cmd_disconnects => 1 ); + =cut sub cmd @@ -778,21 +925,18 @@ $cfg{'Timeout'} ||= $self->Timeout; unless ($cfg{'String'}) { - #$! = "No command passed"; - #warn "No command passed\n"; - return undef; + $self->last_error("No command passed"); + return; } unless ($self->is_connected) { - #$! = "Not connected"; - #warn "Not connected\n"; - return undef; + $self->last_error("Not connected"); + return; } unless ($self->logged_in) { - #$! = "Not logged in"; - #warn "Not logged in\n"; - return undef; + $self->last_error("Not logged in"); + return; } @@ -805,12 +949,13 @@ if ($cfg{'args'}) { $cmd{'String'} .= ' ' . $cfg{'args'}; } + my @lines; - unless ($cfg{'no_prompt'}) { - @lines = $self->SUPER::cmd(%cmd); - } else { + if ($cfg{'no_prompt'}) { $self->print($cmd{'String'}); @lines = $self->lastline; + } else { + @lines = $self->SUPER::cmd(%cmd); } $self->last_lines(\@lines); @@ -843,11 +988,11 @@ if ($PRIVATE{'Decode'} && $cfg{'decode'}) { return $vals; } else { - return @lines; + return \@lines; } } else { - #$! = "Error with command ($cfg{'string'}): $last"; - return undef; + $self->last_error("Error with command ($cfg{'String'}): $last"); + return; } } @@ -860,9 +1005,10 @@ my %conf; my $key = ''; - my $val = ''; + my $val = undef; + my @vals; my $in_key = 0; - my $in_val = 0; + my $in_val = 1; foreach my $line (@lines) { next if $line =~ /$success$/; @@ -878,15 +1024,17 @@ $in_val = 0; } else { $in_key = 0; - $in_val = 0; + $in_val = 1; } if ($key) { $key =~ s/^\s+//; $key =~ s/\s+$//; - $val =~ s/^\s+//; - $val =~ s/\s+$//; + if ($val) { + $val =~ s/^\s+//; + $val =~ s/\s+$//; + } if ($key eq 'Checksum' && $last_key) { # Special case for these bastids. @@ -895,11 +1043,13 @@ $key = $new . " " . $key; } - $last_key = $key; $conf{$key} = $val; + $last_key = $key; $key = ''; - $val = ''; - } + } elsif ($val) { + push @vals, $val; + } + $val = ''; } elsif ($c eq ']') { $in_val = 1; @@ -915,10 +1065,23 @@ } } + unless ($key) { + push @vals, $val; + } + + if (@vals == 1) { + $val = $vals[0]; + } elsif (@vals) { + $val= \@vals; + } else { + $val = undef; + } + if (%conf) { + $conf{_pre} = $val if $val; return \%conf; } else { - return undef; + return $val; } } @@ -1007,7 +1170,7 @@ return \@decoded; } else { # XXX we should have a way to set last error, not sure why we don't - return undef; + return; } } @@ -1024,9 +1187,14 @@ =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 @@ -1034,11 +1202,10 @@ =head1 COPYRIGHT AND LICENSE -Copyright (C) 2005 by Andrew Fresh +Copyright (C) 2005,2006,2007 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