version 1.3, 2007/02/07 17:44:56 |
version 1.6, 2008/09/04 22:05:21 |
|
|
#!/usr/bin/perl |
#!/usr/bin/perl |
# $RedRiver: su.cgi,v 1.2 2007/02/07 17:42: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. |
# su.cgi *** a CGI for Trango SU utilities. |
# |
# |
# 2007.02.07 #*#*# andrew fresh <andrew@mad-techies.org> |
# 2007.02.07 #*#*# andrew fresh <andrew@mad-techies.org> |
######################################################################## |
######################################################################## |
# Copyright (C) 2007 by 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. |
# it under the same terms as Perl itself. |
######################################################################## |
######################################################################## |
use strict; |
use strict; |
|
|
|
|
my $host_file = 'su.yaml'; |
my $host_file = 'su.yaml'; |
|
|
my $default_mac = '0001DE'; |
my $default_timeout = 5; |
my $default_suid = 'all'; |
my $default_mac = '0001DE'; |
my $default_cir = 256; |
my $default_suid = 'all'; |
my $default_mir = 9999; |
my $default_cir = 256; |
my $Start_SUID = 3; |
my $default_mir = 9999; |
|
my $Start_SUID = 3; |
|
|
use CGI qw/:standard/; |
use CGI qw/:standard/; |
use File::Basename; |
use YAML qw/ LoadFile Dump /; |
use YAML qw/ LoadFile /; |
|
use Net::Telnet::Trango; |
use Net::Telnet::Trango; |
|
|
my $me = basename($0); |
print header; |
|
|
my $aps = get_aps($host_file); |
my $aps = get_aps($host_file); |
|
|
print header, |
my ( $header, $body ); |
start_html('Trango SU Utilities'), |
my $head; |
h1('Trango SU Utilities'); |
my $show_form = 0; |
|
|
if (param()) { |
if ( param() ) { |
|
|
my $AP = param('AP'); |
my $AP = param('AP'); |
|
|
unless (exists $aps->{$AP}) { |
unless ( exists $aps->{$AP} ) { |
print h3("AP '$AP' does not exist!"); |
print h3("AP '$AP' does not exist!"); |
print end_html; |
print end_html; |
exit; |
exit; |
} |
} |
|
|
my $sumac = param('sumac'); |
my $sumac = param('sumac') || ''; |
|
|
$sumac =~ s/[^0-9A-Fa-f]//g; |
$sumac =~ s/[^0-9A-Fa-f]//g; |
$sumac = uc($sumac); |
$sumac = uc($sumac); |
|
|
my $suid = param('suid'); |
my $suid = param('suid'); |
|
my $test_type = param('test_type'); |
|
|
if (length $sumac == 12) { |
if ( length $sumac == 12 ) { |
add_su($aps->{$AP}, $sumac); |
( $header, $body ) = add_su( $aps->{$AP}, $sumac, $suid ); |
} elsif (length $suid) { |
|
testrflink($aps->{$AP}, $suid); |
|
} else { |
|
print h3("Invalid SUID '$suid' and MAC '$sumac'"); |
|
show_form($aps, $default_mac); |
|
} |
} |
|
elsif ( length $suid ) { |
|
if ( $test_type && $test_type eq 'linktest' ) { |
|
( $header, $body ) = linktest( $aps->{$AP}, $suid ); |
|
} |
|
else { |
|
( $header, $body ) = testrflink( $aps->{$AP}, $suid ); |
|
$head = '<meta http-equiv=refresh content=5>'; |
|
} |
|
} |
|
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 $file = shift; |
|
|
my $conf = LoadFile($file); |
my $conf = LoadFile($file); |
|
|
my %aps; |
my %aps; |
|
|
foreach my $ap (keys %{ $conf }) { |
my @hosts; |
|
foreach my $ap ( keys %{$conf} ) { |
next if $ap eq 'default'; |
next if $ap eq 'default'; |
$aps{ $ap } = $conf->{$ap}; |
my $h = $conf->{$ap}; |
if (ref $conf->{default} eq 'HASH') { |
|
foreach my $k (keys %{ $conf->{default} }) { |
if ( $h->{name} |
$aps{ $ap }{$k} ||= $conf->{default}->{$k}; |
=~ /^(\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} ) { |
|
$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; |
|
} |
} |
} |
} |
} |
|
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}; |
|
} |
|
} |
|
} |
|
|
return \%aps; |
return \%aps; |
|
|
return { |
return { |
'rrlhcwap0000' => { |
'rrlhcwap0000' => { |
name => '192.168.1.1', |
group => 'Trango', |
password => 'trango', |
version => 1, |
|
name => '192.168.1.1', |
|
port => 161, |
|
Read_Community => 'private', |
|
Write_Community => 'private', |
} |
} |
}; |
}; |
|
|
} |
} |
|
|
sub show_form |
sub show_form { |
{ |
my $aps = shift; |
my $aps = shift; |
|
|
|
my %cache = (); |
my %cache = (); |
my @ap_names = sort { |
my @ap_names = sort { |
my @a = $a =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/; |
my @a = $a =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/; |
my @b = $b =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/; |
my @b = $b =~ /(\d+)\.(\d+)\.(\d+)\.(\d+)/; |
|
|
if (@a) { |
if (@a) { |
$cache{$a} ||= pack('C4' => @a); |
$cache{$a} ||= pack( 'C4' => @a ); |
} else { |
} |
|
else { |
$cache{$a} ||= lc($a); |
$cache{$a} ||= lc($a); |
} |
} |
if (@b) { |
if (@b) { |
$cache{$b} ||= pack('C4' => @b); |
$cache{$b} ||= pack( 'C4' => @b ); |
} else { |
} |
|
else { |
$cache{$b} ||= lc($b); |
$cache{$b} ||= lc($b); |
} |
} |
|
|
$cache{$a} cmp $cache{$b}; |
$cache{$a} cmp $cache{$b}; |
} keys %{ $aps }; |
} keys %{$aps}; |
|
|
print p(start_form(-method => 'GET'), |
print p( |
'AP: ', popup_menu(-name=>'AP', -values=>\@ap_names),br, |
start_form( -method => 'GET' ), |
'SUMAC: ', textfield( -name=>'sumac', -default=>$default_mac),br, |
'AP: ', |
'SUID: ', textfield( -name=>'suid', -default=>$default_suid),br, |
popup_menu( -name => 'AP', -values => \@ap_names ), |
submit, |
br, |
end_form); |
'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 ', |
print p( |
'or fill in the SUID to run an rflinktest.'); |
'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; |
return 1; |
} |
} |
|
|
sub login |
sub login { |
{ |
|
my $host = shift; |
my $host = shift; |
my $password = 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->input_log('/tmp/telnet_log'); |
#$t->dump_log('/tmp/telnet_log'); |
#$t->dump_log('/tmp/telnet_log'); |
|
|
unless ($t->open( Host => $host )) { |
unless ( $t->open( Host => $host ) ) { |
print h3("Error connecting!"); |
print h3("Error connecting!"); |
$t->close; |
$t->close; |
return undef; |
return undef; |
} |
} |
|
|
unless ($t->login( $password ) ) { |
unless ( $t->login($password) ) { |
print h3("Couldn't log in: $!"); |
print h3("Couldn't log in: $!"); |
$t->exit; |
$t->exit; |
$t->close; |
$t->close; |
|
|
return $t; |
return $t; |
} |
} |
|
|
sub add_su |
sub add_su { |
{ |
my ( $ap, $sumac, $suid ) = @_; |
my $ap = shift; |
|
my $sumac = shift; |
|
|
|
my $t = login($ap->{name}, $ap->{password}); |
my $t = login( $ap->{'name'}, $ap->{'Telnet_Password'} ); |
|
|
my $cur_sus = $t->sudb_view; |
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 ( !$new_suid ) { |
if ($sumac eq $su->{mac}) { |
$new_suid = next_suid($cur_sus); |
print h3("MAC '$sumac' already in AP '$ap->{name}' " . |
} |
"with SUID '$su->{suid}'"); |
|
|
my $old_su = ''; |
|
foreach my $su ( @{$cur_sus} ) { |
|
if ( $new_suid == $su->{'suid'} ) { |
|
$old_su = $su; |
|
} |
|
|
|
if ( $sumac eq $su->{'mac'} ) { |
$t->exit; |
$t->exit; |
$t->close; |
$t->close; |
return undef; |
return "MAC '$sumac' already in AP '$ap->{'name'}' " |
|
. "with SUID '$su->{'suid'}'"; |
} |
} |
} |
} |
|
|
unless ($t->sudb_add( |
my $cir = $default_cir; |
$new_suid, 'reg', $default_cir, $default_mir, $sumac |
my $mir = $default_mir; |
) ) { |
|
print h3("Error adding SU!"); |
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->exit; |
$t->close; |
$t->close; |
return undef; |
return "Error adding SU!"; |
} |
} |
|
|
my $new_sus = $t->sudb_view; |
my $new_sus = $t->sudb_view; |
my $added = 0; |
my $added = 0; |
foreach my $su (@{ $new_sus }) { |
foreach my $su ( @{$new_sus} ) { |
if ($su->{suid} == $new_suid) { |
if ( $su->{'suid'} == $new_suid ) { |
$added = 1; |
$added = 1; |
last; |
last; |
} |
} |
} |
} |
|
|
unless ($added) { |
unless ($added) { |
print h3("Couldn't add su id: $new_suid"); |
|
$t->exit; |
$t->exit; |
$t->close; |
$t->close; |
return undef; |
return "Couldn't add su id: $new_suid"; |
} |
} |
|
|
unless ($t->save_sudb) { |
unless ( $t->save_sudb ) { |
print h3("Couldn't save sudb"); |
|
$t->exit; |
$t->exit; |
$t->close; |
$t->close; |
return undef; |
return "Couldn't save sudb"; |
} |
} |
|
|
print p( |
|
"Added new SU with ID '$new_suid' " . |
|
"and MAC '$sumac' " . |
|
"to '$ap->{name}'. " . |
|
'<a href="' . $me . '?' . |
|
'AP=' . $ap->{name} . '&' . |
|
'suid=' . $new_suid . |
|
'">Test SU RFLink</a>' |
|
); |
|
|
|
$t->exit; |
$t->exit; |
$t->close; |
$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'}'. " |
|
. '<a href="' |
|
. url(-relative => 1) |
|
. '?' . 'AP=' |
|
. $ap->{'name'} . '&' . 'suid=' |
|
. $new_suid |
|
. '">Test SU RFLink</a>'; |
|
|
|
return $msg; |
} |
} |
|
|
sub testrflink |
sub testrflink { |
{ |
my $ap = shift; |
my $ap = shift; |
|
my $suid = 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) { |
unless ($result) { |
print h3("Error testing SU rflink!"); |
|
$t->exit; |
$t->exit; |
$t->close; |
$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; |
my @table; |
foreach my $su (@{ $result }) { |
foreach my $su ( @{$result} ) { |
next unless ref $su eq 'HASH'; |
next unless ref $su eq 'HASH'; |
next unless exists $su->{suid}; |
next unless exists $su->{'suid'}; |
$su->{suid} =~ s/\D//g; |
$su->{'suid'} =~ s/\D//g; |
next unless $su->{suid}; |
next unless $su->{'suid'}; |
|
|
push @table, td([ @{ $su }{ @keys } ]); |
push @table, td( [ @{$su}{@keys} ] ); |
} |
} |
|
|
print table({-border=>1,-cellspacing=>0,-cellpadding=>1}, |
$t->exit; |
caption($ap->{name} . ': su testrflink ' . $suid), |
$t->close; |
Tr({-align=>'CENTER', -valign=>'TOP'}, |
return $ap->{'name'} . ': su testrflink ' . $suid, |
[ th(\@keys), @table ] |
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->exit; |
$t->close; |
$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 $sudb = shift; |
|
|
my $next_id = $Start_SUID; |
my $next_id = $Start_SUID; |
|
|
my %ids = map { $_->{suid} => 1 } @{ $sudb }; |
my %ids = map { $_->{'suid'} => 1 } @{$sudb}; |
|
|
my $next_key = sprintf('%04d', $next_id); |
my $next_key = sprintf( '%04d', $next_id ); |
while (exists $ids{$next_key}) { |
while ( exists $ids{$next_key} ) { |
$next_id++; |
$next_id++; |
$next_key = sprintf('%04d', $next_id); |
$next_key = sprintf( '%04d', $next_id ); |
} |
} |
|
|
return $next_id; |
return $next_id; |