=================================================================== RCS file: /cvs/trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm,v retrieving revision 1.51 retrieving revision 1.59 diff -u -r1.51 -r1.59 --- trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2008/02/18 16:37:35 1.51 +++ trango/Net-Telnet-Trango/lib/Net/Telnet/Trango.pm 2009/07/31 22:44:33 1.59 @@ -1,6 +1,6 @@ package Net::Telnet::Trango; -# $RedRiver: Trango.pm,v 1.50 2008/02/08 19:32:15 andrew Exp $ +# $RedRiver: Trango.pm,v 1.58 2009/07/13 16:33:45 andrew Exp $ use strict; use warnings; use base 'Net::Telnet'; @@ -43,16 +43,11 @@ =cut -our $VERSION = '0.01'; +our $VERSION = '0.05'; my $EMPTY = q{}; my $SPACE = q{ }; -my %PRIVATE = ( - is_connected => 0, - logged_in => 0, -); - =pod =head2 B - Creates a new Net::Telnet::Trango object. @@ -61,7 +56,7 @@ [Decode => 0,]); Same as new from L but sets the default Trango Prompt: -'/#> *$/' +'/[\$#]>\s*\Z/' 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 @@ -73,7 +68,7 @@ sub new { my $class = shift; - my %args; + my %args = (); if ( @_ == 1 ) { $args{'Host'} = shift; } @@ -81,17 +76,20 @@ %args = @_; } - $args{'Prompt'} ||= '/#> *$/'; + $args{'Prompt'} ||= '/[\$#]>\s*\r?\n?$/'; - foreach my $key ( keys %args ) { - $PRIVATE{$key} = $args{$key}; - } - $PRIVATE{'Decode'} = 1 unless defined $PRIVATE{'Decode'}; + my $decode = $args{'Decode'}; delete $args{'Decode'}; my $self = $class->SUPER::new(%args); bless $self if ref $self; + $args{Decode} = defined $decode ? $decode : 1; + $args{is_connected} = 0; + $args{logged_in} = 0; + + *$self->{net_telnet_trango} = \%args; + return $self; } @@ -259,6 +257,10 @@ reboots the Trango and closes the connection +==head2 B - Sends a reset command + +resets settings to default + =head2 B - Set or retrieve the remarks. Takes an optional argument, which sets the remarks. @@ -315,63 +317,111 @@ Returns 1 on success, undef on failure. -=head2 B - sets opmode ap y or returns the opmode +=head2 B - sets baseid - $t->opmode([ap y]); + $t->set_baseid($baseid); +=head2 B - sets baseid + + $t->set_suid($baseid); + +=head2 B - sets default opmode + + $t->set_defaultopmode(ap|su); + +=head2 B - sets or returns the opmode + + $t->opmode([ap y|su y]); + +=head2 B - sets or returns the freq + + $channel = '11 v'; + $t->freq([$channel]); + +=head2 B - sets the freq writescan + + $channels = '11 v 11 h 12 v 12 h'; + $t->freq_writescan($channels); + +=head2 B - returns the freq scantable + + $channels = $t->freq_scantable(); + # now $channels eq '11 v 11 h 12 v 12 h'; + + =cut my $success = 'Success\\.'; my %COMMANDS = ( - _clear => { String => "\n" }, - tftpd => { decode => 'all', expect => $success }, + _clear => { String => "\n" }, + 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 }, - 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 }, + 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 }, + 'reset' => {}, + 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 => 'each', expect => $success }, - save_ss => { String => 'save ss', expect => $success }, - opmode => { decode => 'all', expect => $success }, - arq => { decode => 'all' }, + { String => 'su testrflink', decode => 'each', expect => $success }, + save_ss => { String => 'save ss', expect => $success }, + set_baseid => { + String => 'set baseid', + decode => 'all', + expect => $success + }, + set_suid => { + String => 'set suid', + decode => 'all', + expect => $success + }, + set_defaultopmode => { + String => 'set defaultopmode', + decode => 'all', + expect => $success + }, + opmode => { decode => 'all', expect => $success }, + freq => { decode => 'freq', expect => $success }, + freq_writescan => + { String => 'freq writescan', decode => 'all', expect => $success }, + freq_scantable => + { String => 'freq scantable', decode => 'all', expect => $success }, + arq => { decode => 'all' }, ); my %ALIASES = ( - bye => 'exit', - restart => 'reboot', - Host => 'host', + bye => 'exit', + restart => 'reboot', + Host => 'host', save_systemseting => 'save_ss', ); my %ACCESS = map { $_ => 1 } qw( - firmware_version - host_type - is_connected - logged_in - login_banner - Timeout - last_lines - last_vals - last_error - Decode + firmware_version + host_type + is_connected + logged_in + login_banner + Timeout + last_lines + last_vals + last_error + Decode ); sub AUTOLOAD { my $self = shift; my ($method) = ( our $AUTOLOAD ) =~ /^.*::(\w+)$/ - or die "Weird: $AUTOLOAD"; + or die "Weird: $AUTOLOAD"; if ( exists $ALIASES{$method} ) { $method = $ALIASES{$method}; @@ -389,8 +439,9 @@ } if ( exists $ACCESS{$method} ) { - my $prev = $PRIVATE{$method}; - ( $PRIVATE{$method} ) = @_ if @_; + my $s = *$self->{net_telnet_trango}; + my $prev = $s->{$method}; + ( $s->{$method} ) = @_ if @_; return $prev; } @@ -422,11 +473,11 @@ -match => '/password: ?$/i', -errmode => "return", ) - ) + ) { $self->last_error( "problem connecting to host (" - . $self->host . "): " - . $self->lastline ); + . $self->host . "): " + . $self->lastline ); return; } @@ -461,7 +512,7 @@ -match => $self->prompt, -errmode => "return", ) - ) + ) { $self->last_error( "login ($self->host) failed: " . $self->lastline ); return; @@ -491,9 +542,9 @@ my $banner = $self->login_banner; - my ( $type, $sep1, $subtype, $sep2, $ver ) = - $banner =~ - /Welcome to Trango Broadband Wireless,? (\S+)([\s-]+)(\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; @@ -515,21 +566,21 @@ =cut -sub linktest -{ - my $self = shift; - my $suid = shift; +sub linktest { + my $self = shift; + my $suid = shift; + # These numbers are what I found as defaults when running the command my $pkt_len = shift || 1600; - my $pkt_cnt = shift || 500; + my $pkt_cnt = shift || 500; my $cycles = shift || 10; - my %config = @_; + my %config = @_; # * 2, one for the FromAP, one FromSU. Then / 1000 to get to ms. # XXX This might need to be changed, this makes the default timeout the # same as $pkt_len, and that might not be enough at slower speeds. - $config{Timeout} ||= int(($pkt_len * $pkt_cnt * $cycles * 2 ) / 1000); + $config{Timeout} ||= int( ( $pkt_len * $pkt_cnt * $cycles * 2 ) / 1000 ); my $string = join $SPACE, 'linktest', $suid, $pkt_len, $pkt_cnt, $cycles; return $self->cmd( @@ -563,13 +614,54 @@ } return $self->cmd( - String => 'su password ' . $su . $SPACE . $new_pass . $SPACE . $new_pass, + String => 'su password ' + . $su + . $SPACE + . $new_pass + . $SPACE + . $new_pass, expect => $success, ); } =pod +=head2 B - Change IP configuration + +ipconfig( 'new_ip', 'new_subnet', 'new_gateway' ) + + $t->ipconfig( '10.0.1.5', '255.255.255.0', '10.0.1.1' ); + +=cut + +sub ipconfig { + my $self = shift; + + my $string = join $SPACE, 'ipconfig', @_; + + if ( @_ == 3 ) { + $self->print($string); + my @lines = $self->waitfor( Match => '/save\s+and\s+activate/', ); + $self->print('y'); + + $self->logged_in(0); + $self->is_connected(0); + + foreach my $line (@lines) { + if ( $line =~ s/New \s configuration:\s+//xms ) { + return _decode_lines($line); + } + } + + return {}; + } + + # ipconfig [ ] + return $self->cmd( String => $string, expect => $success ); +} + +=pod + =head2 B - Change IP configuration on SUs connected to the AP. su_ipconfig( 'suid', 'new_ip', 'new_subnet', 'new_gateway' ) @@ -605,9 +697,14 @@ # su ipconfig return $self->cmd( - String => 'su ipconfig ' . $suid . $SPACE . $new_ip . $SPACE - . $new_subnet . $SPACE - . $new_gateway, + String => 'su ipconfig ' + . $suid + . $SPACE + . $new_ip + . $SPACE + . $new_subnet + . $SPACE + . $new_gateway, expect => $success, ); } @@ -617,7 +714,7 @@ =head2 B - Returns the output from the sudb view command returns a reference to an array of hashes each containing these keys -'suid', 'type', 'cir', 'mir' and 'mac' +'suid', 'su2su', 'type', 'cir', 'mir' and 'mac' =cut @@ -628,23 +725,37 @@ return unless @{$lines}; - unless ( $PRIVATE{'Decode'} ) { - return $lines; - } + my $s = *$self->{net_telnet_trango}; + return $lines if !$s->{'Decode'}; my @sus; foreach ( @{$lines} ) { next unless $_; - if (/^\[(\d+)\]\s+(\d+)\s+(\d+)\s+(\d+)\s+([0-9A-Fa-f\s]+)$/) { + if (/^ + \[(\d+)\] + \s+ + [[:xdigit:]]{2} + ([[:xdigit:]]) + ([[:xdigit:]]) + \s+ + (\d+) + \s+ + (\d+) + \s+ + ([[:xdigit:]\s]+) + $/ixms + ) + { my %s = ( - suid => $1, - type => $2, - cir => $3, - mir => $4, - mac => $5, + suid => $1, + su2su => $2 ? $2 : undef, + type => $3 == 1 ? 'reg' : $3 == 5 ? 'pri' : $3, + cir => $4, + mir => $5, + mac => $6, ); - $s{'mac'} =~ s/\s//g; + $s{'mac'} =~ s/\s//gxms; $s{'mac'} = uc( $s{'mac'} ); push @sus, \%s; @@ -704,16 +815,24 @@ } my $new_mac = $mac; - $new_mac =~ s/[^0-9A-Fa-f]//; + $new_mac =~ s/[^0-9A-Fa-f]//g; unless ( length $new_mac == 12 ) { $self->last_error("Invalid MAC '$mac'"); return; } $new_mac = join $SPACE, $new_mac =~ /../g; - my $string = - 'sudb add ' . $suid . $SPACE . $type . $SPACE . $cir . $SPACE . $mir . $SPACE - . $new_mac; + my $string + = 'sudb add ' + . $suid + . $SPACE + . $type + . $SPACE + . $cir + . $SPACE + . $mir + . $SPACE + . $new_mac; return $self->cmd( String => $string, expect => $success ); } @@ -881,18 +1000,19 @@ sub cmd { my $self = shift; + my $s = *$self->{net_telnet_trango}; my @valid_net_telnet_opts = qw( - String - Output - Cmd_remove_mode - Errmode - Input_record_separator - Ors - Output_record_separator - Prompt - Rs - Timeout + String + Output + Cmd_remove_mode + Errmode + Input_record_separator + Ors + Output_record_separator + Prompt + Rs + Timeout ); my %cfg; @@ -942,8 +1062,18 @@ $self->last_lines( \@lines ); + my $last = $self->lastline; + my $prompt = $self->prompt; + $prompt =~ s{^/}{}xms; + $prompt =~ s{/[gixms]*$}{}xms; + while ( @lines && $last =~ qr($prompt) ) { + pop @lines; + $last = $lines[-1]; + } + $self->last_error($EMPTY); + my $vals = 1; - if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) { + if ( $s->{'Decode'} && $cfg{'decode'} ) { if ( $cfg{'decode'} eq 'each' ) { $vals = _decode_each_line(@lines); } @@ -952,26 +1082,28 @@ } elsif ( $cfg{'decode'} eq 'maclist' ) { $vals = _decode_maclist(@lines); - if (! $vals) { + if ( !$vals ) { $self->last_error("Error decoding maclist"); } } elsif ( $cfg{'decode'} eq 'linktest' ) { $vals = _decode_linktest(@lines); - if (! $vals) { + if ( !$vals ) { $self->last_error("Error decoding linktest"); } } + elsif ( $cfg{'decode'} eq 'freq' ) { + $vals = _decode_freq(@lines); + } else { $vals = _decode_lines(@lines); } } - + if ( ref $vals eq 'HASH' ) { + $vals->{_raw} = join q{}, @lines; + } $self->last_vals($vals); - my $last = $self->lastline; - $self->last_error($EMPTY); - if ( ( not $cfg{'expect'} ) || $last =~ /$cfg{'expect'}$/ ) { if ( $cfg{'cmd_disconnects'} ) { $self->logged_in(0); @@ -979,7 +1111,7 @@ $self->is_connected(0); } - if ( $PRIVATE{'Decode'} && $cfg{'decode'} ) { + if ( $s->{'Decode'} && $cfg{'decode'} ) { return $vals; } else { @@ -988,13 +1120,14 @@ } else { my $err; - if (grep { /\[ERR\]/ } @lines) { + if ( grep {/\[ERR\]/} @lines ) { $err = _decode_lines(@lines); - } + } - if (ref $err eq 'HASH' && $err->{ERR}) { - $self->last_error($err->{ERR} ); - } else { + if ( ref $err eq 'HASH' && $err->{ERR} ) { + $self->last_error( $err->{ERR} ); + } + else { $self->last_error("Error with command ($cmd{'String'}): $last"); } return; @@ -1014,9 +1147,54 @@ my $in_key = 0; my $in_val = 1; - foreach my $line (@lines) { - next if $line =~ /$success$/; +LINE: while ( my $line = shift @lines ) { + next LINE if $line =~ /$success\Z/; + next LINE if $line =~ /^ \*+ \s+ \d+ \s+ \*+ \Z/xms; + # Special decode for sysinfo on a TrangoLink 45 + if ( $line =~ /^(.* Channel \s+ Table):\s*(.*)\Z/xms ) { + my $key = $1; + my $note = $2; + + my %vals; + while ( $line = shift @lines ) { + if ( $line =~ /^\Z/ ) { + $conf{$key} = \%vals; + $conf{$key}{note} = $note; + next LINE; + } + + my $decoded = _decode_lines($line); + if ($decoded) { + %vals = ( %vals, %{$decoded} ); + } + } + } + + # Another special decode for the TrangoLink + elsif ( + $line =~ /^ + RF \s Band \s \# + (\d+) \s+ + \( ([^\)]+) \) \s* + (.*)$ + /xms + ) + { + my $num = $1; + my $band = $2; + my $extra = $3; + + if ( $extra =~ /\[/ ) { + my $decoded = _decode_lines($extra); + $conf{'RF Band'}{$num} = $decoded; + } + else { + $conf{'RF Band'}{$num}{$extra} = 1; + } + next LINE; + } + my @chars = split //, $line; my $last_key = $EMPTY; @@ -1038,7 +1216,7 @@ if ($val) { $val =~ s/^\s+//; - $val =~ s/\s+$//; + $val =~ s/\s+\.*$//; } if ( $key eq 'Checksum' && $last_key ) { @@ -1079,6 +1257,13 @@ push @vals, $val; } + foreach my $val (@vals) { + if ( defined $val && length $val ) { + $val =~ s/^\s+//; + $val =~ s/\s+\.*$//; + } + } + if ( @vals == 1 ) { $val = $vals[0]; } @@ -1105,7 +1290,7 @@ my @decoded; foreach my $line (@lines) { my $decoded = _decode_lines($line); - push @decoded, $decoded if defined $decoded; + push @decoded, $decoded if defined $decoded && length $decoded; } return \@decoded; } @@ -1117,29 +1302,29 @@ my %decoded; foreach my $line (@lines) { - if ($line =~ s/^(\d+) \s+ //xms) { + if ( $line =~ s/^(\d+) \s+ //xms ) { my $line_id = $1; - my ($tm, $rt); - if ($line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms) { - $rt = $1; - } - if ($line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms) { - $tm = $1; - } + my ( $tm, $rt ); + if ( $line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms ) { + $rt = $1; + } + if ( $line =~ s/\s+ (\d+ \s+ \w+) \s* $//xms ) { + $tm = $1; + } - my $d = _decode_lines($line. "\n"); - $decoded{tests}[$line_id] = $d; + my $d = _decode_lines( $line . "\n" ); + $decoded{tests}[$line_id] = $d; $decoded{tests}[$line_id]{'time'} = $tm; $decoded{tests}[$line_id]{rate} = $rt; } else { - my $d = _decode_lines($line . "\n"); + my $d = _decode_lines( $line . "\n" ); if ($d) { - while (my ($k, $v) = each %{ $d }) { + while ( my ( $k, $v ) = each %{$d} ) { $decoded{$k} = $v; } - } + } } } @@ -1199,12 +1384,12 @@ } push @decoded, - { + { mac => $mac, loc => $loc, tm => $tm, suid => $suid, - }; + }; } elsif ( $line =~ /(\d+)\s+entries/ ) { $total_entries = $1; @@ -1222,6 +1407,38 @@ else { return; } +} + +#=item _decode_freq + +sub _decode_freq { + my @lines = @_; + my $decoded = _decode_lines(@lines); + + if ( $decoded && $decoded->{ERR} ) { + return $decoded; + } + +LINE: foreach my $line (@lines) { + if (my ( $channel, $polarity, $freq ) + = $line =~ / + Ch \s+ \#(\d+) + \s+ + (\w+) + \s+ + \[ (\d+) \s+ MHz\] + /ixms + ) + { + $decoded = { + channel => $channel, + polarity => $polarity, + frequency => $freq, + }; + last LINE; + } + } + return $decoded; } 1; # End of Net::Telnet::Trango