=================================================================== RCS file: /cvs/trango/Net-Telnet-Trango/scripts/su.cgi,v retrieving revision 1.4 retrieving revision 1.6 diff -u -r1.4 -r1.6 --- trango/Net-Telnet-Trango/scripts/su.cgi 2007/02/07 19:25:21 1.4 +++ trango/Net-Telnet-Trango/scripts/su.cgi 2008/09/04 22:05:21 1.6 @@ -1,13 +1,13 @@ #!/usr/bin/perl -# $RedRiver: su.cgi,v 1.3 2007/02/07 17:44:56 andrew Exp $ +# $RedRiver: su.cgi,v 1.5 2008/09/04 20:53:55 andrew Exp $ ######################################################################## # su.cgi *** a CGI for Trango SU utilities. -# +# # 2007.02.07 #*#*# andrew fresh ######################################################################## # Copyright (C) 2007 by Andrew Fresh -# -# This program is free software; you can redistribute it and/or modify +# +# This program is free software; you can redistribute it and/or modify # it under the same terms as Perl itself. ######################################################################## use strict; @@ -15,61 +15,89 @@ my $host_file = 'su.yaml'; -my $default_mac = '0001DE'; -my $default_suid = 'all'; -my $default_cir = 256; -my $default_mir = 9999; -my $Start_SUID = 3; +my $default_timeout = 5; +my $default_mac = '0001DE'; +my $default_suid = 'all'; +my $default_cir = 256; +my $default_mir = 9999; +my $Start_SUID = 3; use CGI qw/:standard/; -use File::Basename; use YAML qw/ LoadFile Dump /; use Net::Telnet::Trango; -my $me = basename($0); +print header; my $aps = get_aps($host_file); -print header, - start_html('Trango SU Utilities'), - h1('Trango SU Utilities'); +my ( $header, $body ); +my $head; +my $show_form = 0; -if (param()) { - +if ( param() ) { my $AP = param('AP'); - unless (exists $aps->{$AP}) { + unless ( exists $aps->{$AP} ) { print h3("AP '$AP' does not exist!"); print end_html; exit; } - my $sumac = param('sumac'); - + my $sumac = param('sumac') || ''; $sumac =~ s/[^0-9A-Fa-f]//g; $sumac = uc($sumac); - my $suid = param('suid'); + my $suid = param('suid'); + my $test_type = param('test_type'); - if (length $sumac == 12) { - add_su($aps->{$AP}, $sumac); - } elsif (length $suid) { - testrflink($aps->{$AP}, $suid); - } else { - print h3("Invalid SUID '$suid' and MAC '$sumac'"); - show_form($aps, $default_mac); + if ( length $sumac == 12 ) { + ( $header, $body ) = add_su( $aps->{$AP}, $sumac, $suid ); } + elsif ( length $suid ) { + if ( $test_type && $test_type eq 'linktest' ) { + ( $header, $body ) = linktest( $aps->{$AP}, $suid ); + } + else { + ( $header, $body ) = testrflink( $aps->{$AP}, $suid ); + $head = ''; + } + } + else { + $header = "Invalid SUID '$suid' and MAC '$sumac'"; + $show_form = 1; + } -} else { - show_form($aps, $default_mac); } +else { + $show_form = 1; +} +if ($header) { -print end_html; +# We don't really want to do this here because we don't want to refresh if we're adding an SU + if ($head) { + print start_html( -title => $header, -head => ["$head"] ); + } + else { + print start_html($header); + } + if ( not defined param('bare') ) { + print h1($header); + } + if ($body) { + print $body; + } +} +else { + print start_html('Trango SU Utilities'), h1('Trango SU Utilities'); +} -sub get_aps -{ +show_form( $aps, $default_mac ) if $show_form; + +print end_html; + +sub get_aps { my $file = shift; my $conf = LoadFile($file); @@ -77,100 +105,126 @@ my %aps; my @hosts; - foreach my $ap (keys %{ $conf }) { + foreach my $ap ( keys %{$conf} ) { next if $ap eq 'default'; - my $h = $conf->{$ap}; + my $h = $conf->{$ap}; - if ($h->{name} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})-(\d{1,3})/) { - for ($2..$3) { + if ( $h->{name} + =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})-(\d{1,3})/ ) + { + for ( $2 .. $3 ) { my %cur_host; - foreach my $k (keys %{ $h }) { + foreach my $k ( keys %{$h} ) { $cur_host{$k} = $h->{$k}; } $cur_host{name} = $1 . $_; - if (! grep { $cur_host{name} eq $h->{name} } values %aps) { - my $ap_name = $ap . $_; - $aps{ $ap_name } = \%cur_host; + if ( !grep { $cur_host{name} eq $h->{name} } values %aps ) { + my $ap_name = $ap . $_; + $aps{$ap_name} = \%cur_host; } } - } else { - $aps{ $ap } = $conf->{$ap}; + } + else { + $aps{$ap} = $conf->{$ap}; push @hosts, $h; } } - if (ref $conf->{default} eq 'HASH') { - foreach my $ap (keys %aps) { - foreach my $k (keys %{ $conf->{default} }) { - $aps{ $ap }{$k} ||= $conf->{default}->{$k}; + if ( ref $conf->{default} eq 'HASH' ) { + foreach my $ap ( keys %aps ) { + foreach my $k ( keys %{ $conf->{default} } ) { + $aps{$ap}{$k} ||= $conf->{default}->{$k}; } } } return \%aps; - return { + return { 'rrlhcwap0000' => { - name => '192.168.1.1', - password => 'trango', + group => 'Trango', + version => 1, + name => '192.168.1.1', + port => 161, + Read_Community => 'private', + Write_Community => 'private', } }; } -sub show_form -{ - my $aps = shift; +sub show_form { + my $aps = shift; - my %cache = (); + my %cache = (); my @ap_names = sort { my @a = $a =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/; my @b = $b =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/; if (@a) { - $cache{$a} ||= pack('C4' => @a); - } else { + $cache{$a} ||= pack( 'C4' => @a ); + } + else { $cache{$a} ||= lc($a); } if (@b) { - $cache{$b} ||= pack('C4' => @b); - } else { + $cache{$b} ||= pack( 'C4' => @b ); + } + else { $cache{$b} ||= lc($b); } $cache{$a} cmp $cache{$b}; - } keys %{ $aps }; + } keys %{$aps}; - print p(start_form(-method => 'GET'), - 'AP: ', popup_menu(-name=>'AP', -values=>\@ap_names),br, - 'SUMAC: ', textfield( -name=>'sumac', -default=>$default_mac),br, - 'SUID: ', textfield( -name=>'suid', -default=>$default_suid),br, - submit, - end_form); + print p( + start_form( -method => 'GET' ), + 'AP: ', + popup_menu( -name => 'AP', -values => \@ap_names ), + br, + 'SUMAC: ', + textfield( -name => 'sumac', -default => $default_mac ), + br, + 'SUID: ', + textfield( -name => 'suid', -default => $default_suid ), + br, + 'Test Type: ', + radio_group( + -name => 'test_type', + -values => [ 'su testrflink', 'linktest' ], + -default => 'su testrflink', + ), + br, submit, end_form + ); - print p('Fill in the SUMAC if you wish to add an SU ', - 'or fill in the SUID to run an rflinktest.'); + print p( + 'Fill in the SUMAC if you wish to add an SU ', + 'or fill in the SUID to run an RF link test. ', + 'If you enter both a valid SUMAC and a numeric SUID, ', + 'the SU will be added with that SUID. ', + 'If the SUID is already in the AP, it will be deleted ', + 'before the new SU is added. ' + ); return 1; } -sub login -{ +sub login { my $host = shift; my $password = shift; - my $t = new Net::Telnet::Trango ( Timeout => 5 ); + my $t = new Net::Telnet::Trango( Timeout => $default_timeout ); #$t->input_log('/tmp/telnet_log'); #$t->dump_log('/tmp/telnet_log'); - unless ($t->open( Host => $host )) { + unless ( $t->open( Host => $host ) ) { print h3("Error connecting!"); $t->close; return undef; } - unless ($t->login( $password ) ) { + unless ( $t->login($password) ) { print h3("Couldn't log in: $!"); $t->exit; $t->close; @@ -180,128 +234,235 @@ return $t; } -sub add_su -{ - my $ap = shift; - my $sumac = shift; +sub add_su { + my ( $ap, $sumac, $suid ) = @_; - my $t = login($ap->{name}, $ap->{password}); + my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} ); my $cur_sus = $t->sudb_view; - my $new_suid = next_suid($cur_sus); + my $new_suid = $suid; + $new_suid =~ s/\D//gxms; - foreach my $su (@{ $cur_sus }) { - if ($sumac eq $su->{mac}) { - print h3("MAC '$sumac' already in AP '$ap->{name}' " . - "with SUID '$su->{suid}'"); + if ( !$new_suid ) { + $new_suid = next_suid($cur_sus); + } + + my $old_su = ''; + foreach my $su ( @{$cur_sus} ) { + if ( $new_suid == $su->{'suid'} ) { + $old_su = $su; + } + + if ( $sumac eq $su->{'mac'} ) { $t->exit; $t->close; - return undef; + return "MAC '$sumac' already in AP '$ap->{'name'}' " + . "with SUID '$su->{'suid'}'"; } } - unless ($t->sudb_add( - $new_suid, 'reg', $default_cir, $default_mir, $sumac - ) ) { - print h3("Error adding SU!"); + my $cir = $default_cir; + my $mir = $default_mir; + + if ($old_su) { + $cir = $old_su->{'cir'} if $old_su->{'cir'}; + $mir = $old_su->{'mir'} if $old_su->{'mir'}; + + if ( !$t->sudb_delete($new_suid) ) { + $t->exit; + $t->close; + return "Error removing SU!"; + } + } + + if ( !$t->sudb_add( $new_suid, 'reg', $cir, $mir, $sumac ) ) { $t->exit; $t->close; - return undef; + return "Error adding SU!"; } my $new_sus = $t->sudb_view; - my $added = 0; - foreach my $su (@{ $new_sus }) { - if ($su->{suid} == $new_suid) { + my $added = 0; + foreach my $su ( @{$new_sus} ) { + if ( $su->{'suid'} == $new_suid ) { $added = 1; last; } } unless ($added) { - print h3("Couldn't add su id: $new_suid"); $t->exit; $t->close; - return undef; + return "Couldn't add su id: $new_suid"; } - unless ($t->save_sudb) { - print h3("Couldn't save sudb"); + unless ( $t->save_sudb ) { $t->exit; $t->close; - return undef; + return "Couldn't save sudb"; } - print p( - "Added new SU with ID '$new_suid' " . - "and MAC '$sumac' " . - "to '$ap->{name}'. " . - 'Test SU RFLink' - ); - $t->exit; $t->close; - return 1; + my $msg = ''; + + if ($old_su) { + $msg + .= "Removed old SU with ID '$new_suid' " + . "and MAC '" + . $old_su->{'mac'} . "' " + . "from '$ap->{'name'}'. "; + } + + $msg + .= "Added new SU with ID '$new_suid' " + . "and MAC '$sumac' " + . "to '$ap->{'name'}'. " + . 'Test SU RFLink'; + + return $msg; } -sub testrflink -{ - my $ap = shift; +sub testrflink { + my $ap = shift; my $suid = shift; - my $t = login($ap->{name}, $ap->{password}); + my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} ); - my $result = $t->su_testrflink( $suid ); + my $timeout = $default_timeout; + if ( $suid eq 'all' ) { + my $sudb = $t->sudb_view(); + my $count = scalar @{$sudb}; + $timeout = $count * $default_timeout; + } + my $result = $t->su_testrflink( args => $suid, Timeout => $timeout ); unless ($result) { - print h3("Error testing SU rflink!"); $t->exit; $t->close; - return undef; + return "Error testing SU rflink!"; } - my @keys = ('suid', 'AP Tx', 'AP Rx', 'SU Rx'); + my @keys = ( 'suid', 'AP Tx', 'AP Rx', 'SU Rx' ); my @table; - foreach my $su (@{ $result }) { + foreach my $su ( @{$result} ) { next unless ref $su eq 'HASH'; - next unless exists $su->{suid}; - $su->{suid} =~ s/\D//g; - next unless $su->{suid}; + next unless exists $su->{'suid'}; + $su->{'suid'} =~ s/\D//g; + next unless $su->{'suid'}; - push @table, td([ @{ $su }{ @keys } ]); + push @table, td( [ @{$su}{@keys} ] ); } - print table({-border=>1,-cellspacing=>0,-cellpadding=>1}, - caption($ap->{name} . ': su testrflink ' . $suid), - Tr({-align=>'CENTER', -valign=>'TOP'}, - [ th(\@keys), @table ] + $t->exit; + $t->close; + return $ap->{'name'} . ': su testrflink ' . $suid, + table( + { -border => 1, -cellspacing => 0, -cellpadding => 1 }, + Tr( { -align => 'CENTER', -valign => 'TOP' }, + [ th( \@keys ), @table ] ) - ); + ); +} + +sub linktest { + my $ap = shift; + my $suid = shift; + + if ( !$suid =~ /^\d+$/ ) { + return "Invalid SUID [$suid]"; + } + + my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} ); + + my $result = $t->linktest($suid); + $t->exit; $t->close; - return 1; + unless ($result) { + return "Error testing SU rflink!"; + } + + my @keys = ( + { caption => 'Overview', + fields => [ + 'AP to SU Error Rate', + 'SU to AP Error Rate', + 'Avg of Throughput', + ], + }, + { caption => 'Details', + fields => [ + 'AP Total nTx', + 'AP Total nRx', + 'AP Total nRxErr', + + 'SU Total nTx', + 'SU Total nRx', + 'SU Total nRxErr', + ], + }, + ); + + my @detail_keys = ( + 'AP Tx', 'AP Rx', 'AP RxErr', 'SU Tx', + 'SU Rx', 'SU RxErr', 'time', 'rate', + ); + + my $html; + foreach my $keys (@keys) { + my @table; + foreach my $k ( @{ $keys->{fields} } ) { + if ( $result->{$k} ) { + push @table, td( [ b($k), $result->{$k} ] ); + } + else { + push @table, td( [] ); + } + } + $html .= table( + { -border => 1, -cellspacing => 0, -cellpadding => 1, }, + caption( $keys->{caption} ), + Tr( { -align => 'CENTER', -valign => 'TOP' }, \@table ), + ); + } + + my @detail_table; + foreach my $test ( @{ $result->{tests} } ) { + push @detail_table, td( [ @{$test}{@detail_keys} ] ); + } + $html .= table( + { -border => 1, -cellspacing => 0, -cellpadding => 1 }, + caption('Test Details'), + Tr( { -align => 'CENTER', -valign => 'TOP' }, + [ th( \@detail_keys ), @detail_table, ], + ), + ); + + return $ap->{'name'} . ': linktest ' . $suid, $html; } -sub next_suid -{ +sub next_suid { my $sudb = shift; my $next_id = $Start_SUID; - my %ids = map { $_->{suid} => 1 } @{ $sudb }; + my %ids = map { $_->{'suid'} => 1 } @{$sudb}; - my $next_key = sprintf('%04d', $next_id); - while (exists $ids{$next_key}) { + my $next_key = sprintf( '%04d', $next_id ); + while ( exists $ids{$next_key} ) { $next_id++; - $next_key = sprintf('%04d', $next_id); + $next_key = sprintf( '%04d', $next_id ); } return $next_id;